Add ErrorT to CompilerM monad stack

4 files changed, 44 insertions, 23 deletions

diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index e5da9b8..79ebb5e 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -112,6 +112,7 @@ import Control.Arrow ((>>>), (&&&), arr)
 import Control.Applicative ((<$>))
 import Control.Monad.Reader (ask)
 import Control.Monad.Trans (liftIO)
+import Control.Monad.Error (throwError)
 import Control.Category (Category, (.), id)
 import Data.Maybe (fromMaybe)
 import System.FilePath (takeExtension)
@@ -133,14 +134,14 @@ import Hakyll.Core.Logger
 -- | Run a compiler, yielding the resulting target and it's dependencies. This
 -- version of 'runCompilerJob' also stores the result
 --
-runCompiler :: Compiler () CompileRule  -- ^ Compiler to run
-            -> Identifier               -- ^ Target identifier
-            -> ResourceProvider         -- ^ Resource provider
-            -> Routes                   -- ^ Route
-            -> Store                    -- ^ Store
-            -> Bool                     -- ^ Was the resource modified?
-            -> Logger                   -- ^ Logger
-            -> IO CompileRule           -- ^ Resulting item
+runCompiler :: Compiler () CompileRule    -- ^ Compiler to run
+            -> Identifier                 -- ^ Target identifier
+            -> ResourceProvider           -- ^ Resource provider
+            -> Routes                     -- ^ Route
+            -> Store                      -- ^ Store
+            -> Bool                       -- ^ Was the resource modified?
+            -> Logger                     -- ^ Logger
+            -> IO (Throwing CompileRule)  -- ^ Resulting item
 runCompiler compiler identifier provider routes store modified logger = do
     -- Run the compiler job
     result <-
@@ -151,7 +152,7 @@ runCompiler compiler identifier provider routes store modified logger = do
         -- In case we compiled an item, we will store a copy in the cache first,
         -- before we return control. This makes sure the compiled item can later
         -- be accessed by e.g. require.
-        CompileRule (CompiledItem x) ->
+        Right (CompileRule (CompiledItem x)) ->
             storeSet store "Hakyll.Core.Compiler.runCompiler" identifier x
 
         -- Otherwise, we do nothing here
@@ -187,16 +188,16 @@ getResourceString = fromJob $ \resource -> CompilerM $ do
 --
 getDependency :: (Binary a, Writable a, Typeable a)
               => Identifier -> CompilerM a
-getDependency identifier = CompilerM $ do
+getDependency id' = CompilerM $ do
     store <- compilerStore <$> ask
-    fmap (fromMaybe error') $ liftIO $
-        storeGet store "Hakyll.Core.Compiler.runCompiler" identifier
+    result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id'
+    case result of
+        Nothing -> throwError error'
+        Just x  -> return x
   where
-    error' = error $  "Hakyll.Core.Compiler.getDependency: "
-                   ++ show identifier
-                   ++ " not found in the cache, the cache might be corrupted or"
-                   ++ " the item you are referring to might not exist"
-
+    error' =  "Hakyll.Core.Compiler.getDependency: " ++ show id'
+           ++ " not found in the cache, the cache might be corrupted or"
+           ++ " the item you are referring to might not exist"
 
 -- | Variant of 'require' which drops the current value
 --
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 53df044..4eef91c 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -5,6 +5,7 @@ module Hakyll.Core.Compiler.Internal
     ( Dependencies
     , DependencyEnvironment (..)
     , CompilerEnvironment (..)
+    , Throwing
     , CompilerM (..)
     , Compiler (..)
     , runCompilerJob
@@ -17,6 +18,7 @@ module Hakyll.Core.Compiler.Internal
 import Prelude hiding ((.), id)
 import Control.Applicative (Applicative, pure, (<*>), (<$>))
 import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)
+import Control.Monad.Error (ErrorT, runErrorT)
 import Control.Monad ((<=<), liftM2)
 import Data.Set (Set)
 import qualified Data.Set as S
@@ -59,10 +61,14 @@ data CompilerEnvironment = CompilerEnvironment
       compilerLogger           :: Logger
     }
 
+-- | A calculation possibly throwing an error
+--
+type Throwing a = Either String a
+
 -- | The compiler monad
 --
 newtype CompilerM a = CompilerM
-    { unCompilerM :: ReaderT CompilerEnvironment IO a
+    { unCompilerM :: ErrorT String (ReaderT CompilerEnvironment IO) a
     } deriving (Monad, Functor, Applicative)
 
 -- | The compiler arrow
@@ -96,7 +102,7 @@ instance ArrowChoice Compiler where
         Left l  -> Left  <$> j l
         Right r -> Right <$> return r
 
--- | Run a compiler, yielding the resulting target and it's dependencies
+-- | Run a compiler, yielding the resulting target
 --
 runCompilerJob :: Compiler () a     -- ^ Compiler to run
                -> Identifier        -- ^ Target identifier
@@ -105,9 +111,9 @@ runCompilerJob :: Compiler () a     -- ^ Compiler to run
                -> Store             -- ^ Store
                -> Bool              -- ^ Was the resource modified?
                -> Logger            -- ^ Logger
-               -> IO a
+               -> IO (Throwing a)   -- ^ Result
 runCompilerJob compiler identifier provider route store modified logger =
-    runReaderT (unCompilerM $ compilerJob compiler ()) env
+    runReaderT (runErrorT $ unCompilerM $ compilerJob compiler ()) env
   where
     env = CompilerEnvironment
             { compilerIdentifier       = identifier
diff --git a/src/Hakyll/Core/Logger.hs b/src/Hakyll/Core/Logger.hs
index 720dee0..5d75fa9 100644
--- a/src/Hakyll/Core/Logger.hs
+++ b/src/Hakyll/Core/Logger.hs
@@ -8,6 +8,7 @@ module Hakyll.Core.Logger
     , section
     , timed
     , report
+    , thrown
     ) where
 
 import Control.Monad (forever)
@@ -88,3 +89,11 @@ report :: MonadIO m
        -> String  -- ^ Message
        -> m ()    -- ^ No result
 report logger msg = liftIO $ message logger $ "  [      ] " ++ msg
+
+-- | Log an error that was thrown in the compilation phase
+--
+thrown :: MonadIO m
+       => Logger  -- ^ Logger
+       -> String  -- ^ Message
+       -> m ()    -- ^ No result
+thrown logger msg = liftIO $ message logger $ "  [ ERROR] " ++ msg
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index 09864be..1fefff8 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -188,7 +188,7 @@ runCompilers ((id', compiler) : compilers) = Runtime $ do
 
     case result of
         -- Compile rule for one item, easy stuff
-        CompileRule compiled -> do
+        Right (CompileRule compiled) -> do
             case runRoutes routes id' of
                 Nothing  -> return ()
                 Just url -> timed logger ("Routing to " ++ url) $ do
@@ -202,6 +202,11 @@ runCompilers ((id', compiler) : compilers) = Runtime $ do
             unRuntime $ runCompilers compilers 
 
         -- Metacompiler, slightly more complicated
-        MetaCompileRule newCompilers ->
+        Right (MetaCompileRule newCompilers) ->
             -- Actually I was just kidding, it's not hard at all
             unRuntime $ addNewCompilers compilers newCompilers
+
+        -- Some error happened, log and continue
+        Left err -> do
+            thrown logger err 
+            unRuntime $ runCompilers compilers