diff --git a/AddHandler.hs b/AddHandler.hs --- a/AddHandler.hs +++ b/AddHandler.hs @@ -22,20 +22,28 @@ [] -> error "No cabal file found" _ -> error "Too many cabal files found" - putStr "Name of route (without trailing R): " - hFlush stdout - name <- getLine - case name of - [] -> error "Please provide a name" - c:_ - | isLower c -> error "Name must start with an upper case letter" - | otherwise -> return () - - -- Check that the handler file doesn't already exist - let handlerFile = concat ["Handler/", name, ".hs"] - exists <- doesFileExist handlerFile - when exists $ error $ "File already exists: " ++ show handlerFile + let routeInput = do + putStr "Name of route (without trailing R): " + hFlush stdout + name <- getLine + case name of + [] -> error "No name entered. Quitting ..." + c:_ + | isLower c -> do + putStrLn "Name must start with an upper case letter" + routeInput + | otherwise -> do + -- Check that the handler file doesn't already exist + let handlerFile = concat ["Handler/", name, ".hs"] + exists <- doesFileExist handlerFile + if exists + then do + putStrLn $ "File already exists: " ++ show handlerFile + putStrLn "Try another name or leave blank to exit" + routeInput + else return (name, handlerFile) + (name, handlerFile) <- routeInput putStr "Enter route pattern (ex: /entry/#EntryId): " hFlush stdout pattern <- getLine diff --git a/Devel.hs b/Devel.hs --- a/Devel.hs +++ b/Devel.hs @@ -388,7 +388,7 @@ Map.differenceWith compareTimes newList list `Map.union` Map.differenceWith compareTimes list newList return (haskellFileChanged, newList) - else timeout (10000000*t) (takeMVar filesModified) >> + else timeout (1000000*t) (takeMVar filesModified) >> watchForChanges filesModified hsSourceDirs extraFiles list t where compareTimes x y @@ -416,7 +416,7 @@ unless (null unlisted) $ do putStrLn "WARNING: the following source files are not listed in exposed-modules or other-modules:" mapM_ putStrLn unlisted - when (D.fromString "Application" `notElem` D.exposedModules dLib) $ + when ("Application" `notElem` (map (last . D.components) $ D.exposedModules dLib)) $ putStrLn "WARNING: no exposed module Application" return (hsSourceDirs, dLib) diff --git a/Keter.hs b/Keter.hs --- a/Keter.hs +++ b/Keter.hs @@ -27,16 +27,17 @@ -> Bool -- ^ no build? -> IO () keter cabal noBuild = do - mvalue <- decodeFile "config/keter.yaml" + ketercfg <- keterConfig + mvalue <- decodeFile ketercfg value <- case mvalue of Nothing -> error "No config/keter.yaml found" Just (Object value) -> case Map.lookup "host" value of Just (String s) | "<<" `T.isPrefixOf` s -> - error "Please set your hostname in config/keter.yaml" + error $ "Please set your hostname in " ++ ketercfg _ -> return value - Just _ -> error "config/keter.yaml is not an object" + Just _ -> error $ ketercfg ++ " is not an object" files <- getDirectoryContents "." project <- @@ -48,7 +49,7 @@ exec <- case Map.lookup "exec" value of Just (String s) -> return $ F.collapse $ "config" F. F.fromText s - _ -> error "exec not found in config/keter.yaml" + _ -> error $ "exec not found in " ++ ketercfg unless noBuild $ do run cabal ["clean"] @@ -67,6 +68,12 @@ Just i -> run "scp" ["-P" ++ show (i :: Int), fp, T.unpack s] Nothing -> run "scp" [fp, T.unpack s] _ -> return () + where + -- Test for alternative config file extension (yaml or yml). + keterConfig = do + let yml = "config/keter.yml" + ymlExists <- doesFileExist yml + return $ if ymlExists then yml else "config/keter.yaml" try' :: IO a -> IO (Either SomeException a) try' = try diff --git a/hsfiles/mongo.hsfiles b/hsfiles/mongo.hsfiles --- a/hsfiles/mongo.hsfiles +++ b/hsfiles/mongo.hsfiles @@ -418,7 +418,7 @@ , bytestring >= 0.9 && < 0.11 , text >= 0.11 && < 2.0 , persistent >= 1.3 && < 1.4 - , persistent-mongoDB >= 1.3 && < 1.4 + , persistent-mongoDB >= 1.3 && < 1.5 , persistent-template >= 1.3 && < 1.4 , template-haskell , shakespeare >= 2.0 && < 2.1 @@ -702,7 +702,7 @@ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== -{-# START_FILE config/keter.yaml #-} +{-# START_FILE config/keter.yml #-} exec: ../dist/build/PROJECTNAME/PROJECTNAME args: - production @@ -878,6 +878,7 @@ web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT {-# START_FILE devel.hs #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (getApplicationDev) import Network.Wai.Handler.Warp @@ -887,8 +888,16 @@ import System.Exit (exitSuccess) import Control.Concurrent (threadDelay) +#ifndef mingw32_HOST_OS +import System.Posix.Signals (installHandler, sigINT, Handler(Catch)) +#endif + main :: IO () main = do +#ifndef mingw32_HOST_OS + _ <- installHandler sigINT (Catch $ return ()) Nothing +#endif + putStrLn "Starting devel application" (port, app) <- getApplicationDev forkIO $ runSettings (setPort port defaultSettings) app diff --git a/hsfiles/mysql.hsfiles b/hsfiles/mysql.hsfiles --- a/hsfiles/mysql.hsfiles +++ b/hsfiles/mysql.hsfiles @@ -706,7 +706,7 @@ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== -{-# START_FILE config/keter.yaml #-} +{-# START_FILE config/keter.yml #-} exec: ../dist/build/PROJECTNAME/PROJECTNAME args: - production @@ -908,6 +908,7 @@ web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT {-# START_FILE devel.hs #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (getApplicationDev) import Network.Wai.Handler.Warp @@ -917,8 +918,16 @@ import System.Exit (exitSuccess) import Control.Concurrent (threadDelay) +#ifndef mingw32_HOST_OS +import System.Posix.Signals (installHandler, sigINT, Handler(Catch)) +#endif + main :: IO () main = do +#ifndef mingw32_HOST_OS + _ <- installHandler sigINT (Catch $ return ()) Nothing +#endif + putStrLn "Starting devel application" (port, app) <- getApplicationDev forkIO $ runSettings (setPort port defaultSettings) app diff --git a/hsfiles/postgres-fay.hsfiles b/hsfiles/postgres-fay.hsfiles --- a/hsfiles/postgres-fay.hsfiles +++ b/hsfiles/postgres-fay.hsfiles @@ -755,7 +755,7 @@ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== -{-# START_FILE config/keter.yaml #-} +{-# START_FILE config/keter.yml #-} exec: ../dist/build/PROJECTNAME/PROJECTNAME args: - production @@ -932,6 +932,7 @@ web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT {-# START_FILE devel.hs #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (getApplicationDev) import Network.Wai.Handler.Warp @@ -941,8 +942,16 @@ import System.Exit (exitSuccess) import Control.Concurrent (threadDelay) +#ifndef mingw32_HOST_OS +import System.Posix.Signals (installHandler, sigINT, Handler(Catch)) +#endif + main :: IO () main = do +#ifndef mingw32_HOST_OS + _ <- installHandler sigINT (Catch $ return ()) Nothing +#endif + putStrLn "Starting devel application" (port, app) <- getApplicationDev forkIO $ runSettings (setPort port defaultSettings) app diff --git a/hsfiles/postgres.hsfiles b/hsfiles/postgres.hsfiles --- a/hsfiles/postgres.hsfiles +++ b/hsfiles/postgres.hsfiles @@ -706,7 +706,7 @@ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== -{-# START_FILE config/keter.yaml #-} +{-# START_FILE config/keter.yml #-} exec: ../dist/build/PROJECTNAME/PROJECTNAME args: - production @@ -882,6 +882,7 @@ web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT {-# START_FILE devel.hs #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (getApplicationDev) import Network.Wai.Handler.Warp @@ -891,8 +892,16 @@ import System.Exit (exitSuccess) import Control.Concurrent (threadDelay) +#ifndef mingw32_HOST_OS +import System.Posix.Signals (installHandler, sigINT, Handler(Catch)) +#endif + main :: IO () main = do +#ifndef mingw32_HOST_OS + _ <- installHandler sigINT (Catch $ return ()) Nothing +#endif + putStrLn "Starting devel application" (port, app) <- getApplicationDev forkIO $ runSettings (setPort port defaultSettings) app diff --git a/hsfiles/simple.hsfiles b/hsfiles/simple.hsfiles --- a/hsfiles/simple.hsfiles +++ b/hsfiles/simple.hsfiles @@ -621,7 +621,7 @@ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== -{-# START_FILE config/keter.yaml #-} +{-# START_FILE config/keter.yml #-} exec: ../dist/build/PROJECTNAME/PROJECTNAME args: - production @@ -756,6 +756,7 @@ web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT {-# START_FILE devel.hs #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (getApplicationDev) import Network.Wai.Handler.Warp @@ -765,8 +766,16 @@ import System.Exit (exitSuccess) import Control.Concurrent (threadDelay) +#ifndef mingw32_HOST_OS +import System.Posix.Signals (installHandler, sigINT, Handler(Catch)) +#endif + main :: IO () main = do +#ifndef mingw32_HOST_OS + _ <- installHandler sigINT (Catch $ return ()) Nothing +#endif + putStrLn "Starting devel application" (port, app) <- getApplicationDev forkIO $ runSettings (setPort port defaultSettings) app diff --git a/hsfiles/sqlite.hsfiles b/hsfiles/sqlite.hsfiles --- a/hsfiles/sqlite.hsfiles +++ b/hsfiles/sqlite.hsfiles @@ -706,7 +706,7 @@ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA== -{-# START_FILE config/keter.yaml #-} +{-# START_FILE config/keter.yml #-} exec: ../dist/build/PROJECTNAME/PROJECTNAME args: - production @@ -878,6 +878,7 @@ web: ./dist/build/PROJECTNAME/PROJECTNAME production -p $PORT {-# START_FILE devel.hs #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (getApplicationDev) import Network.Wai.Handler.Warp @@ -887,8 +888,16 @@ import System.Exit (exitSuccess) import Control.Concurrent (threadDelay) +#ifndef mingw32_HOST_OS +import System.Posix.Signals (installHandler, sigINT, Handler(Catch)) +#endif + main :: IO () main = do +#ifndef mingw32_HOST_OS + _ <- installHandler sigINT (Catch $ return ()) Nothing +#endif + putStrLn "Starting devel application" (port, app) <- getApplicationDev forkIO $ runSettings (setPort port defaultSettings) app diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -152,6 +152,9 @@ keterOptions :: Parser Command keterOptions = Keter <$> switch ( long "nobuild" <> short 'n' <> help "Skip rebuilding" ) +defaultRescan :: Int +defaultRescan = 10 + develOptions :: Parser Command develOptions = Devel <$> switch ( long "disable-api" <> short 'd' <> help "Disable fast GHC API rebuilding") @@ -159,8 +162,10 @@ <> help "Run COMMAND after rebuild succeeds") <*> optStr ( long "failure-hook" <> short 'f' <> metavar "COMMAND" <> help "Run COMMAND when rebuild fails") - <*> option ( long "event-timeout" <> short 't' <> value 1 <> metavar "N" - <> help "Force rescan of files every N seconds" ) + <*> option ( long "event-timeout" <> short 't' <> value defaultRescan <> metavar "N" + <> help ("Force rescan of files every N seconds (default " + ++ show defaultRescan + ++ ", use -1 to rely on FSNotify alone)") ) <*> optStr ( long "builddir" <> short 'b' <> help "Set custom cabal build directory, default `dist'") <*> many ( strOption ( long "ignore" <> short 'i' <> metavar "DIR" 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.12.3 +version: 1.2.12.4 license: MIT license-file: LICENSE author: Michael Snoyman