summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll/Core/Compiler.hs17
-rw-r--r--src/Hakyll/Core/Compiler/Internal.hs28
-rw-r--r--src/Hakyll/Core/DirectedGraph/Dot.hs6
-rw-r--r--src/Hakyll/Core/Resource.hs16
-rw-r--r--src/Hakyll/Core/Resource/Provider.hs12
-rw-r--r--src/Hakyll/Core/Resource/Provider/File.hs9
-rw-r--r--src/Hakyll/Core/Rules.hs6
-rw-r--r--src/Hakyll/Core/Run.hs44
-rw-r--r--src/Hakyll/Core/Store.hs7
9 files changed, 86 insertions, 59 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index db51131..f8e8e6f 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -138,15 +138,16 @@ import Hakyll.Core.Logger
runCompiler :: Compiler () CompileRule -- ^ Compiler to run
-> Identifier -- ^ Target identifier
-> ResourceProvider -- ^ Resource provider
+ -> [Identifier] -- ^ Universe
-> Routes -- ^ Route
-> Store -- ^ Store
-> Bool -- ^ Was the resource modified?
-> Logger -- ^ Logger
-> IO (Throwing CompileRule) -- ^ Resulting item
-runCompiler compiler identifier provider routes store modified logger = do
+runCompiler compiler id' provider universe routes store modified logger = do
-- Run the compiler job
- result <-
- runCompilerJob compiler identifier provider routes store modified logger
+ result <- runCompilerJob compiler id' provider universe
+ routes store modified logger
-- Inspect the result
case result of
@@ -154,7 +155,7 @@ runCompiler compiler identifier provider routes store modified logger = do
-- before we return control. This makes sure the compiled item can later
-- be accessed by e.g. require.
Right (CompileRule (CompiledItem x)) ->
- storeSet store "Hakyll.Core.Compiler.runCompiler" identifier x
+ storeSet store "Hakyll.Core.Compiler.runCompiler" id' x
-- Otherwise, we do nothing here
_ -> return ()
@@ -184,7 +185,7 @@ getResourceString :: Compiler Resource String
getResourceString = fromJob $ \resource -> CompilerM $ do
let identifier = unResource resource
provider <- compilerResourceProvider <$> ask
- if resourceExists provider identifier
+ if resourceExists provider resource
then liftIO $ resourceString provider resource
else throwError $ error' identifier
where
@@ -238,9 +239,9 @@ requireAll_ :: (Binary a, Typeable a, Writable a)
-> Compiler b [a]
requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'
where
- getDeps = filterMatches pattern . map unResource . resourceList
+ getDeps = filterMatches pattern
requireAll_' = const $ CompilerM $ do
- deps <- getDeps . compilerResourceProvider <$> ask
+ deps <- getDeps . compilerUniverse <$> ask
mapM (unCompilerM . getDependency) deps
-- | Require a number of targets. Using this function ensures automatic handling
@@ -271,7 +272,7 @@ cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
modified <- compilerResourceModified <$> ask
report logger $ "Checking cache: " ++ if modified then "modified" else "OK"
if modified
- then do v <- unCompilerM $ j $ Resource identifier
+ then do v <- unCompilerM $ j $ fromIdentifier identifier
liftIO $ storeSet store name identifier v
return v
else do v <- liftIO $ storeGet store name identifier
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 1a3c4c3..594c23e 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -39,9 +39,9 @@ type Dependencies = Set Identifier
--
data DependencyEnvironment = DependencyEnvironment
{ -- | Target identifier
- dependencyIdentifier :: Identifier
- , -- | Resource provider
- dependencyResourceProvider :: ResourceProvider
+ dependencyIdentifier :: Identifier
+ , -- | List of available identifiers we can depend upon
+ dependencyUniverse :: [Identifier]
}
-- | Environment in which a compiler runs
@@ -51,6 +51,8 @@ data CompilerEnvironment = CompilerEnvironment
compilerIdentifier :: Identifier
, -- | Resource provider
compilerResourceProvider :: ResourceProvider
+ , -- | List of all known identifiers
+ compilerUniverse :: [Identifier]
, -- | Site routes
compilerRoutes :: Routes
, -- | Compiler store
@@ -107,17 +109,19 @@ instance ArrowChoice Compiler where
runCompilerJob :: Compiler () a -- ^ Compiler to run
-> Identifier -- ^ Target identifier
-> ResourceProvider -- ^ Resource provider
+ -> [Identifier] -- ^ Universe
-> Routes -- ^ Route
-> Store -- ^ Store
-> Bool -- ^ Was the resource modified?
-> Logger -- ^ Logger
-> IO (Throwing a) -- ^ Result
-runCompilerJob compiler identifier provider route store modified logger =
+runCompilerJob compiler id' provider universe route store modified logger =
runReaderT (runErrorT $ unCompilerM $ compilerJob compiler ()) env
where
env = CompilerEnvironment
- { compilerIdentifier = identifier
+ { compilerIdentifier = id'
, compilerResourceProvider = provider
+ , compilerUniverse = universe
, compilerRoutes = route
, compilerStore = store
, compilerResourceModified = modified
@@ -126,25 +130,25 @@ runCompilerJob compiler identifier provider route store modified logger =
runCompilerDependencies :: Compiler () a
-> Identifier
- -> ResourceProvider
+ -> [Identifier]
-> Dependencies
-runCompilerDependencies compiler identifier provider =
+runCompilerDependencies compiler identifier universe =
runReader (compilerDependencies compiler) env
where
env = DependencyEnvironment
- { dependencyIdentifier = identifier
- , dependencyResourceProvider = provider
+ { dependencyIdentifier = identifier
+ , dependencyUniverse = universe
}
fromJob :: (a -> CompilerM b)
-> Compiler a b
fromJob = Compiler (return S.empty)
-fromDependencies :: (Identifier -> ResourceProvider -> [Identifier])
+fromDependencies :: (Identifier -> [Identifier] -> [Identifier])
-> Compiler b b
fromDependencies collectDeps = flip Compiler return $ do
- DependencyEnvironment identifier provider <- ask
- return $ S.fromList $ collectDeps identifier provider
+ DependencyEnvironment identifier universe <- ask
+ return $ S.fromList $ collectDeps identifier universe
-- | Wait until another compiler has finished before running this compiler
--
diff --git a/src/Hakyll/Core/DirectedGraph/Dot.hs b/src/Hakyll/Core/DirectedGraph/Dot.hs
index 8289992..58f375c 100644
--- a/src/Hakyll/Core/DirectedGraph/Dot.hs
+++ b/src/Hakyll/Core/DirectedGraph/Dot.hs
@@ -16,11 +16,13 @@ toDot :: Ord a
-> String -- ^ Resulting string
toDot showTag graph = unlines $ concat
[ return "digraph dependencies {"
- , concatMap showNode (S.toList $ nodes graph)
+ , map showNode (S.toList $ nodes graph)
+ , concatMap showEdges (S.toList $ nodes graph)
, return "}"
]
where
- showNode node = map (showEdge node) $ S.toList $ neighbours node graph
+ showNode node = " \"" ++ showTag node ++ "\";"
+ showEdges node = map (showEdge node) $ S.toList $ neighbours node graph
showEdge x y = " \"" ++ showTag x ++ "\" -> \"" ++ showTag y ++ "\";"
-- | Write out the @.dot@ file to a given file path. See 'toDot' for more
diff --git a/src/Hakyll/Core/Resource.hs b/src/Hakyll/Core/Resource.hs
index d60fda9..8154752 100644
--- a/src/Hakyll/Core/Resource.hs
+++ b/src/Hakyll/Core/Resource.hs
@@ -2,13 +2,23 @@
--
module Hakyll.Core.Resource
( Resource (..)
+ , fromIdentifier
+ , toIdentifier
) where
import Hakyll.Core.Identifier
-- | A resource
--
--- Invariant: the resource specified by the given identifier must exist
---
-newtype Resource = Resource {unResource :: Identifier}
+newtype Resource = Resource {unResource :: String}
deriving (Eq, Show, Ord)
+
+-- | Create a resource from an identifier
+--
+fromIdentifier :: Identifier -> Resource
+fromIdentifier = Resource . toFilePath
+
+-- | Map the resource to an identifier. Note that the group will not be set!
+--
+toIdentifier :: Resource -> Identifier
+toIdentifier = parseIdentifier . unResource
diff --git a/src/Hakyll/Core/Resource/Provider.hs b/src/Hakyll/Core/Resource/Provider.hs
index 67299a6..cb70cf9 100644
--- a/src/Hakyll/Core/Resource/Provider.hs
+++ b/src/Hakyll/Core/Resource/Provider.hs
@@ -27,7 +27,6 @@ import qualified Data.ByteString.Lazy as LB
import OpenSSL.Digest.ByteString.Lazy (digest)
import OpenSSL.Digest (MessageDigest (MD5))
-import Hakyll.Core.Identifier
import Hakyll.Core.Store
import Hakyll.Core.Resource
@@ -46,8 +45,8 @@ data ResourceProvider = ResourceProvider
-- | Check if a given identifier has a resource
--
-resourceExists :: ResourceProvider -> Identifier -> Bool
-resourceExists provider = flip elem $ map unResource $ resourceList provider
+resourceExists :: ResourceProvider -> Resource -> Bool
+resourceExists provider = flip elem $ resourceList provider
-- | Retrieve a digest for a given resource
--
@@ -64,7 +63,7 @@ resourceModified provider store resource = do
Just m -> return m
-- Not yet in the cache, check digests (if it exists)
Nothing -> do
- m <- if resourceExists provider (unResource resource)
+ m <- if resourceExists provider resource
then digestModified provider store resource
else return False
modifyMVar_ mvar (return . M.insert resource m)
@@ -77,7 +76,7 @@ resourceModified provider store resource = do
digestModified :: ResourceProvider -> Store -> Resource -> IO Bool
digestModified provider store resource = do
-- Get the latest seen digest from the store
- lastDigest <- storeGet store itemName $ unResource resource
+ lastDigest <- storeGet store itemName identifier
-- Calculate the digest for the resource
newDigest <- resourceDigest provider resource
-- Check digests
@@ -85,7 +84,8 @@ digestModified provider store resource = do
-- All is fine, not modified
then return False
-- Resource modified; store new digest
- else do storeSet store itemName (unResource resource) newDigest
+ else do storeSet store itemName identifier newDigest
return True
where
+ identifier = toIdentifier resource
itemName = "Hakyll.Core.ResourceProvider.digestModified"
diff --git a/src/Hakyll/Core/Resource/Provider/File.hs b/src/Hakyll/Core/Resource/Provider/File.hs
index 953d61c..5383b51 100644
--- a/src/Hakyll/Core/Resource/Provider/File.hs
+++ b/src/Hakyll/Core/Resource/Provider/File.hs
@@ -12,7 +12,6 @@ import qualified Data.ByteString.Lazy as LB
import Hakyll.Core.Resource
import Hakyll.Core.Resource.Provider
-import Hakyll.Core.Identifier
import Hakyll.Core.Util.File
import Hakyll.Core.Configuration
@@ -20,8 +19,8 @@ import Hakyll.Core.Configuration
--
fileResourceProvider :: HakyllConfiguration -> IO ResourceProvider
fileResourceProvider configuration = do
- -- Retrieve a list of identifiers
- list <- map parseIdentifier . filter (not . ignoreFile configuration) <$>
+ -- Retrieve a list of paths
+ list <- filter (not . ignoreFile configuration) <$>
getRecursiveContents False "."
-- MVar for the cache
@@ -30,7 +29,7 @@ fileResourceProvider configuration = do
-- Construct a resource provider
return ResourceProvider
{ resourceList = map Resource list
- , resourceString = readFile . toFilePath . unResource
- , resourceLazyByteString = LB.readFile . toFilePath . unResource
+ , resourceString = readFile . unResource
+ , resourceLazyByteString = LB.readFile . unResource
, resourceModifiedCache = mvar
}
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index 9f88b82..93f5028 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -102,11 +102,11 @@ compile :: (Binary a, Typeable a, Writable a)
compile compiler = RulesM $ do
pattern <- rulesPattern <$> ask
provider <- rulesResourceProvider <$> ask
- let ids = filterMatches pattern $ map unResource $ resourceList provider
+ let ids = filterMatches pattern $ map toIdentifier $ resourceList provider
unRulesM $ do
tellCompilers $ flip map ids $ \identifier ->
- (identifier, constA (Resource identifier) >>> compiler)
- tellResources $ map Resource ids
+ (identifier, constA (fromIdentifier identifier) >>> compiler)
+ tellResources $ map fromIdentifier ids
-- | Add a compilation rule
--
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index af2ad22..d9d1cf7 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -64,6 +64,9 @@ run configuration rules = do
, hakyllStore = store
}
+ -- DEBUG
+ report logger $ "Compilers: " ++ show (map fst compilers)
+
-- Run the program and fetch the resulting state
((), state') <- runStateT stateT $ RuntimeState
{ hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph
@@ -118,39 +121,43 @@ addNewCompilers newCompilers = Runtime $ do
provider <- hakyllResourceProvider <$> ask
store <- hakyllStore <$> ask
+ -- DEBUG
+ report logger $ "Adding: " ++ show (map fst newCompilers)
+
-- Old state information
oldCompilers <- hakyllCompilers <$> get
oldAnalyzer <- hakyllAnalyzer <$> get
- let -- Create a new partial dependency graph
+ let -- All known compilers
+ universe = M.keys oldCompilers ++ map fst newCompilers
+
+ -- Create a new partial dependency graph
dependencies = flip map newCompilers $ \(id', compiler) ->
- let deps = runCompilerDependencies compiler id' provider
+ let deps = runCompilerDependencies compiler id' universe
in (id', deps)
-- Create the dependency graph
newGraph = fromList dependencies
+ -- DEBUG
+ report logger $ "Dependencies: " ++ show dependencies
+ liftIO $ writeFile "newGraph.dot" $ toDot show newGraph
+
+
-- Check which items have been modified
- modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $
- liftIO . resourceModified provider store . Resource
- -- newModified <- liftIO $ modified provider store $ map fst newCompilers
+ modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $ \id' -> do
+ m <- liftIO $ resourceModified provider store $ fromIdentifier id'
+ liftIO $ putStrLn $ show id' ++ " " ++ show m
+ return m
+
+ -- DEBUG
+ report logger $ "Modified: " ++ show modified
-- Create a new analyzer and append it to the currect one
let newAnalyzer = makeDependencyAnalyzer newGraph (`S.member` modified) $
analyzerPreviousGraph oldAnalyzer
analyzer = mappend oldAnalyzer newAnalyzer
- -- Debugging
- liftIO $ putStrLn $ "Remains: " ++ show (analyzerRemains newAnalyzer)
- liftIO $ putStrLn $ "Done: " ++ show (analyzerDone newAnalyzer)
- liftIO $ writeFile "old-prev.dot" $ toDot show (analyzerPreviousGraph oldAnalyzer)
- liftIO $ writeFile "old.dot" $ toDot show (analyzerGraph oldAnalyzer)
- liftIO $ writeFile "old-prev.dot" $ toDot show (analyzerPreviousGraph oldAnalyzer)
- liftIO $ writeFile "new.dot" $ toDot show (analyzerGraph newAnalyzer)
- liftIO $ writeFile "new-prev.dot" $ toDot show (analyzerPreviousGraph newAnalyzer)
- liftIO $ writeFile "result.dot" $ toDot show (analyzerGraph analyzer)
- liftIO $ writeFile "result-prev.dot" $ toDot show (analyzerPreviousGraph analyzer)
-
-- Update the state
put $ RuntimeState
{ hakyllAnalyzer = analyzer
@@ -185,11 +192,12 @@ build id' = Runtime $ do
let compiler = compilers M.! id'
-- Check if the resource was modified
- isModified <- liftIO $ resourceModified provider store (Resource id')
+ isModified <- liftIO $ resourceModified provider store $ fromIdentifier id'
-- Run the compiler
result <- timed logger "Total compile time" $ liftIO $
- runCompiler compiler id' provider routes store isModified logger
+ runCompiler compiler id' provider (M.keys compilers) routes
+ store isModified logger
case result of
-- Compile rule for one item, easy stuff
diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs
index be1b4a7..e0d6774 100644
--- a/src/Hakyll/Core/Store.hs
+++ b/src/Hakyll/Core/Store.hs
@@ -11,6 +11,7 @@ module Hakyll.Core.Store
import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_)
import System.FilePath ((</>))
import System.Directory (doesFileExist)
+import Data.Maybe (fromMaybe)
import Data.Map (Map)
import qualified Data.Map as M
@@ -52,8 +53,10 @@ addToMap store path value =
-- | Create a path
--
makePath :: Store -> String -> Identifier -> FilePath
-makePath store name identifier =
- storeDirectory store </> name </> toFilePath identifier </> "hakyllstore"
+makePath store name identifier = storeDirectory store </> name
+ </> group </> toFilePath identifier </> "hakyllstore"
+ where
+ group = fromMaybe "" $ identifierGroup identifier
-- | Store an item
--
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-27 07:58:28 +0000