{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
{- |
This is an approach with no pre-defined direction of type dependencies.
-}
module LLVM.DSL.Render.Run (
   T(Cons, decons),
   postmapPlain,
   premapDSL,
   Creator,
   run,
   (*->),
   ) where

import qualified LLVM.DSL.Render.Argument as Arg
import qualified LLVM.DSL.Expression as Expr
import LLVM.DSL.Render.Argument (Creator)
import LLVM.DSL.Expression (Exp)

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal

import Prelude2010
import Prelude ()



{-
Type order of 'f' and 'fdsl' is consistent with 'run',
but inconsistent with 'Arg.T'.
-}
newtype T m p fdsl f =
   Cons {decons :: (Exp p -> fdsl) -> m (Creator p -> f)}

{-
We could turn this into an 'Functor'/'fmap' instance,
however this is less descriptive and
would require to keep the current type parameter order.
-}
postmapPlain :: Functor m => (f -> g) -> T m p fdsl f -> T m p fdsl g
postmapPlain f build = Cons $ fmap (f .) . decons build

premapDSL :: (gdsl -> fdsl) -> T m p fdsl f -> T m p gdsl f
premapDSL f build = Cons $ decons build . fmap f


-- ToDo: duplicate of Argument
primitiveCreator :: a -> Creator a
primitiveCreator a = return (a, return ())

run :: (Functor m) => T m () fdsl f -> fdsl -> m f
run (Cons build) f = fmap ($ primitiveCreator ()) $ build $ const f


-- precedence like Applicative.<*>, but different associativity
infixr 4 *->

(*->) ::
   (Functor m) =>
   Arg.T a adsl ->
   (forall al. Marshal.C al => T m (p, al) fdsl f) ->
   T m p (adsl -> fdsl) (a -> f)
(*->) arg build = Cons $ \f ->
   case arg of
      Arg.Cons pass createA ->
         fmap
            (\g createP av ->
               g (do (p,finalP) <- createP
                     (pa,finalA) <- createA av
                     return ((p,pa), finalA >> finalP)))
            (decons build (Expr.uncurry $ \p -> f p . pass))