{-# LANGUAGE ScopedTypeVariables #-}
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 fetch key = extract <$> fetch (Key key)
where
extract (Value v) = v
extract _ = error "Inconsistent fetch"
fetchValueTask :: Functor f => (Key k -> f (Value v t)) -> k -> f t
fetchValueTask fetch key = extract <$> fetch (KeyTask key)
where
extract (ValueTask t) = t
extract _ = error "Inconsistent fetch"
selfTrackingM :: forall k v t. (t -> Task Monad k v) -> Tasks Monad k t -> Tasks Monad (Key k) (Value v t)
selfTrackingM _ _ (KeyTask _) = Nothing
selfTrackingM parser tasks (Key k) = runTask <$> tasks k
where
runTask :: Task Monad k t -> Task Monad (Key k) (Value v t)
runTask act = Task $ \fetch -> do
task <- parser <$> run act (fetchValueTask fetch)
Value <$> run task (fetchValue fetch)
selfTrackingA :: (t -> Task Applicative k v) -> (k -> t) -> Tasks Applicative (Key k) (Value v t)
selfTrackingA _ _ (KeyTask _) = Nothing
selfTrackingA parser ask (Key k) = Just $ Task $ \fetch ->
fetch (KeyTask k) *> (Value <$> run (parser $ ask k) (fetchValue fetch))