content: {-# 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 Functor
  
  instance Applicative (Rule k v) where
      pure v = Rule [] (\[] -> v)
      Rule d1 f1 <*> Rule d2 f2 = Rule (d1++d2) $ \vs ->
          let (v1,v2) = splitAt (length d1) vs in f1 v1 $ f2 v2
  
  getRule :: k -> Rule k v v
  getRule k = Rule [k] $ \[v] -> v
  
  toRule :: Task Applicative k v -> Rule k v v
  toRule task = task getRule
  
  fromRule :: Rule k v v -> Task Applicative k v
  fromRule (Rule ds f) fetch = f <$> traverse fetch ds
  
  ------------------------ Isomorphism with Shake's Action -----------------------
  data Action k v a = Finished a
                    | Depends k (v -> Action k v a)
      deriving Functor
  
  instance Applicative (Action k v) where
      pure  = Finished
      (<*>) = ap
  
  instance Monad (Action k v) where
      return = pure
      Finished x    >>= f = f x
      Depends ds op >>= f = Depends ds (op >=> f)
  
  toAction :: Task Monad k v -> Action k v v
  toAction task = task $ \k -> Depends k Finished
  
  fromAction :: Action k v v -> Task Monad k v
  fromAction x fetch = f fetch x
    where
      f _     (Finished v  ) = return v
      f fetch (Depends d op) = fetch d >>= f fetch . op
  