--------------------------------------------------------------------------------
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TupleSections #-}
module Hakyll.Core.Dependencies
    ( Dependency (..)
    , DependencySelector (..)
    , DependencyKind (..)
    , DependencyFacts
    , outOfDate
    , contentDependency
    , metadataDependency
    ) where


--------------------------------------------------------------------------------
import           Control.Monad                  (foldM, forM_, unless, when)
import           Control.Monad.Reader           (ask)
import           Control.Monad.RWS              (RWS, runRWS)
import qualified Control.Monad.State            as State
import           Control.Monad.Writer           (tell)
import           Data.Binary                    (Binary (..), getWord8,
                                                 putWord8)
import           Data.Functor                   ((<&>))
import           Data.List                      (find)
import           Data.Map                       (Map)
import qualified Data.Map                       as M
import           Data.Maybe                     (fromMaybe)
import           Data.Set                       (Set)
import qualified Data.Set                       as S
import           Data.Typeable                  (Typeable)


--------------------------------------------------------------------------------
import           Hakyll.Core.Identifier
import           Hakyll.Core.Identifier.Pattern


--------------------------------------------------------------------------------
data DependencySelector
    = PatternDependency Pattern (Set Identifier)
    | IdentifierDependency Identifier
    deriving (Int -> DependencySelector -> ShowS
[DependencySelector] -> ShowS
DependencySelector -> String
(Int -> DependencySelector -> ShowS)
-> (DependencySelector -> String)
-> ([DependencySelector] -> ShowS)
-> Show DependencySelector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DependencySelector -> ShowS
showsPrec :: Int -> DependencySelector -> ShowS
$cshow :: DependencySelector -> String
show :: DependencySelector -> String
$cshowList :: [DependencySelector] -> ShowS
showList :: [DependencySelector] -> ShowS
Show, Typeable)

--------------------------------------------------------------------------------
instance Binary DependencySelector where
    put :: DependencySelector -> Put
put (PatternDependency Pattern
p Set Identifier
is) = Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pattern -> Put
forall t. Binary t => t -> Put
put Pattern
p Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Set Identifier -> Put
forall t. Binary t => t -> Put
put Set Identifier
is
    put (IdentifierDependency Identifier
i) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Identifier -> Put
forall t. Binary t => t -> Put
put Identifier
i
    get :: Get DependencySelector
get = Get Word8
getWord8 Get Word8
-> (Word8 -> Get DependencySelector) -> Get DependencySelector
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
t -> case Word8
t of
        Word8
0 -> Pattern -> Set Identifier -> DependencySelector
PatternDependency (Pattern -> Set Identifier -> DependencySelector)
-> Get Pattern -> Get (Set Identifier -> DependencySelector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Pattern
forall t. Binary t => Get t
get Get (Set Identifier -> DependencySelector)
-> Get (Set Identifier) -> Get DependencySelector
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Set Identifier)
forall t. Binary t => Get t
get
        Word8
1 -> Identifier -> DependencySelector
IdentifierDependency (Identifier -> DependencySelector)
-> Get Identifier -> Get DependencySelector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Identifier
forall t. Binary t => Get t
get
        Word8
_ -> String -> Get DependencySelector
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Data.Binary.get: Invalid DependencySelector"


--------------------------------------------------------------------------------
-- | A data type representing a dependency on another 'Identifier'. We can
-- depend either on the 'Hakyll.Core.Metadata.Metadata' or the entire content of
-- the underlying file. This is signified by the supplied 'DependencyKind'.
data Dependency
    = Dependency DependencyKind DependencySelector
    | AlwaysOutOfDate
    deriving (Int -> Dependency -> ShowS
[Dependency] -> ShowS
Dependency -> String
(Int -> Dependency -> ShowS)
-> (Dependency -> String)
-> ([Dependency] -> ShowS)
-> Show Dependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dependency -> ShowS
showsPrec :: Int -> Dependency -> ShowS
$cshow :: Dependency -> String
show :: Dependency -> String
$cshowList :: [Dependency] -> ShowS
showList :: [Dependency] -> ShowS
Show, Typeable)


