cbfc7c1 · hakyll · git.iko.soy

src/Hakyll/Core/Compiler.hs+2−2

compare with master

unifiedsplit

@@ -116,7 +116,7 @@ getResourceWith reader = do

116 let filePath = toFilePath id'

117 if resourceExists provider id'

118 then compilerUnsafeIO $ Item id' <$> reader provider id'

119− else compilerThrow $ error' filePath

119+ else fail $ error' filePath

120 where

121 error' fp = "Hakyll.Core.Compiler.getResourceWith: resource " ++

122 show fp ++ " not found"

@@ -156,7 +156,7 @@ cached name compiler = do

156 x <- compilerUnsafeIO $ Store.get store [name, show id']

157 progName <- compilerUnsafeIO getProgName

158 case x of Store.Found x' -> return x'

159− _ -> compilerThrow (error' progName)

159+ _ -> fail $ error' progName

160 where

161 error' progName =

162 "Hakyll.Core.Compiler.cached: Cache corrupt! " ++

src/Hakyll/Core/Compiler/Internal.hs+15−9

@@ -28,6 +28,7 @@ module Hakyll.Core.Compiler.Internal

28import Control.Applicative (Alternative (..),

29 Applicative (..), (<$>))

30import Control.Exception (SomeException, handle)

31+import Control.Monad (forM_)

31import Data.Monoid (Monoid (..))

32import Data.Monoid (Monoid (..))

32import Data.Set (Set)

33import Data.Set (Set)

33import qualified Data.Set as S

34import qualified Data.Set as S

@@ -38,7 +39,8 @@ import Hakyll.Core.Configuration

38import Hakyll.Core.Dependencies

39import Hakyll.Core.Dependencies

39import Hakyll.Core.Identifier

40import Hakyll.Core.Identifier

40import Hakyll.Core.Identifier.Pattern

41import Hakyll.Core.Identifier.Pattern

41−import Hakyll.Core.Logger

42+import Hakyll.Core.Logger (Logger)

43+import qualified Hakyll.Core.Logger as Logger

42import Hakyll.Core.Metadata

44import Hakyll.Core.Metadata

43import Hakyll.Core.Provider

45import Hakyll.Core.Provider

44import Hakyll.Core.Routes

46import Hakyll.Core.Routes

@@ -82,7 +84,7 @@ instance Monoid CompilerWrite where

82--------------------------------------------------------------------------------

84--------------------------------------------------------------------------------

83data CompilerResult a where

85data CompilerResult a where

84 CompilerDone :: a -> CompilerWrite -> CompilerResult a

86 CompilerDone :: a -> CompilerWrite -> CompilerResult a

85− CompilerError :: String -> CompilerResult a

87+ CompilerError :: [String] -> CompilerResult a

86 CompilerRequire :: Identifier -> Compiler a -> CompilerResult a

88 CompilerRequire :: Identifier -> Compiler a -> CompilerResult a

87

89

88

90

@@ -126,7 +128,7 @@ instance Monad Compiler where

126 CompilerRequire i c' -> return $ CompilerRequire i $ c' >>= f

128 CompilerRequire i c' -> return $ CompilerRequire i $ c' >>= f

127 {-# INLINE (>>=) #-}

129 {-# INLINE (>>=) #-}

128

130

129− fail = compilerThrow

131+ fail = compilerThrow . return

130 {-# INLINE fail #-}

132 {-# INLINE fail #-}

131

133

132

134

@@ -150,13 +152,17 @@ runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)

150runCompiler compiler read' = handle handler $ unCompiler compiler read'

152runCompiler compiler read' = handle handler $ unCompiler compiler read'

151 where

153 where

152 handler :: SomeException -> IO (CompilerResult a)

154 handler :: SomeException -> IO (CompilerResult a)

153− handler e = return $ CompilerError $ show e

155+ handler e = return $ CompilerError [show e]

154

156

155

157

156--------------------------------------------------------------------------------

158--------------------------------------------------------------------------------

157instance Alternative Compiler where

159instance Alternative Compiler where

160+ empty = compilerThrow []

161+ x <|> y = compilerCatch x $ \es -> do

162+ logger <- compilerLogger <$> compilerAsk

163+ forM_ es $ \e -> compilerUnsafeIO $ Logger.debug logger $

158− empty = compilerThrow "Hakyll.Core.Compiler.Internal: empty alternative"

164+ "Hakyll.Core.Compiler.Internal: Alternative failed: " ++ e

159− x <|> y = compilerCatch x (\_ -> y)

165+ y

160 {-# INLINE (<|>) #-}

166 {-# INLINE (<|>) #-}

161

167

162

168

@@ -173,13 +179,13 @@ compilerTell deps = Compiler $ \_ -> return $ CompilerDone () deps

173

179

174

180

175--------------------------------------------------------------------------------

181--------------------------------------------------------------------------------

176−compilerThrow :: String -> Compiler a

182+compilerThrow :: [String] -> Compiler a

177−compilerThrow e = Compiler $ \_ -> return $ CompilerError e

183+compilerThrow es = Compiler $ \_ -> return $ CompilerError es

178{-# INLINE compilerThrow #-}

184{-# INLINE compilerThrow #-}

179

185

180

186

181--------------------------------------------------------------------------------

187--------------------------------------------------------------------------------

182−compilerCatch :: Compiler a -> (String -> Compiler a) -> Compiler a

188+compilerCatch :: Compiler a -> ([String] -> Compiler a) -> Compiler a

183compilerCatch (Compiler x) f = Compiler $ \r -> do

189compilerCatch (Compiler x) f = Compiler $ \r -> do

184 res <- x r

190 res <- x r

185 case res of

191 case res of

src/Hakyll/Core/Compiler/Require.hs+3−3

@@ -67,14 +67,14 @@ loadSnapshot id' snapshot = do

67 universe <- compilerUniverse <$> compilerAsk

68

69 -- Quick check for better error messages

70− when (id' `S.notMember` universe) $ compilerThrow notFound

70+ when (id' `S.notMember` universe) $ fail notFound

71

72 compilerTellDependencies [IdentifierDependency id']

73 compilerResult $ CompilerRequire id' $ do

74 result <- compilerUnsafeIO $ Store.get store (key id' snapshot)

75 case result of

76− Store.NotFound -> compilerThrow notFound

76+ Store.NotFound -> fail notFound

77− Store.WrongType e r -> compilerThrow $ wrongType e r

77+ Store.WrongType e r -> fail $ wrongType e r

78 Store.Found x -> return $ Item id' x

79 where

80 notFound =

src/Hakyll/Core/Runtime.hs+3−1

@@ -200,7 +200,9 @@ chase trail id'

200 result <- liftIO $ runCompiler compiler read'

201 case result of

202 -- Rethrow error

203− CompilerError e -> throwError e

203+ CompilerError [] -> throwError

204+ "Compiler failed but no info given, try running with -v?"

205+ CompilerError es -> throwError $ intercalate "; " es

204

206

205 -- Huge success

207 -- Huge success

206 CompilerDone (SomeItem item) cwrite -> do

208 CompilerDone (SomeItem item) cwrite -> do

src/Hakyll/Core/UnixFilter.hs+12−14

@@ -7,24 +7,22 @@ module Hakyll.Core.UnixFilter

7

8

9--------------------------------------------------------------------------------

10−import Control.Concurrent (forkIO)

10+import Control.Concurrent (forkIO)

11−import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)

11+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)

12−import Control.DeepSeq (deepseq)

12+import Control.DeepSeq (deepseq)

13−import Control.Monad (forM_)

13+import Control.Monad (forM_)

14−import Data.ByteString.Lazy (ByteString)

14+import Data.ByteString.Lazy (ByteString)

15−import qualified Data.ByteString.Lazy as LB

15+import qualified Data.ByteString.Lazy as LB

16−import Data.IORef (newIORef, readIORef, writeIORef)

16+import Data.IORef (newIORef, readIORef, writeIORef)

17−import Data.Monoid (Monoid, mempty)

17+import Data.Monoid (Monoid, mempty)

18−import System.Exit (ExitCode (..))

18+import System.Exit (ExitCode (..))

19−import System.IO (Handle, hClose, hFlush,

19+import System.IO (Handle, hClose, hFlush, hGetContents,

20− hGetContents, hPutStr,

21− hSetEncoding, localeEncoding)

20+ hPutStr, hSetEncoding, localeEncoding)

22import System.Process

21import System.Process

23

22

24

23

25--------------------------------------------------------------------------------

24--------------------------------------------------------------------------------

26import Hakyll.Core.Compiler

25import Hakyll.Core.Compiler

27−import Hakyll.Core.Compiler.Internal

28

26

29

27

30--------------------------------------------------------------------------------

28--------------------------------------------------------------------------------

@@ -92,7 +90,7 @@ unixFilterWith writer reader programName args input = do

92 forM_ (lines err) debugCompiler

90 forM_ (lines err) debugCompiler

93 case exitCode of

91 case exitCode of

94 ExitSuccess -> return output

92 ExitSuccess -> return output

95− ExitFailure e -> compilerThrow $

93+ ExitFailure e -> fail $

96 "Hakyll.Core.UnixFilter.unixFilterWith: " ++

94 "Hakyll.Core.UnixFilter.unixFilterWith: " ++

97 unwords (programName : args) ++ " gave exit code " ++ show e

95 unwords (programName : args) ++ " gave exit code " ++ show e

98

96

src/Hakyll/Web/Template/Context.hs+1−1

@@ -226,6 +226,6 @@ modificationTimeFieldWith locale key fmt = field key $ \i -> do

226

227--------------------------------------------------------------------------------

228missingField :: Context a

229−missingField = Context $ \k i -> compilerThrow $

229+missingField = Context $ \k i -> fail $

230 "Missing field $" ++ k ++ "$ in context for item " ++

231 show (itemIdentifier i)

tests/Hakyll/Core/UnixFilter/Tests.hs+2−2

@@ -49,8 +49,8 @@ unixFilterFalse = do

49 provider <- newTestProvider store

50 result <- testCompiler store provider "russian.md" compiler

51 H.assert $ case result of

52− CompilerError e -> "exit code" `isInfixOf` e

52+ CompilerError es -> any ("exit code" `isInfixOf`) es

53− _ -> False

53+ _ -> False

54 cleanTestEnv

55 where

56 compiler = getResourceString >>= withItemBody (unixFilter "false" [])

tests/TestSuite/Util.hs+2−1

@@ -12,6 +12,7 @@ module TestSuite.Util

12

13

14--------------------------------------------------------------------------------

15+import Data.List (intercalate)

15import Data.Monoid (mempty)

16import Data.Monoid (mempty)

16import qualified Data.Set as S

17import qualified Data.Set as S

17import Test.Framework

18import Test.Framework

@@ -78,7 +79,7 @@ testCompilerDone store provider underlying compiler = do

78 CompilerDone x _ -> return x

79 CompilerDone x _ -> return x

79 CompilerError e -> error $

80 CompilerError e -> error $

80 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

81 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

81− " threw: " ++ e

82+ " threw: " ++ intercalate "; " e

82 CompilerRequire i _ -> error $

83 CompilerRequire i _ -> error $

83 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

84 "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++

84 " requires: " ++ show i

85 " requires: " ++ show i