{-# LANGUAGE ImpredicativeTypes, FlexibleContexts, ScopedTypeVariables #-}

-- | Models of several build systems.
module Build.System (
    -- * Toy build systems
    dumb, busy, memo,

    -- * Applicative build systems
    make, ninja, cloudBuild, buck,

    -- * Monadic build systems
    excel, shake, cloudShake, bazel, nix
    ) where

import Control.Monad.State

import Build
import Build.Scheduler
import Build.Store
import Build.Rebuilder
import Build.Trace

-- | This is not a correct build system: given a target key, it simply rebuilds
-- it, without rebuilding any of its dependencies.
dumb :: Eq k => Build Monad () k v
dumb :: forall k v. Eq k => Build Monad () k v
dumb = Scheduler Monad () () k v
forall i k v. Eq k => Scheduler Monad i i k v
independent Rebuilder Monad () k v
forall i k v. Rebuilder Monad i k v
perpetualRebuilder

-- | This is a correct but non-minimal build system: given a target key it
-- recursively rebuilds its dependencies, even if they are already up to date.
-- There is no memoisation, therefore a key may be built multiple times.
busy :: forall k v. Eq k => Build Monad () k v
busy :: forall k v. Eq k => Build Monad () k v
busy Tasks Monad k v
tasks k
key = State (Store () k v) v -> Store () k v -> Store () k v
forall s a. State s a -> s -> s
execState (k -> State (Store () k v) v
fetch k
key)
  where
    fetch :: k -> State (Store () k v) v
    fetch :: k -> State (Store () k v) v
fetch k
k = case Tasks Monad k v
tasks k
k of
        Maybe (Task Monad k v)
Nothing   -> (Store () k v -> v) -> State (Store () k v) v
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (k -> Store () k v -> v
forall k i v. k -> Store i k v -> v
getValue k
k)
        Just Task Monad k v
task -> do v
v <- (k -> State (Store () k v) v) -> State (Store () k v) v
Task Monad k v
task k -> State (Store () k v) v
fetch; (Store () k v -> Store () k v) -> StateT (Store () k v) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (k -> v -> Store () k v -> Store () k v
forall k v i. Eq k => k -> v -> Store i k v -> Store i k v
putValue k
k v
v); v -> State (Store () k v) v
forall a. a -> StateT (Store () k v) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return v
v

-- | This is a correct but non-minimal build system: it will rebuild keys even
-- if they are up to date. However, it performs memoization, therefore it never
-- builds a key twice.
memo :: Ord k => Build Monad () k v
memo :: forall k v. Ord k => Build Monad () k v
memo = Scheduler Monad () () k v
forall i k v. Ord k => Scheduler Monad i i k v
suspending k
-> v
-> (forall {f :: * -> *}. Monad f => (k -> f v) -> f v)
-> forall {f :: * -> *}. MonadState () f => (k -> f v) -> f v
forall i k v. Rebuilder Monad i k v
perpetualRebuilder

-- | A model of Make: an applicative build system that uses file modification
-- times to check if a key is up to date.
make :: Ord k => Build Applicative (MakeInfo k) k v
make :: forall k v. Ord k => Build Applicative (MakeInfo k) k v
make = Scheduler Applicative (MakeInfo k) (MakeInfo k) k v
forall i k v. Ord k => Scheduler Applicative i i k v
topological Rebuilder Applicative (MakeInfo k) k v
forall k v. Ord k => Rebuilder Applicative (MakeInfo k) k v
modTimeRebuilder

-- | A model of Ninja: an applicative build system that uses verifying traces
-- to check if a key is up to date.
ninja :: forall k v. (Ord k, Hashable v) => Build Applicative (VT k v) k v
ninja :: forall k v. (Ord k, Hashable v) => Build Applicative (VT k v) k v
ninja = Scheduler Applicative (VT k v) (VT k v) k v
forall i k v. Ord k => Scheduler Applicative i i k v
topological Rebuilder Applicative (VT k v) k v
rebuilder
  where
    rebuilder :: Rebuilder Applicative (VT k v) k v
    rebuilder :: Rebuilder Applicative (VT k v) k v
rebuilder = Rebuilder Monad (VT k v) k v
k -> v -> Task Applicative k v -> (k -> f v) -> f v
forall k v. (Eq k, Hashable v) => Rebuilder Monad (VT k v) k v
vtRebuilder

-- | Excel stores a dirty bit per key and a calc chain.
type ExcelInfo k = (k -> Bool, Chain k)

-- | A model of Excel: a monadic build system that stores the calculation chain
-- from the previous build and approximate dependencies.
excel :: Ord k => Build Monad (ExcelInfo k) k v
excel :: forall k v. Ord k => Build Monad (ExcelInfo k) k v
excel = Scheduler Monad (k -> Bool, Chain k) (k -> Bool) k v
forall ir k v. Ord k => Scheduler Monad (ir, Chain k) ir k v
restarting Rebuilder Monad (k -> Bool) k v
forall k v. Rebuilder Monad (k -> Bool) k v
dirtyBitRebuilder

-- | A model of Shake: a monadic build system that uses verifying traces to
-- check if a key is up to date.
shake :: (Ord k, Hashable v) => Build Monad (VT k v) k v
shake :: forall k v. (Ord k, Hashable v) => Build Monad (VT k v) k v
shake = Scheduler Monad (VT k v) (VT k v) k v
forall i k v. Ord k => Scheduler Monad i i k v
suspending Rebuilder Monad (VT k v) k v
forall k v. (Eq k, Hashable v) => Rebuilder Monad (VT k v) k v
vtRebuilder

-- | A model of Bazel: a monadic build system that uses constructive traces
-- to check if a key is up to date as well as for caching build results. Note
-- that Bazel currently does not allow users to write monadic build rules: only
-- built-in rules have access to dynamic dependencies.
bazel :: (Ord k, Hashable v) => Build Monad (CT k v) k v
bazel :: forall k v. (Ord k, Hashable v) => Build Monad (CT k v) k v
bazel = Scheduler Monad (CT k v) (CT k v) k v
forall k v.
(Hashable v, Eq k) =>
Scheduler Monad (CT k v) (CT k v) k v
restarting2 Rebuilder Monad (CT k v) k v
forall k v. (Eq k, Hashable v) => Rebuilder Monad (CT k v) k v
ctRebuilder

-- | A model of Cloud Shake: a monadic build system that uses constructive
-- traces to check if a key is up to date as well as for caching build results.
cloudShake :: (Ord k, Hashable v) => Build Monad (CT k v) k v
cloudShake :: forall k v. (Ord k, Hashable v) => Build Monad (CT k v) k v
cloudShake = Scheduler Monad (CT k v) (CT k v) k v
forall i k v. Ord k => Scheduler Monad i i k v
suspending Rebuilder Monad (CT k v) k v
forall k v. (Eq k, Hashable v) => Rebuilder Monad (CT k v) k v
ctRebuilder

-- | A model of CloudBuild: an applicative build system that uses constructive
-- traces to check if a key is up to date as well as for caching build results.
cloudBuild :: forall k v. (Ord k, Hashable v) => Build Applicative (CT k v) k v
cloudBuild :: forall k v. (Ord k, Hashable v) => Build Applicative (CT k v) k v
cloudBuild = Scheduler Applicative (CT k v) (CT k v) k v
forall i k v. Ord k => Scheduler Applicative i i k v
topological Rebuilder Applicative (CT k v) k v
rebuilder
  where
    rebuilder :: Rebuilder Applicative (CT k v) k v
    rebuilder :: Rebuilder Applicative (CT k v) k v
rebuilder = Rebuilder Monad (CT k v) k v
k -> v -> Task Applicative k v -> (k -> f v) -> f v
forall k v. (Eq k, Hashable v) => Rebuilder Monad (CT k v) k v
ctRebuilder

-- | A model of Buck: an applicative build system that uses deep constructive
-- traces to check if a key is up to date as well as for caching build results.
buck :: forall k v. (Ord k, Hashable v) => Build Applicative (DCT k v) k v
buck :: forall k v. (Ord k, Hashable v) => Build Applicative (DCT k v) k v
buck = Scheduler Applicative (DCT k v) (DCT k v) k v
forall i k v. Ord k => Scheduler Applicative i i k v
topological Rebuilder Applicative (DCT k v) k v
rebuilder
  where
    rebuilder :: Rebuilder Applicative (DCT k v) k v
    rebuilder :: Rebuilder Applicative (DCT k v) k v
rebuilder = Rebuilder Monad (DCT k v) k v
k -> v -> Task Applicative k v -> (k -> f v) -> f v
forall k v. (Eq k, Hashable v) => Rebuilder Monad (DCT k v) k v
dctRebuilder

-- | A model of Nix: a monadic build system that uses deep constructive traces
-- to check if a key is up to date as well as for caching build results.
nix :: (Ord k, Hashable v) => Build Monad (DCT k v) k v
nix :: forall k v. (Ord k, Hashable v) => Build Monad (DCT k v) k v
nix = Scheduler Monad (DCT k v) (DCT k v) k v
forall i k v. Ord k => Scheduler Monad i i k v
suspending Rebuilder Monad (DCT k v) k v
forall k v. (Eq k, Hashable v) => Rebuilder Monad (DCT k v) k v
dctRebuilder