--------------------------------------------------------------------------------
module Hakyll.Core.Runtime
    ( run
    ) where


--------------------------------------------------------------------------------
import           Control.Concurrent.Async.Lifted (forConcurrently_)
import           Control.Concurrent.MVar         (modifyMVar_, readMVar, newMVar, MVar)
import           Control.Monad                   (unless)
import           Control.Monad.Except            (ExceptT, runExceptT, throwError)
import           Control.Monad.Reader            (ask)
import           Control.Monad.RWS               (RWST, runRWST)
import           Control.Monad.State             (get)
import           Control.Monad.Trans             (liftIO)
import qualified Data.Array                      as A
import           Data.Graph                      (Graph)
import qualified Data.Graph                      as G
import           Data.List                       (intercalate)
import           Data.Map                        (Map)
import qualified Data.Map                        as M
import           Data.Set                        (Set)
import qualified Data.Set                        as S
import           System.Exit                     (ExitCode (..))
import           System.FilePath                 ((</>))


--------------------------------------------------------------------------------
import           Hakyll.Core.Compiler.Internal
import           Hakyll.Core.Compiler.Require
import           Hakyll.Core.Configuration
import           Hakyll.Core.Dependencies
import           Hakyll.Core.Identifier
import           Hakyll.Core.Item
import           Hakyll.Core.Item.SomeItem
import           Hakyll.Core.Logger            (Logger)
import qualified Hakyll.Core.Logger            as Logger
import           Hakyll.Core.Provider
import           Hakyll.Core.Routes
import           Hakyll.Core.Rules.Internal
import           Hakyll.Core.Store             (Store)
import qualified Hakyll.Core.Store             as Store
import           Hakyll.Core.Util.File
import           Hakyll.Core.Writable


--------------------------------------------------------------------------------
run :: Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
run :: Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
run Configuration
config Logger
logger Rules a
rules = do
    -- Initialization
    Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Initialising..."
    Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.message Logger
logger String
"Creating store..."
    Store
store <- Bool -> String -> IO Store
Store.new (Configuration -> Bool
inMemoryCache Configuration
config) (String -> IO Store) -> String -> IO Store
forall a b. (a -> b) -> a -> b
$ Configuration -> String
storeDirectory Configuration
config
    Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.message Logger
logger String
"Creating provider..."
    Provider
provider <- Store -> (String -> IO Bool) -> String -> IO Provider
newProvider Store
store (Configuration -> String -> IO Bool
shouldIgnoreFile Configuration
config) (String -> IO Provider) -> String -> IO Provider
forall a b. (a -> b) -> a -> b
$
        Configuration -> String
providerDirectory Configuration
config
    Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.message Logger
logger String
"Running rules..."
    RuleSet
ruleSet  <- Rules a -> Provider -> IO RuleSet
forall a. Rules a -> Provider -> IO RuleSet
runRules Rules a
rules Provider
provider

    -- Get old facts
    Result DependencyFacts
mOldFacts <- Store -> [String] -> IO (Result DependencyFacts)
forall a.
(Binary a, Typeable a) =>
Store -> [String] -> IO (Result a)
Store.get Store
store [String]
factsKey
    let (DependencyFacts
oldFacts) = case Result DependencyFacts
mOldFacts of Store.Found DependencyFacts
f -> DependencyFacts
f
                                       Result DependencyFacts
_             -> DependencyFacts
forall a. Monoid a => a
mempty

    -- Build runtime read/state
    let compilers :: [(Identifier, Compiler SomeItem)]
compilers = RuleSet -> [(Identifier, Compiler SomeItem)]
rulesCompilers RuleSet
ruleSet
        read' :: RuntimeRead
read'     = RuntimeRead :: Configuration
-> Logger
-> Provider
-> Store
-> Routes
-> Map Identifier (Compiler SomeItem)
-> RuntimeRead
RuntimeRead
            { runtimeConfiguration :: Configuration
runtimeConfiguration = Configuration
config
            , runtimeLogger :: Logger
runtimeLogger        = Logger
logger
            , runtimeProvider :: Provider
runtimeProvider      = Provider
provider
            , runtimeStore :: Store
runtimeStore         = Store
store
            , runtimeRoutes :: Routes
runtimeRoutes        = RuleSet -> Routes
rulesRoutes RuleSet
ruleSet
            , runtimeUniverse :: Map Identifier (Compiler SomeItem)
runtimeUniverse      = [(Identifier, Compiler SomeItem)]
-> Map Identifier (Compiler SomeItem)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Identifier, Compiler SomeItem)]
compilers
            }

    MVar RuntimeState
