hakyll 3.1.0.0 → 3.1.1.0

raw patch · 18 files changed

+436/−283 lines, 18 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hakyll.cabal +2/−2
• src-inotify/Hakyll/Web/Preview/Poll.hs +1/−2
• src-interval/Hakyll/Web/Preview/Poll.hs +7/−7
• src/Hakyll/Core/Compiler.hs +9/−8
• src/Hakyll/Core/Compiler/Internal.hs +16/−12
• src/Hakyll/Core/DependencyAnalyzer.hs +155/−0
• src/Hakyll/Core/DirectedGraph.hs +3/−12
• src/Hakyll/Core/DirectedGraph/DependencySolver.hs +0/−70
• src/Hakyll/Core/DirectedGraph/Dot.hs +4/−2
• src/Hakyll/Core/Identifier.hs +28/−7
• src/Hakyll/Core/Identifier/Pattern.hs +17/−23
• src/Hakyll/Core/Resource.hs +13/−3
• src/Hakyll/Core/Resource/Provider.hs +22/−12
• src/Hakyll/Core/Resource/Provider/File.hs +4/−16
• src/Hakyll/Core/Rules.hs +67/−15
• src/Hakyll/Core/Rules/Internal.hs +12/−1
• src/Hakyll/Core/Run.hs +71/−89
• src/Hakyll/Core/Store.hs +5/−2

@@ -1,5 +1,5 @@ Name:               hakyll-Version:            3.1.0.0+Version:            3.1.1.0  Synopsis:           A simple static site generator library. Description:        A simple static site generator library, mainly aimed at@@ -82,6 +82,7 @@                       Hakyll.Web.Page.Read                       Hakyll.Web.Page.Metadata                       Hakyll.Core.Configuration+                      Hakyll.Core.DependencyAnalyzer                       Hakyll.Core.Identifier.Pattern                       Hakyll.Core.UnixFilter                       Hakyll.Core.Util.Arrow@@ -99,7 +100,6 @@                       Hakyll.Core.Writable.WritableTuple                       Hakyll.Core.Identifier                       Hakyll.Core.DirectedGraph.Dot-                      Hakyll.Core.DirectedGraph.DependencySolver                       Hakyll.Core.DirectedGraph                       Hakyll.Core.Rules                       Hakyll.Core.Routes

@@ -14,7 +14,6 @@  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 @@     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.

