diff --git a/Devel.hs b/Devel.hs --- a/Devel.hs +++ b/Devel.hs @@ -5,6 +5,7 @@ module Devel ( devel , DevelOpts(..) + , DevelTermOpt(..) , defaultDevelOpts ) where @@ -99,6 +100,8 @@ removeFileIfExists (lockFile opts) removeFileIfExists "dist/devel-terminate" -- for compatibility with old devel.hs +data DevelTermOpt = TerminateOnEnter | TerminateOnlyInterrupt + deriving (Show, Eq) data DevelOpts = DevelOpts { isCabalDev :: Bool , forceCabal :: Bool @@ -110,13 +113,14 @@ , develPort :: Int , proxyTimeout :: Int , useReverseProxy :: Bool + , terminateWith :: DevelTermOpt } deriving (Show, Eq) getBuildDir :: DevelOpts -> String getBuildDir opts = fromMaybe "dist" (buildDir opts) defaultDevelOpts :: DevelOpts -defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10 True +defaultDevelOpts = DevelOpts False False False (-1) Nothing Nothing Nothing 3000 10 True TerminateOnEnter cabalProgram :: DevelOpts -> FilePath cabalProgram opts | isCabalDev opts = "cabal-dev" @@ -194,12 +198,19 @@ checkDevelFile writeLock opts - putStrLn "Yesod devel server. Press ENTER to quit" - _ <- forkIO $ do + let (terminator, after) = case terminateWith opts of + TerminateOnEnter -> + ("Press ENTER", void getLine) + TerminateOnlyInterrupt -> -- run for one year + ("Interrupt", threadDelay $ 1000 * 1000 * 60 * 60 * 24 * 365) + + + putStrLn $ "Yesod devel server. " ++ terminator ++ " to quit" + void $ forkIO $ do filesModified <- newEmptyMVar watchTree manager "." (const True) (\_ -> void (tryPutMVar filesModified ())) evalStateT (mainOuterLoop iappPort filesModified) Map.empty - _ <- getLine + after writeLock opts exitSuccess where diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RecordWildCards #-} import Control.Monad (unless) import Data.Monoid @@ -9,7 +9,7 @@ import System.Process (rawSystem) import AddHandler (addHandler) -import Devel (DevelOpts (..), devel) +import Devel (DevelOpts (..), devel, DevelTermOpt(..)) import Keter (keter) import Options (injectDefaults) import qualified Paths_yesod_bin @@ -60,6 +60,7 @@ , _develPort :: Int , _proxyTimeout :: Int , _noReverseProxy :: Bool + , _interruptOnly :: Bool } | Test | AddHandler @@ -75,36 +76,45 @@ main :: IO () main = do - o <- execParser =<< injectDefaults "yesod" [ ("yesod.devel.extracabalarg" , \o args -> o { optCommand = - case optCommand o of - d@Devel{} -> d { develExtraArgs = args } - c -> c - }) - , ("yesod.devel.ignore" , \o args -> o { optCommand = - case optCommand o of - d@Devel{} -> d { develIgnore = args } - c -> c - }) - , ("yesod.build.extracabalarg" , \o args -> o { optCommand = - case optCommand o of - b@Build{} -> b { buildExtraArgs = args } - c -> c - }) - ] optParser' - let cabal xs = rawSystem' (cabalCommand o) xs + o <- execParser =<< injectDefaults "yesod" + [ ("yesod.devel.extracabalarg" , \o args -> o { optCommand = + case optCommand o of + d@Devel{} -> d { develExtraArgs = args } + c -> c + }) + , ("yesod.devel.ignore" , \o args -> o { optCommand = + case optCommand o of + d@Devel{} -> d { develIgnore = args } + c -> c + }) + , ("yesod.build.extracabalarg" , \o args -> o { optCommand = + case optCommand o of + b@Build{} -> b { buildExtraArgs = args } + c -> c + }) + ] optParser' + let cabal = rawSystem' (cabalCommand o) case optCommand o of - Init bare -> scaffold bare - Configure -> cabal ["configure"] - Build es -> touch' >> cabal ("build":es) - Touch -> touch' - Devel da s f r b _ig es p t nrp -> devel (DevelOpts (optCabalPgm o == CabalDev) da (optVerbose o) r s f b p t (not nrp)) es - Keter noRebuild -> keter (cabalCommand o) noRebuild - Version -> do putStrLn ("yesod-bin version: " ++ showVersion Paths_yesod_bin.version) - AddHandler -> addHandler - Test -> do touch' - cabal ["configure", "--enable-tests", "-flibrary-only"] - cabal ["build"] - cabal ["test"] + Init bare -> scaffold bare + Configure -> cabal ["configure"] + Build es -> touch' >> cabal ("build":es) + Touch -> touch' + Keter noRebuild -> keter (cabalCommand o) noRebuild + Version -> putStrLn ("yesod-bin version: " ++ showVersion Paths_yesod_bin.version) + AddHandler -> addHandler + Test -> cabalTest cabal + Devel{..} -> devel (DevelOpts + (optCabalPgm o == CabalDev) _develDisableApi (optVerbose o) + _develRescan _develSuccessHook _develFailHook + _develBuildDir _develPort _proxyTimeout + (not _noReverseProxy) + (if _interruptOnly then TerminateOnlyInterrupt else TerminateOnEnter ) + ) develExtraArgs + where + cabalTest cabal = do touch' + _ <- cabal ["configure", "--enable-tests", "-flibrary-only"] + _ <- cabal ["build"] + cabal ["test"] optParser' :: ParserInfo Options optParser' = info (helper <*> optParser) ( fullDesc <> header "Yesod Web Framework command line utility" ) @@ -114,7 +124,7 @@ <$> flag Cabal CabalDev ( long "dev" <> short 'd' <> help "use cabal-dev" ) <*> switch ( long "verbose" <> short 'v' <> help "More verbose output" ) <*> subparser ( command "init" - (info (Init <$> (switch (long "bare" <> help "Create files in current folder"))) + (info (Init <$> switch (long "bare" <> help "Create files in current folder")) (progDesc "Scaffold a new site")) <> command "configure" (info (pure Configure) (progDesc "Configure a project for building")) @@ -158,6 +168,8 @@ <> help "Devel server timeout before returning 'not ready' message (in seconds, 0 for none)" ) <*> switch ( long "disable-reverse-proxy" <> short 'n' <> help "Disable reverse proxy" ) + <*> switch ( long "interrupt-only" <> short 'c' + <> help "Disable exiting when enter is pressed") extraCabalArgs :: Parser [String] extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metavar "ARG" diff --git a/yesod-bin.cabal b/yesod-bin.cabal --- a/yesod-bin.cabal +++ b/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.2.5.1 +version: 1.2.5.2 license: MIT license-file: LICENSE author: Michael Snoyman @@ -34,6 +34,7 @@ build-depends: base >= 4 && < 5 , Cabal + executable yesod-ar-wrapper main-is: ghcwrapper.hs cpp-options: -DARCMD @@ -44,6 +45,7 @@ executable yesod if os(windows) cpp-options: -DWINDOWS + build-depends: base >= 4.3 && < 5 , ghc >= 7.0.3 && < 7.8 , ghc-paths >= 0.1