Proper logging

2 files changed, 23 insertions, 37 deletions

diff --git a/src/Hakyll/Core/Logger.hs b/src/Hakyll/Core/Logger.hs
index bff4adc..17bff32 100644
--- a/src/Hakyll/Core/Logger.hs
+++ b/src/Hakyll/Core/Logger.hs
@@ -7,8 +7,7 @@ module Hakyll.Core.Logger
     , flush
     , error
     , header
-    , item
-    , subitem
+    , message
     , debug
     ) where
 
@@ -20,14 +19,12 @@ import           Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
 import           Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)
 import           Control.Monad           (forever)
 import           Control.Monad.Trans     (MonadIO, liftIO)
-import           Data.List               (intercalate)
 import           Prelude                 hiding (error)
 
 
 --------------------------------------------------------------------------------
 data Verbosity
     = Error
-    | Header
     | Message
     | Debug
     deriving (Eq, Ord, Show)
@@ -40,7 +37,6 @@ data Logger = Logger
     , loggerSync      :: MVar ()              -- ^ Used for sync on quit
     , loggerSink      :: String -> IO ()      -- ^ Out sink
     , loggerVerbosity :: Verbosity            -- ^ Verbosity
-    , loggerColumns   :: Int                  -- ^ Preferred number of columns
     }
 
 
@@ -49,7 +45,7 @@ data Logger = Logger
 new :: Verbosity -> (String -> IO ()) -> IO Logger
 new vbty sink = do
     logger <- Logger <$>
-        newChan <*> newEmptyMVar <*> pure sink <*> pure vbty <*> pure 80
+        newChan <*> newEmptyMVar <*> pure sink <*> pure vbty
     _      <- forkIO $ loggerThread logger
     return logger
   where
@@ -84,35 +80,19 @@ string l v m
 
 --------------------------------------------------------------------------------
 error :: MonadIO m => Logger -> String -> m ()
-error l m = string l Error $ "ERROR: " ++ m
+error l m = string l Error $ "  [ERROR] " ++ m
 
 
 --------------------------------------------------------------------------------
 header :: MonadIO m => Logger -> String -> m ()
-header l = string l Header
+header l = string l Message
 
 
 --------------------------------------------------------------------------------
-item :: MonadIO m => Logger -> [String] -> m ()
-item = itemWith 2
-
-
---------------------------------------------------------------------------------
-subitem :: MonadIO m => Logger -> [String] -> m ()
-subitem = itemWith 4
-
-
---------------------------------------------------------------------------------
-itemWith :: MonadIO m => Int -> Logger -> [String] -> m ()
-itemWith _ _ []       = return ()
-itemWith i l [x]      = string l Message $ replicate i ' ' ++ x
-itemWith i l (x : ys) = string l Message $ indent ++ x ++ spaces ++ ys'
-  where
-    indent = replicate i ' '
-    spaces = replicate (max 1 $ loggerColumns l - i - length x - length ys') ' '
-    ys'    = intercalate ", " ys
+message :: MonadIO m => Logger -> String -> m ()
+message l m = string l Message $ "  " ++ m
 
 
 --------------------------------------------------------------------------------
 debug :: MonadIO m => Logger -> String -> m ()
-debug l m = string l Debug $ "  DEBUG: " ++ m
+debug l m = string l Debug $ "  [DEBUG] " ++ m
diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs
index 9f4fc7a..23c24b1 100644
--- a/src/Hakyll/Core/Runtime.hs
+++ b/src/Hakyll/Core/Runtime.hs
@@ -43,13 +43,13 @@ run :: Configuration -> Rules a -> IO RuleSet
 run configuration rules = do
     -- Initialization
     logger <- Logger.new Logger.Debug putStrLn
-    Logger.header logger "Initialising"
-    Logger.item logger ["Creating store"]
+    Logger.header logger "Initialising..."
+    Logger.message logger "Creating store..."
     store  <- Store.new (inMemoryCache configuration) $
         storeDirectory configuration
-    Logger.item logger ["Creating provider"]
+    Logger.message logger "Creating provider..."
     provider <- newResourceProvider store (ignoreFile configuration) "."
-    Logger.item logger ["Running rules"]
+    Logger.message logger "Running rules..."
     ruleSet  <- runRules rules provider
 
     -- Get old facts
@@ -123,6 +123,7 @@ build = do
 --------------------------------------------------------------------------------
 scheduleOutOfDate :: Runtime ()
 scheduleOutOfDate = do
+    logger   <- runtimeLogger   <$> ask
     provider <- runtimeProvider <$> ask
     universe <- runtimeUniverse <$> ask
     facts    <- runtimeFacts    <$> get
@@ -131,10 +132,13 @@ scheduleOutOfDate = do
     let identifiers = map fst universe
     modified <- fmap S.fromList $ flip filterM identifiers $
         liftIO . resourceModified provider
-    let (ood, facts', _) = outOfDate identifiers modified facts
-        todo'            = M.fromList
+    let (ood, facts', msgs) = outOfDate identifiers modified facts
+        todo'               = M.fromList
             [(id', c) | (id', c) <- universe, id' `S.member` ood]
 
+    -- Print messages
+    mapM_ (Logger.debug logger) msgs
+
     -- Update facts and todo items
     modify $ \s -> s
         { runtimeDone  = runtimeDone s `S.union`
@@ -187,18 +191,20 @@ chase trail id'
             CompilerDone (CompiledItem compiled) cwrite -> do
                 let facts     = compilerDependencies cwrite
                     cacheHits
-                        | compilerCacheHits cwrite <= 0 = "modified"
-                        | otherwise                     = "cache hit"
-                Logger.item logger [show id', cacheHits]
+                        | compilerCacheHits cwrite <= 0 = "updated"
+                        | otherwise                     = "cached "
+
+                -- Print some info
+                Logger.message logger $ cacheHits ++ " " ++ show id'
 
                 -- Write if necessary
                 case runRoutes routes id' of
                     Nothing  -> return ()
                     Just url -> do
                         let path = destinationDirectory config </> url
-                        Logger.subitem logger ["-> " ++ path]
                         liftIO $ makeDirectories path
                         liftIO $ write path compiled
+                        Logger.debug logger $ "Routed to " ++ path
 
                 -- Save! (For require)
                 liftIO $ save store id' compiled