Ensure "Listening on 0.0.0.0:8000" message is not garbled

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 :: Configuration -> Logger -> Check -> IO ExitCode
-check config verbosity check' = do
+check config logger check' = do
-    ((), write) <- runChecker checkDestination config verbosity check'
+    ((), 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
+runChecker checker config logger check' = do
-    logger <- Logger.new verbosity
     let read' = CheckerRead
                     { checkerConfig = config
                     , checkerLogger = logger

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 :: Configuration -> Logger -> Rules a -> IO ExitCode
-build conf verbosity rules = fst <$> run conf verbosity rules
+build conf logger rules = fst <$> run conf logger rules
+
 
 --------------------------------------------------------------------------------
 -- | Run the checker and exit
-check :: Configuration -> Verbosity -> Check.Check -> IO ()
+check :: Configuration -> Logger -> Check.Check -> IO ()
-check config verbosity check' = Check.check config verbosity check' >>= exitWith
+check config logger check' = Check.check config logger check' >>= exitWith
 
 
 --------------------------------------------------------------------------------
 -- | Remove the output directories
-clean :: Configuration -> IO ()
+clean :: Configuration -> Logger -> IO ()
-clean conf = do
+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 :: Configuration -> Logger -> Rules a -> IO ExitCode
-rebuild conf verbosity rules =
+rebuild conf logger rules =
-    clean conf >> build conf verbosity 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
-

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 :: Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
-run config verbosity rules = do
+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

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
+        Build   _     -> Commands.build conf logger rules >>= exitWith
-        Check   _ _   -> Commands.check conf verbosity' check'
+        Check   _ _   -> Commands.check conf logger check'
-        Clean   _     -> Commands.clean conf
+        Clean   _     -> Commands.clean conf logger
         Deploy  _     -> Commands.deploy conf >>= exitWith
         Help    _     -> showHelp
-        Preview _ p   -> Commands.preview conf verbosity' rules p
+        Preview _ p   -> Commands.preview conf logger rules p
-        Rebuild _     -> Commands.rebuild conf verbosity' rules >>= exitWith
+        Rebuild _     -> Commands.rebuild conf logger rules >>= exitWith
-        Server  _ _ _   -> Commands.server conf (host args') (port args')
+        Server  _ _ _   -> Commands.server conf logger (host args') (port args')
-        Watch   _ _ p s -> Commands.watch conf verbosity' (host args') p (not s) rules
+        Watch   _ _ p s -> Commands.watch conf logger (host args') p (not s) rules
 
 
 --------------------------------------------------------------------------------

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.Core             as Snap
-import qualified Snap.Http.Server    as Snap
+import qualified Snap.Http.Server      as Snap
-import qualified Snap.Util.FileServe 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

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)