{-# LANGUAGE ScopedTypeVariables, ImpredicativeTypes #-}
module Build.SelfTracking (
Key (..), Value (..), selfTrackingM, selfTrackingA
) where
import Build.Task
data Key k = Key k | KeyTask k
data Value v t = Value v | ValueTask t
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"
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"
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
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
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)
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
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))