Better error messages for type errors

2 files changed, 17 insertions, 15 deletions

diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index 5ef3256..2164dda 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -217,16 +217,18 @@ getDependency id' = CompilerM $ do
     store <- compilerStore <$> ask
     result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id'
     case result of
-        NotFound  -> throwError notFound
-        WrongType -> throwError wrongType
-        Found x   -> return x
+        NotFound      -> throwError notFound
+        WrongType e r -> throwError $ wrongType e r
+        Found x       -> return x
   where
-    notFound =  "Hakyll.Core.Compiler.getDependency: " ++ show id'
-             ++ " not found in the cache, the cache might be corrupted or"
-             ++ " the item you are referring to might not exist"
-    wrongType =  "Hakyll.Core.Compiler.getDependency: " ++ show id'
-              ++ " was found in the cache, but does not have the expected "
-              ++ " type"
+    notFound =
+        "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " not  found " ++
+        "not found in the cache, the cache might be corrupted or " ++
+        "the item you are referring to might not exist"
+    wrongType e r =
+        "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was found " ++
+        "in the cache, but does not have the right type: expected " ++ show e ++
+        " but got " ++ show r
 
 -- | Variant of 'require' which drops the current value
 --
diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs
index 7114afc..20e85d7 100644
--- a/src/Hakyll/Core/Store.hs
+++ b/src/Hakyll/Core/Store.hs
@@ -1,6 +1,6 @@
 -- | A store for stroing and retreiving items
 --
-{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-}
 module Hakyll.Core.Store
     ( Store
     , StoreGet (..)
@@ -17,7 +17,7 @@ import Data.Map (Map)
 import qualified Data.Map as M
 
 import Data.Binary (Binary, encodeFile, decodeFile)
-import Data.Typeable (Typeable, cast)
+import Data.Typeable (Typeable, TypeRep, cast, typeOf)
 
 import Hakyll.Core.Identifier
 import Hakyll.Core.Util.File
@@ -30,8 +30,8 @@ data Storable = forall a. (Binary a, Typeable a) => Storable a
 --
 data StoreGet a = Found a
                 | NotFound
-                | WrongType
-                deriving (Show, Eq, Ord)
+                | WrongType TypeRep TypeRep
+                deriving (Show, Eq)
 
 -- | Data structure used for the store
 --
@@ -79,7 +79,7 @@ storeSet store name identifier value = do
 
 -- | Load an item
 --
-storeGet :: (Binary a, Typeable a)
+storeGet :: forall a. (Binary a, Typeable a)
          => Store -> String -> Identifier -> IO (StoreGet a)
 storeGet store name identifier = do
     -- First check the in-memory map
@@ -87,7 +87,7 @@ storeGet store name identifier = do
     case M.lookup path map' of
         -- Found in the in-memory map
         Just (Storable s) -> return $ case cast s of
-            Nothing -> WrongType
+            Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a)
             Just s' -> Found s'
         -- Not found in the map, try the filesystem
         Nothing -> do