{-# LANGUAGE CPP             #-}
{-# LANGUAGE TemplateHaskell #-}

module Data.Mutable.Internal.TH (
    mutableTuples
  , listRefTuples
  ) where

import           Control.Monad
import           Data.Generics.Product.Internal.HList
import           Data.List
import           Data.Mutable.Internal
import           Language.Haskell.TH

tyVarNames :: [String]
tyVarNames :: [String]
tyVarNames = (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
's') [Char
'a' .. Char
'z']

mutableTuples :: [Int] -> Q [Dec]
mutableTuples :: [Int] -> Q [Dec]
mutableTuples = (Int -> Q Dec) -> [Int] -> Q [Dec]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Int -> Q Dec
mutableTuple

listRefTuples :: [Int] -> Q [Dec]
listRefTuples :: [Int] -> Q [Dec]
listRefTuples = (Int -> Q Dec) -> [Int] -> Q [Dec]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Int -> Q Dec
listRefTuple


mutableTuple
    :: Int
    -> Q Dec
mutableTuple :: Int -> Q Dec
mutableTuple Int
n = do
    [Name]
valVars <- Int -> Q Name -> Q [Name]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (String -> Q Name
newName String
"x")
    [Name]
refVars <- Int -> Q Name -> Q [Name]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (String -> Q Name
newName String
"r")
    -- instance (Mutable s a, Mutable s b, Mutable s c) => Mutable s (a, b, c) where
    Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
InstanceD
      Maybe Overlap
forall a. Maybe a
Nothing
      (Type -> Type
mutableS (Type -> Type) -> (Name -> Type) -> Name -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type
VarT (Name -> Type) -> [Name] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
tyVars)
      (Type -> Type
mutableS Type
instHead)
      [ Dec
refImpl
      , [Name] -> Dec
thawImpl [Name]
valVars
      , [Name] -> Dec
freezeImpl [Name]
refVars
      , [Name] -> [Name] -> Dec
copyImpl [Name]
refVars [Name]
valVars
      , [Name] -> [Name] -> Dec
moveImpl [Name]
refVars [Name]
valVars
      , [Name] -> Dec
cloneImpl [Name]
refVars
      , [Name] -> Dec
unsafeThawImpl [Name]
valVars
      , [Name] -> Dec
unsafeFreezeImpl [Name]
refVars
      ]
  where
    tuplerT :: [Type] -> Type
    tuplerT :: Cxt -> Type
tuplerT = Type -> Cxt -> Type
applyAllT (Int -> Type
TupleT Int
n)
    tupConE :: Exp
    tupConE :: Exp
tupConE = Name -> Exp
ConE (Int -> Name
tupleDataName Int
n)

    mutableS :: Type -> Type
    mutableS :: Type -> Type
mutableS = ((Name -> Type
ConT ''Mutable Type -> Type -> Type
`AppT` Name -> Type
VarT (String -> Name
mkName String
"s")) Type -> Type -> Type
`AppT`)
    refS :: Type -> Type
    refS :: Type -> Type
refS = ((Name -> Type
ConT ''Ref Type -> Type -> Type
`AppT` Name -> Type
VarT (String -> Name
mkName String
"s")) Type -> Type -> Type
`AppT`)
    tyVars :: [Name]
    tyVars :: [Name]
tyVars = String -> Name
mkName (String -> Name) -> [String] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
n [String]
tyVarNames
    instHead :: Type
    instHead :: Type
instHead = Cxt -> Type
tuplerT (Cxt -> Type) -> Cxt -> Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
VarT (Name -> Type) -> [Name] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
tyVars
    -- type Ref s (a, b, c) = (Ref s a, Ref s b, Ref s c)
    refImpl :: Dec
#if MIN_VERSION_template_haskell(2,15,0)
    refImpl :: Dec
refImpl = TySynEqn -> Dec
TySynInstD
            (TySynEqn -> Dec) -> (Type -> TySynEqn) -> Type -> Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [TyVarBndr] -> Type -> Type -> TySynEqn
TySynEqn Maybe [TyVarBndr]
forall a. Maybe a
Nothing (Type -> Type
refS Type
instHead)
#else
    refImpl = TySynInstD ''Ref
            . TySynEqn [VarT (mkName "s"), instHead]
#endif
            (Type -> Dec) -> Type -> Dec
forall a b. (a -> b) -> a -> b
$ Cxt -> Type
tuplerT (Type -> Type
refS (Type -> Type) -> (Name -> Type) -> Name -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type
VarT (Name -> Type) -> [Name] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
tyVars)
    thawImpl :: [Name] -> Dec
    thawImpl :: [Name] -> Dec
thawImpl [Name]
valVars = Name -> [Clause] -> Dec
FunD 'thawRef [
        [Pat] -> Body -> [Dec] -> Clause
Clause [[Pat] -> Pat
TupP (Pat -> Pat
BangP (Pat -> Pat) -> (Name -> Pat) -> Name -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Pat
VarP (Name -> Pat) -> [Name] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
valVars)]
               (Exp -> Body
NormalB (Exp -> Body) -> ([Exp] -> Exp) -> [Exp] -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> [Exp] -> Exp
liftApplyAllE Exp
tupConE ([Exp] -> Body) -> [Exp] -> Body
forall a b. (a -> b) -> a -> b
$
                  (Name -> Exp
VarE 'thawRef Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> (Name -> Exp) -> Name -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Exp
VarE (Name -> Exp) -> [Name] -> [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
valVars
               )
               []
      ]
    -- freezeRef (u , v , w ) = (,,) <$> freezeRef u <*> freezeRef v <*> freezeRef w
    freezeImpl :: [Name] -> Dec
    freezeImpl :: [Name] -> Dec
freezeImpl [Name]
refVars = Name -> [Clause] -> Dec
FunD 'freezeRef [
        [Pat] -> Body -> [Dec] -> Clause
Clause [[Pat] -> Pat
TupP (Name -> Pat
VarP (Name -> Pat) -> [Name] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
refVars)]
               (Exp -> Body
NormalB (Exp -> Body) -> ([Exp] -> Exp) -> [Exp] -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> [Exp] -> Exp
liftApplyAllE Exp
tupConE ([Exp] -> Body) -> [Exp] -> Body
forall a b. (a -> b) -> a -> b
$
                  (Name -> Exp
VarE 'freezeRef Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> (Name -> Exp) -> Name -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Exp
VarE (Name -> Exp) -> [Name] -> [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
refVars
               )
               []
      ]
    -- copyRef   (u , v , w ) (!x, !y, !z) = copyRef u x *> copyRef v y *> copyRef w z
    copyImpl :: [Name] -> [Name] -> Dec
    copyImpl :: [Name] -> [Name] -> Dec
copyImpl [Name]
refVars [Name]
valVars = Name -> [Clause] -> Dec
FunD 'copyRef [
        [Pat] -> Body -> [Dec] -> Clause
Clause [ [Pat] -> Pat
TupP (Pat -> Pat
BangP (Pat -> Pat) -> (Name -> Pat) -> Name -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Pat
VarP (Name -> Pat) -> [Name] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
refVars)
               , [Pat] -> Pat
TupP (Pat -> Pat
BangP (Pat -> Pat) -> (Name -> Pat) -> Name -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Pat
VarP (Name -> Pat) -> [Name] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
valVars)
               ]
               (Exp -> Body
NormalB (Exp -> Body) -> ([Exp] -> Exp) -> [Exp] -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp] -> Exp
sequenceAllE ([Exp] -> Body) -> [Exp] -> Body
forall a b. (a -> b) -> a -> b
$
                  (Name -> Name -> Exp) -> [Name] -> [Name] -> [Exp]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Name
r Name
v -> (Name -> Exp
VarE 'copyRef Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
r) Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
v) [Name]
refVars [Name]
valVars
               )
               []
      ]
    -- moveRef   (u , v , w ) ( x,  y,  z) = moveRef u x *> moveRef v y *> moveRef w z
    moveImpl :: [Name] -> [Name] -> Dec
    moveImpl :: [Name] -> [Name] -> Dec
moveImpl [Name]
refVars [Name]
valVars = Name -> [Clause] -> Dec
FunD 'moveRef [
        [Pat] -> Body -> [Dec] -> Clause
Clause [ [Pat] -> Pat
TupP (Pat -> Pat
BangP (Pat -> Pat) -> (Name -> Pat) -> Name -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Pat
VarP (Name -> Pat) -> [Name] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
refVars)
               , [Pat] -> Pat
TupP (Pat -> Pat
BangP (Pat -> Pat) -> (Name -> Pat) -> Name -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Pat
VarP (Name -> Pat) -> [Name] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
valVars)
               ]
               (Exp -> Body
NormalB (Exp -> Body) -> ([Exp] -> Exp) -> [Exp] -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp] -> Exp
sequenceAllE ([Exp] -> Body) -> [Exp] -> Body
forall a b. (a -> b) -> a -> b
$
                  (Name -> Name -> Exp) -> [Name] -> [Name] -> [Exp]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Name
r Name
v -> (Name -> Exp
VarE 'moveRef Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
r) Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
v) [Name]
refVars [Name]
valVars
               )
               []
      ]
    -- cloneRef  (u , v , w ) = (,,) <$> cloneRef u   <*> cloneRef v   <*> cloneRef w
    cloneImpl :: [Name] -> Dec
    cloneImpl :: [Name] -> Dec