@@ -7,14 +7,13 @@  import Control.Applicative ((<$>)) import Control.Concurrent (threadDelay)-import Control.Monad (when)+import Control.Monad (when, filterM) import System.Time (getClockTime) import Data.Set (Set) import qualified Data.Set as S-import System.Directory (getModificationTime)+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,13 +23,14 @@             -> 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     delay = 1000000     loop files time = do         threadDelay delay-        modified <- any (time <) <$> mapM getModificationTime files-        when modified callback-        loop files =<< getClockTime+        files' <- filterM doesFileExist files+        modified <- any (time <) <$> mapM getModificationTime files'+        when (modified || files' /= files) callback+        loop files' =<< getClockTime

@@ -138,15 +138,16 @@ 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 @@         -- 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 = 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 @@             -> 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 @@     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 @@ -- 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 @@       compilerIdentifier       :: Identifier     , -- | Resource provider       compilerResourceProvider :: ResourceProvider+    , -- | List of all known identifiers+      compilerUniverse         :: [Identifier]     , -- | Site routes       compilerRoutes           :: Routes     , -- | Compiler store@@ -107,17 +109,19 @@ 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 @@  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 --

@@ -0,0 +1,155 @@+module Hakyll.Core.DependencyAnalyzer+    ( DependencyAnalyzer (..)+    , Signal (..)+    , makeDependencyAnalyzer+    , step+    , stepAll+    ) where++import Prelude hiding (reverse)+import qualified Prelude as P (reverse)+import Control.Arrow (first)+import Data.Set (Set)+import qualified Data.Set as S+import Data.Monoid (Monoid, mappend, mempty)++import Hakyll.Core.DirectedGraph++-- | This data structure represents the state of the dependency analyzer. It+-- holds a complete graph in 'analyzerGraph', which always contains all items,+-- whether they are to be compiled or not.+--+-- The 'analyzerRemains' fields holds the items that still need to be compiled,+-- and 'analyzerDone' holds the items which are already compiled. This means+-- that initally, 'analyzerDone' is empty and 'analyzerRemains' contains the+-- items which are out-of-date (or items which have out-of-date dependencies).+--+-- We also hold the dependency graph from the previous run because we need it+-- when we want to determine when an item is out-of-date. An item is out-of-date+-- when:+--+-- * the resource from which it compiles is out-of-date, or;+--+-- * any of it's dependencies is out-of-date, or;+--+-- * it's set of dependencies has changed since the previous run.+--+data DependencyAnalyzer a = DependencyAnalyzer+    { -- | The complete dependency graph+      analyzerGraph         :: DirectedGraph a+    , -- | A set of items yet to be compiled+      analyzerRemains       :: Set a+    , -- | A set of items already compiled+      analyzerDone          :: Set a+    , -- | The dependency graph from the previous run+      analyzerPreviousGraph :: DirectedGraph a+    } deriving (Show)++data Signal a = Build a+              | Cycle [a]+              | Done++instance (Ord a, Show a) => Monoid (DependencyAnalyzer a) where+    mempty = DependencyAnalyzer mempty mempty mempty mempty+    mappend x y = growRemains $ DependencyAnalyzer+        (analyzerGraph x `mappend` analyzerGraph y)+        (analyzerRemains x `mappend` analyzerRemains y)+        (analyzerDone x `mappend` analyzerDone y)+        (analyzerPreviousGraph x `mappend` analyzerPreviousGraph y)++-- | Construct a dependency analyzer+--+makeDependencyAnalyzer :: (Ord a, Show a)+                       => DirectedGraph a       -- ^ The dependency graph+                       -> (a -> Bool)           -- ^ Is an item out-of-date?+                       -> DirectedGraph a       -- ^ The old dependency graph+                       -> DependencyAnalyzer a  -- ^ Resulting analyzer+makeDependencyAnalyzer graph isOutOfDate prev =+    growRemains $ DependencyAnalyzer graph remains S.empty prev+  where+    -- Construct the remains set by filtering using the given predicate+    remains = S.fromList $ filter isOutOfDate $ map fst $ toList graph++-- | The 'analyzerRemains' field of a 'DependencyAnalyzer' is supposed to+-- contain all out-of-date items, including the items with out-of-date+-- dependencies. However, it is easier to just set up the directly out-of-date+-- items initially -- and then grow the remains fields.+--+-- This function assumes the 'analyzerRemains' fields in incomplete, and tries+-- to correct it. Running it when the field is complete has no effect -- but it+-- is a pretty expensive function, and it should be used with care.+--+growRemains :: (Ord a, Show a) => DependencyAnalyzer a -> DependencyAnalyzer a+growRemains (DependencyAnalyzer graph remains done prev) =+    (DependencyAnalyzer graph remains' done prev)+  where+    -- Grow the remains set using the indirect and changedDeps values, then+    -- filter out the items already done+    remains' = S.filter (`S.notMember` done) indirect++    -- Select the nodes which are reachable from the remaining nodes in the+    -- reversed dependency graph: these are the indirectly out-of-date items+    indirect = reachableNodes (remains `S.union` changedDeps) $ reverse graph++    -- For all nodes in the graph, check which items have a different dependency+    -- set compared to the previous run+    changedDeps = S.fromList $ map fst $+        filter (uncurry (/=) . first (`neighbours` prev)) $ toList graph++-- | Step a dependency analyzer+--+step :: (Ord a, Show a) => DependencyAnalyzer a -> (Signal a, DependencyAnalyzer a)+step analyzer@(DependencyAnalyzer graph remains done prev)+    -- No remaining items+    | S.null remains = (Done, analyzer)+    -- An item remains, let's find a ready item+    | otherwise =+        let item = S.findMin remains+        in case findReady analyzer item of+            Done        -> (Done, analyzer)+            Cycle c     -> (Cycle c, analyzer)+            -- A ready item was found, signal a build+            Build build ->+                let remains' = S.delete build remains+                    done'    = S.insert build done+                in (Build build, DependencyAnalyzer graph remains' done' prev)++-- | Step until done, creating a set of items we need to build -- mostly used+-- for debugging purposes+--+stepAll :: (Ord a, Show a) => DependencyAnalyzer a -> Maybe (Set a)+stepAll = stepAll' S.empty+  where+    stepAll' xs analyzer = case step analyzer of+        (Build x, analyzer') -> stepAll' (S.insert x xs) analyzer'+        (Done, _)            -> Just xs+        (Cycle _, _)         -> Nothing++-- | Find an item ready to be compiled+--+findReady :: (Ord a, Show a) => DependencyAnalyzer a -> a -> Signal a+findReady analyzer = findReady' [] S.empty+  where+    -- The dependency graph+    graph = analyzerGraph analyzer++    -- Items to do+    todo = analyzerRemains analyzer `S.difference` analyzerDone analyzer++    -- Worker+    findReady' stack visited item+        -- We already visited this item, the cycle is the reversed stack+        | item `S.member` visited = Cycle $ P.reverse stack'+        -- Look at the neighbours we to do+        | otherwise = case filter (`S.member` todo) neighbours' of+            -- No neighbours available to be done: it's ready!+            []      -> Build item+            -- At least one neighbour is available, search for that one+            (x : _) -> findReady' stack' visited' x+      where+        -- Our neighbours+        neighbours' = S.toList $ neighbours item graph++        -- The new visited stack/set+        stack' = item : stack+        visited' = S.insert item visited

@@ -10,7 +10,6 @@     , neighbours     , reverse     , reachableNodes-    , sanitize     ) where  import Prelude hiding (reverse)@@ -77,17 +76,9 @@   where     reachable next visited         | S.null next = visited-        | otherwise = reachable (sanitize' neighbours') (next `S.union` visited)+        | otherwise = reachable (sanitize neighbours') (next `S.union` visited)       where-        sanitize' = S.filter (`S.notMember` visited)-        neighbours' = setNeighbours (sanitize' next)+        sanitize = S.filter (`S.notMember` visited)+        neighbours' = setNeighbours (sanitize next)      setNeighbours = S.unions . map (`neighbours` graph) . S.toList-    --- | Remove all dangling pointers, i.e. references to notes that do --- not actually exist in the graph.----sanitize :: Ord a => DirectedGraph a -> DirectedGraph a-sanitize (DirectedGraph graph) = DirectedGraph $ M.map sanitize' graph-  where-    sanitize' (Node t n) = Node t $ S.filter (`M.member` graph) n

