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


--------------------------------------------------------------------------------
import           Control.Concurrent.Async.Lifted (forConcurrently)
import           Control.Concurrent.MVar         (modifyMVar_, readMVar, newMVar, MVar)
import           Control.Monad                   (join, unless, when)
import           Control.Monad.Except            (ExceptT, runExceptT, throwError)
import           Control.Monad.Reader            (ReaderT, ask, runReaderT)
import           Control.Monad.Trans             (liftIO)
import           Data.Foldable                   (traverse_)
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           Data.Traversable                (for)
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


factsKey :: [String]
factsKey :: [String]
factsKey = [String
"Hakyll.Core.Runtime.run", String
"facts"]


--------------------------------------------------------------------------------
-- | Whether to execute a normal run (build the site) or a dry run.
data RunMode = RunModeNormal | RunModePrintOutOfDate
    deriving (Int -> RunMode -> ShowS
[RunMode] -> ShowS
RunMode -> String
(Int -> RunMode -> ShowS)
-> (RunMode -> String) -> ([RunMode] -> ShowS) -> Show RunMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunMode] -> ShowS
$cshowList :: [RunMode] -> ShowS
show :: RunMode -> String
$cshow :: RunMode -> String
showsPrec :: Int -> RunMode -> ShowS
$cshowsPrec :: Int -> RunMode -> ShowS
Show)


--------------------------------------------------------------------------------
run :: RunMode -> Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
run :: RunMode
-> Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
run RunMode
mode 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

    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, String))
-> 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, String))
runtimeDependencies = Map Identifier (Set (Identifier, String))
forall k a. Map k a
M.empty
            }

    -- Build runtime read/state
    let compilers :: [(Identifier, Compiler SomeItem)]
compilers = RuleSet -> [(Identifier, Compiler SomeItem)]
rulesCompilers RuleSet
ruleSet
        read' :: RuntimeRead
read'     = RuntimeRead :: Configuration
-> Logger
-> Provider
-> MVar RuntimeState
-> Store
-> Routes
-> Map Identifier (Compiler SomeItem)
-> RuntimeRead
RuntimeRead
            { runtimeConfiguration :: Configuration
runtimeConfiguration = Configuration
config
            , runtimeLogger :: Logger
runtimeLogger        = Logger
logger
            , runtimeProvider :: Provider
runtimeProvider      = Provider
provider
            , runtimeState :: MVar RuntimeState
runtimeState         = MVar RuntimeState
state
            , 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
            }

    -- Run the program and fetch the resulting state
    Either String ()
result <- ExceptT String IO () -> IO (Either String ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO () -> IO (Either String ()))
-> ExceptT String IO () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ ReaderT RuntimeRead (ExceptT String IO) ()
-> RuntimeRead -> ExceptT String IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (RunMode -> ReaderT RuntimeRead (ExceptT String IO) ()
build RunMode
mode) RuntimeRead
read'
    case Either String ()
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 ()
_ -> do
            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)


--------------------------------------------------------------------------------
data RuntimeRead = RuntimeRead
    { RuntimeRead -> Configuration
runtimeConfiguration :: Configuration
    , RuntimeRead -> Logger
runtimeLogger        :: Logger
    , RuntimeRead -> Provider
runtimeProvider      :: Provider
    , RuntimeRead -> MVar RuntimeState
runtimeState         :: MVar RuntimeState
    , 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, String))
runtimeDependencies :: Map Identifier (Set (Identifier, Snapshot))
    }


--------------------------------------------------------------------------------
type Runtime a = ReaderT RuntimeRead (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)
-> ReaderT RuntimeRead (ExceptT String IO) ()
modifyRuntimeState RuntimeState -> RuntimeState
f = IO () -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT RuntimeRead (ExceptT String IO) ())
-> (RuntimeRead -> IO ())
-> RuntimeRead
-> ReaderT RuntimeRead (ExceptT String IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar RuntimeState -> (RuntimeState -> IO RuntimeState) -> IO ())
-> (RuntimeState -> IO RuntimeState) -> MVar RuntimeState -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVar RuntimeState -> (RuntimeState -> IO RuntimeState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (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) (MVar RuntimeState -> IO ())
-> (RuntimeRead -> MVar RuntimeState) -> RuntimeRead -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeRead -> MVar RuntimeState
runtimeState (RuntimeRead -> ReaderT RuntimeRead (ExceptT String IO) ())
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask


--------------------------------------------------------------------------------
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)
-> (RuntimeRead -> IO RuntimeState)
-> RuntimeRead
-> 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 -> IO RuntimeState)
-> (RuntimeRead -> MVar RuntimeState)
-> RuntimeRead
-> IO RuntimeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeRead -> MVar RuntimeState
runtimeState (RuntimeRead -> Runtime RuntimeState)
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> Runtime RuntimeState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask


