Jasper Van der Jeugt
parent
c40cf286af
commit
cbfc7c18e1
8 changed files with 40 additions and 33 deletions
|
|
@ -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! " ++
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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" [])
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue