cbfc7c1 · hakyll · git.iko.soy

git.iko.soy/hakyll

Debug info for Alternative instances

See #126

commitcbfc7c18e1aa6c498d2fc7bdecf2f127b6582dbd authorJasper Van der Jeugt <m@jaspervdj.be> dateThu 4 Apr 2013, 00:26 (14 years ago) parentc40cf28

8 files changed+40−33

compare with master

unifiedsplit

src/Hakyll/Core/Compiler.hs+2−2 src/Hakyll/Core/Compiler/Internal.hs+15−9 src/Hakyll/Core/Compiler/Require.hs+3−3 src/Hakyll/Core/Runtime.hs+3−1 src/Hakyll/Core/UnixFilter.hs+12−14 src/Hakyll/Web/Template/Context.hs+1−1 tests/Hakyll/Core/UnixFilter/Tests.hs+2−2 tests/TestSuite/Util.hs+2−1

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

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

116116 let filePath = toFilePath id'

117117 if resourceExists provider id'

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

119− else compilerThrow $ error' filePath

119+ else fail $ error' filePath

120120 where

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

122122 show fp ++ " not found"

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

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

157157 progName <- compilerUnsafeIO getProgName

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

159− _ -> compilerThrow (error' progName)

159+ _ -> fail $ error' progName

160160 where

161161 error' progName =

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

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

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

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

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

3030import Control.Exception (SomeException, handle)

31+import Control.Monad (forM_)

3132import Data.Monoid (Monoid (..))

3233import Data.Set (Set)

3334import qualified Data.Set as S

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

3839import Hakyll.Core.Dependencies

3940import Hakyll.Core.Identifier

4041import Hakyll.Core.Identifier.Pattern

41−import Hakyll.Core.Logger

42+import Hakyll.Core.Logger (Logger)

43+import qualified Hakyll.Core.Logger as Logger

4244import Hakyll.Core.Metadata

4345import Hakyll.Core.Provider

4446import Hakyll.Core.Routes

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

8284--------------------------------------------------------------------------------

8385data CompilerResult a where

8486 CompilerDone :: a -> CompilerWrite -> CompilerResult a

85− CompilerError :: String -> CompilerResult a

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

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

8789

8890

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

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

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

128130

129− fail = compilerThrow

131+ fail = compilerThrow . return

130132 {-# INLINE fail #-}

131133

132134

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

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

151153 where

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

153− handler e = return $ CompilerError $ show e

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

154156

155157

156158--------------------------------------------------------------------------------

157159instance Alternative Compiler where

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

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

160+ empty = compilerThrow []

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

162+ logger <- compilerLogger <$> compilerAsk

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

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

165+ y

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

161167

162168

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

173179

174180

175181--------------------------------------------------------------------------------

176−compilerThrow :: String -> Compiler a

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

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

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

178184{-# INLINE compilerThrow #-}

179185

180186

181187--------------------------------------------------------------------------------

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

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

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

184190 res <- x r

185191 case res of

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

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

6767 universe <- compilerUniverse <$> compilerAsk

6868

6969 -- Quick check for better error messages

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

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

7171

7272 compilerTellDependencies [IdentifierDependency id']

7373 compilerResult $ CompilerRequire id' $ do

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

7575 case result of

76− Store.NotFound -> compilerThrow notFound

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

76+ Store.NotFound -> fail notFound

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

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

7979 where

8080 notFound =

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

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

200200 result <- liftIO $ runCompiler compiler read'

201201 case result of

202202 -- 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

204206

205207 -- Huge success

206208 CompilerDone (SomeItem item) cwrite -> do

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

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

99--------------------------------------------------------------------------------

10−import Control.Concurrent (forkIO)

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

12−import Control.DeepSeq (deepseq)

13−import Control.Monad (forM_)

14−import Data.ByteString.Lazy (ByteString)

15−import qualified Data.ByteString.Lazy as LB

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

17−import Data.Monoid (Monoid, mempty)

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

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

20− hGetContents, hPutStr,

21− hSetEncoding, localeEncoding)

10+import Control.Concurrent (forkIO)

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

12+import Control.DeepSeq (deepseq)

13+import Control.Monad (forM_)

14+import Data.ByteString.Lazy (ByteString)

15+import qualified Data.ByteString.Lazy as LB

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

17+import Data.Monoid (Monoid, mempty)

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

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

20+ hPutStr, hSetEncoding, localeEncoding)

2221import System.Process

2322

2423

2524--------------------------------------------------------------------------------

2625import Hakyll.Core.Compiler

27−import Hakyll.Core.Compiler.Internal

2826

2927

3028--------------------------------------------------------------------------------

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

9290 forM_ (lines err) debugCompiler

9391 case exitCode of

9492 ExitSuccess -> return output

95− ExitFailure e -> compilerThrow $

93+ ExitFailure e -> fail $

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

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

9896

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

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

226226

227227--------------------------------------------------------------------------------

228228missingField :: Context a

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

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

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

231231 show (itemIdentifier i)

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

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

4949 provider <- newTestProvider store

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

5151 H.assert $ case result of

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

53− _ -> False

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

53+ _ -> False

5454 cleanTestEnv

5555 where

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

tests/TestSuite/Util.hs+2−1

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

1212

1313

1414--------------------------------------------------------------------------------

15+import Data.List (intercalate)

1516import Data.Monoid (mempty)

1617import qualified Data.Set as S

1718import Test.Framework

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

7879 CompilerDone x _ -> return x

7980 CompilerError e -> error $

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

81− " threw: " ++ e

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

8283 CompilerRequire i _ -> error $

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

8485 " requires: " ++ show i