--------------------------------------------------------------------------------
build :: RunMode -> Runtime ()
build :: RunMode -> ReaderT RuntimeRead (ExceptT String IO) ()
build RunMode
mode = do
    Logger
logger <- RuntimeRead -> Logger
runtimeLogger (RuntimeRead -> Logger)
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT RuntimeRead (ExceptT String IO) Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Logger -> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Checking for out-of-date items"
    ReaderT RuntimeRead (ExceptT String IO) ()
scheduleOutOfDate
    case RunMode
mode of
        RunMode
RunModeNormal -> do
            Logger -> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Compiling"
            ReaderT RuntimeRead (ExceptT String IO) ()
pickAndChase
            Logger -> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Success"
            DependencyFacts
facts <- RuntimeState -> DependencyFacts
runtimeFacts (RuntimeState -> DependencyFacts)
-> Runtime RuntimeState
-> ReaderT RuntimeRead (ExceptT String IO) DependencyFacts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Runtime RuntimeState
getRuntimeState
            Store
store <- RuntimeRead -> Store
runtimeStore (RuntimeRead -> Store)
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT RuntimeRead (ExceptT String IO) Store
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
            IO () -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT RuntimeRead (ExceptT String IO) ())
-> IO () -> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ Store -> [String] -> DependencyFacts -> IO ()
forall a. (Binary a, Typeable a) => Store -> [String] -> a -> IO ()
Store.set Store
store [String]
factsKey DependencyFacts
facts
        RunMode
RunModePrintOutOfDate -> do
            Logger -> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Out of date items:"
            Map Identifier (Compiler SomeItem)
todo <- RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo (RuntimeState -> Map Identifier (Compiler SomeItem))
-> Runtime RuntimeState
-> ReaderT
     RuntimeRead
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Runtime RuntimeState
getRuntimeState
            (Identifier -> ReaderT RuntimeRead (ExceptT String IO) ())
-> [Identifier] -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Logger -> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.message Logger
logger (String -> ReaderT RuntimeRead (ExceptT String IO) ())
-> (Identifier -> String)
-> Identifier
-> ReaderT RuntimeRead (ExceptT String IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> String
forall a. Show a => a -> String
show) (Map Identifier (Compiler SomeItem) -> [Identifier]
forall k a. Map k a -> [k]
M.keys Map Identifier (Compiler SomeItem)
todo)


--------------------------------------------------------------------------------
scheduleOutOfDate :: Runtime ()
scheduleOutOfDate :: ReaderT RuntimeRead (ExceptT String IO) ()
scheduleOutOfDate = do
    Logger
logger   <- RuntimeRead -> Logger
runtimeLogger   (RuntimeRead -> Logger)
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT RuntimeRead (ExceptT String IO) Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Provider
provider <- RuntimeRead -> Provider
runtimeProvider (RuntimeRead -> Provider)
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT RuntimeRead (ExceptT String IO) Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RuntimeRead (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))
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT
     RuntimeRead
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RuntimeRead (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 -> Bool) -> Set Identifier -> Set Identifier
forall a. (a -> Bool) -> Set a -> Set a
S.filter (Provider -> Identifier -> Bool
resourceModified Provider
provider) (Map Identifier (Compiler SomeItem) -> Set Identifier
forall k a. Map k a -> Set k
M.keysSet Map Identifier (Compiler SomeItem)
universe)

    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
        done :: Set Identifier
done  = RuntimeState -> Set Identifier
runtimeDone 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
        done' :: Set Identifier
done'               = Set Identifier
done Set Identifier -> Set Identifier -> Set Identifier
forall a. Ord a => Set a -> Set a -> Set a
`S.union` (Map Identifier (Compiler SomeItem) -> Set Identifier
forall k a. Map k a -> Set k
M.keysSet Map Identifier (Compiler SomeItem)
universe Set Identifier -> Set Identifier -> Set Identifier
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Identifier
ood)

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

    -- Update facts and todo items
    (RuntimeState -> RuntimeState)
