From dfe14d295ec7c3f75a0ea845d34de00cda2986e9 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Tue, 17 May 2011 10:57:37 +0200
Subject: More better errors

---
 src/Hakyll/Core/Compiler.hs          | 18 +++++++++++-------
 src/Hakyll/Core/Resource/Provider.hs |  2 +-
 src/Hakyll/Core/Run.hs               |  6 +++---
 src/Hakyll/Core/Store.hs             | 18 ++++++++++++++----
 4 files changed, 29 insertions(+), 15 deletions(-)

diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index d25af45..767a082 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -213,12 +213,16 @@ getDependency id' = CompilerM $ do
     store <- compilerStore <$> ask
     result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id'
     case result of
-        Nothing -> throwError error'
-        Just x  -> return x
+        NotFound  -> throwError notFound
+        WrongType -> throwError wrongType
+        Found x   -> return x
   where
-    error' =  "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"
+    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"
 
 -- | Variant of 'require' which drops the current value
 --
@@ -289,8 +293,8 @@ cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
                 liftIO $ storeSet store name identifier v
                 return v
         else do v <- liftIO $ storeGet store name identifier
-                case v of Just v' -> return v'
-                          Nothing -> throwError error'
+                case v of Found v' -> return v'
+                          _        -> throwError error'
   where
     error' = "Hakyll.Core.Compiler.cached: Cache corrupt!"
 
diff --git a/src/Hakyll/Core/Resource/Provider.hs b/src/Hakyll/Core/Resource/Provider.hs
index 944f9c7..16b9220 100644
--- a/src/Hakyll/Core/Resource/Provider.hs
+++ b/src/Hakyll/Core/Resource/Provider.hs
@@ -90,7 +90,7 @@ digestModified provider store resource = do
     -- Calculate the digest for the resource
     newDigest <- resourceDigest provider resource
     -- Check digests
-    if Just newDigest == lastDigest
+    if Found newDigest == lastDigest
         -- All is fine, not modified
         then return False
         -- Resource modified; store new digest
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index 9b49b74..643aa4e 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -14,7 +14,6 @@ import Control.Monad.State.Strict (StateT, runStateT, get, put)
 import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Monoid (mempty, mappend)
-import Data.Maybe (fromMaybe)
 import System.FilePath ((</>))
 import qualified Data.Set as S
 
@@ -48,8 +47,9 @@ run configuration rules = do
 
     -- Fetch the old graph from the store. If we don't find it, we consider this
     -- to be the first run
-    (firstRun, oldGraph) <- fromMaybe (True, mempty) . fmap ((,) False) <$>
-        storeGet store "Hakyll.Core.Run.run" "dependencies"
+    graph <- storeGet store "Hakyll.Core.Run.run" "dependencies"
+    let (firstRun, oldGraph) = case graph of Found g -> (False, g)
+                                             _       -> (True, mempty)
 
     let ruleSet = runRules rules provider
         compilers = rulesCompilers ruleSet
diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs
index e0d6774..7114afc 100644
--- a/src/Hakyll/Core/Store.hs
+++ b/src/Hakyll/Core/Store.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE ExistentialQuantification #-}
 module Hakyll.Core.Store
     ( Store
+    , StoreGet (..)
     , makeStore
     , storeSet
     , storeGet
@@ -25,6 +26,13 @@ import Hakyll.Core.Util.File
 --
 data Storable = forall a. (Binary a, Typeable a) => Storable a
 
+-- | Result when an item from the store
+--
+data StoreGet a = Found a
+                | NotFound
+                | WrongType
+                deriving (Show, Eq, Ord)
+
 -- | Data structure used for the store
 --
 data Store = Store
@@ -72,22 +80,24 @@ storeSet store name identifier value = do
 -- | Load an item
 --
 storeGet :: (Binary a, Typeable a)
-         => Store -> String -> Identifier -> IO (Maybe a)
+         => Store -> String -> Identifier -> IO (StoreGet a)
 storeGet store name identifier = do
     -- First check the in-memory map
     map' <- readMVar $ storeMap store
     case M.lookup path map' of
         -- Found in the in-memory map
-        Just (Storable s) -> return $ cast s
+        Just (Storable s) -> return $ case cast s of
+            Nothing -> WrongType
+            Just s' -> Found s'
         -- Not found in the map, try the filesystem
         Nothing -> do
             exists <- doesFileExist path
             if not exists
                 -- Not found in the filesystem either
-                then return Nothing
+                then return NotFound
                 -- Found in the filesystem
                 else do v <- decodeFile path
                         addToMap store path v
-                        return $ Just v
+                        return $ Found v
   where
     path = makePath store name identifier
-- 
cgit v1.2.3