551d4f9 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Proper logging

551d4f9Jasper Van der Jeugt14 years ago

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

compare with master

unifiedsplit

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

7 , flush

8 , error

9 , header

10− , item

10+ , message

11− , subitem

12 , debug

11 , debug

13 ) where

12 ) where

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

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

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

21import Control.Monad (forever)

20import Control.Monad (forever)

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

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

23−import Data.List (intercalate)

24import Prelude hiding (error)

22import Prelude hiding (error)

27--------------------------------------------------------------------------------

25--------------------------------------------------------------------------------

28data Verbosity

26data Verbosity

29 = Error

27 = Error

30− | Header

31 | Message

28 | Message

32 | Debug

29 | Debug

33 deriving (Eq, Ord, Show)

30 deriving (Eq, Ord, Show)

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

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

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

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

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

42 , loggerVerbosity :: Verbosity -- ^ Verbosity

39 , loggerVerbosity :: Verbosity -- ^ Verbosity

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

44 }

40 }

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

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

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

50new vbty sink = do

46new vbty sink = do

51 logger <- Logger <$>

47 logger <- Logger <$>

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

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

53 _ <- forkIO $ loggerThread logger

49 _ <- forkIO $ loggerThread logger

54 return logger

50 return logger

55 where

51 where

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

85--------------------------------------------------------------------------------

81--------------------------------------------------------------------------------

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

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

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

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

90--------------------------------------------------------------------------------

86--------------------------------------------------------------------------------

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

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

92−header l = string l Header

88+header l = string l Message

95--------------------------------------------------------------------------------

91--------------------------------------------------------------------------------

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

92+message :: 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

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

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

114

115

116--------------------------------------------------------------------------------

96--------------------------------------------------------------------------------

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

97debug :: 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

43run configuration rules = do

44 -- Initialization

45 logger <- Logger.new Logger.Debug putStrLn

46− Logger.header logger "Initialising"

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

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

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

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

49 storeDirectory configuration

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

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

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

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

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

53 ruleSet <- runRules rules provider

55 -- Get old facts

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

123--------------------------------------------------------------------------------

124scheduleOutOfDate :: Runtime ()

125scheduleOutOfDate = do

126+ logger <- runtimeLogger <$> ask

126 provider <- runtimeProvider <$> ask

127 provider <- runtimeProvider <$> ask

127 universe <- runtimeUniverse <$> ask

128 universe <- runtimeUniverse <$> ask

128 facts <- runtimeFacts <$> get

129 facts <- runtimeFacts <$> get

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

131 let identifiers = map fst universe

132 let identifiers = map fst universe

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

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

133 liftIO . resourceModified provider

134 liftIO . resourceModified provider

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

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

135− todo' = M.fromList

136+ todo' = M.fromList

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

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

137

138

139+ -- Print messages

140+ mapM_ (Logger.debug logger) msgs

141+

138 -- Update facts and todo items

142 -- Update facts and todo items

139 modify $ \s -> s

143 modify $ \s -> s

140 { runtimeDone = runtimeDone s `S.union`

144 { runtimeDone = runtimeDone s `S.union`

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

187 CompilerDone (CompiledItem compiled) cwrite -> do

191 CompilerDone (CompiledItem compiled) cwrite -> do

188 let facts = compilerDependencies cwrite

192 let facts = compilerDependencies cwrite

189 cacheHits

193 cacheHits

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

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

191− | otherwise = "cache hit"

195+ | otherwise = "cached "

196+

197+ -- Print some info

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

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

193

199

194 -- Write if necessary

200 -- Write if necessary

195 case runRoutes routes id' of

201 case runRoutes routes id' of

196 Nothing -> return ()

202 Nothing -> return ()

197 Just url -> do

203 Just url -> do

198 let path = destinationDirectory config </> url

204 let path = destinationDirectory config </> url

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

200 liftIO $ makeDirectories path

205 liftIO $ makeDirectories path

201 liftIO $ write path compiled

206 liftIO $ write path compiled

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

202

208

203 -- Save! (For require)

209 -- Save! (For require)

204 liftIO $ save store id' compiled

210 liftIO $ save store id' compiled