-> ReaderT RuntimeRead (ExceptT String IO) ()
modifyRuntimeState ((RuntimeState -> RuntimeState)
 -> ReaderT RuntimeRead (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ \RuntimeState
s -> RuntimeState
s
        { runtimeDone :: Set Identifier
runtimeDone  = Set Identifier
done'
        , 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 :: ReaderT RuntimeRead (ExceptT String IO) ()
pickAndChase = do
    Map Identifier (Compiler SomeItem)
todo <- RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo (RuntimeState -> Map Identifier (Compiler SomeItem))
-> Runtime RuntimeState
-> ReaderT
     RuntimeRead
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Runtime RuntimeState
getRuntimeState
    Bool
-> ReaderT RuntimeRead (ExceptT String IO) ()
-> ReaderT RuntimeRead (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) (ReaderT RuntimeRead (ExceptT String IO) ()
 -> ReaderT RuntimeRead (ExceptT String IO) ())
-> ReaderT RuntimeRead (ExceptT String IO) ()
-> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ do
        Progress
acted <- [Progress] -> Progress
forall a. Monoid a => [a] -> a
mconcat ([Progress] -> Progress)
-> ReaderT RuntimeRead (ExceptT String IO) [Progress]
-> ReaderT RuntimeRead (ExceptT String IO) Progress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Identifier]
-> (Identifier -> ReaderT RuntimeRead (ExceptT String IO) Progress)
-> ReaderT RuntimeRead (ExceptT String IO) [Progress]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadBaseControl IO m) =>
t a -> (a -> m b) -> m (t b)
forConcurrently (Map Identifier (Compiler SomeItem) -> [Identifier]
forall k a. Map k a -> [k]
M.keys Map Identifier (Compiler SomeItem)
todo) Identifier -> ReaderT RuntimeRead (ExceptT String IO) Progress
chase
        Bool
-> ReaderT RuntimeRead (ExceptT String IO) ()
-> ReaderT RuntimeRead (ExceptT String IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Progress
acted Progress -> Progress -> Bool
forall a. Eq a => a -> a -> Bool
== Progress
Idled) (ReaderT RuntimeRead (ExceptT String IO) ()
 -> ReaderT RuntimeRead (ExceptT String IO) ())
-> ReaderT RuntimeRead (ExceptT String IO) ()
-> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ do
            -- This clause happens when chasing *every item* in `todo` resulted in 
            -- idling because tasks are all waiting on something: a dependency cycle  
            Map Identifier (Set (Identifier, String))
deps <- RuntimeState -> Map Identifier (Set (Identifier, String))
runtimeDependencies (RuntimeState -> Map Identifier (Set (Identifier, String)))
-> Runtime RuntimeState
-> ReaderT
     RuntimeRead
     (ExceptT String IO)
     (Map Identifier (Set (Identifier, String)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Runtime RuntimeState
getRuntimeState
            String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ReaderT RuntimeRead (ExceptT String IO) ())
-> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Hakyll.Core.Runtime.pickAndChase: Dependency cycle detected: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ 
                String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [Identifier -> String
forall a. Show a => a -> String
show Identifier
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" depends on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Identifier, String)] -> String
forall a. Show a => a -> String
show (Set (Identifier, String) -> [(Identifier, String)]
forall a. Set a -> [a]
S.toList Set (Identifier, String)
v) | (Identifier
k, Set (Identifier, String)
v) <- Map Identifier (Set (Identifier, String))
-> [(Identifier, Set (Identifier, String))]
forall k a. Map k a -> [(k, a)]
M.toList Map Identifier (Set (Identifier, String))
deps]
        ReaderT RuntimeRead (ExceptT String IO) ()
pickAndChase


--------------------------------------------------------------------------------
-- | Tracks whether a set of tasks has progressed overall (at least one task progressed)
-- or has idled
data Progress = Progressed | Idled deriving (Progress -> Progress -> Bool
(Progress -> Progress -> Bool)
-> (Progress -> Progress -> Bool) -> Eq Progress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Progress -> Progress -> Bool
$c/= :: Progress -> Progress -> Bool
== :: Progress -> Progress -> Bool
$c== :: Progress -> Progress -> Bool
Eq)

instance Semigroup Progress where
    Progress
Idled      <> :: Progress -> Progress -> Progress
<> Progress
Idled      = Progress
Idled
    Progress
Progressed <> Progress
_          = Progress
Progressed
    Progress
_          <> Progress
Progressed = Progress
Progressed

instance Monoid Progress where
    mempty :: Progress
mempty = Progress
Idled


--------------------------------------------------------------------------------
chase :: Identifier -> Runtime Progress
chase :: Identifier -> ReaderT RuntimeRead (ExceptT String IO) Progress
chase Identifier
id' = do
    Logger
logger    <- RuntimeRead -> Logger
runtimeLogger        (RuntimeRead -> Logger)
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT RuntimeRead (ExceptT String IO) Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Provider
provider  <- RuntimeRead -> Provider
runtimeProvider      (RuntimeRead -> Provider)
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT RuntimeRead (ExceptT String IO) Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RuntimeRead (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))
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT
     RuntimeRead
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Routes
routes    <- RuntimeRead -> Routes
runtimeRoutes        (RuntimeRead -> Routes)
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT RuntimeRead (ExceptT String IO) Routes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Store
store     <- RuntimeRead -> Store
runtimeStore         (RuntimeRead -> Store)
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT RuntimeRead (ExceptT String IO) Store
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Configuration
config    <- RuntimeRead -> Configuration
runtimeConfiguration (RuntimeRead -> Configuration)
-> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
-> ReaderT RuntimeRead (ExceptT String IO) Configuration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RuntimeRead (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask

    RuntimeState
state     <- Runtime RuntimeState
getRuntimeState

    Logger -> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger (String -> ReaderT RuntimeRead (ExceptT String IO) ())
-> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Processing " String -> ShowS
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)
-> ReaderT
     RuntimeRead (ExceptT String IO) (CompilerResult SomeItem)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CompilerResult SomeItem)
 -> ReaderT
      RuntimeRead (ExceptT String IO) (CompilerResult SomeItem))
