add --interrupt-only so yesod does not interrupt on enter
Useful when running multiple jobs in the same shell
This commit is contained in:
Greg Weber
parent
84c53fb74f
commit
12d0832f50
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: yesod-bin
|
||||
version: 1.2.4.1
|
||||
version: 1.2.5
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Michael Snoyman <michael@snoyman.com>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user