From 9307ec526308f55340b95e199d6aad0850d17d04 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sat, 10 Jan 2015 22:15:51 +0100 Subject: Ensure "Listening on 0.0.0.0:8000" message is not garbled --- src/Hakyll/Check.hs | 13 +++++----- src/Hakyll/Commands.hs | 53 +++++++++++++++++++------------------- src/Hakyll/Core/Runtime.hs | 7 +++-- src/Hakyll/Main.hs | 15 ++++++----- src/Hakyll/Preview/Server.hs | 20 +++++++++----- tests/Hakyll/Core/Runtime/Tests.hs | 6 +++-- 6 files changed, 62 insertions(+), 52 deletions(-) diff --git a/src/Hakyll/Check.hs b/src/Hakyll/Check.hs index cfd30e4..8e808ba 100644 --- a/src/Hakyll/Check.hs +++ b/src/Hakyll/Check.hs @@ -42,7 +42,7 @@ import qualified Paths_hakyll as Paths_hakyll -------------------------------------------------------------------------------- import Hakyll.Core.Configuration -import Hakyll.Core.Logger (Logger, Verbosity) +import Hakyll.Core.Logger (Logger) import qualified Hakyll.Core.Logger as Logger import Hakyll.Core.Util.File import Hakyll.Web.Html @@ -54,9 +54,9 @@ data Check = All | InternalLinks -------------------------------------------------------------------------------- -check :: Configuration -> Verbosity -> Check -> IO ExitCode -check config verbosity check' = do - ((), write) <- runChecker checkDestination config verbosity check' +check :: Configuration -> Logger -> Check -> IO ExitCode +check config logger check' = do + ((), write) <- runChecker checkDestination config logger check' return $ if checkerFaulty write > 0 then ExitFailure 1 else ExitSuccess @@ -91,10 +91,9 @@ type Checker a = RWST CheckerRead CheckerWrite CheckerState IO a -------------------------------------------------------------------------------- -runChecker :: Checker a -> Configuration -> Verbosity -> Check +runChecker :: Checker a -> Configuration -> Logger -> Check -> IO (a, CheckerWrite) -runChecker checker config verbosity check' = do - logger <- Logger.new verbosity +runChecker checker config logger check' = do let read' = CheckerRead { checkerConfig = config , checkerLogger = logger diff --git a/src/Hakyll/Commands.hs b/src/Hakyll/Commands.hs index 8db889c..66e171c 100644 --- a/src/Hakyll/Commands.hs +++ b/src/Hakyll/Commands.hs @@ -14,16 +14,17 @@ module Hakyll.Commands -------------------------------------------------------------------------------- -import System.Exit (exitWith, ExitCode) -import System.IO.Error (catchIOError) import Control.Applicative -import Control.Monad (void) import Control.Concurrent +import Control.Monad (void) +import System.Exit (ExitCode, exitWith) +import System.IO.Error (catchIOError) -------------------------------------------------------------------------------- import qualified Hakyll.Check as Check import Hakyll.Core.Configuration -import Hakyll.Core.Logger (Verbosity) +import Hakyll.Core.Logger (Logger) +import qualified Hakyll.Core.Logger as Logger import Hakyll.Core.Rules import Hakyll.Core.Rules.Internal import Hakyll.Core.Runtime @@ -31,7 +32,7 @@ import Hakyll.Core.Util.File -------------------------------------------------------------------------------- #ifdef WATCH_SERVER -import Hakyll.Preview.Poll (watchUpdates) +import Hakyll.Preview.Poll (watchUpdates) #endif #ifdef PREVIEW_SERVER @@ -41,35 +42,36 @@ import Hakyll.Preview.Server -------------------------------------------------------------------------------- -- | Build the site -build :: Configuration -> Verbosity -> Rules a -> IO ExitCode -build conf verbosity rules = fst <$> run conf verbosity rules +build :: Configuration -> Logger -> Rules a -> IO ExitCode +build conf logger rules = fst <$> run conf logger rules + -------------------------------------------------------------------------------- -- | Run the checker and exit -check :: Configuration -> Verbosity -> Check.Check -> IO () -check config verbosity check' = Check.check config verbosity check' >>= exitWith +check :: Configuration -> Logger -> Check.Check -> IO () +check config logger check' = Check.check config logger check' >>= exitWith -------------------------------------------------------------------------------- -- | Remove the output directories -clean :: Configuration -> IO () -clean conf = do +clean :: Configuration -> Logger -> IO () +clean conf logger = do remove $ destinationDirectory conf remove $ storeDirectory conf remove $ tmpDirectory conf where remove dir = do - putStrLn $ "Removing " ++ dir ++ "..." + Logger.header logger $ "Removing " ++ dir ++ "..." removeDirectory dir -------------------------------------------------------------------------------- -- | Preview the site -preview :: Configuration -> Verbosity -> Rules a -> Int -> IO () +preview :: Configuration -> Logger -> Rules a -> Int -> IO () #ifdef PREVIEW_SERVER -preview conf verbosity rules port = do +preview conf logger rules port = do deprecatedMessage - watch conf verbosity "0.0.0.0" port True rules + watch conf logger "0.0.0.0" port True rules where deprecatedMessage = mapM_ putStrLn [ "The preview command has been deprecated." , "Use the watch command for recompilation and serving." @@ -82,9 +84,9 @@ preview _ _ _ _ = previewServerDisabled -------------------------------------------------------------------------------- -- | Watch and recompile for changes -watch :: Configuration -> Verbosity -> String -> Int -> Bool -> Rules a -> IO () +watch :: Configuration -> Logger -> String -> Int -> Bool -> Rules a -> IO () #ifdef WATCH_SERVER -watch conf verbosity host port runServer rules = do +watch conf logger host port runServer rules = do #ifndef mingw32_HOST_OS _ <- forkIO $ watchUpdates conf update #else @@ -97,27 +99,27 @@ watch conf verbosity host port runServer rules = do server' where update = do - (_, ruleSet) <- run conf verbosity rules + (_, ruleSet) <- run conf logger rules return $ rulesPattern ruleSet loop = threadDelay 100000 >> loop - server' = if runServer then server conf host port else loop + server' = if runServer then server conf logger host port else loop #else watch _ _ _ _ _ _ = watchServerDisabled #endif -------------------------------------------------------------------------------- -- | Rebuild the site -rebuild :: Configuration -> Verbosity -> Rules a -> IO ExitCode -rebuild conf verbosity rules = - clean conf >> build conf verbosity rules +rebuild :: Configuration -> Logger -> Rules a -> IO ExitCode +rebuild conf logger rules = + clean conf logger >> build conf logger rules -------------------------------------------------------------------------------- -- | Start a server -server :: Configuration -> String -> Int -> IO () +server :: Configuration -> Logger -> String -> Int -> IO () #ifdef PREVIEW_SERVER -server conf host port = do +server conf logger host port = do let destination = destinationDirectory conf - staticServer destination preServeHook host port + staticServer logger destination preServeHook host port where preServeHook _ = return () #else @@ -156,4 +158,3 @@ watchServerDisabled = , "Alternatively, use an external tool to serve your site directory." ] #endif - diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs index ea5f811..e85d60d 100644 --- a/src/Hakyll/Core/Runtime.hs +++ b/src/Hakyll/Core/Runtime.hs @@ -30,7 +30,7 @@ import Hakyll.Core.Dependencies import Hakyll.Core.Identifier import Hakyll.Core.Item import Hakyll.Core.Item.SomeItem -import Hakyll.Core.Logger (Logger, Verbosity) +import Hakyll.Core.Logger (Logger) import qualified Hakyll.Core.Logger as Logger import Hakyll.Core.Provider import Hakyll.Core.Routes @@ -42,10 +42,9 @@ import Hakyll.Core.Writable -------------------------------------------------------------------------------- -run :: Configuration -> Verbosity -> Rules a -> IO (ExitCode, RuleSet) -run config verbosity rules = do +run :: Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet) +run config logger rules = do -- Initialization - logger <- Logger.new verbosity Logger.header logger "Initialising..." Logger.message logger "Creating store..." store <- Store.new (inMemoryCache config) $ storeDirectory config diff --git a/src/Hakyll/Main.hs b/src/Hakyll/Main.hs index e0c8d4e..1deb93a 100644 --- a/src/Hakyll/Main.hs +++ b/src/Hakyll/Main.hs @@ -40,16 +40,17 @@ hakyllWith conf rules = do check' = if internal_links args' then Check.InternalLinks else Check.All + logger <- Logger.new verbosity' case args' of - Build _ -> Commands.build conf verbosity' rules >>= exitWith - Check _ _ -> Commands.check conf verbosity' check' - Clean _ -> Commands.clean conf + Build _ -> Commands.build conf logger rules >>= exitWith + Check _ _ -> Commands.check conf logger check' + Clean _ -> Commands.clean conf logger Deploy _ -> Commands.deploy conf >>= exitWith Help _ -> showHelp - Preview _ p -> Commands.preview conf verbosity' rules p - Rebuild _ -> Commands.rebuild conf verbosity' rules >>= exitWith - Server _ _ _ -> Commands.server conf (host args') (port args') - Watch _ _ p s -> Commands.watch conf verbosity' (host args') p (not s) rules + Preview _ p -> Commands.preview conf logger rules p + Rebuild _ -> Commands.rebuild conf logger rules >>= exitWith + Server _ _ _ -> Commands.server conf logger (host args') (port args') + Watch _ _ p s -> Commands.watch conf logger (host args') p (not s) rules -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Preview/Server.hs b/src/Hakyll/Preview/Server.hs index ef1c3c5..5de3d0c 100644 --- a/src/Hakyll/Preview/Server.hs +++ b/src/Hakyll/Preview/Server.hs @@ -7,11 +7,16 @@ module Hakyll.Preview.Server -------------------------------------------------------------------------------- -import Control.Monad.Trans (liftIO) +import Control.Monad.Trans (liftIO) import qualified Data.ByteString.Char8 as B -import qualified Snap.Core as Snap -import qualified Snap.Http.Server as Snap -import qualified Snap.Util.FileServe as Snap +import qualified Snap.Core as Snap +import qualified Snap.Http.Server as Snap +import qualified Snap.Util.FileServe as Snap + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Logger (Logger) +import qualified Hakyll.Core.Logger as Logger -------------------------------------------------------------------------------- @@ -30,12 +35,14 @@ static directory preServe = -------------------------------------------------------------------------------- -- | Main method, runs a static server in the given directory -staticServer :: FilePath -- ^ Directory to serve +staticServer :: Logger -- ^ Logger + -> FilePath -- ^ Directory to serve -> (FilePath -> IO ()) -- ^ Pre-serve hook -> String -- ^ Host to bind on -> Int -- ^ Port to listen on -> IO () -- ^ Blocks forever -staticServer directory preServe host port = +staticServer logger directory preServe host port = do + Logger.header logger $ "Listening on http://" ++ host ++ ":" ++ show port Snap.httpServe config $ static directory preServe where -- Snap server config @@ -43,4 +50,5 @@ staticServer directory preServe host port = $ Snap.setPort port $ Snap.setAccessLog Snap.ConfigNoLog $ Snap.setErrorLog Snap.ConfigNoLog + $ Snap.setVerbose False $ Snap.emptyConfig diff --git a/tests/Hakyll/Core/Runtime/Tests.hs b/tests/Hakyll/Core/Runtime/Tests.hs index 1ca8dc1..73a3c6b 100644 --- a/tests/Hakyll/Core/Runtime/Tests.hs +++ b/tests/Hakyll/Core/Runtime/Tests.hs @@ -28,7 +28,8 @@ tests = testGroup "Hakyll.Core.Runtime.Tests" $ -------------------------------------------------------------------------------- case01 :: Assertion case01 = do - _ <- run testConfiguration Logger.Error $ do + logger <- Logger.new Logger.Error + _ <- run testConfiguration logger $ do match "images/*" $ do route idRoute compile copyFileCompiler @@ -65,7 +66,8 @@ case01 = do -------------------------------------------------------------------------------- case02 :: Assertion case02 = do - _ <- run testConfiguration Logger.Error $ do + logger <- Logger.new Logger.Error + _ <- run testConfiguration logger $ do match "images/favicon.ico" $ do route $ gsubRoute "images/" (const "") compile $ makeItem ("Test" :: String) -- cgit v1.2.3