-> IO (CompilerResult SomeItem)
-> ReaderT
     RuntimeRead (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 -> ReaderT RuntimeRead (ExceptT String IO) Progress
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ReaderT RuntimeRead (ExceptT String IO) Progress)
-> String -> ReaderT RuntimeRead (ExceptT String IO) Progress
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)
-> ReaderT RuntimeRead (ExceptT String IO) ()
modifyRuntimeState ((RuntimeState -> RuntimeState)
 -> ReaderT RuntimeRead (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> ReaderT RuntimeRead (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)
                }

            Progress -> ReaderT RuntimeRead (ExceptT String IO) Progress
forall (m :: * -> *) a. Monad m => a -> m a
return Progress
Progressed


        -- 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 -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.message Logger
logger (String -> ReaderT RuntimeRead (ExceptT String IO) ())
-> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
cacheHits String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
id'

            -- Sanity check
            Bool
-> ReaderT RuntimeRead (ExceptT String IO) ()
-> ReaderT RuntimeRead (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') (ReaderT RuntimeRead (ExceptT String IO) ()
 -> ReaderT RuntimeRead (ExceptT String IO) ())
-> ReaderT RuntimeRead (ExceptT String IO) ()
-> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ReaderT RuntimeRead (ExceptT String IO) ())
-> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$
                String
"The compiler yielded an Item with Identifier " String -> ShowS
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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but we were expecting " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                String
"an Item with Identifier " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
id' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
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)
-> ReaderT RuntimeRead (ExceptT String IO) (Maybe String, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String, Bool)
 -> ReaderT RuntimeRead (ExceptT String IO) (Maybe String, Bool))
-> IO (Maybe String, Bool)
-> ReaderT RuntimeRead (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    -> () -> ReaderT RuntimeRead (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 -> ShowS
</> String
route
                    IO () -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT RuntimeRead (ExceptT String IO) ())
-> IO () -> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
makeDirectories String
path
                    IO () -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT RuntimeRead (ExceptT String IO) ())
-> IO () -> ReaderT RuntimeRead (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 -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger (String -> ReaderT RuntimeRead (ExceptT String IO) ())
-> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Routed to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path

            -- Save! (For load)
            IO () -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT RuntimeRead (ExceptT String IO) ())
-> IO () -> ReaderT RuntimeRead (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)
-> ReaderT RuntimeRead (ExceptT String IO) ()
modifyRuntimeState ((RuntimeState -> RuntimeState)
 -> ReaderT RuntimeRead (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> ReaderT RuntimeRead (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)
                , runtimeDependencies :: Map Identifier (Set (Identifier, String))
runtimeDependencies = Identifier
-> Map Identifier (Set (Identifier, String))
-> Map Identifier (Set (Identifier, String))
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Identifier
id' (RuntimeState -> Map Identifier (Set (Identifier, String))
runtimeDependencies RuntimeState
s)
                }
            
            Progress -> ReaderT RuntimeRead (ExceptT String IO) Progress