@@ -1,70 +0,0 @@--- | Given a dependency graph, this module provides a function that will--- generate an order in which the graph can be visited, so that all the--- dependencies of a given node have been visited before the node itself is--- visited.----module Hakyll.Core.DirectedGraph.DependencySolver-    ( solveDependencies-    ) where--import Prelude-import qualified Prelude as P-import Data.Set (Set)-import Data.Maybe (mapMaybe)-import qualified Data.Map as M-import qualified Data.Set as S--import Hakyll.Core.DirectedGraph-import Hakyll.Core.DirectedGraph.Internal---- | Solve a dependency graph. This function returns an order to run the--- different nodes----solveDependencies :: Ord a-                  => DirectedGraph a  -- ^ Graph-                  -> [a]              -- ^ Resulting plan-solveDependencies = P.reverse . order [] [] S.empty---- | Produce a reversed order using a stack----order :: Ord a-      => [a]              -- ^ Temporary result-      -> [Node a]         -- ^ Backtrace stack-      -> Set a            -- ^ Items in the stack-      -> DirectedGraph a  -- ^ Graph-      -> [a]              -- ^ Ordered result-order temp stack set graph@(DirectedGraph graph')-    -- Empty graph - return our current result-    | M.null graph' = temp-    | otherwise = case stack of--        -- Empty stack - pick a node, and add it to the stack-        [] ->-            let (tag, node) = M.findMin graph'-            in order temp (node : stack) (S.insert tag set) graph--        -- At least one item on the stack - continue using this item-        (node : stackTail) ->-            -- Check which dependencies are still in the graph-            let tag = nodeTag node-                deps = S.toList $ nodeNeighbours node-                unsatisfied = mapMaybe (`M.lookup` graph') deps-            in case unsatisfied of-                -                -- All dependencies for node are satisfied, we can return it and-                -- remove it from the graph-                [] -> order (tag : temp) stackTail (S.delete tag set)-                            (DirectedGraph $ M.delete tag graph')--                -- There is at least one dependency left. We need to solve that-                -- one first...-                (dep : _) -> if nodeTag dep `S.member` set-                    -- The dependency is already in our stack - cycle detected!-                    then cycleError-                    -- Continue with the dependency-                    else order temp (dep : node : stackTail)-                                    (S.insert (nodeTag dep) set)-                                    graph-  where-    cycleError = error $  "Hakyll.Core.DirectedGraph.DependencySolver.order: "-                       ++ "Cycle detected!"  -- TODO: Dump cycle

@@ -16,11 +16,13 @@       -> 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

@@ -25,23 +25,38 @@     ( Identifier (..)     , parseIdentifier     , toFilePath+    , setGroup     ) where  import Control.Arrow (second)-import Data.Monoid (Monoid)+import Control.Applicative ((<$>), (<*>))+import Control.Monad (mplus)+import Data.Monoid (Monoid, mempty, mappend) import Data.List (intercalate) -import Data.Binary (Binary)+import Data.Binary (Binary, get, put) import GHC.Exts (IsString, fromString) import Data.Typeable (Typeable)  -- | An identifier used to uniquely identify a value ---newtype Identifier = Identifier {unIdentifier :: String}-                   deriving (Eq, Ord, Monoid, Binary, Typeable)+data Identifier = Identifier+    { identifierGroup :: Maybe String+    , identifierPath  :: String+    } deriving (Eq, Ord, Typeable) +instance Monoid Identifier where+    mempty = Identifier Nothing ""+    Identifier g1 p1 `mappend` Identifier g2 p2 =+        Identifier (g1 `mplus` g2) (p1 `mappend` p2)++instance Binary Identifier where+    put (Identifier g p) = put g >> put p+    get = Identifier <$> get <*> get+ instance Show Identifier where-    show = toFilePath+    show i@(Identifier Nothing _)  = toFilePath i+    show i@(Identifier (Just g) _) = toFilePath i ++ " (" ++ g ++ ")"  instance IsString Identifier where     fromString = parseIdentifier@@ -49,7 +64,8 @@ -- | Parse an identifier from a string -- parseIdentifier :: String -> Identifier-parseIdentifier = Identifier . intercalate "/" . filter (not . null) . split'+parseIdentifier = Identifier Nothing+                . intercalate "/" . filter (not . null) . split'   where     split' [] = [[]]     split' str = let (pre, post) = second (drop 1) $ break (== '/') str@@ -58,4 +74,9 @@ -- | Convert an identifier to a relative 'FilePath' -- toFilePath :: Identifier -> FilePath-toFilePath = unIdentifier+toFilePath = identifierPath++-- | Set the identifier group for some identifier+--+setGroup :: Maybe String -> Identifier -> Identifier+setGroup g (Identifier _ p) = Identifier g p

@@ -36,11 +36,11 @@     , parseGlob     , predicate     , regex+    , inGroup     , matches     , filterMatches     , capture     , fromCapture-    , fromCaptureString     , fromCaptures     ) where @@ -107,6 +107,12 @@ regex :: String -> Pattern regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath +-- | Create a 'Pattern' which matches if the identifier is in a certain group+-- (or in no group)+--+inGroup :: Maybe String -> Pattern+inGroup group = predicate $ (== group) . identifierGroup+ -- | Check if an identifier matches a pattern -- matches :: Pattern -> Identifier -> Bool@@ -126,9 +132,9 @@  -- | Match a glob against a pattern, generating a list of captures ---capture :: Pattern -> Identifier -> Maybe [Identifier]-capture (Glob p) (Identifier i) = fmap (map Identifier) $ capture' p i-capture (Predicate _) _         = Nothing+capture :: Pattern -> Identifier -> Maybe [String]+capture (Glob p) (Identifier _ i) = capture' p i+capture (Predicate _) _           = Nothing  -- | Internal verion of 'capture' --@@ -152,44 +158,32 @@ -- -- Example: ----- > fromCapture (parseGlob "tags/*") (parseIdentifier "foo")+-- > fromCapture (parseGlob "tags/*") "foo" -- -- Result: -- -- > "tags/foo" ---fromCapture :: Pattern -> Identifier -> Identifier+fromCapture :: Pattern -> String -> Identifier fromCapture pattern = fromCaptures pattern . repeat --- | Simplified version of 'fromCapture' which takes a 'String' instead of an--- 'Identifier'------ > fromCaptureString (parseGlob "tags/*") "foo"------ Result:------ > "tags/foo"----fromCaptureString :: Pattern -> String -> Identifier-fromCaptureString pattern = fromCapture pattern . parseIdentifier- -- | Create an identifier from a pattern by filling in the captures with the -- given list of strings ---fromCaptures :: Pattern -> [Identifier] -> Identifier-fromCaptures (Glob p)      = fromCaptures' p+fromCaptures :: Pattern -> [String] -> Identifier+fromCaptures (Glob p)      = Identifier Nothing . fromCaptures' p fromCaptures (Predicate _) = error $     "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures called on a " ++     "predicate instead of a glob"  -- | Internally used version of 'fromCaptures' ---fromCaptures' :: [GlobComponent] -> [Identifier] -> Identifier+fromCaptures' :: [GlobComponent] -> [String] -> String fromCaptures' []        _ = mempty fromCaptures' (m : ms) [] = case m of-    Literal l -> Identifier l `mappend` fromCaptures' ms []+    Literal l -> l `mappend` fromCaptures' ms []     _         -> error $  "Hakyll.Core.Identifier.Pattern.fromCaptures': "                        ++ "identifier list exhausted" fromCaptures' (m : ms) ids@(i : is) = case m of-    Literal l -> Identifier l `mappend` fromCaptures' ms ids+    Literal l -> l `mappend` fromCaptures' ms ids     _         -> i `mappend` fromCaptures' ms is

