diff options
| -rw-r--r-- | src/Hakyll/Core/Compiler/Internal.hs | 6 | ||||
| -rw-r--r-- | src/Hakyll/Core/Compiler/Require.hs | 8 | ||||
| -rw-r--r-- | src/Hakyll/Core/Runtime.hs | 12 | ||||
| -rw-r--r-- | tests/TestSuite/Util.hs | 3 |
4 files changed, 19 insertions, 10 deletions
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 diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs index 8e6249e..7a2f0a7 100644 --- a/tests/TestSuite/Util.hs +++ b/tests/TestSuite/Util.hs @@ -14,6 +14,7 @@ module TestSuite.Util -------------------------------------------------------------------------------- import Data.Monoid (mempty) +import qualified Data.Set as S import System.Directory (removeDirectoryRecursive) import Test.Framework import Test.Framework.Providers.HUnit @@ -71,7 +72,7 @@ testCompiler store provider underlying compiler = do let read' = CompilerRead { compilerUnderlying = underlying , compilerProvider = provider - , compilerUniverse = [] + , compilerUniverse = S.empty , compilerRoutes = mempty , compilerStore = store , compilerLogger = logger |