git.iko.soy/hakyll
on master help sign in
Better error messages for type errors
da3aa16Jasper Van der Jeugt
src/Hakyll/Core/Compiler.hs+11−9
compare with master
unifiedsplit
@@ -217,16 +217,18 @@ getDependency id' = CompilerM $ do
217 store <- compilerStore <$> ask
217 store <- compilerStore <$> ask
218 result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id'
218 result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id'
219 case result of
219 case result of
220− NotFound -> throwError notFound
220+ NotFound -> throwError notFound
221− WrongType -> throwError wrongType
221+ WrongType e r -> throwError $ wrongType e r
222− Found x -> return x
222+ Found x -> return x
223 where
223 where
224+ notFound =
224− notFound = "Hakyll.Core.Compiler.getDependency: " ++ show id'
225+ "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " not found " ++
225− ++ " not found in the cache, the cache might be corrupted or"
226+ "not found in the cache, the cache might be corrupted or " ++
226− ++ " the item you are referring to might not exist"
227+ "the item you are referring to might not exist"
228+ wrongType e r =
227− wrongType = "Hakyll.Core.Compiler.getDependency: " ++ show id'
229+ "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was found " ++
228− ++ " was found in the cache, but does not have the expected "
230+ "in the cache, but does not have the right type: expected " ++ show e ++
229− ++ " type"
231+ " but got " ++ show r
230
232
231-- | Variant of 'require' which drops the current value
233-- | Variant of 'require' which drops the current value
232--
234--
src/Hakyll/Core/Store.hs+6−6
@@ -1,6 +1,6 @@
1-- | A store for stroing and retreiving items
1-- | A store for stroing and retreiving items
2--
2--
3−{-# LANGUAGE ExistentialQuantification #-}
3+{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-}
4module Hakyll.Core.Store
4module Hakyll.Core.Store
5 ( Store
5 ( Store
6 , StoreGet (..)
6 , StoreGet (..)
@@ -17,7 +17,7 @@ import Data.Map (Map)
17import qualified Data.Map as M
17import qualified Data.Map as M
18
18
19import Data.Binary (Binary, encodeFile, decodeFile)
19import Data.Binary (Binary, encodeFile, decodeFile)
20−import Data.Typeable (Typeable, cast)
20+import Data.Typeable (Typeable, TypeRep, cast, typeOf)
21
21
22import Hakyll.Core.Identifier
22import Hakyll.Core.Identifier
23import Hakyll.Core.Util.File
23import Hakyll.Core.Util.File
@@ -30,8 +30,8 @@ data Storable = forall a. (Binary a, Typeable a) => Storable a
30--
30--
31data StoreGet a = Found a
31data StoreGet a = Found a
32 | NotFound
32 | NotFound
33− | WrongType
33+ | WrongType TypeRep TypeRep
34− deriving (Show, Eq, Ord)
34+ deriving (Show, Eq)
35
35
36-- | Data structure used for the store
36-- | Data structure used for the store
37--
37--
@@ -79,7 +79,7 @@ storeSet store name identifier value = do
79
79
80-- | Load an item
80-- | Load an item
81--
81--
82−storeGet :: (Binary a, Typeable a)
82+storeGet :: forall a. (Binary a, Typeable a)
83 => Store -> String -> Identifier -> IO (StoreGet a)
83 => Store -> String -> Identifier -> IO (StoreGet a)
84storeGet store name identifier = do
84storeGet store name identifier = do
85 -- First check the in-memory map
85 -- First check the in-memory map
@@ -87,7 +87,7 @@ storeGet store name identifier = do
87 case M.lookup path map' of
87 case M.lookup path map' of
88 -- Found in the in-memory map
88 -- Found in the in-memory map
89 Just (Storable s) -> return $ case cast s of
89 Just (Storable s) -> return $ case cast s of
90− Nothing -> WrongType
90+ Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a)
91 Just s' -> Found s'
91 Just s' -> Found s'
92 -- Not found in the map, try the filesystem
92 -- Not found in the map, try the filesystem
93 Nothing -> do
93 Nothing -> do