--------------------------------------------------------------------------------
-- | Utility function to create a new content dependency.
contentDependency :: DependencySelector -> Dependency
contentDependency :: DependencySelector -> Dependency
contentDependency = DependencyKind -> DependencySelector -> Dependency
Dependency DependencyKind
KindContent

-- | Utility function to a create a new metadata dependency.
metadataDependency :: DependencySelector -> Dependency
metadataDependency :: DependencySelector -> Dependency
metadataDependency = DependencyKind -> DependencySelector -> Dependency
Dependency DependencyKind
KindMetadata


--------------------------------------------------------------------------------
instance Binary Dependency where
    put :: Dependency -> Put
put Dependency
AlwaysOutOfDate = Word8 -> Put
putWord8 Word8
2
    put (Dependency DependencyKind
k DependencySelector
s) = Word8 -> Put
putWord8 Word8
3 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DependencyKind -> Put
forall t. Binary t => t -> Put
put DependencyKind
k Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DependencySelector -> Put
forall t. Binary t => t -> Put
put DependencySelector
s

    get :: Get Dependency
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get Dependency) -> Get Dependency
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
t -> case Word8
t of
        -- XXX: Backwards compatability with Hakyll <=4.16.7.1.
        Word8
0 -> (\Pattern
p Set Identifier
i -> DependencySelector -> Dependency
contentDependency (DependencySelector -> Dependency)
-> DependencySelector -> Dependency
forall a b. (a -> b) -> a -> b
$ Pattern -> Set Identifier -> DependencySelector
PatternDependency Pattern
p Set Identifier
i) (Pattern -> Set Identifier -> Dependency)
-> Get Pattern -> Get (Set Identifier -> Dependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Pattern
forall t. Binary t => Get t
get Get (Set Identifier -> Dependency)
-> Get (Set Identifier) -> Get Dependency
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Set Identifier)
forall t. Binary t => Get t
get
        Word8
1 -> DependencySelector -> Dependency
contentDependency (DependencySelector -> Dependency)
-> (Identifier -> DependencySelector) -> Identifier -> Dependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> DependencySelector
IdentifierDependency (Identifier -> Dependency) -> Get Identifier -> Get Dependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Identifier
forall t. Binary t => Get t
get

        Word8
2 -> Dependency -> Get Dependency
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Dependency
AlwaysOutOfDate
        Word8
