8cfa962 · hakyll · git.iko.soy

git.iko.soy/hakyll

Add ErrorT to CompilerM monad stack

commit8cfa962005938cc441523ca55f3770fe55602036 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateSun 6 Mar 2011, 15:56 (16 years ago) parentbe685e6

4 files changed+44−23

compare with master

unifiedsplit

src/Hakyll/Core/Compiler.hs+18−17 src/Hakyll/Core/Compiler/Internal.hs+10−4 src/Hakyll/Core/Logger.hs+9 src/Hakyll/Core/Run.hs+7−2

src/Hakyll/Core/Compiler.hs+18−17

@@ -112,6 +112,7 @@ import Control.Arrow ((>>>), (&&&), arr)

112112import Control.Applicative ((<$>))

113113import Control.Monad.Reader (ask)

114114import Control.Monad.Trans (liftIO)

115+import Control.Monad.Error (throwError)

115116import Control.Category (Category, (.), id)

116117import Data.Maybe (fromMaybe)

117118import System.FilePath (takeExtension)

@@ -133,14 +134,14 @@ import Hakyll.Core.Logger

133134-- | Run a compiler, yielding the resulting target and it's dependencies. This

134135-- version of 'runCompilerJob' also stores the result

135136--

136−runCompiler :: Compiler () CompileRule -- ^ Compiler to run

137− -> Identifier -- ^ Target identifier

138− -> ResourceProvider -- ^ Resource provider

139− -> Routes -- ^ Route

140− -> Store -- ^ Store

141− -> Bool -- ^ Was the resource modified?

142− -> Logger -- ^ Logger

143− -> IO CompileRule -- ^ Resulting item

137+runCompiler :: Compiler () CompileRule -- ^ Compiler to run

138+ -> Identifier -- ^ Target identifier

139+ -> ResourceProvider -- ^ Resource provider

140+ -> Routes -- ^ Route

141+ -> Store -- ^ Store

142+ -> Bool -- ^ Was the resource modified?

143+ -> Logger -- ^ Logger

144+ -> IO (Throwing CompileRule) -- ^ Resulting item

144145runCompiler compiler identifier provider routes store modified logger = do

145146 -- Run the compiler job

146147 result <-

@@ -151,7 +152,7 @@ runCompiler compiler identifier provider routes store modified logger = do

151152 -- In case we compiled an item, we will store a copy in the cache first,

152153 -- before we return control. This makes sure the compiled item can later

153154 -- be accessed by e.g. require.

154− CompileRule (CompiledItem x) ->

155+ Right (CompileRule (CompiledItem x)) ->

155156 storeSet store "Hakyll.Core.Compiler.runCompiler" identifier x

156157

157158 -- Otherwise, we do nothing here

@@ -187,16 +188,16 @@ getResourceString = fromJob $ \resource -> CompilerM $ do

187188--

188189getDependency :: (Binary a, Writable a, Typeable a)

189190 => Identifier -> CompilerM a

190−getDependency identifier = CompilerM $ do

191+getDependency id' = CompilerM $ do

191192 store <- compilerStore <$> ask

192− fmap (fromMaybe error') $ liftIO $

193− storeGet store "Hakyll.Core.Compiler.runCompiler" identifier

193+ result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id'

194+ case result of

195+ Nothing -> throwError error'

196+ Just x -> return x

194197 where

195− error' = error $ "Hakyll.Core.Compiler.getDependency: "

196− ++ show identifier

197− ++ " not found in the cache, the cache might be corrupted or"

198− ++ " the item you are referring to might not exist"

199−

198+ error' = "Hakyll.Core.Compiler.getDependency: " ++ show id'

199+ ++ " not found in the cache, the cache might be corrupted or"

200+ ++ " the item you are referring to might not exist"

200201

201202-- | Variant of 'require' which drops the current value

202203--

src/Hakyll/Core/Compiler/Internal.hs+10−4

@@ -5,6 +5,7 @@ module Hakyll.Core.Compiler.Internal

55 ( Dependencies

66 , DependencyEnvironment (..)

77 , CompilerEnvironment (..)

8+ , Throwing

89 , CompilerM (..)

910 , Compiler (..)

1011 , runCompilerJob

@@ -17,6 +18,7 @@ module Hakyll.Core.Compiler.Internal

1718import Prelude hiding ((.), id)

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

1920import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)

21+import Control.Monad.Error (ErrorT, runErrorT)

2022import Control.Monad ((<=<), liftM2)

2123import Data.Set (Set)

2224import qualified Data.Set as S

@@ -59,10 +61,14 @@ data CompilerEnvironment = CompilerEnvironment

5961 compilerLogger :: Logger

6062 }

