{-# LANGUAGE GADTs, ImpredicativeTypes, ConstraintKinds, ScopedTypeVariables #-}

module Build.SelfTracking.Typed (
    Fetch, TaskT (..), TasksT, Key (..), selfTracking
  ) where

import Build.Task

type Fetch k f = forall v. k v -> f v

newtype TaskT c k v = TaskT { forall (c :: (* -> *) -> Constraint) (k :: * -> *) v.
TaskT c k v -> forall (f :: * -> *). c f => Fetch k f -> f v
runT :: forall f. c f => Fetch k f -> f v }

type TasksT c k = forall v. k v -> Maybe (TaskT c k v)

-- | The type variable @s@ stands for "scripts" written in some task description
-- language.
data Key k v s a where
    Script :: k -> Key k v s s -- Keys for build scripts
    Value  :: k -> Key k v s v -- Keys for all other values

selfTracking :: forall k v s. (s -> Task Monad k v) -> Tasks Monad k s -> TasksT Monad (Key k v s)
selfTracking :: forall k v s.
(s -> Task Monad k v)
-> Tasks Monad k s -> TasksT Monad (Key k v s)
selfTracking s -> Task Monad k v
parse Tasks Monad k s
tasks Key k v s v
key = case Key k v s v
key of
    Script k
k -> Task Monad k s -> TaskT Monad (Key k v s) s
getScript (Task Monad k s -> TaskT Monad (Key k v s) s)
-> Maybe (Task Monad k s) -> Maybe (TaskT Monad (Key k v s) s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tasks Monad k s
tasks k
k
    Value  k
k -> Task Monad k s -> TaskT Monad (Key k v s) v
runScript (Task Monad k s -> TaskT Monad (Key k v s) v)
-> Maybe (Task Monad k s) -> Maybe (TaskT Monad (Key k v s) v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tasks Monad k s
tasks k
k
  where
    -- Get the task for building the script
    getScript :: Task Monad k s -> TaskT Monad (Key k v s) s
    getScript :: Task Monad k s -> TaskT Monad (Key k v s) s
getScript Task Monad k s
task = (forall (f :: * -> *). Monad f => Fetch (Key k v s) f -> f s)
-> TaskT Monad (Key k v s) s
forall (c :: (* -> *) -> Constraint) (k :: * -> *) v.
(forall (f :: * -> *). c f => Fetch k f -> f v) -> TaskT c k v
TaskT ((forall (f :: * -> *). Monad f => Fetch (Key k v s) f -> f s)
 -> TaskT Monad (Key k v s) s)
-> (forall (f :: * -> *). Monad f => Fetch (Key k v s) f -> f s)
-> TaskT Monad (Key k v s) s
forall a b. (a -> b) -> a -> b
$ \Fetch (Key k v s) f
fetch -> (k -> f s) -> f s
Task Monad k s
task (Key k v s s -> f s
Fetch (Key k v s) f
fetch (Key k v s s -> f s) -> (k -> Key k v s s) -> k -> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Key k v s s
forall k v s. k -> Key k v s s
Script)
    -- Build the script, parse it, and then run the obtained task
    runScript :: Task Monad k s -> TaskT Monad (Key k v s) v
    runScript :: Task Monad k s -> TaskT Monad (Key k v s) v
runScript Task Monad k s
task = (forall (f :: * -> *). Monad f => Fetch (Key k v s) f -> f v)
-> TaskT Monad (Key k v s) v
forall (c :: (* -> *) -> Constraint) (k :: * -> *) v.
(forall (f :: * -> *). c f => Fetch k f -> f v) -> TaskT c k v
TaskT ((forall (f :: * -> *). Monad f => Fetch (Key k v s) f -> f v)
 -> TaskT Monad (Key k v s) v)
-> (forall (f :: * -> *). Monad f => Fetch (Key k v s) f -> f v)
-> TaskT Monad (Key k v s) v
forall a b. (a -> b) -> a -> b
$ \Fetch (Key k v s) f
fetch -> do
        s
script <- (k -> f s) -> f s
Task Monad k s
task (Key k v s s -> f s
Fetch (Key k v s) f
fetch (Key k v s s -> f s) -> (k -> Key k v s s) -> k -> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Key k v s s
forall k v s. k -> Key k v s s
Script)
        s -> Task Monad k v
parse s
script (Key k v s v -> f v
Fetch (Key k v s) f
fetch (Key k v s v -> f v) -> (k -> Key k v s v) -> k -> f v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Key k v s v
forall k v s. k -> Key k v s v
Value)