forall (m :: * -> *) a. Monad m => a -> m a
return Progress
Progressed

        -- Try something else first
        CompilerRequire [(Identifier, String)]
reqs Compiler SomeItem
c -> do
            let done :: Set Identifier
done      = RuntimeState -> Set Identifier
runtimeDone RuntimeState
state
                snapshots :: Set (Identifier, String)
snapshots = RuntimeState -> Set (Identifier, String)
runtimeSnapshots RuntimeState
state

            [(Identifier, String)]
deps <- ([[(Identifier, String)]] -> [(Identifier, String)])
-> ReaderT RuntimeRead (ExceptT String IO) [[(Identifier, String)]]
-> ReaderT RuntimeRead (ExceptT String IO) [(Identifier, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(Identifier, String)]] -> [(Identifier, String)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ReaderT RuntimeRead (ExceptT String IO) [[(Identifier, String)]]
 -> ReaderT RuntimeRead (ExceptT String IO) [(Identifier, String)])
-> (((Identifier, String)
     -> ReaderT RuntimeRead (ExceptT String IO) [(Identifier, String)])
    -> ReaderT
         RuntimeRead (ExceptT String IO) [[(Identifier, String)]])
-> ((Identifier, String)
    -> ReaderT RuntimeRead (ExceptT String IO) [(Identifier, String)])
-> ReaderT RuntimeRead (ExceptT String IO) [(Identifier, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Identifier, String)]
-> ((Identifier, String)
    -> ReaderT RuntimeRead (ExceptT String IO) [(Identifier, String)])
-> ReaderT RuntimeRead (ExceptT String IO) [[(Identifier, String)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Identifier, String)]
reqs (((Identifier, String)
  -> ReaderT RuntimeRead (ExceptT String IO) [(Identifier, String)])
 -> ReaderT RuntimeRead (ExceptT String IO) [(Identifier, String)])
-> ((Identifier, String)
    -> ReaderT RuntimeRead (ExceptT String IO) [(Identifier, String)])
-> ReaderT RuntimeRead (ExceptT String IO) [(Identifier, String)]
forall a b. (a -> b) -> a -> b
$ \(Identifier
depId, String
depSnapshot) -> do
                Logger -> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger (String -> ReaderT RuntimeRead (ExceptT String IO) ())
-> String -> ReaderT RuntimeRead (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$
                    String
"Compiler requirement found for: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
id' String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
depId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (snapshot " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
depSnapshot String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

                -- 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
                    actualDep :: [(Identifier, String)]
actualDep = [(Identifier
depId, String
depSnapshot) | Bool -> Bool
not Bool
depDone]

                [(Identifier, String)]
-> ReaderT RuntimeRead (ExceptT String IO) [(Identifier, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Identifier, String)]
actualDep  

            (RuntimeState -> RuntimeState)
-> ReaderT RuntimeRead (ExceptT String IO) ()
modifyRuntimeState ((RuntimeState -> RuntimeState)
 -> ReaderT RuntimeRead (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> ReaderT RuntimeRead (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 [(Identifier, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Identifier, String)]
deps 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)
                 -- We track dependencies only to inform users when an infinite loop is detected
                , runtimeDependencies :: Map Identifier (Set (Identifier, String))
runtimeDependencies = (Set (Identifier, String)
 -> Set (Identifier, String) -> Set (Identifier, String))
-> Identifier
-> Set (Identifier, String)
-> Map Identifier (Set (Identifier, String))
-> Map Identifier (Set (Identifier, String))
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Set (Identifier, String)
-> Set (Identifier, String) -> Set (Identifier, String)
forall a. Ord a => Set a -> Set a -> Set a
S.union Identifier
id' ([(Identifier, String)] -> Set (Identifier, String)
forall a. Ord a => [a] -> Set a
S.fromList [(Identifier, String)]
deps) (RuntimeState -> Map Identifier (Set (Identifier, String))
runtimeDependencies RuntimeState
s)
                }

            -- Progress has been made if at least one of the 
            -- requirements can move forwards at the next pass
            let progress :: Progress
progress | [(Identifier, String)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Identifier, String)]
deps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [(Identifier, String)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Identifier, String)]
reqs = Progress
Progressed
                         | Bool
otherwise                 = Progress
Idled

            Progress -> ReaderT RuntimeRead (ExceptT String IO) Progress
forall (m :: * -> *) a. Monad m => a -> m a
return Progress
progress