yogsototh/hakyll
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
Jasper Van der Jeugt 2015-01-10 22:15:51 +01:00
parent 23ab06de05
commit 9307ec5263
6 changed files with 62 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
src/Hakyll/Check.hs
View file

@ -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

53
src/Hakyll/Commands.hs
View file

@ -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

7
src/Hakyll/Core/Runtime.hs
View file

@ -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

15
src/Hakyll/Main.hs
View file

@ -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
--------------------------------------------------------------------------------

20
src/Hakyll/Preview/Server.hs
View file

@ -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

6
tests/Hakyll/Core/Runtime/Tests.hs
View file

@ -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)