haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

small fixes and cleanups

Browse Source
This commit is contained in:
Luite Stegeman 2012-10-15 17:10:58 +02:00
parent 75b8dc4457
commit 77383f8002
1 changed files with 60 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
yesod/Devel.hs
View File

@ -1,56 +1,71 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
module Devel module Devel
( devel ( devel
, DevelOpts(..) , DevelOpts(..)
) where ) where
import qualified Distribution.Simple.Utils as D import qualified Distribution.Compiler as D
import qualified Distribution.Verbosity as D import qualified Distribution.ModuleName as D
import qualified Distribution.PackageDescription as D
import qualified Distribution.PackageDescription.Parse as D import qualified Distribution.PackageDescription.Parse as D
import qualified Distribution.PackageDescription as D import qualified Distribution.Simple.Build as D
import qualified Distribution.ModuleName as D import qualified Distribution.Simple.Configure as D
import qualified Distribution.Simple.Setup as DSS import qualified Distribution.Simple.Program as D
import qualified Distribution.Simple.Configure as D import qualified Distribution.Simple.Register as D
import qualified Distribution.Simple.Program as D import qualified Distribution.Simple.Setup as DSS
import qualified Distribution.Simple.Build as D import qualified Distribution.Simple.Utils as D
import qualified Distribution.Simple.Register as D import qualified Distribution.Verbosity as D
import qualified Distribution.Compiler as D
-- import qualified Distribution.InstalledPackageInfo as D -- import qualified Distribution.InstalledPackageInfo as D
import qualified Distribution.InstalledPackageInfo as IPI import qualified Distribution.InstalledPackageInfo as IPI
import qualified Distribution.Simple.LocalBuildInfo as D import qualified Distribution.Package as D
import qualified Distribution.Package as D import qualified Distribution.Simple.LocalBuildInfo as D
import qualified Distribution.Verbosity as D import qualified Distribution.Verbosity as D
import Control.Applicative ((<$>), (<*>)) import Control.Applicative ((<$>), (<*>))
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import qualified Control.Exception as Ex import qualified Control.Exception as Ex
import Control.Monad (forever, when, unless) import Control.Monad (forever, unless, when)
import Data.Char (isUpper, isNumber) import Data.Char (isNumber, isUpper)
import qualified Data.List as L import qualified Data.List as L
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe) import qualified Data.Set as Set
import System.Directory import System.Directory
import System.Exit (exitFailure, exitSuccess, ExitCode (..)) import System.Exit (ExitCode (..),
import System.FilePath (splitDirectories, dropExtension, takeExtension) exitFailure,
import System.Posix.Types (EpochTime) exitSuccess)
import System.PosixCompat.Files (modificationTime, getFileStatus) import System.FilePath (dropExtension,
import System.Process (createProcess, proc, terminateProcess, readProcess, ProcessHandle, splitDirectories,
getProcessExitCode,waitForProcess, rawSystem, takeExtension)
runInteractiveProcess, system) import System.IO (hClose, hGetLine,
import System.IO (hClose, hIsEOF, hGetLine, stdout, stderr, hPutStrLn) hIsEOF, hPutStrLn,
import System.IO.Error (isDoesNotExistError) stderr, stdout)
import System.IO.Error (isDoesNotExistError)
import System.Posix.Types (EpochTime)
import System.PosixCompat.Files (getFileStatus,
modificationTime)
import System.Process (ProcessHandle,
createProcess,
getProcessExitCode,
proc, rawSystem,
readProcess,
runInteractiveProcess,
system,
terminateProcess,
waitForProcess)
import Build (recompDeps, getDeps, isNewerThan) import Build (getDeps, isNewerThan,
import GhcBuild (getBuildFlags, buildPackage) recompDeps)
import GhcBuild (buildPackage,
getBuildFlags)
import qualified Config as GHC import qualified Config as GHC
import SrcLoc (Located) import SrcLoc (Located)
lockFile :: FilePath lockFile :: FilePath
lockFile = "dist/devel-terminate" lockFile = "dist/devel-terminate"
@ -112,9 +127,9 @@ devel opts passThroughArgs = do
pkgArgs <- ghcPackageArgs opts ghcVer (D.packageDescription gpd) lib pkgArgs <- ghcPackageArgs opts ghcVer (D.packageDescription gpd) lib
let devArgs = pkgArgs ++ ["devel.hs"] ++ passThroughArgs let devArgs = pkgArgs ++ ["devel.hs"] ++ passThroughArgs
if not success if not success
then do then do
putStrLn "Build failure, pausing..." putStrLn "Build failure, pausing..."
runBuildHook $ failHook opts runBuildHook $ failHook opts
else do else do
runBuildHook $ successHook opts runBuildHook $ successHook opts
removeLock removeLock
@ -134,7 +149,7 @@ devel opts passThroughArgs = do
watchForChanges hsSourceDirs [cabal] list watchForChanges hsSourceDirs [cabal] list
runBuildHook :: Maybe String -> IO () runBuildHook :: Maybe String -> IO ()
runBuildHook (Just s) = do runBuildHook (Just s) = do
ret <- system s ret <- system s
case ret of case ret of
ExitFailure f -> putStrLn $ "Error executing hook: " ++ s ExitFailure f -> putStrLn $ "Error executing hook: " ++ s
@ -203,7 +218,7 @@ removeFileIfExists file = removeFile file `Ex.catch` handler
mkRebuild :: D.GenericPackageDescription -> String -> FilePath -> DevelOpts -> (FilePath, FilePath) -> IO (IO Bool) mkRebuild :: D.GenericPackageDescription -> String -> FilePath -> DevelOpts -> (FilePath, FilePath) -> IO (IO Bool)
mkRebuild gpd ghcVer cabalFile opts (ldPath, arPath) mkRebuild gpd ghcVer cabalFile opts (ldPath, arPath)
| GHC.cProjectVersion /= ghcVer = failWith "yesod has been compiled with a different GHC version, please reinstall" | GHC.cProjectVersion /= ghcVer = failWith "Yesod has been compiled with a different GHC version, please reinstall"
| forceCabal opts = return (rebuildCabal gpd opts) | forceCabal opts = return (rebuildCabal gpd opts)
| otherwise = do | otherwise = do
return $ do return $ do
@ -219,20 +234,20 @@ mkRebuild gpd ghcVer cabalFile opts (ldPath, arPath)
rebuildGhc :: [Located String] -> FilePath -> FilePath -> IO Bool rebuildGhc :: [Located String] -> FilePath -> FilePath -> IO Bool
rebuildGhc bf ld ar = do rebuildGhc bf ld ar = do
putStrLn "Rebuilding application... (GHC API)" putStrLn "Rebuilding application... (using GHC API)"
buildPackage bf ld ar buildPackage bf ld ar
rebuildCabal :: D.GenericPackageDescription -> DevelOpts -> IO Bool rebuildCabal :: D.GenericPackageDescription -> DevelOpts -> IO Bool
rebuildCabal gpd opts rebuildCabal gpd opts
| isCabalDev opts = do | isCabalDev opts = do
let cmd = cabalCommand opts let cmd = cabalCommand opts
putStrLn $ "Rebuilding application... (" ++ cmd ++ ")" putStrLn $ "Rebuilding application... (using " ++ cmd ++ ")"
exit <- (if verbose opts then rawSystem else rawSystemFilter) cmd ["build"] exit <- (if verbose opts then rawSystem else rawSystemFilter) cmd ["build"]
return $ case exit of return $ case exit of
ExitSuccess -> True ExitSuccess -> True
_ -> False _ -> False
| otherwise = do | otherwise = do
putStrLn $ "Rebuilding application... (Cabal library)" putStrLn $ "Rebuilding application... (using Cabal library)"
lbi <- getPersistBuildConfig "dist" -- fixme we could cache this from the configure step lbi <- getPersistBuildConfig "dist" -- fixme we could cache this from the configure step
let buildFlags | verbose opts = DSS.defaultBuildFlags let buildFlags | verbose opts = DSS.defaultBuildFlags
| otherwise = DSS.defaultBuildFlags { DSS.buildVerbosity = DSS.Flag D.silent } | otherwise = DSS.defaultBuildFlags { DSS.buildVerbosity = DSS.Flag D.silent }
@ -351,7 +366,7 @@ lookupDevelLib gpd ct | found = Just (D.condTreeData ct)
-- location of `ld' and `ar' programs -- location of `ld' and `ar' programs
lookupLdAr :: IO (FilePath, FilePath) lookupLdAr :: IO (FilePath, FilePath)
lookupLdAr = do lookupLdAr = do
mla <- lookupLdAr' mla <- lookupLdAr'
case mla of case mla of
Nothing -> failWith "Cannot determine location of `ar' or `ld' program" Nothing -> failWith "Cannot determine location of `ar' or `ld' program"