summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Hakyll/Core/Compiler.hs4
-rw-r--r--src/Hakyll/Core/Compiler/Internal.hs24
-rw-r--r--src/Hakyll/Core/Compiler/Require.hs6
-rw-r--r--src/Hakyll/Core/Runtime.hs4
-rw-r--r--src/Hakyll/Core/UnixFilter.hs26
-rw-r--r--src/Hakyll/Web/Template/Context.hs2
-rw-r--r--tests/Hakyll/Core/UnixFilter/Tests.hs4
-rw-r--r--tests/TestSuite/Util.hs3
8 files changed, 40 insertions, 33 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index c0a217f..a672395 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/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! " ++
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 9aa441d..bf384bf 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/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"
- x <|> y = compilerCatch x (\_ -> y)
+ empty = compilerThrow []
+ 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 e = Compiler $ \_ -> return $ CompilerError e
+compilerThrow :: [String] -> Compiler a
+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
diff --git a/src/Hakyll/Core/Compiler/Require.hs b/src/Hakyll/Core/Compiler/Require.hs
index ef3b11b..0811e5d 100644
--- a/src/Hakyll/Core/Compiler/Require.hs
+++ b/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.WrongType e r -> compilerThrow $ wrongType e r
+ Store.NotFound -> fail notFound
+ Store.WrongType e r -> fail $ wrongType e r
Store.Found x -> return $ Item id' x
where
notFound =
diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs
index 9f27969..0e1ceb2 100644
--- a/src/Hakyll/Core/Runtime.hs
+++ b/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
diff --git a/src/Hakyll/Core/UnixFilter.hs b/src/Hakyll/Core/UnixFilter.hs
index 1544bf2..e6d4610 100644
--- a/src/Hakyll/Core/UnixFilter.hs
+++ b/src/Hakyll/Core/UnixFilter.hs
@@ -7,24 +7,22 @@ module Hakyll.Core.UnixFilter
--------------------------------------------------------------------------------
-import Control.Concurrent (forkIO)
-import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
-import Control.DeepSeq (deepseq)
-import Control.Monad (forM_)
-import Data.ByteString.Lazy (ByteString)
-import qualified Data.ByteString.Lazy as LB
-import Data.IORef (newIORef, readIORef, writeIORef)
-import Data.Monoid (Monoid, mempty)
-import System.Exit (ExitCode (..))
-import System.IO (Handle, hClose, hFlush,
- hGetContents, hPutStr,
- hSetEncoding, localeEncoding)
+import Control.Concurrent (forkIO)
+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
+import Control.DeepSeq (deepseq)
+import Control.Monad (forM_)
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as LB
+import Data.IORef (newIORef, readIORef, writeIORef)
+import Data.Monoid (Monoid, mempty)
+import System.Exit (ExitCode (..))
+import System.IO (Handle, hClose, hFlush, hGetContents,
+ hPutStr, 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
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index e46f9d3..b885462 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/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)
diff --git a/tests/Hakyll/Core/UnixFilter/Tests.hs b/tests/Hakyll/Core/UnixFilter/Tests.hs
index 04051e3..92c2904 100644
--- a/tests/Hakyll/Core/UnixFilter/Tests.hs
+++ b/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
- _ -> False
+ CompilerError es -> any ("exit code" `isInfixOf`) es
+ _ -> False
cleanTestEnv
where
compiler = getResourceString >>= withItemBody (unixFilter "false" [])
diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs
index ef8768c..e727ecb 100644
--- a/tests/TestSuite/Util.hs
+++ b/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
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-15 07:26:36 +0000