3 -> DependencyKind -> DependencySelector -> Dependency
Dependency (DependencyKind -> DependencySelector -> Dependency)
-> Get DependencyKind -> Get (DependencySelector -> Dependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get DependencyKind
forall t. Binary t => Get t
get Get (DependencySelector -> Dependency)
-> Get DependencySelector -> Get Dependency
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get DependencySelector
forall t. Binary t => Get t
get
        Word8
_ -> String -> Get Dependency
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Data.Binary.get: Invalid Dependency"


--------------------------------------------------------------------------------
type DependencyFacts = Map Identifier [Dependency]


--------------------------------------------------------------------------------
outOfDate
    :: [Identifier]     -- ^ All known identifiers
    -> Set Identifier   -- ^ Changed content
    -> Set Identifier   -- ^ Changed metadata
    -> DependencyFacts  -- ^ Old dependency facts
    -> (Set Identifier, DependencyFacts, [String])
outOfDate :: [Identifier]
-> Set Identifier
-> Set Identifier
-> DependencyFacts
-> (Set Identifier, DependencyFacts, [String])
outOfDate [Identifier]
universe Set Identifier
ood Set Identifier
oodMeta DependencyFacts
oldFacts =
    let (()
_, DependencyState
state, [String]
logs) = RWS [Identifier] [String] DependencyState ()
-> [Identifier]
-> DependencyState
-> ((), DependencyState, [String])
forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS RWS [Identifier] [String] DependencyState ()
rws [Identifier]
universe (DependencyFacts
-> Set Identifier -> Set Identifier -> DependencyState
DependencyState DependencyFacts
oldFacts Set Identifier
ood Set Identifier
oodMeta)
    in (DependencyState -> Set Identifier
dependencyOod DependencyState
state, DependencyState -> DependencyFacts
dependencyFacts DependencyState
state, [String]
logs)
  where
    rws :: RWS [Identifier] [String] DependencyState ()
rws = do
        RWS [Identifier] [String] DependencyState ()
checkNew
        RWS [Identifier] [String] DependencyState ()
checkChangedPatterns
        RWS [Identifier] [String] DependencyState ()
bruteForce


--------------------------------------------------------------------------------
data DependencyState = DependencyState
    { DependencyState -> DependencyFacts
dependencyFacts   :: DependencyFacts
    , DependencyState -> Set Identifier
dependencyOod     :: Set Identifier
    , DependencyState -> Set Identifier
dependencyOodMeta :: Set Identifier
    } deriving (Int -> DependencyState -> ShowS
[DependencyState] -> ShowS
DependencyState -> String
(Int -> DependencyState -> ShowS)
-> (DependencyState -> String)
-> ([DependencyState] -> ShowS)
-> Show DependencyState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DependencyState -> ShowS
showsPrec :: Int -> DependencyState -> ShowS
$cshow :: DependencyState -> String
show :: DependencyState -> String
$cshowList :: [DependencyState] -> ShowS
showList :: [DependencyState] -> ShowS
Show)


--------------------------------------------------------------------------------
type DependencyM a = RWS [Identifier] [String] DependencyState a


--------------------------------------------------------------------------------
markOod :: Identifier -> DependencyM ()
markOod :: Identifier -> RWS [Identifier] [String] DependencyState ()
markOod Identifier
id' = (DependencyState -> DependencyState)
-> RWS [Identifier] [String] DependencyState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((DependencyState -> DependencyState)
 -> RWS [Identifier] [String] DependencyState ())
-> (DependencyState -> DependencyState)
-> RWS [Identifier] [String] DependencyState ()
forall a b. (a -> b) -> a -> b
$ \DependencyState
s ->
    DependencyState
s {dependencyOod = S.insert id' $ dependencyOod s}


--------------------------------------------------------------------------------
data DependencyKind = KindContent | KindMetadata
  deriving (Int -> DependencyKind -> ShowS
[DependencyKind] -> ShowS
DependencyKind -> String
(Int -> DependencyKind -> ShowS)
-> (DependencyKind -> String)
-> ([DependencyKind] -> ShowS)
-> Show DependencyKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DependencyKind -> ShowS
showsPrec :: Int -> DependencyKind -> ShowS
$cshow :: DependencyKind -> String
show :: DependencyKind -> String
$cshowList :: [DependencyKind] -> ShowS
showList :: [DependencyKind] -> ShowS
Show)

instance Binary DependencyKind where
  put :: DependencyKind -> Put
put DependencyKind
KindContent = Word8 -> Put
putWord8 Word8
0
  put DependencyKind
KindMetadata = Word8 -> Put
putWord8 Word8
1

  get :: Get DependencyKind
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get DependencyKind) -> Get DependencyKind
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
t -> case Word8
t of
      Word8
0 -> DependencyKind -> Get DependencyKind
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DependencyKind
KindContent
      Word8
1 -> DependencyKind -> Get DependencyKind
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DependencyKind
KindMetadata
      Word8
_ -> String -> Get DependencyKind
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Data.Binary.get: Invalid DependencyKind"

--------------------------------------------------------------------------------
-- | Collection of dependencies that should be checked to determine
-- if an identifier needs rebuilding.
data Dependencies
  = DependsOn [(DependencyKind, Identifier)]
  | MustRebuild
  deriving (Int -> Dependencies -> ShowS
[Dependencies] -> ShowS
Dependencies -> String
(Int -> Dependencies -> ShowS)
-> (Dependencies -> String)
-> ([Dependencies] -> ShowS)
-> Show Dependencies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dependencies -> ShowS
showsPrec :: Int -> Dependencies -> ShowS
$cshow :: Dependencies -> String
show :: Dependencies -> String
$cshowList :: [Dependencies] -> ShowS
showList :: [Dependencies] -> ShowS
Show)

instance Semigroup Dependencies where
  DependsOn [(DependencyKind, Identifier)]
ids <> :: Dependencies -> Dependencies -> Dependencies
<> DependsOn [(DependencyKind, Identifier)]
moreIds = [(DependencyKind, Identifier)] -> Dependencies
DependsOn ([(DependencyKind, Identifier)]
ids [(DependencyKind, Identifier)]
-> [(DependencyKind, Identifier)] -> [(DependencyKind, Identifier)]
forall a. Semigroup a => a -> a -> a
<> [(DependencyKind, Identifier)]
moreIds)
  Dependencies
MustRebuild <> Dependencies
_ = Dependencies
MustRebuild
  Dependencies
_ <> Dependencies
MustRebuild = Dependencies
MustRebuild

instance Monoid Dependencies where
  mempty :: Dependencies
mempty = [(DependencyKind, Identifier)] -> Dependencies
DependsOn []

--------------------------------------------------------------------------------
dependenciesFor :: Identifier -> DependencyM Dependencies
dependenciesFor :: Identifier -> DependencyM Dependencies
dependenciesFor Identifier
id' = do
    DependencyFacts
facts <- DependencyState -> DependencyFacts
dependencyFacts (DependencyState -> DependencyFacts)
-> RWST
     [Identifier] [String] DependencyState Identity DependencyState
-> RWST
     [Identifier] [String] DependencyState Identity DependencyFacts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST [Identifier] [String] DependencyState Identity DependencyState
forall s (m :: * -> *). MonadState s m => m s
State.get
    Dependencies -> DependencyM Dependencies
forall a.
a -> RWST [Identifier] [String] DependencyState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dependencies -> DependencyM Dependencies)
-> Dependencies -> DependencyM Dependencies
forall a b. (a -> b) -> a -> b
$ (Dependency -> Dependencies) -> [Dependency] -> Dependencies
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Dependency -> Dependencies
dependenciesFor' ([Dependency] -> Dependencies) -> [Dependency] -> Dependencies
forall a b. (a -> b) -> a -> b
$ [Dependency] -> Maybe [Dependency] -> [Dependency]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Dependency] -> [Dependency])
-> Maybe [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ Identifier -> DependencyFacts -> Maybe [Dependency]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
id' DependencyFacts
facts
  where
    dependenciesForSelector :: DependencySelector -> [Identifier]
dependenciesForSelector (IdentifierDependency Identifier
i) = [Identifier
i]
    dependenciesForSelector (PatternDependency Pattern
_ Set Identifier
is) = Set Identifier -> [Identifier]
forall a. Set a -> [a]
S.toList Set Identifier
is

    dependenciesFor' :: Dependency -> Dependencies
dependenciesFor' Dependency
AlwaysOutOfDate            = Dependencies
MustRebuild
    dependenciesFor' (Dependency DependencyKind
kind DependencySelector
selector) = [(DependencyKind, Identifier)] -> Dependencies
DependsOn ([(DependencyKind, Identifier)] -> Dependencies)
-> [(DependencyKind, Identifier)] -> Dependencies
forall a b. (a -> b) -> a -> b
$
        (Identifier -> (DependencyKind, Identifier))
