Major refactoring of identifiers/resources/groups
This commit is contained in:
Jasper Van der Jeugt
parent
0a3cd37cc9
commit
b37da38d39
11 changed files with 88 additions and 63 deletions
|
|
@ -14,7 +14,6 @@ import System.INotify
|
|||
|
||||
import Hakyll.Core.Configuration
|
||||
import Hakyll.Core.Resource
|
||||
import Hakyll.Core.Identifier
|
||||
|
||||
-- | Calls the given callback when the directory tree changes
|
||||
--
|
||||
|
|
@ -27,7 +26,7 @@ previewPoll _ resources callback = do
|
|||
inotify <- initINotify
|
||||
|
||||
let -- A set of file paths
|
||||
paths = S.map (toFilePath . unResource) resources
|
||||
paths = S.map unResource resources
|
||||
|
||||
-- A list of directories. Run it through a set so we have every
|
||||
-- directory only once.
|
||||
|
|
|
|||
|
|
@ -14,7 +14,6 @@ import qualified Data.Set as S
|
|||
import System.Directory (getModificationTime, doesFileExist)
|
||||
|
||||
import Hakyll.Core.Configuration
|
||||
import Hakyll.Core.Identifier
|
||||
import Hakyll.Core.Resource
|
||||
|
||||
-- | A preview thread that periodically recompiles the site.
|
||||
|
|
@ -24,7 +23,7 @@ previewPoll :: HakyllConfiguration -- ^ Configuration
|
|||
-> IO () -- ^ Action called when something changes
|
||||
-> IO () -- ^ Can block forever
|
||||
previewPoll _ resources callback = do
|
||||
let files = map (toFilePath . unResource) $ S.toList resources
|
||||
let files = map unResource $ S.toList resources
|
||||
time <- getClockTime
|
||||
loop files time
|
||||
where
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
--
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
--
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
--
|
||||
|
|
|
|||
Loading…
Reference in a new issue