cloneImpl [Name]
refVars = Name -> [Clause] -> Dec
FunD 'cloneRef [
        [Pat] -> Body -> [Dec] -> Clause
Clause [[Pat] -> Pat
TupP (Name -> Pat
VarP (Name -> Pat) -> [Name] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
refVars)]
               (Exp -> Body
NormalB (Exp -> Body) -> ([Exp] -> Exp) -> [Exp] -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> [Exp] -> Exp
liftApplyAllE Exp
tupConE ([Exp] -> Body) -> [Exp] -> Body
forall a b. (a -> b) -> a -> b
$
                  (Name -> Exp
VarE 'cloneRef Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> (Name -> Exp) -> Name -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Exp
VarE (Name -> Exp) -> [Name] -> [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
refVars
               )
               []
      ]
    -- unsafeThawRef   (!x, !y, !z) = (,,) <$> unsafeThawRef x   <*> unsafeThawRef y   <*> unsafeThawRef z
    unsafeThawImpl :: [Name] -> Dec
    unsafeThawImpl :: [Name] -> Dec
unsafeThawImpl [Name]
valVars = Name -> [Clause] -> Dec
FunD 'unsafeThawRef [
        [Pat] -> Body -> [Dec] -> Clause
Clause [[Pat] -> Pat
TupP (Pat -> Pat
BangP (Pat -> Pat) -> (Name -> Pat) -> Name -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Pat
VarP (Name -> Pat) -> [Name] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
valVars)]
               (Exp -> Body
NormalB (Exp -> Body) -> ([Exp] -> Exp) -> [Exp] -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> [Exp] -> Exp
liftApplyAllE Exp
tupConE ([Exp] -> Body) -> [Exp] -> Body
forall a b. (a -> b) -> a -> b
$
                  (Name -> Exp
VarE 'unsafeThawRef Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> (Name -> Exp) -> Name -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Exp
VarE (Name -> Exp) -> [Name] -> [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
valVars
               )
               []
      ]
    -- unsafeFreezeRef (u , v , w ) = (,,) <$> unsafeFreezeRef u <*> unsafeFreezeRef v <*> unsafeFreezeRef w
    unsafeFreezeImpl :: [Name] -> Dec
    unsafeFreezeImpl :: [Name] -> Dec
unsafeFreezeImpl [Name]
refVars = Name -> [Clause] -> Dec
FunD 'unsafeFreezeRef [
        [Pat] -> Body -> [Dec] -> Clause
Clause [[Pat] -> Pat
TupP (Name -> Pat
VarP (Name -> Pat) -> [Name] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
refVars)]
               (Exp -> Body
NormalB (Exp -> Body) -> ([Exp] -> Exp) -> [Exp] -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> [Exp] -> Exp
liftApplyAllE Exp
tupConE ([Exp] -> Body) -> [Exp] -> Body
forall a b. (a -> b) -> a -> b
$
                  (Name -> Exp
VarE 'unsafeFreezeRef Exp -> Exp -> Exp
`AppE`) (Exp -> Exp) -> (Name -> Exp) -> Name -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Exp
VarE (Name -> Exp) -> [Name] -> [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
refVars
               )
               []
      ]

listRefTuple
    :: Int
    -> Q Dec
listRefTuple :: Int -> Q Dec
listRefTuple Int
n = do
    [Name]
valVars <- Int -> Q Name -> Q [Name]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (String -> Q Name
newName String
"x")
    -- instance (Ref s a ~ ra, Ref s b ~ rb) => ListRefTuple s (ra, rb) '[a, b] where
    Dec -> Q Dec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
InstanceD
      Maybe Overlap
forall a. Maybe a
Nothing
      ((Name -> Name -> Type) -> [Name] -> [Name] -> Cxt
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Name -> Name -> Type
refConstr [Name]
refVars [Name]
tyVars)
      (Type -> Type
listRefTupleS (Cxt -> Type
tuplerT (Name -> Type
VarT (Name -> Type) -> [Name] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
refVars)) Type -> Type -> Type
`AppT`
          (Cxt -> Type
liftedList (Name -> Type
VarT (Name -> Type) -> [Name] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
tyVars))
      )
      [ [Name] -> Dec
tupToListImpl [Name]
valVars
      , [Name] -> Dec
listToTupImpl [Name]
valVars
      ]
  where
    tuplerT :: [Type] -> Type
    tuplerT :: Cxt -> Type
tuplerT = Type -> Cxt -> Type
applyAllT (Int -> Type
TupleT Int
n)
    tupConE :: Exp
    tupConE :: Exp
tupConE = Name -> Exp
ConE (Int -> Name
tupleDataName Int
n)

    listRefTupleS :: Type -> Type
    listRefTupleS :: Type -> Type
listRefTupleS = ((Name -> Type
ConT ''ListRefTuple Type -> Type -> Type
`AppT` Name -> Type
VarT (String -> Name
mkName String
"s")) Type -> Type -> Type
`AppT`)
    refS :: Type -> Type
    refS :: Type -> Type
refS = ((Name -> Type
ConT ''Ref Type -> Type -> Type
`AppT` Name -> Type
VarT (String -> Name
mkName String
"s")) Type -> Type -> Type
`AppT`)
    tyVarsStr :: [String]
    tyVarsStr :: [String]
tyVarsStr = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
n [String]
tyVarNames
    tyVars :: [Name]
    tyVars :: [Name]
tyVars = String -> Name
mkName (String -> Name) -> [String] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
tyVarsStr
    refVars :: [Name]
    refVars :: [Name]
refVars = String -> Name
mkName (String -> Name) -> (String -> String) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"r" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> Name) -> [String] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
tyVarsStr

    refConstr :: Name -> Name -> Pred
    refConstr :: Name -> Name -> Type
refConstr Name
r Name
v = (Type
EqualityT Type -> Type -> Type
`AppT` Type -> Type
refS (Name -> Type
VarT Name
v))
             Type -> Type -> Type
`AppT` Name -> Type
VarT Name
r

    -- tupleToListRef (x, y) = x :> y :> Nil
    tupToListImpl :: [Name] -> Dec
    tupToListImpl :: [Name] -> Dec
tupToListImpl [Name]
valVars = Name -> [Clause] -> Dec
FunD 'tupleToListRef [
        [Pat] -> Body -> [Dec] -> Clause
Clause [[Pat] -> Pat
TupP (Name -> Pat
VarP (Name -> Pat) -> [Name] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
valVars)]
               ( Exp -> Body
NormalB
                      (Exp -> Body) -> ([Name] -> Exp) -> [Name] -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Exp -> Exp) -> Exp -> [Name] -> Exp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Name
x Exp
y -> (Name -> Exp
ConE '(:>) Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
x) Exp -> Exp -> Exp
`AppE` Exp
y) (Name -> Exp
ConE 'Nil)
                      ([Name] -> Body) -> [Name] -> Body
forall a b. (a -> b) -> a -> b
$ [Name]
valVars
               )
               []
      ]
    -- listRefToTuple (x :> y :> _) = (x, y)
    listToTupImpl :: [Name] -> Dec
    listToTupImpl :: [Name] -> Dec