state <- RuntimeState -> IO (MVar RuntimeState)
forall a. a -> IO (MVar a)
newMVar (RuntimeState -> IO (MVar RuntimeState))
-> RuntimeState -> IO (MVar RuntimeState)
forall a b. (a -> b) -> a -> b
$ RuntimeState :: Set Identifier
-> Set (Identifier, String)
-> Map Identifier (Compiler SomeItem)
-> DependencyFacts
-> Map Identifier (Set Identifier)
-> RuntimeState
RuntimeState
            { runtimeDone :: Set Identifier
runtimeDone         = Set Identifier
forall a. Set a
S.empty
            , runtimeSnapshots :: Set (Identifier, String)
runtimeSnapshots    = Set (Identifier, String)
forall a. Set a
S.empty
            , runtimeTodo :: Map Identifier (Compiler SomeItem)
runtimeTodo         = Map Identifier (Compiler SomeItem)
forall k a. Map k a
M.empty
            , runtimeFacts :: DependencyFacts
runtimeFacts        = DependencyFacts
oldFacts
            , runtimeDependencies :: Map Identifier (Set Identifier)
runtimeDependencies = Map Identifier (Set Identifier)
forall k a. Map k a
M.empty
            }

    -- Run the program and fetch the resulting state
    Either String ((), MVar RuntimeState, ())
result <- ExceptT String IO ((), MVar RuntimeState, ())
-> IO (Either String ((), MVar RuntimeState, ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO ((), MVar RuntimeState, ())
 -> IO (Either String ((), MVar RuntimeState, ())))
-> ExceptT String IO ((), MVar RuntimeState, ())
-> IO (Either String ((), MVar RuntimeState, ()))
forall a b. (a -> b) -> a -> b
$ RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
-> RuntimeRead
-> MVar RuntimeState
-> ExceptT String IO ((), MVar RuntimeState, ())
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
build RuntimeRead
read' MVar RuntimeState
state
    case Either String ((), MVar RuntimeState, ())
result of
        Left String
e          -> do
            Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.error Logger
logger String
e
            Logger -> IO ()
Logger.flush Logger
logger
            (ExitCode, RuleSet) -> IO (ExitCode, RuleSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
1, RuleSet
ruleSet)

        Right (()
_, MVar RuntimeState
s, ()
_) -> do
            DependencyFacts
facts <- (RuntimeState -> DependencyFacts)
-> IO RuntimeState -> IO DependencyFacts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RuntimeState -> DependencyFacts
runtimeFacts (IO RuntimeState -> IO DependencyFacts)
-> (MVar RuntimeState -> IO RuntimeState)
-> MVar RuntimeState
-> IO DependencyFacts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO RuntimeState -> IO RuntimeState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RuntimeState -> IO RuntimeState)
-> (MVar RuntimeState -> IO RuntimeState)
-> MVar RuntimeState
-> IO RuntimeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar RuntimeState -> IO RuntimeState
forall a. MVar a -> IO a
readMVar (MVar RuntimeState -> IO DependencyFacts)
-> MVar RuntimeState -> IO DependencyFacts
forall a b. (a -> b) -> a -> b
$ MVar RuntimeState
s
            Store -> [String] -> DependencyFacts -> IO ()
forall a. (Binary a, Typeable a) => Store -> [String] -> a -> IO ()
Store.set Store
store [String]
factsKey DependencyFacts
facts

            Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger String
"Removing tmp directory..."
            String -> IO ()