-> [Identifier] -> [(DependencyKind, Identifier)]
forall a b. (a -> b) -> [a] -> [b]
map (DependencyKind
kind,) ([Identifier] -> [(DependencyKind, Identifier)])
-> [Identifier] -> [(DependencyKind, Identifier)]
forall a b. (a -> b) -> a -> b
$ DependencySelector -> [Identifier]
dependenciesForSelector DependencySelector
selector


--------------------------------------------------------------------------------
checkNew :: DependencyM ()
checkNew :: RWS [Identifier] [String] DependencyState ()
checkNew = do
    [Identifier]
universe <- RWST [Identifier] [String] DependencyState Identity [Identifier]
forall r (m :: * -> *). MonadReader r m => m r
ask
    DependencyFacts
facts    <- DependencyState -> DependencyFacts
dependencyFacts (DependencyState -> DependencyFacts)
-> RWST
     [Identifier] [String] DependencyState Identity DependencyState
-> RWST
     [Identifier] [String] DependencyState Identity DependencyFacts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST [Identifier] [String] DependencyState Identity DependencyState
forall s (m :: * -> *). MonadState s m => m s
State.get
    [Identifier]
-> (Identifier -> RWS [Identifier] [String] DependencyState ())
-> RWS [Identifier] [String] DependencyState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Identifier]
universe ((Identifier -> RWS [Identifier] [String] DependencyState ())
 -> RWS [Identifier] [String] DependencyState ())
