Debug info for Alternative instances

See #126

src/Hakyll/Core/Compiler.hs

@@ -116,7 +116,7 @@ getResourceWith reader = do
     let filePath = toFilePath id'
     if resourceExists provider id'
         then compilerUnsafeIO $ Item id' <$> reader provider id'
-        else compilerThrow $ error' filePath
+        else fail $ error' filePath
   where
     error' fp = "Hakyll.Core.Compiler.getResourceWith: resource " ++
         show fp ++ " not found"
@@ -156,7 +156,7 @@ cached name compiler = do
             x        <- compilerUnsafeIO $ Store.get store [name, show id']
             progName <- compilerUnsafeIO getProgName
             case x of Store.Found x' -> return x'
-                      _              -> compilerThrow (error' progName)
+                      _              -> fail $ error' progName
   where
     error' progName =
         "Hakyll.Core.Compiler.cached: Cache corrupt! " ++

src/Hakyll/Core/Compiler/Internal.hs

@@ -28,6 +28,7 @@ module Hakyll.Core.Compiler.Internal
 import           Control.Applicative            (Alternative (..),
                                                  Applicative (..), (<$>))
 import           Control.Exception              (SomeException, handle)
+import           Control.Monad                  (forM_)
 import           Data.Monoid                    (Monoid (..))
 import           Data.Set                       (Set)
 import qualified Data.Set                       as S
@@ -38,7 +39,8 @@ import           Hakyll.Core.Configuration
 import           Hakyll.Core.Dependencies
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Identifier.Pattern
-import           Hakyll.Core.Logger
+import           Hakyll.Core.Logger             (Logger)
+import qualified Hakyll.Core.Logger             as Logger
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider
 import           Hakyll.Core.Routes
@@ -82,7 +84,7 @@ instance Monoid CompilerWrite where
 --------------------------------------------------------------------------------
 data CompilerResult a where
     CompilerDone    :: a -> CompilerWrite -> CompilerResult a
-    CompilerError   :: String -> CompilerResult a
+    CompilerError   :: [String] -> CompilerResult a
     CompilerRequire :: Identifier -> Compiler a -> CompilerResult a
 
 
@@ -126,7 +128,7 @@ instance Monad Compiler where
             CompilerRequire i c' -> return $ CompilerRequire i $ c' >>= f
     {-# INLINE (>>=) #-}
 
-    fail = compilerThrow
+    fail = compilerThrow . return
     {-# INLINE fail #-}
 
 
@@ -150,13 +152,17 @@ runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
 runCompiler compiler read' = handle handler $ unCompiler compiler read'
   where
     handler :: SomeException -> IO (CompilerResult a)
-    handler e = return $ CompilerError $ show e
+    handler e = return $ CompilerError [show e]
 
 
 --------------------------------------------------------------------------------
 instance Alternative Compiler where
-    empty   = compilerThrow "Hakyll.Core.Compiler.Internal: empty alternative"
+    empty   = compilerThrow []
-    x <|> y = compilerCatch x (\_ -> y)
+    x <|> y = compilerCatch x $ \es -> do
+        logger <- compilerLogger <$> compilerAsk
+        forM_ es $ \e -> compilerUnsafeIO $ Logger.debug logger $
+            "Hakyll.Core.Compiler.Internal: Alternative failed: " ++ e
+        y
     {-# INLINE (<|>) #-}
 
 
@@ -173,13 +179,13 @@ compilerTell deps = Compiler $ \_ -> return $ CompilerDone () deps
 
 
 --------------------------------------------------------------------------------
-compilerThrow :: String -> Compiler a
+compilerThrow :: [String] -> Compiler a
-compilerThrow e = Compiler $ \_ -> return $ CompilerError e
+compilerThrow es = Compiler $ \_ -> return $ CompilerError es
 {-# INLINE compilerThrow #-}
 
 
 --------------------------------------------------------------------------------
-compilerCatch :: Compiler a -> (String -> Compiler a) -> Compiler a
+compilerCatch :: Compiler a -> ([String] -> Compiler a) -> Compiler a
 compilerCatch (Compiler x) f = Compiler $ \r -> do
     res <- x r
     case res of

src/Hakyll/Core/Compiler/Require.hs

@@ -67,14 +67,14 @@ loadSnapshot id' snapshot = do
     universe <- compilerUniverse <$> compilerAsk
 
     -- Quick check for better error messages
-    when (id' `S.notMember` universe) $ compilerThrow notFound
+    when (id' `S.notMember` universe) $ fail notFound
 
     compilerTellDependencies [IdentifierDependency id']
     compilerResult $ CompilerRequire id' $ do
         result <- compilerUnsafeIO $ Store.get store (key id' snapshot)
         case result of
-            Store.NotFound      -> compilerThrow notFound
+            Store.NotFound      -> fail notFound
-            Store.WrongType e r -> compilerThrow $ wrongType e r
+            Store.WrongType e r -> fail $ wrongType e r
             Store.Found x       -> return $ Item id' x
   where
     notFound =

src/Hakyll/Core/Runtime.hs

@@ -200,7 +200,9 @@ chase trail id'
         result <- liftIO $ runCompiler compiler read'
         case result of
             -- Rethrow error
-            CompilerError e -> throwError e
+            CompilerError [] -> throwError
+                "Compiler failed but no info given, try running with -v?"
+            CompilerError es -> throwError $ intercalate "; " es
 
             -- Huge success
             CompilerDone (SomeItem item) cwrite -> do

src/Hakyll/Core/UnixFilter.hs

@@ -7,24 +7,22 @@ module Hakyll.Core.UnixFilter
 
 
 --------------------------------------------------------------------------------
-import           Control.Concurrent            (forkIO)
+import           Control.Concurrent      (forkIO)
-import           Control.Concurrent.MVar       (newEmptyMVar, putMVar, takeMVar)
+import           Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
-import           Control.DeepSeq               (deepseq)
+import           Control.DeepSeq         (deepseq)
-import           Control.Monad                 (forM_)
+import           Control.Monad           (forM_)
-import           Data.ByteString.Lazy          (ByteString)
+import           Data.ByteString.Lazy    (ByteString)
-import qualified Data.ByteString.Lazy          as LB
+import qualified Data.ByteString.Lazy    as LB
-import           Data.IORef                    (newIORef, readIORef, writeIORef)
+import           Data.IORef              (newIORef, readIORef, writeIORef)
-import           Data.Monoid                   (Monoid, mempty)
+import           Data.Monoid             (Monoid, mempty)
-import           System.Exit                   (ExitCode (..))
+import           System.Exit             (ExitCode (..))
-import           System.IO                     (Handle, hClose, hFlush,
+import           System.IO               (Handle, hClose, hFlush, hGetContents,
-                                                hGetContents, hPutStr,
+                                          hPutStr, hSetEncoding, localeEncoding)
-                                                hSetEncoding, localeEncoding)
 import           System.Process
 
 
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
-import           Hakyll.Core.Compiler.Internal
 
 
 --------------------------------------------------------------------------------
@@ -92,7 +90,7 @@ unixFilterWith writer reader programName args input = do
     forM_ (lines err) debugCompiler
     case exitCode of
         ExitSuccess   -> return output
-        ExitFailure e -> compilerThrow $
+        ExitFailure e -> fail $
             "Hakyll.Core.UnixFilter.unixFilterWith: " ++
             unwords (programName : args) ++ " gave exit code " ++ show e
 

src/Hakyll/Web/Template/Context.hs

@@ -226,6 +226,6 @@ modificationTimeFieldWith locale key fmt = field key $ \i -> do
 
 --------------------------------------------------------------------------------
 missingField :: Context a
-missingField = Context $ \k i -> compilerThrow $
+missingField = Context $ \k i -> fail $
     "Missing field $" ++ k ++ "$ in context for item " ++
     show (itemIdentifier i)

tests/Hakyll/Core/UnixFilter/Tests.hs

@@ -49,8 +49,8 @@ unixFilterFalse = do
     provider <- newTestProvider store
     result   <- testCompiler store provider "russian.md" compiler
     H.assert $ case result of
-        CompilerError e -> "exit code" `isInfixOf` e
+        CompilerError es -> any ("exit code" `isInfixOf`) es
-        _               -> False
+        _                -> False
     cleanTestEnv
   where
     compiler = getResourceString >>= withItemBody (unixFilter "false" [])

tests/TestSuite/Util.hs

@@ -12,6 +12,7 @@ module TestSuite.Util
 
 
 --------------------------------------------------------------------------------
+import           Data.List                      (intercalate)
 import           Data.Monoid                    (mempty)
 import qualified Data.Set                       as S
 import           Test.Framework
@@ -78,7 +79,7 @@ testCompilerDone store provider underlying compiler = do
         CompilerDone x _    -> return x
         CompilerError e     -> error $
             "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
-            " threw: " ++ e
+            " threw: " ++ intercalate "; " e
         CompilerRequire i _ -> error $
             "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
             " requires: " ++ show i