removeDirectory (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Configuration -> String
tmpDirectory Configuration
config

            Logger -> IO ()
Logger.flush Logger
logger
            (ExitCode, RuleSet) -> IO (ExitCode, RuleSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, RuleSet
ruleSet)
  where
    factsKey :: [String]
factsKey = [String
"Hakyll.Core.Runtime.run", String
"facts"]


--------------------------------------------------------------------------------
data RuntimeRead = RuntimeRead
    { RuntimeRead -> Configuration
runtimeConfiguration :: Configuration
    , RuntimeRead -> Logger
runtimeLogger        :: Logger
    , RuntimeRead -> Provider
runtimeProvider      :: Provider
    , RuntimeRead -> Store
runtimeStore         :: Store
    , RuntimeRead -> Routes
runtimeRoutes        :: Routes
    , RuntimeRead -> Map Identifier (Compiler SomeItem)
runtimeUniverse      :: Map Identifier (Compiler SomeItem)
    }


--------------------------------------------------------------------------------
data RuntimeState = RuntimeState
    { RuntimeState -> Set Identifier
runtimeDone         :: Set Identifier
    , RuntimeState -> Set (Identifier, String)
runtimeSnapshots    :: Set (Identifier, Snapshot)
    , RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo         :: Map Identifier (Compiler SomeItem)
    , RuntimeState -> DependencyFacts
runtimeFacts        :: DependencyFacts
    , RuntimeState -> Map Identifier (Set Identifier)
runtimeDependencies :: Map Identifier (Set Identifier)
    }


--------------------------------------------------------------------------------
type Runtime a = RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) a


