diff options
| -rw-r--r-- | src/Hakyll/Core/Compiler.hs | 6 | ||||
| -rw-r--r-- | src/Hakyll/Core/Logger.hs | 15 | ||||
| -rw-r--r-- | src/Hakyll/Core/Run.hs | 2 |
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" $ |