listToTupImpl [Name]
valVars = Name -> [Clause] -> Dec
FunD 'listRefToTuple [
        [Pat] -> Body -> [Dec] -> Clause
Clause [ (Name -> Pat -> Pat) -> Pat -> [Name] -> Pat
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Name
x Pat
y -> Name -> [Pat] -> Pat
ConP '(:>) [Name -> Pat
VarP Name
x, Pat
y]) (Name -> [Pat] -> Pat
ConP 'Nil []) [Name]
valVars
               ]
               ( Exp -> Body
NormalB (Exp -> Body) -> ([Exp] -> Exp) -> [Exp] -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> [Exp] -> Exp
applyAllE Exp
tupConE ([Exp] -> Body) -> [Exp] -> Body
forall a b. (a -> b) -> a -> b
$
                    Name -> Exp
VarE (Name -> Exp) -> [Name] -> [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
valVars
               )
               []
      ]


applyAllT
    :: Type
    -> [Type]
    -> Type
applyAllT :: Type -> Cxt -> Type
applyAllT = (Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Type
t Type
m -> Type
t Type -> Type -> Type
`AppT` Type
m)

-- | liftApplyAllE f [x,y,z] = f <$> x <*> y <*> z
liftApplyAllE
    :: Exp
    -> [Exp]
    -> Exp