--------------------------------------------------------------------------------
-- Because compilation of rules often revolves around IO,
-- be very careful when modifying the state
modifyRuntimeState :: (RuntimeState -> RuntimeState) -> Runtime ()
modifyRuntimeState :: (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
modifyRuntimeState RuntimeState -> RuntimeState
f = RWST
  RuntimeRead
  ()
  (MVar RuntimeState)
  (ExceptT String IO)
  (MVar RuntimeState)
forall s (m :: * -> *). MonadState s m => m s
get RWST
  RuntimeRead
  ()
  (MVar RuntimeState)
  (ExceptT String IO)
  (MVar RuntimeState)
-> (MVar RuntimeState
    -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar RuntimeState
s -> IO ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> IO ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ MVar RuntimeState -> (RuntimeState -> IO RuntimeState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar RuntimeState
s (RuntimeState -> IO RuntimeState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RuntimeState -> IO RuntimeState)
-> (RuntimeState -> RuntimeState)
-> RuntimeState
-> IO RuntimeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeState -> RuntimeState
f)


--------------------------------------------------------------------------------
getRuntimeState :: Runtime RuntimeState
getRuntimeState :: Runtime RuntimeState
getRuntimeState = IO RuntimeState -> Runtime RuntimeState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RuntimeState -> Runtime RuntimeState)
-> (MVar RuntimeState -> IO RuntimeState)
-> MVar RuntimeState
-> Runtime RuntimeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar RuntimeState -> IO RuntimeState
forall a. MVar a -> IO a
readMVar (MVar RuntimeState -> Runtime RuntimeState)
-> RWST
     RuntimeRead
     ()
     (MVar RuntimeState)
     (ExceptT String IO)
     (MVar RuntimeState)
-> Runtime RuntimeState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RWST
  RuntimeRead
  ()
  (MVar RuntimeState)
  (ExceptT String IO)
  (MVar RuntimeState)
forall s (m :: * -> *). MonadState s m => m s
get


--------------------------------------------------------------------------------
build :: Runtime ()
build :: RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
build = do
    Logger
logger <- RuntimeRead -> Logger
runtimeLogger (RuntimeRead -> Logger)
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Logger
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Checking for out-of-date items"
    RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
scheduleOutOfDate
    Logger
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Compiling"
    RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
pickAndChase
    Logger
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Success"


--------------------------------------------------------------------------------
scheduleOutOfDate :: Runtime ()
scheduleOutOfDate :: RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
scheduleOutOfDate = do
    Logger
logger   <- RuntimeRead -> Logger
runtimeLogger   (RuntimeRead -> Logger)
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Provider
provider <- RuntimeRead -> Provider
runtimeProvider (RuntimeRead -> Provider)
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Map Identifier (Compiler SomeItem)
universe <- RuntimeRead -> Map Identifier (Compiler SomeItem)
runtimeUniverse (RuntimeRead -> Map Identifier (Compiler SomeItem))
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead
     ()
     (MVar RuntimeState)
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask

    let identifiers :: [Identifier]
identifiers = Map Identifier (Compiler SomeItem) -> [Identifier]
forall k a. Map k a -> [k]
M.keys Map Identifier (Compiler SomeItem)
universe
        modified :: Set Identifier
modified    = [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
$ ((Identifier -> Bool) -> [Identifier] -> [Identifier])
-> [Identifier] -> (Identifier -> Bool) -> [Identifier]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Identifier -> Bool) -> [Identifier] -> [Identifier]
forall a. (a -> Bool) -> [a] -> [a]
filter [Identifier]
identifiers ((Identifier -> Bool) -> [Identifier])
-> (Identifier -> Bool) -> [Identifier]
forall a b. (a -> b) -> a -> b
$
            Provider -> Identifier -> Bool
resourceModified Provider
provider

    RuntimeState
state <- Runtime RuntimeState
getRuntimeState
    let facts :: DependencyFacts
facts = RuntimeState -> DependencyFacts
runtimeFacts RuntimeState
state
        todo :: Map Identifier (Compiler SomeItem)
todo  = RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo RuntimeState
state

    let (Set Identifier
ood, DependencyFacts
facts', [String]
msgs) = [Identifier]
-> Set Identifier
-> DependencyFacts
-> (Set Identifier, DependencyFacts, [String])
outOfDate [Identifier]
identifiers Set Identifier
modified DependencyFacts
facts
        todo' :: Map Identifier (Compiler SomeItem)
todo'               = (Identifier -> Compiler SomeItem -> Bool)
-> Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey
            (\Identifier
id' Compiler SomeItem
_ -> Identifier
id' Identifier -> Set Identifier -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Identifier
ood) Map Identifier (Compiler SomeItem)
universe

    -- Print messages
    (String
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> [String]
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Logger
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger) [String]
msgs

    -- Update facts and todo items
    (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
modifyRuntimeState ((RuntimeState -> RuntimeState)
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ \RuntimeState
s -> RuntimeState
s
        { runtimeDone :: Set Identifier
runtimeDone  = RuntimeState -> Set Identifier
runtimeDone RuntimeState
s Set Identifier -> Set Identifier -> Set Identifier
forall a. Ord a => Set a -> Set a -> Set a
`S.union`
            ([Identifier] -> Set Identifier
forall a. Ord a => [a] -> Set a
S.fromList [Identifier]
identifiers Set Identifier -> Set Identifier -> Set Identifier
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Identifier
ood)
        , runtimeTodo :: Map Identifier (Compiler SomeItem)
runtimeTodo  = Map Identifier (Compiler SomeItem)
todo Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map Identifier (Compiler SomeItem)
todo'
        , runtimeFacts :: DependencyFacts
runtimeFacts = DependencyFacts
facts'
        }


--------------------------------------------------------------------------------
pickAndChase :: Runtime ()
pickAndChase :: RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
pickAndChase = do
    Map Identifier (Compiler SomeItem)
todo <- RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo (RuntimeState -> Map Identifier (Compiler SomeItem))
-> Runtime RuntimeState
-> RWST
     RuntimeRead
     ()
     (MVar RuntimeState)
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Runtime RuntimeState
getRuntimeState
    Bool
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map Identifier (Compiler SomeItem) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Identifier (Compiler SomeItem)
todo) (RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ do
        RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
checkForDependencyCycle
        [Identifier]
-> (Identifier
    -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, MonadBaseControl IO m) =>
t a -> (a -> m b) -> m ()
forConcurrently_ (Map Identifier (Compiler SomeItem) -> [Identifier]
forall k a. Map k a -> [k]
M.keys Map Identifier (Compiler SomeItem)
todo) Identifier
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
chase
        RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
pickAndChase


--------------------------------------------------------------------------------
-- | Check for cyclic dependencies in the current state
checkForDependencyCycle :: Runtime ()
checkForDependencyCycle :: RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
checkForDependencyCycle = do
    Map Identifier (Set Identifier)
deps <- RuntimeState -> Map Identifier (Set Identifier)
runtimeDependencies (RuntimeState -> Map Identifier (Set Identifier))
-> Runtime RuntimeState
-> RWST
     RuntimeRead
     ()
     (MVar RuntimeState)
     (ExceptT String IO)
     (Map Identifier (Set Identifier))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Runtime RuntimeState
getRuntimeState
    let (Graph
depgraph, Int -> (Identifier, Identifier, [Identifier])
nodeFromVertex, Identifier -> Maybe Int
_) = [(Identifier, Identifier, [Identifier])]
-> (Graph, Int -> (Identifier, Identifier, [Identifier]),
    Identifier -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
G.graphFromEdges [(Identifier
k, Identifier
k, Set Identifier -> [Identifier]
forall a. Set a -> [a]
S.toList Set Identifier
dps) | (Identifier
k, Set Identifier
dps) <- Map Identifier (Set Identifier) -> [(Identifier, Set Identifier)]
forall k a. Map k a -> [(k, a)]
M.toList Map Identifier (Set Identifier)
deps]
        dependencyCycles :: [Identifier]
dependencyCycles = (Int -> Identifier) -> [Int] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map ((\(Identifier
_, Identifier
k, [Identifier]
_) -> Identifier
k) ((Identifier, Identifier, [Identifier]) -> Identifier)
-> (Int -> (Identifier, Identifier, [Identifier]))
-> Int
-> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Identifier, Identifier, [Identifier])
nodeFromVertex) ([Int] -> [Identifier]) -> [Int] -> [Identifier]
forall a b. (a -> b) -> a -> b
$ Graph -> [Int]
cycles Graph
depgraph

    Bool
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Identifier] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Identifier]
dependencyCycles) (RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ do
        String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Hakyll.Core.Runtime.pickAndChase: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"Dependency cycle detected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Identifier -> String) -> [Identifier] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Identifier -> String
forall a. Show a => a -> String
show [Identifier]
dependencyCycles) String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
" are inter-dependent."
    where
        cycles :: Graph -> [G.Vertex]
        cycles :: Graph -> [Int]
