From 95e1fcf0a2a5a51e486311079d7aa2bb2035c8e6 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <m@jaspervdj.be>
Date: Wed, 5 Dec 2012 16:49:28 +0100
Subject: Better error message for require/notFound
---
src/Hakyll/Core/Compiler/Internal.hs | 6 ++++--
src/Hakyll/Core/Compiler/Require.hs | 8 +++++++-
src/Hakyll/Core/Runtime.hs | 12 ++++++------
3 files changed, 17 insertions(+), 9 deletions(-)
(limited to 'src')
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 8eb950c..6e07602 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -29,6 +29,8 @@ import Control.Applicative (Alternative (..),
Applicative (..), (<$>))
import Control.Exception (SomeException, handle)
import Data.Monoid (Monoid (..))
+import Data.Set (Set)
+import qualified Data.Set as S
--------------------------------------------------------------------------------
@@ -50,7 +52,7 @@ data CompilerRead = CompilerRead
, -- | Resource provider
compilerProvider :: Provider
, -- | List of all known identifiers
- compilerUniverse :: [Identifier]
+ compilerUniverse :: Set Identifier
, -- | Site routes
compilerRoutes :: Routes
, -- | Compiler store
@@ -219,6 +221,6 @@ compilerGetMetadata identifier = do
compilerGetMatches :: Pattern -> Compiler [Identifier]
compilerGetMatches pattern = do
universe <- compilerUniverse <$> compilerAsk
- let matching = filterMatches pattern universe
+ let matching = filterMatches pattern $ S.toList universe
compilerTellDependencies [PatternDependency pattern matching]
return matching
diff --git a/src/Hakyll/Core/Compiler/Require.hs b/src/Hakyll/Core/Compiler/Require.hs
index f67bf2c..3571bf6 100644
--- a/src/Hakyll/Core/Compiler/Require.hs
+++ b/src/Hakyll/Core/Compiler/Require.hs
@@ -14,7 +14,9 @@ module Hakyll.Core.Compiler.Require
--------------------------------------------------------------------------------
import Control.Applicative ((<$>))
+import Control.Monad (when)
import Data.Binary (Binary)
+import qualified Data.Set as S
import Data.Typeable
@@ -61,7 +63,11 @@ require id' = requireSnapshot id' final
requireSnapshot :: (Binary a, Typeable a)
=> Identifier -> Snapshot -> Compiler (Item a)
requireSnapshot id' snapshot = do
- store <- compilerStore <$> compilerAsk
+ store <- compilerStore <$> compilerAsk
+ universe <- compilerUniverse <$> compilerAsk
+
+ -- Quick check for better error messages
+ when (id' `S.notMember` universe) $ compilerThrow notFound
compilerTellDependencies [IdentifierDependency id']
compilerResult $ CompilerRequire id' $ do
diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs
index 99ba1a4..63e2414 100644
--- a/src/Hakyll/Core/Runtime.hs
+++ b/src/Hakyll/Core/Runtime.hs
@@ -66,7 +66,7 @@ run config rules = do
, runtimeProvider = provider
, runtimeStore = store
, runtimeRoutes = rulesRoutes ruleSet
- , runtimeUniverse = compilers
+ , runtimeUniverse = M.fromList compilers
}
state = RuntimeState
{ runtimeDone = S.empty
@@ -97,7 +97,7 @@ data RuntimeRead = RuntimeRead
, runtimeProvider :: Provider
, runtimeStore :: Store
, runtimeRoutes :: Routes
- , runtimeUniverse :: [(Identifier, Compiler SomeItem)]
+ , runtimeUniverse :: Map Identifier (Compiler SomeItem)
}
@@ -133,12 +133,12 @@ scheduleOutOfDate = do
facts <- runtimeFacts <$> get
todo <- runtimeTodo <$> get
- let identifiers = map fst universe
+ let identifiers = M.keys universe
modified <- fmap S.fromList $ flip filterM identifiers $
liftIO . resourceModified provider
let (ood, facts', msgs) = outOfDate identifiers modified facts
- todo' = M.fromList
- [(id', c) | (id', c) <- universe, id' `S.member` ood]
+ todo' = M.filterWithKey
+ (\id' _ -> id' `S.member` ood) universe
-- Print messages
mapM_ (Logger.debug logger) msgs
@@ -181,7 +181,7 @@ chase trail id'
read' = CompilerRead
{ compilerUnderlying = id'
, compilerProvider = provider
- , compilerUniverse = map fst universe
+ , compilerUniverse = M.keysSet universe
, compilerRoutes = routes
, compilerStore = store
, compilerLogger = logger
--
cgit v1.2.3