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

allow custom build directory with command line flag or env var

Browse Source
This commit is contained in:
Luite Stegeman 2012-10-17 14:31:45 +02:00
parent 174ac36719
commit 80a8c51434
5 changed files with 122 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
yesod/Devel.hs
View File

@ -34,6 +34,7 @@ import Control.Monad (forever, unless, void,
import Data.Char (isNumber, isUpper) 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 Data.Maybe (fromMaybe)
import qualified Data.Set as Set import qualified Data.Set as Set
import System.Directory import System.Directory
@ -42,7 +43,7 @@ import System.Exit (ExitCode (..),
exitSuccess) exitSuccess)
import System.FilePath (dropExtension, import System.FilePath (dropExtension,
splitDirectories, splitDirectories,
takeExtension) takeExtension, (</>))
import System.FSNotify import System.FSNotify
import System.IO (hClose, hGetLine, import System.IO (hClose, hGetLine,
hIsEOF, hPutStrLn, hIsEOF, hPutStrLn,
@ -69,16 +70,20 @@ import GhcBuild (buildPackage,
import qualified Config as GHC import qualified Config as GHC
import SrcLoc (Located) import SrcLoc (Located)
lockFile :: FilePath lockFile :: DevelOpts -> FilePath
lockFile = "dist/devel-terminate" lockFile _opts = "yesod-devel/devel-terminate"
writeLock :: IO () writeLock :: DevelOpts -> IO ()
writeLock = do writeLock opts = do
createDirectoryIfMissing True "dist" createDirectoryIfMissing True "yesod-devel"
writeFile lockFile "" writeFile (lockFile opts) ""
createDirectoryIfMissing True "dist" -- for compatibility with old devel.hs
writeFile "dist/devel-terminate" ""
removeLock :: IO () removeLock :: DevelOpts -> IO ()
removeLock = removeFileIfExists lockFile removeLock opts = do
removeFileIfExists (lockFile opts)
removeFileIfExists "dist/devel-terminate" -- for compatibility with old devel.hs
data DevelOpts = DevelOpts data DevelOpts = DevelOpts
{ isCabalDev :: Bool { isCabalDev :: Bool
@ -87,19 +92,23 @@ data DevelOpts = DevelOpts
, eventTimeout :: Int -- negative value for no timeout , eventTimeout :: Int -- negative value for no timeout
, successHook :: Maybe String , successHook :: Maybe String
, failHook :: Maybe String , failHook :: Maybe String
, buildDir :: Maybe String
} deriving (Show, Eq) } deriving (Show, Eq)
getBuildDir :: DevelOpts -> String
getBuildDir opts = fromMaybe "dist" (buildDir opts)
cabalCommand :: DevelOpts -> FilePath cabalCommand :: DevelOpts -> FilePath
cabalCommand opts | isCabalDev opts = "cabal-dev" cabalCommand opts | isCabalDev opts = "cabal-dev"
| otherwise = "cabal" | otherwise = "cabal"
defaultDevelOpts :: DevelOpts defaultDevelOpts :: DevelOpts
defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing
devel :: DevelOpts -> [String] -> IO () devel :: DevelOpts -> [String] -> IO ()
devel opts passThroughArgs = withManager $ \manager -> do devel opts passThroughArgs = withManager $ \manager -> do
checkDevelFile checkDevelFile
writeLock writeLock opts
putStrLn "Yesod devel server. Press ENTER to quit" putStrLn "Yesod devel server. Press ENTER to quit"
_ <- forkIO $ do _ <- forkIO $ do
@ -109,19 +118,20 @@ devel opts passThroughArgs = withManager $ \manager -> do
ldar <- lookupLdAr ldar <- lookupLdAr
(hsSourceDirs, lib) <- checkCabalFile gpd (hsSourceDirs, lib) <- checkCabalFile gpd
removeFileIfExists "dist/setup-config" removeFileIfExists (bd </> "setup-config")
configure cabal gpd opts configure cabal gpd opts
removeFileIfExists "dist/ghcargs.txt" -- these files contain the wrong data after removeFileIfExists "yesod-devel/ghcargs.txt" -- these files contain the wrong data after
removeFileIfExists "dist/arargs.txt" -- the configure step, remove them to force removeFileIfExists "yesod-devel/arargs.txt" -- the configure step, remove them to force
removeFileIfExists "dist/ldargs.txt" -- a cabal build first removeFileIfExists "yesod-devel/ldargs.txt" -- a cabal build first
filesModified <- newEmptyMVar filesModified <- newEmptyMVar
watchTree manager "." (const True) (\_ -> void (tryPutMVar filesModified ())) watchTree manager "." (const True) (\_ -> void (tryPutMVar filesModified ()))
mainLoop hsSourceDirs filesModified cabal gpd lib ldar mainLoop hsSourceDirs filesModified cabal gpd lib ldar
_ <- getLine _ <- getLine
writeLock writeLock opts
exitSuccess exitSuccess
where where
bd = getBuildDir opts
mainLoop :: [FilePath] mainLoop :: [FilePath]
-> MVar () -> MVar ()
-> FilePath -> FilePath
@ -144,14 +154,14 @@ devel opts passThroughArgs = withManager $ \manager -> do
runBuildHook $ failHook opts runBuildHook $ failHook opts
else do else do
runBuildHook $ successHook opts runBuildHook $ successHook opts
removeLock removeLock opts
putStrLn $ if verbose opts then "Starting development server: runghc " ++ L.unwords devArgs putStrLn $ if verbose opts then "Starting development server: runghc " ++ L.unwords devArgs
else "Starting development server..." else "Starting development server..."
(_,_,_,ph) <- createProcess $ proc "runghc" devArgs (_,_,_,ph) <- createProcess $ proc "runghc" devArgs
watchTid <- forkIO . try_ $ do watchTid <- forkIO . try_ $ do
watchForChanges filesModified hsSourceDirs [cabal] list (eventTimeout opts) watchForChanges filesModified hsSourceDirs [cabal] list (eventTimeout opts)
putStrLn "Stopping development server..." putStrLn "Stopping development server..."
writeLock writeLock opts
threadDelay 1000000 threadDelay 1000000
putStrLn "Terminating development server..." putStrLn "Terminating development server..."
terminateProcess ph terminateProcess ph
@ -180,7 +190,7 @@ configure _cabalFile gpd opts
| isCabalDev opts = rawSystem (cabalCommand opts) args >> return () | isCabalDev opts = rawSystem (cabalCommand opts) args >> return ()
| otherwise = do | otherwise = do
lbi <- D.configure (gpd, hookedBuildInfo) configFlags lbi <- D.configure (gpd, hookedBuildInfo) configFlags
D.writePersistBuildConfig "dist" lbi -- fixme we could keep this in memory instead of file D.writePersistBuildConfig (getBuildDir opts) lbi -- fixme we could keep this in memory instead of file
where where
hookedBuildInfo = (Nothing, []) hookedBuildInfo = (Nothing, [])
configFlags | forceCabal opts = config configFlags | forceCabal opts = config
@ -234,9 +244,9 @@ mkRebuild gpd ghcVer cabalFile opts (ldPath, arPath)
| forceCabal opts = return (rebuildCabal gpd opts) | forceCabal opts = return (rebuildCabal gpd opts)
| otherwise = do | otherwise = do
return $ do return $ do
n1 <- cabalFile `isNewerThan` "dist/ghcargs.txt" n1 <- cabalFile `isNewerThan` "yesod-devel/ghcargs.txt"
n2 <- cabalFile `isNewerThan` "dist/arargs.txt" n2 <- cabalFile `isNewerThan` "yesod-devel/arargs.txt"
n3 <- cabalFile `isNewerThan` "dist/ldargs.txt" n3 <- cabalFile `isNewerThan` "yesod-devel/ldargs.txt"
if n1 || n2 || n3 if n1 || n2 || n3
then rebuildCabal gpd opts then rebuildCabal gpd opts
else do else do
@ -260,7 +270,7 @@ rebuildCabal _gpd opts
_ -> False _ -> False
| otherwise = do | otherwise = do
putStrLn $ "Rebuilding application... (using Cabal library)" putStrLn $ "Rebuilding application... (using Cabal library)"
lbi <- getPersistBuildConfig "dist" -- fixme we could cache this from the configure step lbi <- getPersistBuildConfig opts -- 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 }
tryBool $ D.build (D.localPkgDescr lbi) lbi buildFlags [] tryBool $ D.build (D.localPkgDescr lbi) lbi buildFlags []
@ -344,7 +354,7 @@ ghcVersion = fmap getNumber $ readProcess "runghc" ["--numeric-version", "0"] []
ghcPackageArgs :: DevelOpts -> String -> D.PackageDescription -> D.Library -> IO [String] ghcPackageArgs :: DevelOpts -> String -> D.PackageDescription -> D.Library -> IO [String]
ghcPackageArgs opts ghcVer cabal lib = do ghcPackageArgs opts ghcVer cabal lib = do
lbi <- getPersistBuildConfig "dist" lbi <- getPersistBuildConfig opts
cbi <- fromMaybeErr errCbi (D.libraryConfig lbi) cbi <- fromMaybeErr errCbi (D.libraryConfig lbi)
if isCabalDev opts if isCabalDev opts
then return ("-hide-all-packages" : "-no-user-package-conf" : inplaceConf : selfPkgArg lbi : cabalDevConf : depArgs lbi cbi) then return ("-hide-all-packages" : "-no-user-package-conf" : inplaceConf : selfPkgArg lbi : cabalDevConf : depArgs lbi cbi)
@ -353,26 +363,26 @@ ghcPackageArgs opts ghcVer cabal lib = do
selfPkgArg lbi = pkgArg . D.inplacePackageId . D.package . D.localPkgDescr $ lbi selfPkgArg lbi = pkgArg . D.inplacePackageId . D.package . D.localPkgDescr $ lbi
pkgArg (D.InstalledPackageId pkgId) = "-package-id" ++ pkgId pkgArg (D.InstalledPackageId pkgId) = "-package-id" ++ pkgId
depArgs lbi cbi = map pkgArg (deps lbi cbi) depArgs lbi cbi = map pkgArg (deps lbi cbi)
deps lbi cbi = let pkgInfo = D.inplaceInstalledPackageInfo "." "dist" cabal lib lbi cbi deps lbi cbi = let pkgInfo = D.inplaceInstalledPackageInfo "." (getBuildDir opts) cabal lib lbi cbi
in IPI.depends $ pkgInfo in IPI.depends $ pkgInfo
errCbi = "No library ComponentBuildInfo" errCbi = "No library ComponentBuildInfo"
cabalDevConf = "-package-confcabal-dev/packages-" ++ ghcVer ++ ".conf" cabalDevConf = "-package-confcabal-dev/packages-" ++ ghcVer ++ ".conf"
inplaceConf = "-package-confdist/package.conf.inplace" inplaceConf = "-package-conf" ++ (getBuildDir opts</>"package.conf.inplace")
getPersistBuildConfig :: FilePath -> IO D.LocalBuildInfo getPersistBuildConfig :: DevelOpts -> IO D.LocalBuildInfo
getPersistBuildConfig path = fromRightErr errLbi =<< getPersistConfigLenient path -- D.maybeGetPersistBuildConfig path getPersistBuildConfig opts = fromRightErr errLbi =<< getPersistConfigLenient opts -- D.maybeGetPersistBuildConfig path
where where
errLbi = "Could not read BuildInfo file: " ++ D.localBuildInfoFile "dist" ++ errLbi = "Could not read BuildInfo file: " ++ D.localBuildInfoFile (getBuildDir opts) ++
"\nMake sure that cabal-install has been compiled with the same GHC version as yesod." ++ "\nMake sure that cabal-install has been compiled with the same GHC version as yesod." ++
"\nand that the Cabal library used by GHC is the same version" "\nand that the Cabal library used by GHC is the same version"
-- there can be slight differences in the cabal version, ignore those when loading the file as long as we can parse it -- there can be slight differences in the cabal version, ignore those when loading the file as long as we can parse it
getPersistConfigLenient :: FilePath -> IO (Either String D.LocalBuildInfo) getPersistConfigLenient :: DevelOpts -> IO (Either String D.LocalBuildInfo)
getPersistConfigLenient fp = do getPersistConfigLenient opts = do
let file = fp ++ "/setup-config" let file = D.localBuildInfoFile (getBuildDir opts)
exists <- doesFileExist file exists <- doesFileExist file
if not exists if not exists
then return (Left $ "file does not exist: " ++ fp) then return (Left $ "file does not exist: " ++ file)
else do else do
xs <- readFile file xs <- readFile file
return $ case lines xs of return $ case lines xs of

49
yesod/GhcBuild.hs
View File

@ -8,7 +8,9 @@
difficult to compare the code to the original, just ignore unused difficult to compare the code to the original, just ignore unused
binds and imports. binds and imports.
-} -}
{-# LANGUAGE CPP, ScopedTypeVariables, PatternGuards #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- {-
build package with the GHC API build package with the GHC API
@ -17,28 +19,29 @@
module GhcBuild (getBuildFlags, buildPackage) where module GhcBuild (getBuildFlags, buildPackage) where
import qualified Control.Exception as Ex import qualified Control.Exception as Ex
import System.Process (rawSystem) import Control.Monad (when)
import Control.Monad (when) import Data.IORef
import Data.IORef import System.Process (rawSystem)
import qualified GHC import CmdLineParser
import DriverPhases ( Phase(..), isSourceFilename, anyHsc, startPhase, isHaskellSrcFilename ) import Data.Char (toLower)
import Util (looksLikeModuleName, consIORef) import Data.List (isPrefixOf, partition)
import DriverPipeline (oneShot, compileFile, link, linkBinary ) import Data.Maybe (fromMaybe)
import StaticFlags (v_Ld_inputs) import DriverPhases (Phase (..), anyHsc, isHaskellSrcFilename,
import HscTypes ( emptyHomePackageTable, HscEnv(..) ) isSourceFilename, startPhase)
import System.FilePath (normalise) import DriverPipeline (compileFile, link, linkBinary, oneShot)
import GHC.Paths (libdir) import DynFlags (DynFlags, compilerInfo)
import MonadUtils ( liftIO )
import CmdLineParser
import SrcLoc (Located, mkGeneralLocated)
import DynFlags (DynFlags, compilerInfo)
import Data.Char (toLower)
import Data.Maybe (fromMaybe)
import Panic (panic, ghcError)
import Data.List (partition, isPrefixOf)
import qualified DynFlags import qualified DynFlags
import qualified GHC
import GHC.Paths (libdir)
import HscTypes (HscEnv (..), emptyHomePackageTable)
import MonadUtils (liftIO)
import Panic (ghcError, panic)
import SrcLoc (Located, mkGeneralLocated)
import StaticFlags (v_Ld_inputs)
import qualified StaticFlags import qualified StaticFlags
import System.FilePath (normalise, (</>))
import Util (consIORef, looksLikeModuleName)
{- {-
This contains a huge hack: This contains a huge hack:
@ -49,7 +52,7 @@ import qualified StaticFlags
-} -}
getBuildFlags :: IO [Located String] getBuildFlags :: IO [Located String]
getBuildFlags = do getBuildFlags = do
argv0 <- fmap read $ readFile "dist/ghcargs.txt" -- generated by yesod-ghc-wrapper argv0 <- fmap read $ readFile "yesod-devel/ghcargs.txt" -- generated by yesod-ghc-wrapper
let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0 let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0
mbMinusB | null minusB_args = Nothing mbMinusB | null minusB_args = Nothing
| otherwise = Just (drop 2 (last minusB_args)) | otherwise = Just (drop 2 (last minusB_args))
@ -107,9 +110,9 @@ buildPackage' argv2 ld ar = do
linkPkg :: FilePath -> FilePath -> IO () linkPkg :: FilePath -> FilePath -> IO ()
linkPkg ld ar = do linkPkg ld ar = do
arargs <- fmap read $ readFile "dist/arargs.txt" arargs <- fmap read $ readFile "yesod-devel/arargs.txt"
rawSystem ar arargs rawSystem ar arargs
ldargs <- fmap read $ readFile "dist/ldargs.txt" ldargs <- fmap read $ readFile "yesod-devel/ldargs.txt"
rawSystem ld ldargs rawSystem ld ldargs
return () return ()

39
yesod/ghcwrapper.hs
View File

@ -5,37 +5,40 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Main where module Main where
import Control.Monad (when) import Control.Monad (when)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Distribution.Compiler (CompilerFlavor(..)) import Distribution.Compiler (CompilerFlavor (..))
import Distribution.Simple.Configure (configCompiler) import Distribution.Simple.Configure (configCompiler)
import Distribution.Simple.Program (defaultProgramConfiguration, programPath, ghcProgram, import Distribution.Simple.Program (arProgram,
ldProgram, arProgram) defaultProgramConfiguration,
import Distribution.Simple.Program.Db (lookupProgram, configureAllKnownPrograms) ghcProgram, ldProgram,
import Distribution.Simple.Program.Types (Program(..)) programPath)
import Distribution.Verbosity (silent) import Distribution.Simple.Program.Db (configureAllKnownPrograms,
lookupProgram)
import Distribution.Simple.Program.Types (Program (..))
import Distribution.Verbosity (silent)
import System.Directory (doesDirectoryExist) import System.Directory (doesDirectoryExist)
import System.Environment (getArgs) import System.Environment (getArgs)
import System.Exit (exitWith, ExitCode(..)) import System.Exit (ExitCode (..), exitWith)
import System.IO (hPutStrLn, stderr) import System.IO (hPutStrLn, stderr)
import System.Process (rawSystem, readProcess) import System.Process (rawSystem, readProcess)
#ifdef LDCMD #ifdef LDCMD
cmd :: Program cmd :: Program
cmd = ldProgram cmd = ldProgram
outFile = "dist/ldargs.txt" outFile = "yesod-devel/ldargs.txt"
#else #else
#ifdef ARCMD #ifdef ARCMD
cmd :: Program cmd :: Program
cmd = arProgram cmd = arProgram
outFile ="dist/arargs.txt" outFile ="yesod-devel/arargs.txt"
#else #else
cmd :: Program cmd :: Program
cmd = ghcProgram cmd = ghcProgram
outFile = "dist/ghcargs.txt" outFile = "yesod-devel/ghcargs.txt"
#endif #endif
#endif #endif
@ -51,7 +54,7 @@ runProgram pgm args = do
main = do main = do
args <- getArgs args <- getArgs
e <- doesDirectoryExist "dist" e <- doesDirectoryExist "yesod-devel"
when e $ writeFile outFile (show args ++ "\n") when e $ writeFile outFile (show args ++ "\n")
ex <- runProgram cmd args ex <- runProgram cmd args
exitWith ex exitWith ex

48
yesod/main.hs
View File

@ -4,6 +4,7 @@ import Control.Monad (unless)
import Data.Monoid import Data.Monoid
import Data.Version (showVersion) import Data.Version (showVersion)
import Options.Applicative import Options.Applicative
import System.Environment (getEnvironment)
import System.Exit (ExitCode (ExitSuccess), exitWith) import System.Exit (ExitCode (ExitSuccess), exitWith)
import System.Process (rawSystem) import System.Process (rawSystem)
@ -53,6 +54,7 @@ data Command = Init
, _develSuccessHook :: Maybe String , _develSuccessHook :: Maybe String
, _develFailHook :: Maybe String , _develFailHook :: Maybe String
, _develRescan :: Int , _develRescan :: Int
, _develBuildDir :: Maybe String
, _develExtraArgs :: [String] , _develExtraArgs :: [String]
} }
| Test | Test
@ -61,16 +63,19 @@ data Command = Init
| Version | Version
deriving (Show, Eq) deriving (Show, Eq)
type Environment = [(String, String)]
main :: IO () main :: IO ()
main = do main = do
o <- execParser optParser' env <- getEnvironment
o <- execParser (optParser' env)
let cabal xs = rawSystem' (cabalCommand o) xs let cabal xs = rawSystem' (cabalCommand o) xs
case optCommand o of case optCommand o of
Init -> scaffold Init -> scaffold
Configure -> cabal ["configure"] Configure -> cabal ["configure"]
Build es -> touch' >> cabal ("build":es) Build es -> touch' >> cabal ("build":es)
Touch -> touch' Touch -> touch'
Devel da s f r es -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f) es Devel da s f r b es -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b) es
Keter noRebuild -> keter (cabalCommand o) noRebuild Keter noRebuild -> keter (cabalCommand o) noRebuild
Version -> do putStrLn ("yesod-core version:" ++ yesodVersion) Version -> do putStrLn ("yesod-core version:" ++ yesodVersion)
putStrLn ("yesod version:" ++ showVersion Paths_yesod.version) putStrLn ("yesod version:" ++ showVersion Paths_yesod.version)
@ -80,11 +85,11 @@ main = do
cabal ["build"] cabal ["build"]
cabal ["test"] cabal ["test"]
optParser' :: ParserInfo Options optParser' :: Environment -> ParserInfo Options
optParser' = info (helper <*> optParser) ( fullDesc <> header "Yesod Web Framework command line utility" ) optParser' env = info (helper <*> optParser env) ( fullDesc <> header "Yesod Web Framework command line utility" )
optParser :: Parser Options optParser :: Environment -> Parser Options
optParser = Options optParser env = Options
<$> flag Cabal CabalDev ( long "dev" <> short 'd' <> help "use cabal-dev" ) <$> flag Cabal CabalDev ( long "dev" <> short 'd' <> help "use cabal-dev" )
<*> switch ( long "verbose" <> short 'v' <> help "More verbose output" ) <*> switch ( long "verbose" <> short 'v' <> help "More verbose output" )
<*> subparser ( command "init" (info (pure Init) <*> subparser ( command "init" (info (pure Init)
@ -95,7 +100,7 @@ optParser = Options
(progDesc $ "Build project (performs TH dependency analysis)" ++ windowsWarning)) (progDesc $ "Build project (performs TH dependency analysis)" ++ windowsWarning))
<> command "touch" (info (pure Touch) <> command "touch" (info (pure Touch)
(progDesc $ "Touch any files with altered TH dependencies but do not build" ++ windowsWarning)) (progDesc $ "Touch any files with altered TH dependencies but do not build" ++ windowsWarning))
<> command "devel" (info develOptions <> command "devel" (info (develOptions env)
(progDesc "Run project with the devel server")) (progDesc "Run project with the devel server"))
<> command "test" (info (pure Test) <> command "test" (info (pure Test)
(progDesc "Build and run the integration tests")) (progDesc "Build and run the integration tests"))
@ -110,16 +115,19 @@ optParser = Options
keterOptions :: Parser Command keterOptions :: Parser Command
keterOptions = Keter <$> switch ( long "nobuild" <> short 'n' <> help "Skip rebuilding" ) keterOptions = Keter <$> switch ( long "nobuild" <> short 'n' <> help "Skip rebuilding" )
develOptions :: Parser Command develOptions :: Environment -> Parser Command
develOptions = Devel <$> switch ( long "disable-api" <> short 'd' develOptions env = Devel <$> switch ( long "disable-api" <> short 'd'
<> help "Disable fast GHC API rebuilding") <> help "Disable fast GHC API rebuilding")
<*> optStr ( long "success-hook" <> short 's' <> metavar "COMMAND" <*> optStr ( long "success-hook" <> short 's' <> metavar "COMMAND"
<> help "Run COMMAND after rebuild succeeds") <> help "Run COMMAND after rebuild succeeds")
<*> optStr ( long "failure-hook" <> short 'f' <> metavar "COMMAND" <*> optStr ( long "failure-hook" <> short 'f' <> metavar "COMMAND"
<> help "Run COMMAND when rebuild fails") <> help "Run COMMAND when rebuild fails")
<*> option ( long "event-timeout" <> short 't' <> value (-1) <> metavar "N" <*> option ( long "event-timeout" <> short 't' <> value (-1) <> metavar "N"
<> help "Force rescan of files every N seconds" ) <> help "Force rescan of files every N seconds" )
<*> extraCabalArgs
<*> optStrEnv env "CABAL_BUILDDIR" ( long "builddir" <> short 'b'
<> help "Set custom cabal build directory, default `dist' or the CABAL_BUILDDIR environment variable")
<*> extraCabalArgs
extraCabalArgs :: Parser [String] extraCabalArgs :: Parser [String]
extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metavar "ARG" extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metavar "ARG"
@ -130,6 +138,12 @@ extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metava
optStr :: Mod OptionFields (Maybe String) -> Parser (Maybe String) optStr :: Mod OptionFields (Maybe String) -> Parser (Maybe String)
optStr m = nullOption $ value Nothing <> reader (Just . str) <> m optStr m = nullOption $ value Nothing <> reader (Just . str) <> m
optStrEnv :: Environment
-> String
-> Mod OptionFields (Maybe String)
-> Parser (Maybe String)
optStrEnv env v m = nullOption $ value (lookup v env) <> reader (Just . str) <> m
-- | Like @rawSystem@, but exits if it receives a non-success result. -- | Like @rawSystem@, but exits if it receives a non-success result.
rawSystem' :: String -> [String] -> IO () rawSystem' :: String -> [String] -> IO ()
rawSystem' x y = do rawSystem' x y = do

2
yesod/scaffold/devel.hs.cg
View File

@ -19,7 +19,7 @@ main = do
loop :: IO () loop :: IO ()
loop = do loop = do
threadDelay 100000 threadDelay 100000
e <- doesFileExist "dist/devel-terminate" e <- doesFileExist "yesod-devel/devel-terminate"
if e then terminateDevel else loop if e then terminateDevel else loop
terminateDevel :: IO () terminateDevel :: IO ()