dependencies.hs

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'