@@ -1,14 +1,22 @@
11--------------------------------------------------------------------------------
2−{-# LANGUAGE BangPatterns #-}
32module Hakyll.Core.Dependencies
4− (
3+ ( Dependency (..)
4+ , DependencyFacts
5+ , outOfDate
56 ) where
67
78
89--------------------------------------------------------------------------------
9−import Data.List (foldl')
10+import Control.Applicative ((<$>))
11+import Control.Monad (foldM, forM_, unless, when)
12+import Control.Monad.Reader (ask)
13+import Control.Monad.RWS (RWS, runRWS)
14+import Control.Monad.State (get, modify)
15+import Control.Monad.Writer (tell)
16+import Data.List (find)
1017import Data.Map (Map)
1118import qualified Data.Map as M
19+import Data.Maybe (fromMaybe)
1220import Data.Set (Set)
1321import qualified Data.Set as S
1422
@@ -34,26 +42,89 @@ outOfDate
3442 :: [Identifier ()] -- ^ All known identifiers
3543 -> Set (Identifier ()) -- ^ Initially out-of-date resources
3644 -> DependencyFacts -- ^ Old dependency facts
37− -> (Set (Identifier ()), DependencyFacts)
38−outOfDate universe ood oldFacts = (ood, oldFacts)
45+ -> (Set (Identifier ()), DependencyFacts, [String])
46+outOfDate universe ood oldFacts =
47+ let (_, state, logs) = runRWS rws universe (DependencyState oldFacts ood)
48+ in (dependencyOod state, dependencyFacts state, logs)
49+ where
50+ rws = do
51+ checkNew
52+ checkChangedPatterns
53+ bruteForce
54+
55+
56+--------------------------------------------------------------------------------
57+data DependencyState = DependencyState
58+ { dependencyFacts :: DependencyFacts
59+ , dependencyOod :: Set (Identifier ())
60+ } deriving (Show)
3961
4062
4163--------------------------------------------------------------------------------
42−-- | Determine patterns with changed results
43−changedPatterns
44− :: [Identifier ()]
45− -> DependencyFacts
46− -> (Set (Identifier ()), DependencyFacts)
47−changedPatterns universe facts =
48− M.foldlWithKey' changed (S.empty, facts) facts
64+type DependencyM a = RWS [Identifier ()] [String] DependencyState a
65+
66+
67+--------------------------------------------------------------------------------
68+markOod :: Identifier () -> DependencyM ()
69+markOod id' = modify $ \s -> s {dependencyOod = S.insert id' $ dependencyOod s}
70+
71+
72+--------------------------------------------------------------------------------
73+dependenciesFor :: Identifier () -> DependencyM [Identifier ()]
74+dependenciesFor id' = do
75+ facts <- dependencyFacts <$> get
76+ let relevant = fromMaybe [] $ M.lookup id' facts
77+ return [i | Identifier i <- relevant]
78+
79+
80+--------------------------------------------------------------------------------
81+checkNew :: DependencyM ()
82+checkNew = do
83+ universe <- ask
84+ facts <- dependencyFacts <$> get
85+ forM_ universe $ \id' -> unless (id' `M.member` facts) $ do
86+ tell [show id' ++ " is out-of-date because it is new"]
87+ markOod id'
88+
89+
90+--------------------------------------------------------------------------------
91+checkChangedPatterns :: DependencyM ()
92+checkChangedPatterns = do
93+ facts <- M.toList . dependencyFacts <$> get
94+ forM_ facts $ \(id', deps) -> do
95+ deps' <- foldM (go id') [] deps
96+ modify $ \s -> s
97+ {dependencyFacts = M.insert id' deps' $ dependencyFacts s}
4998 where
50− changed (!o, !f) id' deps =
51− let (o', deps') = foldr (changed' id') (o, []) deps
52− in (o', M.insert id' deps' f)
53−
54− changed' _ (Identifier i) (o, d) = (o, Identifier i : d)
55− changed' id' (Pattern p ls) (o, d)
56− | ls == ls' = (o, Pattern p ls : d)
57− | otherwise = (S.insert id' o, Pattern p ls' : d)
58− where
59− ls' = filterMatches p universe
99+ go _ ds (Identifier i) = return $ Identifier i : ds
100+ go id' ds (Pattern p ls) = do
101+ universe <- ask
102+ let ls' = filterMatches p universe
103+ if ls == ls'
104+ then return $ Pattern p ls : ds
105+ else do
106+ tell [show id' ++ " is out-of-date because a pattern changed"]
107+ markOod id'
108+ return $ Pattern p ls' : ds
109+
110+
111+--------------------------------------------------------------------------------
112+bruteForce :: DependencyM ()
113+bruteForce = do
114+ todo <- ask
115+ go todo
116+ where
117+ go todo = do
118+ (todo', changed) <- foldM check ([], False) todo
119+ when changed (go todo')
120+
121+ check (todo, changed) id' = do
122+ deps <- dependenciesFor id'
123+ ood <- dependencyOod <$> get
124+ case find (`S.member` ood) deps of
125+ Nothing -> return (id' : todo, changed)
126+ Just d -> do
127+ tell [show id' ++ " is out-of-date because " ++
128+ show d ++ " is out-of-date"]
129+ markOod id'
130+ return (todo, True)