551d4f9 · hakyll · git.iko.soy

git.iko.soy/hakyll

Proper logging

commit551d4f9f4f425aed8dfe99a4669f1ed795ee83f6 authorJasper Van der Jeugt <m@jaspervdj.be> dateWed 14 Nov 2012, 13:32 (14 years ago) parent547030f

2 files changed+23−37

compare with master

unifiedsplit

src/Hakyll/Core/Logger.hs+7−27 src/Hakyll/Core/Runtime.hs+16−10

src/Hakyll/Core/Logger.hs+7−27

@@ -7,8 +7,7 @@ module Hakyll.Core.Logger

77 , flush

88 , error

99 , header

10− , item

11− , subitem

10+ , message

1211 , debug

1312 ) where

1413

@@ -20,14 +19,12 @@ import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)

2019import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)

2120import Control.Monad (forever)

2221import Control.Monad.Trans (MonadIO, liftIO)

23−import Data.List (intercalate)

2422import Prelude hiding (error)

2523

2624

2725--------------------------------------------------------------------------------

2826data Verbosity

2927 = Error

30− | Header

3128 | Message

3229 | Debug

3330 deriving (Eq, Ord, Show)

@@ -40,7 +37,6 @@ data Logger = Logger

4037 , loggerSync :: MVar () -- ^ Used for sync on quit

4138 , loggerSink :: String -> IO () -- ^ Out sink

4239 , loggerVerbosity :: Verbosity -- ^ Verbosity

43− , loggerColumns :: Int -- ^ Preferred number of columns

4440 }

4541

4642

@@ -49,7 +45,7 @@ data Logger = Logger

4945new :: Verbosity -> (String -> IO ()) -> IO Logger

5046new vbty sink = do

5147 logger <- Logger <$>

52− newChan <*> newEmptyMVar <*> pure sink <*> pure vbty <*> pure 80

48+ newChan <*> newEmptyMVar <*> pure sink <*> pure vbty

5349 _ <- forkIO $ loggerThread logger

5450 return logger

5551 where

@@ -84,35 +80,19 @@ string l v m

8480

8581--------------------------------------------------------------------------------

8682error :: MonadIO m => Logger -> String -> m ()

87−error l m = string l Error $ "ERROR: " ++ m

83+error l m = string l Error $ " [ERROR] " ++ m

8884

8985

9086--------------------------------------------------------------------------------

9187header :: MonadIO m => Logger -> String -> m ()

92−header l = string l Header

88+header l = string l Message

9389

9490

9591--------------------------------------------------------------------------------

96−item :: MonadIO m => Logger -> [String] -> m ()

97−item = itemWith 2

98−

99−

100−--------------------------------------------------------------------------------

101−subitem :: MonadIO m => Logger -> [String] -> m ()

102−subitem = itemWith 4

103−

104−

105−--------------------------------------------------------------------------------

106−itemWith :: MonadIO m => Int -> Logger -> [String] -> m ()

107−itemWith _ _ [] = return ()

108−itemWith i l [x] = string l Message $ replicate i ' ' ++ x

109−itemWith i l (x : ys) = string l Message $ indent ++ x ++ spaces ++ ys'

110− where

111− indent = replicate i ' '

112− spaces = replicate (max 1 $ loggerColumns l - i - length x - length ys') ' '

113− ys' = intercalate ", " ys

92+message :: MonadIO m => Logger -> String -> m ()

93+message l m = string l Message $ " " ++ m

11494

11595

11696--------------------------------------------------------------------------------

11797debug :: MonadIO m => Logger -> String -> m ()

118−debug l m = string l Debug $ " DEBUG: " ++ m

98+debug l m = string l Debug $ " [DEBUG] " ++ m

src/Hakyll/Core/Runtime.hs+16−10

@@ -43,13 +43,13 @@ run :: Configuration -> Rules a -> IO RuleSet

4343run configuration rules = do

4444 -- Initialization

4545 logger <- Logger.new Logger.Debug putStrLn

46− Logger.header logger "Initialising"

47− Logger.item logger ["Creating store"]

46+ Logger.header logger "Initialising..."

47+ Logger.message logger "Creating store..."

4848 store <- Store.new (inMemoryCache configuration) $

4949 storeDirectory configuration

50− Logger.item logger ["Creating provider"]

50+ Logger.message logger "Creating provider..."

5151 provider <- newResourceProvider store (ignoreFile configuration) "."

52− Logger.item logger ["Running rules"]

52+ Logger.message logger "Running rules..."

5353 ruleSet <- runRules rules provider

5454

5555 -- Get old facts

@@ -123,6 +123,7 @@ build = do

123123--------------------------------------------------------------------------------

124124scheduleOutOfDate :: Runtime ()

125125scheduleOutOfDate = do

126+ logger <- runtimeLogger <$> ask

126127 provider <- runtimeProvider <$> ask

127128 universe <- runtimeUniverse <$> ask

128129 facts <- runtimeFacts <$> get

@@ -131,10 +132,13 @@ scheduleOutOfDate = do

131132 let identifiers = map fst universe

132133 modified <- fmap S.fromList $ flip filterM identifiers $

133134 liftIO . resourceModified provider

134− let (ood, facts', _) = outOfDate identifiers modified facts

135− todo' = M.fromList

135+ let (ood, facts', msgs) = outOfDate identifiers modified facts

136+ todo' = M.fromList

136137 [(id', c) | (id', c) <- universe, id' `S.member` ood]

137138

139+ -- Print messages

140+ mapM_ (Logger.debug logger) msgs

141+

138142 -- Update facts and todo items

139143 modify $ \s -> s

140144 { runtimeDone = runtimeDone s `S.union`

@@ -187,18 +191,20 @@ chase trail id'

187191 CompilerDone (CompiledItem compiled) cwrite -> do

188192 let facts = compilerDependencies cwrite

189193 cacheHits

190− | compilerCacheHits cwrite <= 0 = "modified"

191− | otherwise = "cache hit"

192− Logger.item logger [show id', cacheHits]

194+ | compilerCacheHits cwrite <= 0 = "updated"

195+ | otherwise = "cached "

196+

197+ -- Print some info

198+ Logger.message logger $ cacheHits ++ " " ++ show id'

193199

194200 -- Write if necessary

195201 case runRoutes routes id' of

196202 Nothing -> return ()

197203 Just url -> do

198204 let path = destinationDirectory config </> url

199− Logger.subitem logger ["-> " ++ path]

200205 liftIO $ makeDirectories path

201206 liftIO $ write path compiled

207+ Logger.debug logger $ "Routed to " ++ path

202208

203209 -- Save! (For require)

204210 liftIO $ save store id' compiled