cycles Graph
g = ((Int, [Int]) -> Int) -> [(Int, [Int])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [Int]) -> Int
forall a b. (a, b) -> a
fst ([(Int, [Int])] -> [Int])
-> (Graph -> [(Int, [Int])]) -> Graph -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [Int]) -> Bool) -> [(Int, [Int])] -> [(Int, [Int])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> [Int] -> Bool) -> (Int, [Int]) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> [Int] -> Bool) -> (Int, [Int]) -> Bool)
-> (Int -> [Int] -> Bool) -> (Int, [Int]) -> Bool
forall a b. (a -> b) -> a -> b
$ Graph -> Int -> [Int] -> Bool
reachableFromAny Graph
g) ([(Int, [Int])] -> [(Int, [Int])])
-> (Graph -> [(Int, [Int])]) -> Graph -> [(Int, [Int])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [(Int, [Int])]
forall i e. Ix i => Array i e -> [(i, e)]
A.assocs (Graph -> [Int]) -> Graph -> [Int]
forall a b. (a -> b) -> a -> b
$ Graph
g

        reachableFromAny :: Graph -> G.Vertex -> [G.Vertex] -> Bool
        reachableFromAny :: Graph -> Int -> [Int] -> Bool
reachableFromAny Graph
graph Int
node = Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
node ([Int] -> Bool) -> ([Int] -> [Int]) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Int]) -> [Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Graph -> Int -> [Int]
G.reachable Graph
graph)


--------------------------------------------------------------------------------
chase :: Identifier -> Runtime ()
chase :: Identifier
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
chase Identifier
id' = do
    Logger
logger    <- RuntimeRead -> Logger
runtimeLogger        (RuntimeRead -> Logger)
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Provider
provider  <- RuntimeRead -> Provider
runtimeProvider      (RuntimeRead -> Provider)
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Map Identifier (Compiler SomeItem)
universe  <- RuntimeRead -> Map Identifier (Compiler SomeItem)
runtimeUniverse      (RuntimeRead -> Map Identifier (Compiler SomeItem))
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead
     ()
     (MVar RuntimeState)
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Routes
routes    <- RuntimeRead -> Routes
runtimeRoutes        (RuntimeRead -> Routes)
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) Routes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Store
store     <- RuntimeRead -> Store
runtimeStore         (RuntimeRead -> Store)
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) Store
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Configuration
config    <- RuntimeRead -> Configuration
runtimeConfiguration (RuntimeRead -> Configuration)
-> RWST
     RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead
     ()
     (MVar RuntimeState)
     (ExceptT String IO)
     Configuration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  RuntimeRead () (MVar RuntimeState) (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask

    RuntimeState
state     <- Runtime RuntimeState
getRuntimeState

    Logger
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger (String
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Processing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
id'

    let compiler :: Compiler SomeItem
compiler = (RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo RuntimeState
state) Map Identifier (Compiler SomeItem)
-> Identifier -> Compiler SomeItem
forall k a. Ord k => Map k a -> k -> a
M.! Identifier
id'
        read' :: CompilerRead
read' = CompilerRead :: Configuration
-> Identifier
-> Provider
-> Set Identifier
-> Routes
-> Store
-> Logger
-> CompilerRead
CompilerRead
            { compilerConfig :: Configuration
compilerConfig     = Configuration
config
            , compilerUnderlying :: Identifier
compilerUnderlying = Identifier
id'
            , compilerProvider :: Provider
compilerProvider   = Provider
provider
            , compilerUniverse :: Set Identifier
compilerUniverse   = Map Identifier (Compiler SomeItem) -> Set Identifier
forall k a. Map k a -> Set k
M.keysSet Map Identifier (Compiler SomeItem)
universe
            , compilerRoutes :: Routes
compilerRoutes     = Routes
routes
            , compilerStore :: Store
compilerStore      = Store
store
            , compilerLogger :: Logger
compilerLogger     = Logger
logger
            }

    CompilerResult SomeItem
result <- IO (CompilerResult SomeItem)
-> RWST
     RuntimeRead
     ()
     (MVar RuntimeState)
     (ExceptT String IO)
     (CompilerResult SomeItem)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CompilerResult SomeItem)
 -> RWST
      RuntimeRead
      ()
      (MVar RuntimeState)
      (ExceptT String IO)
      (CompilerResult SomeItem))
