From 12d0832f50b32e09d5bdc99f1e1c87284c059969 Mon Sep 17 00:00:00 2001 From: Greg Weber Date: Fri, 22 Nov 2013 16:15:35 -0800 Subject: [PATCH] add --interrupt-only so yesod does not interrupt on enter Useful when running multiple jobs in the same shell --- yesod-bin/Devel.hs | 19 +++++++--- yesod-bin/main.hs | 76 ++++++++++++++++++++++----------------- yesod-bin/yesod-bin.cabal | 2 +- 3 files changed, 60 insertions(+), 37 deletions(-) diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs index a6b888c7..26a31540 100644 --- a/yesod-bin/Devel.hs +++ b/yesod-bin/Devel.hs @@ -7,6 +7,7 @@ module Devel ( devel , DevelOpts(..) + , DevelTermOpt(..) , defaultDevelOpts ) where @@ -100,6 +101,8 @@ removeLock opts = do 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 @@ -111,13 +114,14 @@ data DevelOpts = DevelOpts , 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" @@ -195,12 +199,19 @@ devel opts passThroughArgs = withSocketsDo $ withManager $ \manager -> do 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/yesod-bin/main.hs b/yesod-bin/main.hs index f4016523..b860a55a 100755 --- a/yesod-bin/main.hs +++ b/yesod-bin/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.Exit (ExitCode (ExitSuccess), exitWith) 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 @@ data Command = Init { _initBare :: Bool } , _develPort :: Int , _proxyTimeout :: Int , _noReverseProxy :: Bool + , _interruptOnly :: Bool } | Test | AddHandler @@ -75,36 +76,45 @@ cabalCommand mopt 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 @@ optParser = Options <$> 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 @@ develOptions = Devel <$> switch ( long "disable-api" <> short 'd' <> 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/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index d4a7a5b5..dec2ee9e 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.2.4.1 +version: 1.2.5 license: MIT license-file: LICENSE author: Michael Snoyman