    --------------------------------------------------------------------------------
    {-# LANGUAGE DeriveDataTypeable #-}
    module Hakyll.Core.Dependencies
        ( Dependency (..)
        , DependencyFacts
        , outOfDate
        ) 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.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 Dependency
        = PatternDependency Pattern (Set Identifier)
        | IdentifierDependency Identifier
        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
    showList :: [Dependency] -> ShowS
    $cshowList :: [Dependency] -> ShowS
    show :: Dependency -> String
    $cshow :: Dependency -> String
    showsPrec :: Int -> Dependency -> ShowS
    $cshowsPrec :: Int -> Dependency -> ShowS
    Show, Typeable)

    --------------------------------------------------------------------------------
    instance Binary Dependency where
        put :: Dependency -> Put
    put (PatternDependency p :: Pattern
    p is :: Set Identifier
    is) = Word8 -> Put
    putWord8 0 Put -> Put -> Put
    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 (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 i :: Identifier
    i) = Word8 -> Put
    putWord8 1 Put -> Put -> Put
    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 Dependency
    get = Get Word8
    getWord8 Get Word8 -> (Word8 -> Get Dependency) -> Get Dependency
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \t :: Word8
    t -> case Word8
    t of
            0 -> Pattern -> Set Identifier -> Dependency
    PatternDependency (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get (Set Identifier)
    forall t. Binary t => Get t
    get
            1 -> Identifier -> Dependency
    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
            _ -> String -> Get Dependency
    forall a. HasCallStack => String -> a
    error "Data.Binary.get: Invalid Dependency"

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

    --------------------------------------------------------------------------------
    outOfDate
        :: [Identifier]     -- ^ All known identifiers
        -> Set Identifier   -- ^ Initially out-of-date resources
        -> DependencyFacts  -- ^ Old dependency facts
        -> (Set Identifier, DependencyFacts, [String])
    outOfDate :: [Identifier]
    -> Set Identifier
    -> DependencyFacts
    -> (Set Identifier, DependencyFacts, [String])
    outOfDate universe :: [Identifier]
    universe ood :: Set Identifier
    ood oldFacts :: DependencyFacts
    oldFacts =
        let (_, state :: DependencyState
    state, logs :: [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 -> DependencyState
    DependencyState DependencyFacts
    oldFacts Set Identifier
    ood)
        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
        } 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
    showList :: [DependencyState] -> ShowS
    $cshowList :: [DependencyState] -> ShowS
    show :: DependencyState -> String
    $cshow :: DependencyState -> String
    showsPrec :: Int -> DependencyState -> ShowS
    $cshowsPrec :: Int -> DependencyState -> ShowS
    Show)

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

    --------------------------------------------------------------------------------
    markOod :: Identifier -> DependencyM ()
    markOod :: Identifier -> RWS [Identifier] [String] DependencyState ()
    markOod id' :: 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
    $ \s :: DependencyState
    s ->
        DependencyState
    s {dependencyOod :: Set Identifier
    dependencyOod = Identifier -> Set Identifier -> Set Identifier
    forall a. Ord a => a -> Set a -> Set a
    S.insert Identifier
    id' (Set Identifier -> Set Identifier)
    -> Set Identifier -> Set Identifier
    forall a b. (a -> b) -> a -> b
    $ DependencyState -> Set Identifier
    dependencyOod DependencyState
    s}

    --------------------------------------------------------------------------------
    dependenciesFor :: Identifier -> DependencyM [Identifier]
    dependenciesFor :: Identifier -> DependencyM [Identifier]
    dependenciesFor id' :: 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
        [Identifier] -> DependencyM [Identifier]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Identifier] -> DependencyM [Identifier])
    -> [Identifier] -> DependencyM [Identifier]
    forall a b. (a -> b) -> a -> b
    $ (Dependency -> [Identifier]) -> [Dependency] -> [Identifier]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Dependency -> [Identifier]
    dependenciesFor' ([Dependency] -> [Identifier]) -> [Dependency] -> [Identifier]
    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
        dependenciesFor' :: Dependency -> [Identifier]
    dependenciesFor' (IdentifierDependency i :: Identifier
    i) = [Identifier
    i]
        dependenciesFor' (PatternDependency _ is :: Set Identifier
    is) = Set Identifier -> [Identifier]
    forall a. Set a -> [a]
    S.toList Set Identifier
    is

    --------------------------------------------------------------------------------
    checkNew :: DependencyM ()
    checkNew :: RWS [Identifier] [String] DependencyState ()
    checkNew = do
        [Identifier]
    universe <- DependencyM [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
    $ \id' :: 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]
    ++ " 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
    $ \(id' :: Identifier
    id', deps :: [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
    $ \s :: DependencyState
    s -> DependencyState
    s
                {dependencyFacts :: DependencyFacts
    dependencyFacts = Identifier -> [Dependency] -> DependencyFacts -> DependencyFacts
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Identifier
    id' [Dependency]
    deps' (DependencyFacts -> DependencyFacts)
    -> DependencyFacts -> DependencyFacts
    forall a b. (a -> b) -> a -> b
    $ DependencyState -> DependencyFacts
    dependencyFacts DependencyState
    s}
      where
        go :: Identifier
    -> [Dependency]
    -> Dependency
    -> RWST [Identifier] [String] DependencyState Identity [Dependency]
    go _   ds :: [Dependency]
    ds (IdentifierDependency i :: Identifier
    i) = [Dependency]
    -> RWST [Identifier] [String] DependencyState Identity [Dependency]
    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
    $ Identifier -> Dependency
    IdentifierDependency Identifier
    i Dependency -> [Dependency] -> [Dependency]
    forall a. a -> [a] -> [a]
    : [Dependency]
    ds
        go id' :: Identifier
    id' ds :: [Dependency]
    ds (PatternDependency p :: Pattern
    p ls :: Set Identifier
    ls) = do
            [Identifier]
    universe <- DependencyM [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 [Dependency]
    -> RWST [Identifier] [String] DependencyState Identity [Dependency]
    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
    $ Pattern -> Set Identifier -> Dependency
    PatternDependency Pattern
    p Set Identifier
    ls Dependency -> [Dependency] -> [Dependency]
    forall a. a -> [a] -> [a]
    : [Dependency]
    ds
                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]
    ++ " is out-of-date because a pattern changed"]
                    Identifier -> RWS [Identifier] [String] DependencyState ()
    markOod Identifier
    id'
                    [Dependency]
    -> RWST [Identifier] [String] DependencyState Identity [Dependency]
    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
    $ Pattern -> Set Identifier -> Dependency
    PatternDependency Pattern
    p Set Identifier
    ls' Dependency -> [Dependency] -> [Dependency]
    forall a. a -> [a] -> [a]
    : [Dependency]
    ds

    --------------------------------------------------------------------------------
    bruteForce :: DependencyM ()
    bruteForce :: RWS [Identifier] [String] DependencyState ()
    bruteForce = do
        [Identifier]
    todo <- DependencyM [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 todo :: [Identifier]
    todo = do
            (todo' :: [Identifier]
    todo', changed :: 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')

        check :: ([Identifier], Bool)
    -> Identifier
    -> RWST
         [Identifier] [String] DependencyState Identity ([Identifier], Bool)
    check (todo :: [Identifier]
    todo, changed :: Bool
    changed) id' :: Identifier
    id' = do
            [Identifier]
    deps <- Identifier -> DependencyM [Identifier]
    dependenciesFor Identifier
    id'
            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
            case (Identifier -> Bool) -> [Identifier] -> Maybe Identifier
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (Identifier -> Set Identifier -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set Identifier
    ood) [Identifier]
    deps of
                Nothing -> ([Identifier], Bool)
    -> RWST
         [Identifier] [String] DependencyState Identity ([Identifier], Bool)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Identifier
    id' Identifier -> [Identifier] -> [Identifier]
    forall a. a -> [a] -> [a]
    : [Identifier]
    todo, Bool
    changed)
                Just d :: 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]
    ++ " is out-of-date because " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                        Identifier -> String
    forall a. Show a => a -> String
    show Identifier
    d String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " is out-of-date"]
                    Identifier -> RWS [Identifier] [String] DependencyState ()
    markOod Identifier
    id'
                    ([Identifier], Bool)
    -> RWST
         [Identifier] [String] DependencyState Identity ([Identifier], Bool)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Identifier]
    todo, Bool
    True)