-> (Identifier -> RWS [Identifier] [String] DependencyState ())
-> RWS [Identifier] [String] DependencyState ()
forall a b. (a -> b) -> a -> b
$ \Identifier
id' -> Bool
-> RWS [Identifier] [String] DependencyState ()
-> RWS [Identifier] [String] DependencyState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Identifier
id' Identifier -> DependencyFacts -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` DependencyFacts
facts) (RWS [Identifier] [String] DependencyState ()
 -> RWS [Identifier] [String] DependencyState ())
-> RWS [Identifier] [String] DependencyState ()
-> RWS [Identifier] [String] DependencyState ()
forall a b. (a -> b) -> a -> b
$ do
        [String] -> RWS [Identifier] [String] DependencyState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Identifier -> String
forall a. Show a => a -> String
show Identifier
id' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is out-of-date because it is new"]
        Identifier -> RWS [Identifier] [String] DependencyState ()
markOod Identifier
id'


--------------------------------------------------------------------------------
checkChangedPatterns :: DependencyM ()
checkChangedPatterns :: RWS [Identifier] [String] DependencyState ()
checkChangedPatterns = do
    [(Identifier, [Dependency])]
facts <- DependencyFacts -> [(Identifier, [Dependency])]
forall k a. Map k a -> [(k, a)]
M.toList (DependencyFacts -> [(Identifier, [Dependency])])
-> (DependencyState -> DependencyFacts)
-> DependencyState
-> [(Identifier, [Dependency])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependencyState -> DependencyFacts
dependencyFacts (DependencyState -> [(Identifier, [Dependency])])
-> RWST
     [Identifier] [String] DependencyState Identity DependencyState
-> RWST
     [Identifier]
     [String]
     DependencyState
     Identity
     [(Identifier, [Dependency])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST [Identifier] [String] DependencyState Identity DependencyState
forall s (m :: * -> *). MonadState s m => m s
State.get
    [(Identifier, [Dependency])]
-> ((Identifier, [Dependency])
    -> RWS [Identifier] [String] DependencyState ())
-> RWS [Identifier] [String] DependencyState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Identifier, [Dependency])]
facts (((Identifier, [Dependency])
  -> RWS [Identifier] [String] DependencyState ())
 -> RWS [Identifier] [String] DependencyState ())
-> ((Identifier, [Dependency])
    -> RWS [Identifier] [String] DependencyState ())
-> RWS [Identifier] [String] DependencyState ()
forall a b. (a -> b) -> a -> b
$ \(Identifier
id', [Dependency]
deps) -> do
        [Dependency]
deps' <- ([Dependency]
 -> Dependency
 -> RWST
      [Identifier] [String] DependencyState Identity [Dependency])
-> [Dependency]
-> [Dependency]
-> RWST [Identifier] [String] DependencyState Identity [Dependency]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Identifier
-> [Dependency]
-> Dependency
-> RWST [Identifier] [String] DependencyState Identity [Dependency]
go Identifier
id') [] [Dependency]
deps
        (DependencyState -> DependencyState)
-> RWS [Identifier] [String] DependencyState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((DependencyState -> DependencyState)
 -> RWS [Identifier] [String] DependencyState ())
-> (DependencyState -> DependencyState)
-> RWS [Identifier] [String] DependencyState ()
forall a b. (a -> b) -> a -> b
$ \DependencyState
s -> DependencyState
s
            {dependencyFacts = M.insert id' deps' $ dependencyFacts s}
  where
    go' :: Identifier
-> DependencySelector
-> RWST
     [Identifier] [String] DependencyState Identity DependencySelector
go' Identifier
_   (IdentifierDependency Identifier
i) = DependencySelector
-> RWST
     [Identifier] [String] DependencyState Identity DependencySelector
forall a.
a -> RWST [Identifier] [String] DependencyState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (DependencySelector
 -> RWST
      [Identifier] [String] DependencyState Identity DependencySelector)
-> DependencySelector
-> RWST
     [Identifier] [String] DependencyState Identity DependencySelector
forall a b. (a -> b) -> a -> b
$ Identifier -> DependencySelector
IdentifierDependency Identifier
i
    go' Identifier
id' (PatternDependency Pattern
p Set Identifier
ls) = do
        [Identifier]
