Created
March 27, 2011 08:50
-
-
Save jaspervdj/889061 to your computer and use it in GitHub Desktop.
Draft of a new dependency analyzer for Hakyll
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Prelude hiding (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 | |
} | |
data Signal a = Build a | |
| Cycle | |
| Done | |
instance Ord a => Monoid (DependencyAnalyzer a) where | |
mempty = DependencyAnalyzer mempty mempty mempty mempty | |
DependencyAnalyzer g1 r1 d1 p1 `mappend` DependencyAnalyzer g2 r2 d2 p2 = | |
growRemains $ DependencyAnalyzer (mappend g1 g2) (mappend r1 r2) | |
(mappend d1 d2) (mappend p1 p2) | |
-- | 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 => 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) $ | |
remains `S.union` indirect `S.union` changedDeps | |
-- 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 $ 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 => 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 item S.empty analyzer of | |
Done -> (Done, analyzer) | |
Cycle -> (Cycle, 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) | |
-- | Find an item ready to be compiled | |
-- | |
findReady :: Ord a => a -> Set a -> DependencyAnalyzer a -> Signal a | |
findReady item visited analyzer | |
-- We already visited this item, cycle detected! | |
| item `S.member` visited = Cycle | |
-- The item is ready, return it | |
| isReady = Build item | |
-- Continue our search: find a neighbour we haven't visited yet | |
| otherwise = case filter (`S.notMember` visited) neighbours' of | |
-- No neighbours available: cycle! | |
[] -> Cycle | |
-- At least one neighbour is available, search for that one | |
(x : _) -> findReady x visited' analyzer | |
where | |
-- The dependency graph | |
graph = analyzerGraph analyzer | |
-- Our neighbours | |
neighbours' = S.toList $ neighbours item graph | |
-- The new visited set | |
visited' = S.insert item visited | |
-- Check if a certain item is ready to be compiled | |
isReady = all (`S.member` analyzerDone analyzer) neighbours' |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment