{-# LANGUAGE ImpredicativeTypes, DeriveFunctor #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

-- | The free description of tasks.
module Build.Task.Free (
    Rule (..), toRule, fromRule, Action (..), toAction, fromAction
  ) where

import Build.Task
import Control.Monad

------------------------- Isomorphism with Make's Rule -------------------------
data Rule k v r = Rule [k] ([v] -> r)
    deriving (forall a b. (a -> b) -> Rule k v a -> Rule k v b)
-> (forall a b. a -> Rule k v b -> Rule k v a)
-> Functor (Rule k v)
forall a b. a -> Rule k v b -> Rule k v a
forall a b. (a -> b) -> Rule k v a -> Rule k v b
forall k v a b. a -> Rule k v b -> Rule k v a
forall k v a b. (a -> b) -> Rule k v a -> Rule k v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k v a b. (a -> b) -> Rule k v a -> Rule k v b
fmap :: forall a b. (a -> b) -> Rule k v a -> Rule k v b
$c<$ :: forall k v a b. a -> Rule k v b -> Rule k v a
<$ :: forall a b. a -> Rule k v b -> Rule k v a
Functor

instance Applicative (Rule k v) where
    pure :: forall a. a -> Rule k v a
pure a
v = [k] -> ([v] -> a) -> Rule k v a
forall k v r. [k] -> ([v] -> r) -> Rule k v r
Rule [] (\[] -> a
v)
    Rule [k]
d1 [v] -> a -> b
f1 <*> :: forall a b. Rule k v (a -> b) -> Rule k v a -> Rule k v b
<*> Rule [k]
d2 [v] -> a
f2 = [k] -> ([v] -> b) -> Rule k v b
forall k v r. [k] -> ([v] -> r) -> Rule k v r
Rule ([k]
d1[k] -> [k] -> [k]
forall a. [a] -> [a] -> [a]
++[k]
d2) (([v] -> b) -> Rule k v b) -> ([v] -> b) -> Rule k v b
forall a b. (a -> b) -> a -> b
$ \[v]
vs ->
        let ([v]
v1,[v]
v2) = Int -> [v] -> ([v], [v])
forall a. Int -> [a] -> ([a], [a])
splitAt ([k] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [k]
d1) [v]
vs in [v] -> a -> b
f1 [v]
v1 (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ [v] -> a
f2 [v]
v2

getRule :: k -> Rule k v v
getRule :: forall k v. k -> Rule k v v
getRule k
k = [k] -> ([v] -> v) -> Rule k v v
forall k v r. [k] -> ([v] -> r) -> Rule k v r
Rule [k
k] (([v] -> v) -> Rule k v v) -> ([v] -> v) -> Rule k v v
forall a b. (a -> b) -> a -> b
$ \[v
v] -> v
v

toRule :: Task Applicative k v -> Rule k v v
toRule :: forall k v. Task Applicative k v -> Rule k v v
toRule Task Applicative k v
task = (k -> Rule k v v) -> Rule k v v
Task Applicative k v
task k -> Rule k v v
forall k v. k -> Rule k v v
getRule

fromRule :: Rule k v v -> Task Applicative k v
fromRule :: forall k v. Rule k v v -> Task Applicative k v
fromRule (Rule [k]
ds [v] -> v
f) k -> f v
fetch = [v] -> v
f ([v] -> v) -> f [v] -> f v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (k -> f v) -> [k] -> f [v]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse k -> f v
fetch [k]
ds

------------------------ Isomorphism with Shake's Action -----------------------
data Action k v a = Finished a
                  | Depends k (v -> Action k v a)
    deriving (forall a b. (a -> b) -> Action k v a -> Action k v b)
-> (forall a b. a -> Action k v b -> Action k v a)
-> Functor (Action k v)
forall a b. a -> Action k v b -> Action k v a
forall a b. (a -> b) -> Action k v a -> Action k v b
forall k v a b. a -> Action k v b -> Action k v a
forall k v a b. (a -> b) -> Action k v a -> Action k v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k v a b. (a -> b) -> Action k v a -> Action k v b
fmap :: forall a b. (a -> b) -> Action k v a -> Action k v b
$c<$ :: forall k v a b. a -> Action k v b -> Action k v a
<$ :: forall a b. a -> Action k v b -> Action k v a
Functor

instance Applicative (Action k v) where
    pure :: forall a. a -> Action k v a
pure  = a -> Action k v a
forall k v a. a -> Action k v a
Finished
    <*> :: forall a b. Action k v (a -> b) -> Action k v a -> Action k v b
(<*>) = Action k v (a -> b) -> Action k v a -> Action k v b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (Action k v) where
    return :: forall a. a -> Action k v a
return = a -> Action k v a
forall a. a -> Action k v a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Finished a
x    >>= :: forall a b. Action k v a -> (a -> Action k v b) -> Action k v b
>>= a -> Action k v b
f = a -> Action k v b
f a
x
    Depends k
ds v -> Action k v a
op >>= a -> Action k v b
f = k -> (v -> Action k v b) -> Action k v b
forall k v a. k -> (v -> Action k v a) -> Action k v a
Depends k
ds (v -> Action k v a
op (v -> Action k v a) -> (a -> Action k v b) -> v -> Action k v b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Action k v b
f)

toAction :: Task Monad k v -> Action k v v
toAction :: forall k v. Task Monad k v -> Action k v v
toAction Task Monad k v
task = (k -> Action k v v) -> Action k v v
Task Monad k v
task ((k -> Action k v v) -> Action k v v)
-> (k -> Action k v v) -> Action k v v
forall a b. (a -> b) -> a -> b
$ \k
k -> k -> (v -> Action k v v) -> Action k v v
forall k v a. k -> (v -> Action k v a) -> Action k v a
Depends k
k v -> Action k v v
forall k v a. a -> Action k v a
Finished

fromAction :: Action k v v -> Task Monad k v
fromAction :: forall k v. Action k v v -> Task Monad k v
fromAction Action k v v
x k -> f v
fetch = (k -> f v) -> Action k v v -> f v
forall {m :: * -> *} {t} {v} {a}.
Monad m =>
(t -> m v) -> Action t v a -> m a
f k -> f v
fetch Action k v v
x
  where
    f :: (t -> m v) -> Action t v a -> m a
f t -> m v
_     (Finished a
v  ) = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
    f t -> m v
fetch (Depends t
d v -> Action t v a
op) = t -> m v
fetch t
d m v -> (v -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (t -> m v) -> Action t v a -> m a
f t -> m v
fetch (Action t v a -> m a) -> (v -> Action t v a) -> v -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Action t v a
op