universe <- RWST [Identifier] [String] DependencyState Identity [Identifier]
forall r (m :: * -> *). MonadReader r m => m r
ask
        let ls' :: Set Identifier
ls' = [Identifier] -> Set Identifier
forall a. Ord a => [a] -> Set a
S.fromList ([Identifier] -> Set Identifier) -> [Identifier] -> Set Identifier
forall a b. (a -> b) -> a -> b
$ Pattern -> [Identifier] -> [Identifier]
filterMatches Pattern
p [Identifier]
universe
        if Set Identifier
ls Set Identifier -> Set Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Set Identifier
ls'
            then DependencySelector
-> RWST
     [Identifier] [String] DependencyState Identity DependencySelector
forall a.
a -> RWST [Identifier] [String] DependencyState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (DependencySelector
 -> RWST
      [Identifier] [String] DependencyState Identity DependencySelector)
-> DependencySelector
-> RWST
     [Identifier] [String] DependencyState Identity DependencySelector
forall a b. (a -> b) -> a -> b
$ Pattern -> Set Identifier -> DependencySelector
PatternDependency Pattern
p Set Identifier
ls
            else do
                [String] -> RWS [Identifier] [String] DependencyState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Identifier -> String
forall a. Show a => a -> String
show Identifier
id' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is out-of-date because a pattern changed"]
                Identifier -> RWS [Identifier] [String] DependencyState ()
markOod Identifier
id'
                DependencySelector
-> RWST
     [Identifier] [String] DependencyState Identity DependencySelector
forall a.
a -> RWST [Identifier] [String] DependencyState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (DependencySelector
 -> RWST
      [Identifier] [String] DependencyState Identity DependencySelector)
-> DependencySelector
-> RWST
     [Identifier] [String] DependencyState Identity DependencySelector
forall a b. (a -> b) -> a -> b
$ Pattern -> Set Identifier -> DependencySelector
PatternDependency Pattern
p Set Identifier
ls'

    go :: Identifier
-> [Dependency]
-> Dependency
-> RWST [Identifier] [String] DependencyState Identity [Dependency]
go Identifier
_   [Dependency]
ds Dependency
AlwaysOutOfDate          = [Dependency]
-> RWST [Identifier] [String] DependencyState Identity [Dependency]
forall a.
a -> RWST [Identifier] [String] DependencyState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dependency]
 -> RWST
      [Identifier] [String] DependencyState Identity [Dependency])
-> [Dependency]
-> RWST [Identifier] [String] DependencyState Identity [Dependency]
forall a b. (a -> b) -> a -> b
$ Dependency
AlwaysOutOfDate Dependency -> [Dependency] -> [Dependency]
forall a. a -> [a] -> [a]
: [Dependency]
ds
    go Identifier
id' [Dependency]
ds (Dependency DependencyKind
kind DependencySelector
select) = (DependencyKind -> DependencySelector -> Dependency
Dependency DependencyKind
kind (DependencySelector -> Dependency)
-> RWST
     [Identifier] [String] DependencyState Identity DependencySelector
-> RWST [Identifier] [String] DependencyState Identity Dependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier
-> DependencySelector
-> RWST
     [Identifier] [String] DependencyState Identity DependencySelector
go' Identifier
id' DependencySelector
select) RWST [Identifier] [String] DependencyState Identity Dependency
-> (Dependency -> [Dependency])
-> RWST [Identifier] [String] DependencyState Identity [Dependency]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Dependency -> [Dependency] -> [Dependency]
forall a. a -> [a] -> [a]
: [Dependency]
ds)


--------------------------------------------------------------------------------
bruteForce :: DependencyM ()
bruteForce :: RWS [Identifier] [String] DependencyState ()
bruteForce = do
    [Identifier]
todo <- RWST [Identifier] [String] DependencyState Identity [Identifier]
forall r (m :: * -> *). MonadReader r m => m r
ask
    [Identifier] -> RWS [Identifier] [String] DependencyState ()
go [Identifier]
todo
  where
    go :: [Identifier] -> RWS [Identifier] [String] DependencyState ()
go [Identifier]
todo = do
        ([Identifier]
todo', Bool
changed) <- (([Identifier], Bool)
 -> Identifier
 -> RWST
      [Identifier]
      [String]
      DependencyState
      Identity
      ([Identifier], Bool))