@@ -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

@@ -12,12 +12,14 @@ -- module Hakyll.Core.Resource.Provider     ( ResourceProvider (..)+    , makeResourceProvider     , resourceExists     , resourceDigest     , resourceModified     ) where -import Control.Concurrent (MVar, readMVar, modifyMVar_)+import Control.Applicative ((<$>))+import Control.Concurrent (MVar, readMVar, modifyMVar_, newMVar) import Control.Monad ((<=<)) import Data.Word (Word8) import Data.Map (Map)@@ -27,7 +29,6 @@ import OpenSSL.Digest.ByteString.Lazy (digest) import OpenSSL.Digest (MessageDigest (MD5)) -import Hakyll.Core.Identifier import Hakyll.Core.Store import Hakyll.Core.Resource @@ -44,10 +45,18 @@       resourceModifiedCache  :: MVar (Map Resource Bool)     } +-- | Create a resource provider+--+makeResourceProvider :: [Resource]                      -- ^ Resource list+                     -> (Resource -> IO String)         -- ^ String reader+                     -> (Resource -> IO LB.ByteString)  -- ^ ByteString reader+                     -> IO ResourceProvider             -- ^ Resulting provider+makeResourceProvider l s b = ResourceProvider l s b <$> newMVar M.empty+ -- | 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 --@@ -56,16 +65,16 @@  -- | Check if a resource was modified ---resourceModified :: ResourceProvider -> Resource -> Store -> IO Bool-resourceModified provider resource store = do+resourceModified :: ResourceProvider -> Store -> Resource -> IO Bool+resourceModified provider store resource = do     cache <- readMVar mvar     case M.lookup resource cache of         -- Already in the cache         Just m  -> return m         -- Not yet in the cache, check digests (if it exists)         Nothing -> do-            m <- if resourceExists provider (unResource resource)-                        then digestModified provider resource store+            m <- if resourceExists provider resource+                        then digestModified provider store resource                         else return False             modifyMVar_ mvar (return . M.insert resource m)             return m@@ -74,10 +83,10 @@  -- | Check if a resource digest was modified ---digestModified :: ResourceProvider -> Resource -> Store -> IO Bool-digestModified provider resource store = 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 +94,8 @@         -- 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"

