63a637f · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Add getResource, customizable sink for logger

63a637fJasper Van der Jeugt15 years ago

src/Hakyll/Core/Compiler.hs+6

compare with master

unifiedsplit

@@ -93,6 +93,7 @@ module Hakyll.Core.Compiler

93 ( Compiler

94 , runCompiler

95 , getIdentifier

96+ , getResource

96 , getRoute

97 , getRoute

97 , getRouteFor

98 , getRouteFor

98 , getResourceString

99 , getResourceString

@@ -173,6 +174,11 @@ runCompiler compiler id' provider universe routes store modified logger = do

173getIdentifier :: Compiler a Identifier

174getIdentifier :: Compiler a Identifier

174getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask

175getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask

175

176

177+-- | Get the resource that is currently being compiled

178+--

179+getResource :: Compiler a Resource

180+getResource = getIdentifier >>> arr fromIdentifier

181+

176-- | Get the route we are using for this item

182-- | Get the route we are using for this item

177--

183--

178getRoute :: Compiler a (Maybe FilePath)

184getRoute :: Compiler a (Maybe FilePath)

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

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

14import Control.Monad (forever)

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

16−import Control.Applicative ((<$>), (<*>))

16+import Control.Applicative (pure, (<$>), (<*>))

17import Control.Concurrent (forkIO)

18import Control.Concurrent.Chan.Strict (Chan, newChan, readChan, writeChan)

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

@@ -24,15 +24,16 @@ import Data.Time (getCurrentTime, diffUTCTime)

24-- | Logger structure. Very complicated.

25--

26data Logger = Logger

27− { loggerChan :: Chan (Maybe String) -- Nothing marks the end

27+ { loggerChan :: Chan (Maybe String) -- ^ Nothing marks the end

28− , loggerSync :: MVar () -- Used for sync on quit

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

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

29 }

30 }

31-- | Create a new logger

32-- | Create a new logger

32--

33--

33−makeLogger :: IO Logger

34+makeLogger :: (String -> IO ()) -> IO Logger

34−makeLogger = do

35+makeLogger sink = do

35− logger <- Logger <$> newChan <*> newEmptyMVar

36+ logger <- Logger <$> newChan <*> newEmptyMVar <*> pure sink

36 _ <- forkIO $ loggerThread logger

37 _ <- forkIO $ loggerThread logger

37 return logger

38 return logger

38 where

39 where

@@ -42,7 +43,7 @@ makeLogger = do

42 -- Stop: sync

43 -- Stop: sync

43 Nothing -> putMVar (loggerSync logger) ()

44 Nothing -> putMVar (loggerSync logger) ()

44 -- Print and continue

45 -- Print and continue

45− Just m -> putStrLn m

46+ Just m -> loggerSink logger m

47-- | Flush the logger (blocks until flushed)

48-- | Flush the logger (blocks until flushed)

48--

49--

src/Hakyll/Core/Run.hs+1−1

@@ -37,7 +37,7 @@ import Hakyll.Core.Logger

37--

38run :: HakyllConfiguration -> Rules -> IO RuleSet

39run configuration rules = do

40− logger <- makeLogger

40+ logger <- makeLogger putStrLn

42 section logger "Initialising"

43 store <- timed logger "Creating store" $