-> ([Identifier], Bool)
-> [Identifier]
-> RWST
     [Identifier] [String] DependencyState Identity ([Identifier], Bool)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Identifier], Bool)
-> Identifier
-> RWST
     [Identifier] [String] DependencyState Identity ([Identifier], Bool)
check ([], Bool
False) [Identifier]
todo
        Bool
-> RWS [Identifier] [String] DependencyState ()
-> RWS [Identifier] [String] DependencyState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed ([Identifier] -> RWS [Identifier] [String] DependencyState ()
go [Identifier]
todo')

    findOod :: Set a -> Set a -> (DependencyKind, a) -> Bool
findOod Set a
oodContent Set a
oodMetadata (DependencyKind
k, a
i)
      = a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member a
i (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$
          case DependencyKind
k of
            DependencyKind
KindContent  -> Set a
oodContent
            DependencyKind
KindMetadata -> Set a
oodMetadata

    check :: ([Identifier], Bool)
-> Identifier
-> RWST
     [Identifier] [String] DependencyState Identity ([Identifier], Bool)
check ([Identifier]
todo, Bool
changed) Identifier
id' = do
        Dependencies
deps <- Identifier -> DependencyM Dependencies
dependenciesFor Identifier
id'
        case Dependencies
deps of
          DependsOn [(DependencyKind, Identifier)]
depList -> do
            Set Identifier
ood     <- DependencyState -> Set Identifier
dependencyOod (DependencyState -> Set Identifier)
-> RWST
     [Identifier] [String] DependencyState Identity DependencyState
-> RWST
     [Identifier] [String] DependencyState Identity (Set Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST [Identifier] [String] DependencyState Identity DependencyState
forall s (m :: * -> *). MonadState s m => m s
State.get
            Set Identifier
oodMeta <- DependencyState -> Set Identifier
dependencyOodMeta (DependencyState -> Set Identifier)
-> RWST
     [Identifier] [String] DependencyState Identity DependencyState
-> RWST
     [Identifier] [String] DependencyState Identity (Set Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST [Identifier] [String] DependencyState Identity DependencyState
forall s (m :: * -> *). MonadState s m => m s
State.get
            case ((DependencyKind, Identifier) -> Bool)
-> [(DependencyKind, Identifier)]
-> Maybe (DependencyKind, Identifier)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Set Identifier
-> Set Identifier -> (DependencyKind, Identifier) -> Bool
forall {a}. Ord a => Set a -> Set a -> (DependencyKind, a) -> Bool
findOod Set Identifier
ood Set Identifier
oodMeta) [(DependencyKind, Identifier)]
depList of
                Maybe (DependencyKind, Identifier)
Nothing -> ([Identifier], Bool)
-> RWST
     [Identifier] [String] DependencyState Identity ([Identifier], Bool)
forall a.
a -> RWST [Identifier] [String] DependencyState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Identifier
id' Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: [Identifier]
todo, Bool
changed)
                Just (DependencyKind, Identifier)
d  -> do
                    [String] -> RWS [Identifier] [String] DependencyState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Identifier -> String
forall a. Show a => a -> String
show Identifier
id' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is out-of-date because " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                        (DependencyKind, Identifier) -> String
forall a. Show a => a -> String
show (DependencyKind, Identifier)
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is out-of-date"]
                    Identifier -> RWS [Identifier] [String] DependencyState ()
markOod Identifier
id'
                    ([Identifier], Bool)
-> RWST
     [Identifier] [String] DependencyState Identity ([Identifier], Bool)
forall a.
a -> RWST [Identifier] [String] DependencyState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Identifier]
todo, Bool
True)
          Dependencies
MustRebuild -> do
            [String] -> RWS [Identifier] [String] DependencyState ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Identifier -> String
forall a. Show a => a -> String
show Identifier
id' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" will be forcibly rebuilt"]
            Identifier -> RWS [Identifier] [String] DependencyState ()
markOod Identifier
id'
            ([Identifier], Bool)
-> RWST
     [Identifier] [String] DependencyState Identity ([Identifier], Bool)
forall a.
a -> RWST [Identifier] [String] DependencyState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Identifier]
todo, Bool
True)