-> IO (CompilerResult SomeItem)
-> RWST
     RuntimeRead
     ()
     (MVar RuntimeState)
     (ExceptT String IO)
     (CompilerResult SomeItem)
forall a b. (a -> b) -> a -> b
$ Compiler SomeItem -> CompilerRead -> IO (CompilerResult SomeItem)
forall a. Compiler a -> CompilerRead -> IO (CompilerResult a)
runCompiler Compiler SomeItem
compiler CompilerRead
read'
    case CompilerResult SomeItem
result of
        -- Rethrow error
        CompilerError CompilerErrors String
e -> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ case CompilerErrors String -> [String]
forall a. CompilerErrors a -> [a]
compilerErrorMessages CompilerErrors String
e of
            [] -> String
"Compiler failed but no info given, try running with -v?"
            [String]
es -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"; " [String]
es

        -- Signal that a snapshot was saved ->
        CompilerSnapshot String
snapshot Compiler SomeItem
c -> do
            -- Update info. The next 'chase' will pick us again at some
            -- point so we can continue then.
            (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
modifyRuntimeState ((RuntimeState -> RuntimeState)
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ \RuntimeState
s -> RuntimeState
s
                { runtimeSnapshots :: Set (Identifier, String)
runtimeSnapshots = (Identifier, String)
-> Set (Identifier, String) -> Set (Identifier, String)
forall a. Ord a => a -> Set a -> Set a
S.insert (Identifier
id', String
snapshot) (RuntimeState -> Set (Identifier, String)
runtimeSnapshots RuntimeState
s)
                , runtimeTodo :: Map Identifier (Compiler SomeItem)
runtimeTodo      = Identifier
-> Compiler SomeItem
-> Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
id' Compiler SomeItem
c (RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo RuntimeState
s)
                }


        -- Huge success
        CompilerDone (SomeItem Item a
item) CompilerWrite
cwrite -> do
            -- Print some info
            let facts :: [Dependency]
facts = CompilerWrite -> [Dependency]
compilerDependencies CompilerWrite
cwrite
                cacheHits :: String
cacheHits
                    | CompilerWrite -> Int
compilerCacheHits CompilerWrite
cwrite Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String
"updated"
                    | Bool
otherwise                     = String
"cached "
            Logger
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.message Logger
logger (String
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
cacheHits String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
id'

            -- Sanity check
            Bool
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
item Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
id') (RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$
                String
"The compiler yielded an Item with Identifier " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                Identifier -> String
forall a. Show a => a -> String
show (Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
item) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but we were expecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"an Item with Identifier " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
id' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"(you probably want to call makeItem to solve this problem)"

            -- Write if necessary
            (Maybe String
mroute, Bool
_) <- IO (Maybe String, Bool)
-> RWST
     RuntimeRead
     ()
     (MVar RuntimeState)
     (ExceptT String IO)
     (Maybe String, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String, Bool)
 -> RWST
      RuntimeRead
      ()
      (MVar RuntimeState)
      (ExceptT String IO)
      (Maybe String, Bool))
-> IO (Maybe String, Bool)
-> RWST
     RuntimeRead
     ()
     (MVar RuntimeState)
     (ExceptT String IO)
     (Maybe String, Bool)
forall a b. (a -> b) -> a -> b
$ Routes -> Provider -> Identifier -> IO (Maybe String, Bool)
runRoutes Routes
routes Provider
provider Identifier
id'
            case Maybe String
mroute of
                Maybe String
Nothing    -> ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just String
route -> do
                    let path :: String
path = Configuration -> String
destinationDirectory Configuration
config String -> String -> String
</> String
route
                    IO ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> IO ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
makeDirectories String
path
                    IO ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> IO ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String -> Item a -> IO ()
forall a. Writable a => String -> Item a -> IO ()
write String
path Item a
item
                    Logger
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger (String
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Routed to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path

            -- Save! (For load)
            IO ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> IO ()
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ Store -> Item a -> IO ()
forall a. (Binary a, Typeable a) => Store -> Item a -> IO ()
save Store
store Item a
item

            (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
modifyRuntimeState ((RuntimeState -> RuntimeState)
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ \RuntimeState
s -> RuntimeState
s
                { runtimeDone :: Set Identifier
runtimeDone  = Identifier -> Set Identifier -> Set Identifier
forall a. Ord a => a -> Set a -> Set a
S.insert Identifier
id' (RuntimeState -> Set Identifier
runtimeDone RuntimeState
s)
                , runtimeTodo :: Map Identifier (Compiler SomeItem)
runtimeTodo  = Identifier
-> Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Identifier
id' (RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo RuntimeState
s)
                , runtimeFacts :: DependencyFacts
runtimeFacts = Identifier -> [Dependency] -> DependencyFacts -> DependencyFacts
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
id' [Dependency]
facts (RuntimeState -> DependencyFacts
runtimeFacts RuntimeState
s)
                }

        -- Try something else first
        CompilerRequire (Identifier, String)
dep Compiler SomeItem
c -> do
            let (Identifier
depId, String
depSnapshot) = (Identifier, String)
dep
            Logger
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger (String
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$
                String
"Compiler requirement found for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
id' String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
", requirement: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
depId

            let done :: Set Identifier
done      = RuntimeState -> Set Identifier
runtimeDone RuntimeState
state
                snapshots :: Set (Identifier, String)
snapshots = RuntimeState -> Set (Identifier, String)
runtimeSnapshots RuntimeState
state
                deps :: Map Identifier (Set Identifier)
deps      = RuntimeState -> Map Identifier (Set Identifier)
runtimeDependencies RuntimeState
state

            -- Done if we either completed the entire item (runtimeDone) or
            -- if we previously saved the snapshot (runtimeSnapshots).
            let depDone :: Bool
depDone =
                    Identifier
depId Identifier -> Set Identifier -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Identifier
done Bool -> Bool -> Bool
||
                    (Identifier
depId, String
depSnapshot) (Identifier, String) -> Set (Identifier, String) -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set (Identifier, String)
snapshots

            let deps' :: Map Identifier (Set Identifier)
deps' = if Bool
depDone
                            then Map Identifier (Set Identifier)
deps
                            else (Set Identifier -> Set Identifier -> Set Identifier)
-> Identifier
-> Set Identifier
-> Map Identifier (Set Identifier)
-> Map Identifier (Set Identifier)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Set Identifier -> Set Identifier -> Set Identifier
forall a. Ord a => Set a -> Set a -> Set a
S.union Identifier
id' (Identifier -> Set Identifier
forall a. a -> Set a
S.singleton Identifier
depId) Map Identifier (Set Identifier)
deps

            (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
modifyRuntimeState ((RuntimeState -> RuntimeState)
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ \RuntimeState
s -> RuntimeState
s
                { runtimeTodo :: Map Identifier (Compiler SomeItem)
runtimeTodo         = Identifier
-> Compiler SomeItem
-> Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
id'
                    (if Bool
depDone then Compiler SomeItem
c else CompilerResult SomeItem -> Compiler SomeItem
forall a. CompilerResult a -> Compiler a
compilerResult CompilerResult SomeItem
result)
                    (RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo RuntimeState
s)
                , runtimeDependencies :: Map Identifier (Set Identifier)
runtimeDependencies = Map Identifier (Set Identifier)
deps'
                }

            Logger
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger (String
 -> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () (MVar RuntimeState) (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Require " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
depId String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
" (snapshot " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
depSnapshot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") "