Catch errors in compilers

2 files changed, 31 insertions, 24 deletions

diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index b7ea65a..069c873 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -88,7 +88,7 @@
 -- the type @a@. It is /very/ important that the compiler which produced this
 -- value, produced the right type as well!
 --
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
 module Hakyll.Core.Compiler
     ( Compiler
     , runCompiler
@@ -118,6 +118,7 @@ module Hakyll.Core.Compiler
 import Prelude hiding ((.), id)
 import Control.Arrow ((>>>), (&&&), arr, first)
 import Control.Applicative ((<$>))
+import Control.Exception (SomeException, handle)
 import Control.Monad.Reader (ask)
 import Control.Monad.Trans (liftIO)
 import Control.Monad.Error (throwError)
@@ -155,8 +156,9 @@ runCompiler :: Compiler () CompileRule    -- ^ Compiler to run
             -> IO (Throwing CompileRule)  -- ^ Resulting item
 runCompiler compiler id' provider universe routes store modified logger = do
     -- Run the compiler job
-    result <- runCompilerJob compiler id' provider universe
-                             routes store modified logger
+    result <- handle (\(e :: SomeException) -> return $ Left $ show e) $
+        runCompilerJob compiler id' provider universe routes store modified
+            logger
 
     -- Inspect the result
     case result of
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index 88cc160..f98259c 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -5,33 +5,35 @@ module Hakyll.Core.Run
     ( run
     ) where
 
-import Prelude hiding (reverse)
-import Control.Monad (filterM, forM_)
-import Control.Monad.Trans (liftIO)
 import Control.Applicative (Applicative, (<$>))
+import Control.Exception (handle)
+import Control.Monad (filterM, forM_)
+import Control.Monad.Error (ErrorT, runErrorT, throwError)
 import Control.Monad.Reader (ReaderT, runReaderT, ask)
 import Control.Monad.State.Strict (StateT, runStateT, get, put)
+import Control.Monad.Trans (liftIO)
 import Data.Map (Map)
-import qualified Data.Map as M
 import Data.Monoid (mempty, mappend)
+import Prelude hiding (reverse)
 import System.FilePath ((</>))
+import qualified Data.Map as M
 import qualified Data.Set as S
 
-import Hakyll.Core.Routes
-import Hakyll.Core.Identifier
-import Hakyll.Core.Util.File
 import Hakyll.Core.Compiler
 import Hakyll.Core.Compiler.Internal
+import Hakyll.Core.Configuration
+import Hakyll.Core.DependencyAnalyzer
+import Hakyll.Core.DirectedGraph
+import Hakyll.Core.Identifier
+import Hakyll.Core.Logger
 import Hakyll.Core.Resource
 import Hakyll.Core.Resource.Provider
 import Hakyll.Core.Resource.Provider.File
+import Hakyll.Core.Routes
 import Hakyll.Core.Rules.Internal
-import Hakyll.Core.DirectedGraph
-import Hakyll.Core.DependencyAnalyzer
-import Hakyll.Core.Writable
 import Hakyll.Core.Store
-import Hakyll.Core.Configuration
-import Hakyll.Core.Logger
+import Hakyll.Core.Util.File
+import Hakyll.Core.Writable
 
 -- | Run all rules needed, return the rule set used
 --
@@ -66,14 +68,18 @@ run configuration rules = do
                     }
 
     -- Run the program and fetch the resulting state
-    ((), state') <- runStateT stateT $ RuntimeState
+    result <- runErrorT $ runStateT stateT $ RuntimeState
         { hakyllAnalyzer  = makeDependencyAnalyzer mempty (const False) oldGraph
         , hakyllCompilers = M.empty
         }
 
-    -- We want to save the final dependency graph for the next run
-    storeSet store "Hakyll.Core.Run.run" "dependencies" $
-        analyzerGraph $ hakyllAnalyzer state'
+    case result of
+        Left e             ->
+            thrown logger e
+        Right ((), state') ->
+            -- We want to save the final dependency graph for the next run
+            storeSet store "Hakyll.Core.Run.run" "dependencies" $
+                analyzerGraph $ hakyllAnalyzer state'
 
     -- Flush and return
     flushLogger logger
@@ -94,7 +100,8 @@ data RuntimeState = RuntimeState
     }
 
 newtype Runtime a = Runtime
-    { unRuntime :: ReaderT RuntimeEnvironment (StateT RuntimeState IO) a
+    { unRuntime :: ReaderT RuntimeEnvironment
+        (StateT RuntimeState (ErrorT String IO)) a
     } deriving (Functor, Applicative, Monad)
 
 -- | Add a number of compilers and continue using these compilers
@@ -205,7 +212,5 @@ build id' = Runtime $ do
             -- Actually I was just kidding, it's not hard at all
             unRuntime $ addNewCompilers newCompilers
 
-        -- Some error happened, log and continue
-        Left err -> do
-            thrown logger err 
-            unRuntime stepAnalyzer
+        -- Some error happened, rethrow in Runtime monad
+        Left err -> throwError err