liftApplyAllE :: Exp -> [Exp] -> Exp
liftApplyAllE = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Exp
t Exp
m -> (Name -> Exp
VarE '(<*>) Exp -> Exp -> Exp
`AppE` Exp
t) Exp -> Exp -> Exp
`AppE` Exp
m)
              (Exp -> [Exp] -> Exp) -> (Exp -> Exp) -> Exp -> [Exp] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Exp
VarE 'pure Exp -> Exp -> Exp
`AppE`)

-- | applyAllE f [x,y,z] = f x y z
applyAllE
    :: Exp
    -> [Exp]
    -> Exp
applyAllE :: Exp -> [Exp] -> Exp
applyAllE = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Exp
t Exp
m -> Exp
t Exp -> Exp -> Exp
`AppE` Exp
m)

-- | sequenceAllE [x,y,z] = x *> y *> z
sequenceAllE
    :: [Exp]
    -> Exp
sequenceAllE :: [Exp] -> Exp
sequenceAllE = (Exp -> Exp -> Exp) -> [Exp] -> Exp
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Exp
x Exp
y -> (Name -> Exp
VarE '(*>) Exp -> Exp -> Exp
`AppE` Exp
x) Exp -> Exp -> Exp
`AppE` Exp
y)

liftedList
    :: [Type]
    -> Type
liftedList :: Cxt -> Type
liftedList = (Type -> Type -> Type) -> Type -> Cxt -> Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Type
x Type
y -> (Type
PromotedConsT Type -> Type -> Type
`AppT` Type
x) Type -> Type -> Type
`AppT` Type
y) Type
PromotedNilT