@@ -5,14 +5,11 @@     ) where  import Control.Applicative ((<$>))-import Control.Concurrent (newMVar)-import qualified Data.Map as M  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,17 +17,8 @@ -- 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 <- map Resource . filter (not . ignoreFile configuration) <$>         getRecursiveContents False "."--    -- MVar for the cache-    mvar <- newMVar M.empty--    -- Construct a resource provider-    return ResourceProvider-        { resourceList           = map Resource list-        , resourceString         = readFile . toFilePath . unResource-        , resourceLazyByteString = LB.readFile . toFilePath . unResource-        , resourceModifiedCache  = mvar-        }+    makeResourceProvider list (readFile . unResource)+                              (LB.readFile . unResource)

@@ -19,6 +19,7 @@     ( RulesM     , Rules     , match+    , group     , compile     , create     , route@@ -29,7 +30,7 @@ import Control.Applicative ((<$>)) import Control.Monad.Writer (tell) import Control.Monad.Reader (ask, local)-import Control.Arrow (second, (>>>), arr, (>>^))+import Control.Arrow (second, (>>>), arr, (>>^), (***)) import Control.Monad.State (get, put) import Data.Monoid (mempty, mappend) import qualified Data.Set as S@@ -58,16 +59,21 @@ tellCompilers :: (Binary a, Typeable a, Writable a)              => [(Identifier, Compiler () a)]              -> Rules-tellCompilers compilers = RulesM $ tell $ RuleSet mempty compilers' mempty+tellCompilers compilers = RulesM $ do+    -- We box the compilers so they have a more simple type, and we apply the+    -- current group to the corresponding identifiers+    group' <- rulesGroup <$> ask+    let compilers' = map (setGroup group' *** boxCompiler) compilers+    tell $ RuleSet mempty compilers' mempty   where-    compilers' = map (second boxCompiler) compilers     boxCompiler = (>>> arr compiledItem >>> arr CompileRule)  -- | Add resources -- tellResources :: [Resource]               -> Rules-tellResources resources = RulesM $ tell $ RuleSet mempty mempty $ S.fromList resources+tellResources resources = RulesM $ tell $+    RuleSet mempty mempty $ S.fromList resources  -- | Only compile/route items satisfying the given predicate --@@ -78,6 +84,42 @@         { rulesPattern = rulesPattern env `mappend` pattern         } +-- | Greate a group of compilers+--+-- Imagine you have a page that you want to render, but you also want the raw+-- content available on your site.+--+-- > match "test.markdown" $ do+-- >     route $ setExtension "html"+-- >     compile pageCompiler+-- >+-- > match "test.markdown" $ do+-- >     route idRoute+-- >     compile copyPageCompiler+--+-- Will of course conflict! In this case, Hakyll will pick the first matching+-- compiler (@pageCompiler@ in this case).+--+-- In case you want to have them both, you can use the 'group' function to+-- create a new group. For example,+--+-- > match "test.markdown" $ do+-- >     route $ setExtension "html"+-- >     compile pageCompiler+-- >+-- > group "raw" $ do+-- >     match "test.markdown" $ do+-- >         route idRoute+-- >         compile copyPageCompiler+--+-- This will put the compiler for the raw content in a separate group+-- (@\"raw\"@), which causes it to be compiled as well.+--+group :: String -> Rules -> Rules+group g = RulesM . local setGroup' . unRulesM+  where+    setGroup' env = env { rulesGroup = Just g }+ -- | Add a compilation rule to the rules. -- -- This instructs all resources to be compiled using the given compiler. When@@ -89,11 +131,11 @@ 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 --@@ -112,8 +154,11 @@ -- route :: Routes -> Rules route route' = RulesM $ do+    -- We want the route only to be applied if we match the current pattern and+    -- group     pattern <- rulesPattern <$> ask-    unRulesM $ tellRoute $ matchRoute pattern route'+    group' <- rulesGroup <$> ask+    unRulesM $ tellRoute $ matchRoute (pattern `mappend` inGroup group') route'  -- | Apart from regular compilers, one is also able to specify metacompilers. -- Metacompilers are a special class of compilers: they are compilers which@@ -154,7 +199,7 @@     -- Create an identifier from the state     state <- get     let index = rulesMetaCompilerIndex state-        id' = fromCaptureString "Hakyll.Core.Rules.metaCompile/*" (show index)+        id' = fromCapture "Hakyll.Core.Rules.metaCompile/*" (show index)      -- Update the state with a new identifier     put $ state {rulesMetaCompilerIndex = index + 1}@@ -172,9 +217,16 @@                 -- ^ Compiler generating the other compilers                 -> Rules                 -- ^ Resulting rules-metaCompileWith identifier compiler = RulesM $ tell $-    RuleSet mempty compilers mempty-  where-    makeRule = MetaCompileRule . map (second box)-    compilers = [(identifier, compiler >>> arr makeRule )]-    box = (>>> fromDependency identifier >>^ CompileRule . compiledItem)+metaCompileWith identifier compiler = RulesM $ do+    group' <- rulesGroup <$> ask++    let -- Set the correct group on the identifier+        id' = setGroup group' identifier+        -- Function to box an item into a rule+        makeRule = MetaCompileRule . map (second box)+        -- Entire boxing function+        box = (>>> fromDependency id' >>^ CompileRule . compiledItem)+        -- Resulting compiler list+        compilers = [(id', compiler >>> arr makeRule )]++    tell $ RuleSet mempty compilers mempty

@@ -17,6 +17,7 @@ import Control.Monad.State (State, evalState) import Data.Monoid (Monoid, mempty, mappend) import Data.Set (Set)+import qualified Data.Map as M  import Hakyll.Core.Resource import Hakyll.Core.Resource.Provider@@ -63,6 +64,7 @@ data RuleEnvironment = RuleEnvironment     { rulesResourceProvider :: ResourceProvider     , rulesPattern          :: Pattern+    , rulesGroup            :: Maybe String     }  -- | The monad used to compose rules@@ -79,10 +81,19 @@ -- | Run a Rules monad, resulting in a 'RuleSet' -- runRules :: Rules -> ResourceProvider -> RuleSet-runRules rules provider =+runRules rules provider = nubCompilers $     evalState (execWriterT $ runReaderT (unRulesM rules) env) state   where     state = RuleState {rulesMetaCompilerIndex = 0}     env = RuleEnvironment { rulesResourceProvider = provider                           , rulesPattern          = mempty+                          , rulesGroup            = Nothing                           }++-- | Remove duplicate compilers from the 'RuleSet'. When two compilers match an+-- item, we prefer the first one+--+nubCompilers :: RuleSet -> RuleSet+nubCompilers set = set { rulesCompilers = nubCompilers' (rulesCompilers set) }+  where+    nubCompilers' = M.toList . M.fromListWith (flip const)

@@ -10,12 +10,12 @@ import Control.Monad.Trans (liftIO) import Control.Applicative (Applicative, (<$>)) import Control.Monad.Reader (ReaderT, runReaderT, ask)-import Control.Monad.State.Strict (StateT, runStateT, get, modify)-import Control.Arrow ((&&&))+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 Data.Set (Set) import qualified Data.Set as S  import Hakyll.Core.Routes@@ -28,7 +28,7 @@ import Hakyll.Core.Resource.Provider.File import Hakyll.Core.Rules.Internal import Hakyll.Core.DirectedGraph-import Hakyll.Core.DirectedGraph.DependencySolver+import Hakyll.Core.DependencyAnalyzer import Hakyll.Core.Writable import Hakyll.Core.Store import Hakyll.Core.Configuration@@ -46,36 +46,37 @@     provider <- timed logger "Creating provider" $         fileResourceProvider configuration +    -- Fetch the old graph from the store+    oldGraph <- fromMaybe mempty <$>+        storeGet store "Hakyll.Core.Run.run" "dependencies"+     let ruleSet = runRules rules provider         compilers = rulesCompilers ruleSet          -- Extract the reader/state-        reader = unRuntime $ addNewCompilers [] compilers-        stateT = runReaderT reader $ env logger ruleSet provider store+        reader = unRuntime $ addNewCompilers compilers+        stateT = runReaderT reader $ RuntimeEnvironment+                    { hakyllLogger           = logger+                    , hakyllConfiguration    = configuration+                    , hakyllRoutes           = rulesRoutes ruleSet+                    , hakyllResourceProvider = provider+                    , hakyllStore            = store+                    }      -- Run the program and fetch the resulting state-    ((), state') <- runStateT stateT state+    ((), state') <- runStateT stateT $ RuntimeState+        { hakyllAnalyzer  = makeDependencyAnalyzer mempty (const False) oldGraph+        , hakyllCompilers = M.empty+        }      -- We want to save the final dependency graph for the next run-    storeSet store "Hakyll.Core.Run.run" "dependencies" $ hakyllGraph state'+    storeSet store "Hakyll.Core.Run.run" "dependencies" $+        analyzerGraph $ hakyllAnalyzer state'      -- Flush and return     flushLogger logger     return ruleSet-  where-    env logger ruleSet provider store = RuntimeEnvironment-        { hakyllLogger           = logger-        , hakyllConfiguration    = configuration-        , hakyllRoutes           = rulesRoutes ruleSet-        , hakyllResourceProvider = provider-        , hakyllStore            = store-        } -    state = RuntimeState-        { hakyllModified = S.empty-        , hakyllGraph    = mempty-        }- data RuntimeEnvironment = RuntimeEnvironment     { hakyllLogger           :: Logger     , hakyllConfiguration    :: HakyllConfiguration@@ -85,109 +86,90 @@     }  data RuntimeState = RuntimeState-    { hakyllModified :: Set Identifier-    , hakyllGraph    :: DirectedGraph Identifier+    { hakyllAnalyzer  :: DependencyAnalyzer Identifier+    , hakyllCompilers :: Map Identifier (Compiler () CompileRule)     }  newtype Runtime a = Runtime     { unRuntime :: ReaderT RuntimeEnvironment (StateT RuntimeState IO) a     } deriving (Functor, Applicative, Monad) --- | Return a set of modified identifiers----modified :: ResourceProvider     -- ^ Resource provider-         -> Store                -- ^ Store-         -> [Identifier]         -- ^ Identifiers to check-         -> IO (Set Identifier)  -- ^ Modified resources-modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->-    resourceModified provider (Resource id') store- -- | Add a number of compilers and continue using these compilers -- addNewCompilers :: [(Identifier, Compiler () CompileRule)]-                -- ^ Remaining compilers yet to be run-                -> [(Identifier, Compiler () CompileRule)]                 -- ^ Compilers to add                 -> Runtime ()-addNewCompilers oldCompilers newCompilers = Runtime $ do+addNewCompilers newCompilers = Runtime $ do     -- Get some information     logger <- hakyllLogger <$> ask     section logger "Adding new compilers"     provider <- hakyllResourceProvider <$> ask     store <- hakyllStore <$> ask -    let -- All compilers-        compilers = oldCompilers ++ newCompilers+    -- Old state information+    oldCompilers <- hakyllCompilers <$> get+    oldAnalyzer <- hakyllAnalyzer <$> get -        -- Get all dependencies for the compilers-        dependencies = flip map compilers $ \(id', compiler) ->-            let deps = runCompilerDependencies compiler id' provider-            in (id', deps)+    let -- All known compilers+        universe = M.keys oldCompilers ++ map fst newCompilers -        -- Create a compiler map (Id -> Compiler)-        compilerMap = M.fromList compilers+        -- Create a new partial dependency graph+        dependencies = flip map newCompilers $ \(id', compiler) ->+            let deps = runCompilerDependencies compiler id' universe+            in (id', deps)          -- Create the dependency graph-        currentGraph = fromList dependencies--    -- Find the old graph and append the new graph to it. This forms the-    -- complete graph-    completeGraph <- timed logger "Creating graph" $-        mappend currentGraph . hakyllGraph <$> get+        newGraph = fromList dependencies -    orderedCompilers <- timed logger "Solving dependencies" $ do-        -- Check which items are up-to-date. This only needs to happen for the new-        -- compilers-        oldModified <- hakyllModified <$> get -        newModified <- liftIO $ modified provider store $ map fst newCompilers+    -- Check which items have been modified+    modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $+        liftIO . resourceModified provider store . fromIdentifier -        let modified' = oldModified `S.union` newModified-            -            -- Find obsolete items. Every item that is reachable from a modified-            -- item is considered obsolete. From these obsolete items, we are only-            -- interested in ones that are in the current subgraph.-            obsolete = S.filter (`member` currentGraph)-                     $ reachableNodes modified' $ reverse completeGraph+    -- Create a new analyzer and append it to the currect one+    let newAnalyzer = makeDependencyAnalyzer newGraph (`S.member` modified) $+            analyzerPreviousGraph oldAnalyzer+        analyzer = mappend oldAnalyzer newAnalyzer -            -- Solve the graph and retain only the obsolete items-            ordered = filter (`S.member` obsolete) $ solveDependencies currentGraph+    -- Update the state+    put $ RuntimeState+        { hakyllAnalyzer  = analyzer+        , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)+        } -        -- Update the state-        modify $ updateState modified' completeGraph+    -- Continue+    unRuntime stepAnalyzer -        -- Join the order with the compilers again-        return $ map (id &&& (compilerMap M.!)) ordered+stepAnalyzer :: Runtime ()+stepAnalyzer = Runtime $ do+    -- Step the analyzer+    state <- get+    let (signal, analyzer') = step $ hakyllAnalyzer state+    put $ state { hakyllAnalyzer = analyzer' } -    -- Now run the ordered list of compilers-    unRuntime $ runCompilers orderedCompilers-  where-    -- Add the modified information for the new compilers-    updateState modified' graph state = state-        { hakyllModified = modified'-        , hakyllGraph    = graph-        }+    case signal of Done      -> return ()+                   Cycle _   -> return ()+                   Build id' -> unRuntime $ build id' -runCompilers :: [(Identifier, Compiler () CompileRule)]-             -- ^ Ordered list of compilers-             -> Runtime ()-             -- ^ No result-runCompilers [] = return ()-runCompilers ((id', compiler) : compilers) = Runtime $ do-    -- Obtain information+build :: Identifier -> Runtime ()+build id' = Runtime $ do     logger <- hakyllLogger <$> ask     routes <- hakyllRoutes <$> ask     provider <- hakyllResourceProvider <$> ask     store <- hakyllStore <$> ask-    modified' <- hakyllModified <$> get+    compilers <- hakyllCompilers <$> get      section logger $ "Compiling " ++ show id' -    let -- Check if the resource was modified-        isModified = id' `S.member` modified'+    -- Fetch the right compiler from the map+    let compiler = compilers M.! id' +    -- Check if the resource was modified+    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@@ -202,14 +184,14 @@                     liftIO $ write path compiled              -- Continue for the remaining compilers-            unRuntime $ runCompilers compilers +            unRuntime stepAnalyzer          -- Metacompiler, slightly more complicated         Right (MetaCompileRule newCompilers) ->             -- Actually I was just kidding, it's not hard at all-            unRuntime $ addNewCompilers compilers newCompilers+            unRuntime $ addNewCompilers newCompilers          -- Some error happened, log and continue         Left err -> do             thrown logger err -            unRuntime $ runCompilers compilers+            unRuntime stepAnalyzer

@@ -11,6 +11,7 @@ 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 @@ -- | 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 --