{-# LANGUAGE ScopedTypeVariables, ImpredicativeTypes #-}

-- | This module defines two different strategies of self-tracking, based
-- around the idea of storing task descriptions that can be parsed into a 'Task'.
--
-- * For 'Monad' it works out beautifully. You just store the rule on the disk,
-- and depend on it.
--
-- * For 'Applicative', we generate a fresh 'Task' each time, but have that
-- 'Task' depend on a fake version of the rules. This is a change in the 'Task',
-- but it's one for which the standard implementations tend to cope with just
-- fine. Most applicative systems with self-tracking probably do it this way.
module Build.SelfTracking (
    Key (..), Value (..), selfTrackingM, selfTrackingA
    ) where

import Build.Task

-- | We assume that the fetch passed to a Task is consistent and returns values
-- matching the keys. It is possible to switch to typed tasks to check this
-- assumption at compile time, e.g. see "Build.Task.Typed".
data Key k     = Key k   | KeyTask k
data Value v t = Value v | ValueTask t

-- | Fetch a value.
fetchValue :: Functor f => (Key k -> f (Value v t)) -> k -> f v
fetchValue :: forall (f :: * -> *) k v t.
Functor f =>
(Key k -> f (Value v t)) -> k -> f v
fetchValue Key k -> f (Value v t)
fetch k
key = Value v t -> v
forall {v} {t}. Value v t -> v
extract (Value v t -> v) -> f (Value v t) -> f v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key k -> f (Value v t)
fetch (k -> Key k
forall k. k -> Key k
Key k
key)
  where
    extract :: Value v t -> v
extract (Value v
v) = v
v
    extract Value v t
_ = [Char] -> v
forall a. HasCallStack => [Char] -> a
error [Char]
"Inconsistent fetch"

-- | Fetch a task description.
fetchValueTask :: Functor f => (Key k -> f (Value v t)) -> k -> f t
fetchValueTask :: forall (f :: * -> *) k v t.
Functor f =>
(Key k -> f (Value v t)) -> k -> f t
fetchValueTask Key k -> f (Value v t)
fetch k
key = Value v t -> t
forall {v} {t}. Value v t -> t
extract (Value v t -> t) -> f (Value v t) -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key k -> f (Value v t)
fetch (k -> Key k
forall k. k -> Key k
KeyTask k
key)
  where
    extract :: Value v t -> t
extract (ValueTask t
t) = t
t
    extract Value v t
_ = [Char] -> t
forall a. HasCallStack => [Char] -> a
error [Char]
"Inconsistent fetch"

-- | A model for 'Monad', works beautifully and allows storing the key on disk.
selfTrackingM :: forall k v t. (t -> Task Monad k v) -> Tasks Monad k t -> Tasks Monad (Key k) (Value v t)
selfTrackingM :: forall k v t.
(t -> Task Monad k v)
-> Tasks Monad k t -> Tasks Monad (Key k) (Value v t)
selfTrackingM t -> Task Monad k v
_          Tasks Monad k t
_     (KeyTask k
_) = Maybe (Task Monad (Key k) (Value v t))
forall a. Maybe a
Nothing -- Task keys are inputs
selfTrackingM t -> Task Monad k v
taskParser Tasks Monad k t
tasks (Key     k
k) = Task Monad k t -> Task Monad (Key k) (Value v t)
runTask (Task Monad k t -> Task Monad (Key k) (Value v t))
-> Maybe (Task Monad k t) -> Maybe (Task Monad (Key k) (Value v t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tasks Monad k t
tasks k
k
  where
    -- Fetch the task description, parse it, and then run the obtained task
    runTask :: Task Monad k t -> Task Monad (Key k) (Value v t)
    runTask :: Task Monad k t -> Task Monad (Key k) (Value v t)
runTask Task Monad k t
task Key k -> f (Value v t)
fetch = do
        t
task <- (k -> f t) -> f t
Task Monad k t
task ((Key k -> f (Value v t)) -> k -> f t
forall (f :: * -> *) k v t.
Functor f =>
(Key k -> f (Value v t)) -> k -> f t
fetchValueTask Key k -> f (Value v t)
fetch)
        v -> Value v t
forall v t. v -> Value v t
Value (v -> Value v t) -> f v -> f (Value v t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Task Monad k v
taskParser t
task ((Key k -> f (Value v t)) -> k -> f v
forall (f :: * -> *) k v t.
Functor f =>
(Key k -> f (Value v t)) -> k -> f v
fetchValue Key k -> f (Value v t)
fetch)

-- | The applicative model requires every key to be able to associate with its
-- environment (e.g. a reader somewhere). Does not support cutoff if a key changes.
selfTrackingA :: (t -> Task Applicative k v) -> (k -> t) -> Tasks Applicative (Key k) (Value v t)
selfTrackingA :: forall t k v.
(t -> Task Applicative k v)
-> (k -> t) -> Tasks Applicative (Key k) (Value v t)
selfTrackingA t -> Task Applicative k v
_      k -> t
_   (KeyTask k
_) = Maybe (Task Applicative (Key k) (Value v t))
forall a. Maybe a
Nothing -- Task keys are inputs
selfTrackingA t -> Task Applicative k v
parser k -> t
ask (Key k
k) = Task Applicative (Key k) (Value v t)
-> Maybe (Task Applicative (Key k) (Value v t))
forall a. a -> Maybe a
Just (Task Applicative (Key k) (Value v t)
 -> Maybe (Task Applicative (Key k) (Value v t)))
-> Task Applicative (Key k) (Value v t)
-> Maybe (Task Applicative (Key k) (Value v t))
forall a b. (a -> b) -> a -> b
$ \Key k -> f (Value v t)
fetch ->
    Key k -> f (Value v t)
fetch (k -> Key k
forall k. k -> Key k
KeyTask k
k) f (Value v t) -> f (Value v t) -> f (Value v t)
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (v -> Value v t
forall v t. v -> Value v t
Value (v -> Value v t) -> f v -> f (Value v t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t -> Task Applicative k v
parser (t -> Task Applicative k v) -> t -> Task Applicative k v
forall a b. (a -> b) -> a -> b
$ k -> t
ask k
k) ((Key k -> f (Value v t)) -> k -> f v
forall (f :: * -> *) k v t.
Functor f =>
(Key k -> f (Value v t)) -> k -> f v
fetchValue Key k -> f (Value v t)
fetch))