Add getResource, customizable sink for logger

3 files changed, 15 insertions, 8 deletions

diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index 2164dda..6960fd1 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -93,6 +93,7 @@ module Hakyll.Core.Compiler
     ( Compiler
     , runCompiler
     , getIdentifier
+    , getResource
     , getRoute
     , getRouteFor
     , getResourceString
@@ -173,6 +174,11 @@ runCompiler compiler id' provider universe routes store modified logger = do
 getIdentifier :: Compiler a Identifier
 getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask
 
+-- | Get the resource that is currently being compiled
+--
+getResource :: Compiler a Resource
+getResource = getIdentifier >>> arr fromIdentifier
+
 -- | Get the route we are using for this item
 --
 getRoute :: Compiler a (Maybe FilePath)
diff --git a/src/Hakyll/Core/Logger.hs b/src/Hakyll/Core/Logger.hs
index 5d75fa9..912cc98 100644
--- a/src/Hakyll/Core/Logger.hs
+++ b/src/Hakyll/Core/Logger.hs
@@ -13,7 +13,7 @@ module Hakyll.Core.Logger
 
 import Control.Monad (forever)
 import Control.Monad.Trans (MonadIO, liftIO)
-import Control.Applicative ((<$>), (<*>))
+import Control.Applicative (pure, (<$>), (<*>))
 import Control.Concurrent (forkIO)
 import Control.Concurrent.Chan.Strict (Chan, newChan, readChan, writeChan)
 import Control.Concurrent.MVar.Strict (MVar, newEmptyMVar, takeMVar, putMVar)
@@ -24,15 +24,16 @@ import Data.Time (getCurrentTime, diffUTCTime)
 -- | Logger structure. Very complicated.
 --
 data Logger = Logger
-    { loggerChan :: Chan (Maybe String)  -- Nothing marks the end
-    , loggerSync :: MVar ()              -- Used for sync on quit
+    { loggerChan :: Chan (Maybe String)  -- ^ Nothing marks the end
+    , loggerSync :: MVar ()              -- ^ Used for sync on quit
+    , loggerSink :: String -> IO ()      -- ^ Out sink
     }
 
 -- | Create a new logger
 --
-makeLogger :: IO Logger
-makeLogger = do
-    logger <- Logger <$> newChan <*> newEmptyMVar
+makeLogger :: (String -> IO ()) -> IO Logger
+makeLogger sink = do
+    logger <- Logger <$> newChan <*> newEmptyMVar <*> pure sink
     _ <- forkIO $ loggerThread logger
     return logger
   where
@@ -42,7 +43,7 @@ makeLogger = do
             -- Stop: sync
             Nothing -> putMVar (loggerSync logger) ()
             -- Print and continue
-            Just m  -> putStrLn m
+            Just m  -> loggerSink logger m
 
 -- | Flush the logger (blocks until flushed)
 --
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index 643aa4e..5e29953 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -37,7 +37,7 @@ import Hakyll.Core.Logger
 --
 run :: HakyllConfiguration -> Rules -> IO RuleSet
 run configuration rules = do
-    logger <- makeLogger
+    logger <- makeLogger putStrLn
 
     section logger "Initialising"
     store <- timed logger "Creating store" $