6163

64+-- | A calculation possibly throwing an error

65+--

66+type Throwing a = Either String a

67+

6268-- | The compiler monad

6369--

6470newtype CompilerM a = CompilerM

65− { unCompilerM :: ReaderT CompilerEnvironment IO a

71+ { unCompilerM :: ErrorT String (ReaderT CompilerEnvironment IO) a

6672 } deriving (Monad, Functor, Applicative)

6773

6874-- | The compiler arrow

@@ -96,7 +102,7 @@ instance ArrowChoice Compiler where

96102 Left l -> Left <$> j l

97103 Right r -> Right <$> return r

98104

99−-- | Run a compiler, yielding the resulting target and it's dependencies

105+-- | Run a compiler, yielding the resulting target

100106--

101107runCompilerJob :: Compiler () a -- ^ Compiler to run

102108 -> Identifier -- ^ Target identifier

@@ -105,9 +111,9 @@ runCompilerJob :: Compiler () a -- ^ Compiler to run

105111 -> Store -- ^ Store

106112 -> Bool -- ^ Was the resource modified?

107113 -> Logger -- ^ Logger

108− -> IO a

114+ -> IO (Throwing a) -- ^ Result

109115runCompilerJob compiler identifier provider route store modified logger =

110− runReaderT (unCompilerM $ compilerJob compiler ()) env

116+ runReaderT (runErrorT $ unCompilerM $ compilerJob compiler ()) env

111117 where

112118 env = CompilerEnvironment

113119 { compilerIdentifier = identifier

src/Hakyll/Core/Logger.hs+9

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

88 , section

99 , timed

1010 , report

11+ , thrown

1112 ) where

1213

1314import Control.Monad (forever)

@@ -88,3 +89,11 @@ report :: MonadIO m

8889 -> String -- ^ Message

8990 -> m () -- ^ No result

9091report logger msg = liftIO $ message logger $ " [ ] " ++ msg

92+

93+-- | Log an error that was thrown in the compilation phase

94+--

95+thrown :: MonadIO m

96+ => Logger -- ^ Logger

97+ -> String -- ^ Message

98+ -> m () -- ^ No result

99+thrown logger msg = liftIO $ message logger $ " [ ERROR] " ++ msg

src/Hakyll/Core/Run.hs+7−2

@@ -188,7 +188,7 @@ runCompilers ((id', compiler) : compilers) = Runtime $ do

188188

189189 case result of

190190 -- Compile rule for one item, easy stuff

191− CompileRule compiled -> do

191+ Right (CompileRule compiled) -> do

192192 case runRoutes routes id' of

193193 Nothing -> return ()

194194 Just url -> timed logger ("Routing to " ++ url) $ do

@@ -202,6 +202,11 @@ runCompilers ((id', compiler) : compilers) = Runtime $ do

202202 unRuntime $ runCompilers compilers

203203

204204 -- Metacompiler, slightly more complicated

205− MetaCompileRule newCompilers ->

205+ Right (MetaCompileRule newCompilers) ->

206206 -- Actually I was just kidding, it's not hard at all

207207 unRuntime $ addNewCompilers compilers newCompilers

208+

209+ -- Some error happened, log and continue

210+ Left err -> do

211+ thrown logger err

212+ unRuntime $ runCompilers compilers