{-# LANGUAGE CPP, Safe, TemplateHaskellQuotes #-}

{-|
Module      : Data.Tuple.Append.TemplateHaskell
Description : A module that defines template Haskell expressions to define typeclass instances to prepend and append tuples.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

A module hat defines template Haskell expressions to define typeclass instances to prepend and append tuples.
-}

module Data.Tuple.Append.TemplateHaskell (
    -- * Quasiquoters for typeclass instances
    defineTupleAddUpto, defineTupleAppendUpto
    -- * Quasiquoters for unboxed tuples
  , defineUnboxedTupleAppendFunctionsUpto
    -- * Functions to construct typeclass instance declarations
  , tupleAddL, tupleAddR, tupleAdd, tupleAppend, tupleAppendFor
    -- * Function declarations
  , boxedTupleAddLFun, boxedTupleAddRFun, boxedTupleAppendFun
  , unboxedTupleAddLFun, unboxedTupleAddRFun, unboxedTupleAppendFun
    -- * Function builders (for template Haskell)
  , makeBoxedTupleAddLFun, makeBoxedTupleAddRFun, makeBoxedTupleAppendFun
  , makeUnboxedTupleAddLFun, makeUnboxedTupleAddRFun, makeUnboxedTupleAppendFun
    -- * Create a function clause
    -- ** Boxed tuples
  , boxedAddLClause, boxedAddRClause, boxedAppendClause
    -- ** Unboxed tuples
  , unboxedAddLClause, unboxedAddRClause, unboxedAppendClause
  ) where

import Control.Monad((<=<))

import Data.Char(chr, ord)
import Data.Tuple.Append.Class(TupleAddL((<++)), TupleAddR((++>)), TupleAppend((+++)))

import Language.Haskell.TH.Lib(DecsQ)
import Language.Haskell.TH.Quote(QuasiQuoter(QuasiQuoter))
import Language.Haskell.TH.Syntax(
    Body(NormalB), Clause(Clause), Dec(FunD, InstanceD, SigD), Exp(TupE, UnboxedTupE, VarE), Name, Pat(TildeP, TupP, UnboxedTupP, VarP), Q, Type(AppT, ArrowT, ConT, TupleT, UnboxedTupleT, VarT)
  , mkName
  )

_nameZZ :: Name
_nameZZ :: Name
_nameZZ = String -> Name
mkName String
"x"

_varZZ :: Type
_varZZ :: Type
_varZZ = Name -> Type
VarT Name
_nameZZ

_patZZ :: Pat
_patZZ :: Pat
_patZZ = Name -> Pat
VarP Name
_nameZZ

_varNames :: Char -> [Name]
_varNames :: Char -> [Name]
_varNames Char
c = (Int -> Name) -> [Int] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Name
mkName (String -> Name) -> (Int -> String) -> Int -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Char -> Int) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
8272 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int
1 :: Int ..]

_uNames :: [Name]
_uNames :: [Name]
_uNames = Char -> [Name]
_varNames Char
'u'

_vNames :: [Name]
_vNames :: [Name]
_vNames = Char -> [Name]
_varNames Char
'v'

_tupleVar' :: Int -> [Name] -> Type
_tupleVar' :: Int -> [Name] -> Type
_tupleVar' Int
n [Name]
ns = (Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Int -> Type
TupleT Int
n) ((Name -> Type) -> [Name] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
n [Name]
ns))

_utupleVar' :: Int -> [Name] -> Type
_utupleVar' :: Int -> [Name] -> Type
_utupleVar' Int
n [Name]
ns = (Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Int -> Type
UnboxedTupleT Int
n) ((Name -> Type) -> [Name] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
n [Name]
ns))

_tupleP'' :: ([Pat] -> Pat) -> [Name] -> Pat
_tupleP'' :: ([Pat] -> Pat) -> [Name] -> Pat
_tupleP'' = (([Pat] -> Pat) -> ([Name] -> [Pat]) -> [Name] -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Pat) -> [Name] -> [Pat]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Pat
VarP)

_tupleP' :: [Name] -> Pat
_tupleP' :: [Name] -> Pat
_tupleP' = ([Pat] -> Pat) -> [Name] -> Pat
_tupleP'' (Pat -> Pat
TildeP (Pat -> Pat) -> ([Pat] -> Pat) -> [Pat] -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pat] -> Pat
TupP)

_utupleP' :: [Name] -> Pat
_utupleP' :: [Name] -> Pat
_utupleP' = ([Pat] -> Pat) -> [Name] -> Pat
_tupleP'' [Pat] -> Pat
UnboxedTupP

_tupleRange :: Int -> [Int]
#if MIN_VERSION_ghc_prim(0,7,0)
_tupleRange = enumFromTo 0  -- 0 .. n
#else
_tupleRange :: Int -> [Int]
_tupleRange = (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int]) -> (Int -> [Int]) -> Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [Int]
forall a. Enum a => a -> a -> [a]
enumFromTo Int
2  -- 0 and 2 .. n
#endif

_tupleCheck :: Int -> Bool
#if MIN_VERSION_ghc_prim(0,7,0)
_tupleCheck = (0 <=)
#else
_tupleCheck :: Int -> Bool
_tupleCheck Int
0 = Bool
True
_tupleCheck Int
n = Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
#endif

#if MIN_VERSION_template_haskell(2,16,0)
_tupleB' :: ([Maybe Exp] -> Exp) -> [Name] -> Body
_tupleB' :: ([Maybe Exp] -> Exp) -> [Name] -> Body
_tupleB' [Maybe Exp] -> Exp
f = Exp -> Body
NormalB (Exp -> Body) -> ([Name] -> Exp) -> [Name] -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Exp] -> Exp
f ([Maybe Exp] -> Exp) -> ([Name] -> [Maybe Exp]) -> [Name] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Maybe Exp) -> [Name] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> (Name -> Exp) -> Name -> Maybe Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Exp
VarE)
#else
_tupleB' :: ([Exp] -> Exp) -> [Name] -> Body
_tupleB' f = NormalB . f . map VarE
#endif

_clause :: [Pat] -> Body -> Name -> Dec
_clause :: [Pat] -> Body -> Name -> Dec
_clause [Pat]
ps Body
b = (Name -> [Clause] -> Dec
`FunD` [[Pat] -> Body -> [Dec] -> Clause
Clause [Pat]
ps Body
b []])

#if MIN_VERSION_template_haskell(2,16,0)
_appendClause :: ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Int -> Name -> Dec
#else
_appendClause :: ([Pat] -> Pat) -> ([Exp] -> Exp) -> Int -> Int -> Name -> Dec
#endif
_appendClause :: ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Int -> Name -> Dec
_appendClause [Pat] -> Pat
fp [Maybe Exp] -> Exp
fe Int
m Int
n = [Pat] -> Body -> Name -> Dec
_clause [ ([Pat] -> Pat) -> [Name] -> Pat
_tupleP'' [Pat] -> Pat
fp [Name]
um, ([Pat] -> Pat) -> [Name] -> Pat
_tupleP'' [Pat] -> Pat
fp [Name]
vn] (([Maybe Exp] -> Exp) -> [Name] -> Body
_tupleB' [Maybe Exp] -> Exp
fe ([Name]
um [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
vn))
  where um :: [Name]
um = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
m [Name]
_uNames
        vn :: [Name]
vn = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
n [Name]
_vNames

#if MIN_VERSION_template_haskell(2,16,0)
_addLClause :: ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Name -> Dec
#else
_addLClause :: ([Pat] -> Pat) -> ([Exp] -> Exp) -> Int -> Name -> Dec
#endif
_addLClause :: ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Name -> Dec
_addLClause [Pat] -> Pat
fp [Maybe Exp] -> Exp
fe Int
n = [Pat] -> Body -> Name -> Dec
_clause [ Pat
_patZZ, ([Pat] -> Pat) -> [Name] -> Pat
_tupleP'' [Pat] -> Pat
fp [Name]
vars] (([Maybe Exp] -> Exp) -> [Name] -> Body
_tupleB' [Maybe Exp] -> Exp
fe (Name
_nameZZ Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
vars))
  where vars :: [Name]
vars = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
n [Name]
_vNames

#if MIN_VERSION_template_haskell(2,16,0)
_addRClause :: ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Name -> Dec
#else
_addRClause :: ([Pat] -> Pat) -> ([Exp] -> Exp) -> Int -> Name -> Dec
#endif
_addRClause :: ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Name -> Dec
_addRClause [Pat] -> Pat
fp [Maybe Exp] -> Exp
fe Int
n = [Pat] -> Body -> Name -> Dec
_clause [([Pat] -> Pat) -> [Name] -> Pat
_tupleP'' [Pat] -> Pat
fp [Name]
vars, Pat
_patZZ] (([Maybe Exp] -> Exp) -> [Name] -> Body
_tupleB' [Maybe Exp] -> Exp
fe ([Name]
vars [Name] -> Name -> [Name]
forall 𝐯 x 𝐯x. TupleAddR 𝐯 x 𝐯x => 𝐯 -> x -> 𝐯x
++> Name
_nameZZ))
  where vars :: [Name]
vars = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
n [Name]
_vNames

-- | Create a function declaration to append two boxed tuples together in a new boxed tuple. This only contains a declaration for the /body/ of the function, not a type signature.
boxedAppendClause
  :: Int  -- ^ The number of items for the first boxed tuple parameter.
  -> Int  -- ^ The number of items for the second boxed tuple parameter.
  -> Name  -- ^ The name of the function to define.
  -> Dec  -- ^ A function declaration that only contains the body of the function.
boxedAppendClause :: Int -> Int -> Name -> Dec
boxedAppendClause = ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Int -> Name -> Dec
_appendClause [Pat] -> Pat
TupP [Maybe Exp] -> Exp
TupE

-- | Create a function declaration to append two unboxed tuples together in a new unboxed tuple. This only contains a declaration for the /body/ of the function, not a type signature.
unboxedAppendClause
  :: Int  -- ^ The number of items for the first unboxed tuple parameter.
  -> Int  -- ^ The number of items for the second unboxed tuple parameter.
  -> Name  -- ^ The name of the function to define.
  -> Dec  -- ^ A function declaration that only contains the body of the function.
unboxedAppendClause :: Int -> Int -> Name -> Dec
unboxedAppendClause = ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Int -> Name -> Dec
_appendClause [Pat] -> Pat
UnboxedTupP [Maybe Exp] -> Exp
UnboxedTupE

-- | Create a function declaration to add an item to the left side of a boxed tuple in a new boxed tuple. This only contains a declaration for the /body/ of the function, not a type signature.
boxedAddLClause
  :: Int  -- The number of items of the boxed tuple to add an item to.
  -> Name  -- ^ The name of the function to define.
  -> Dec  -- ^ A function declaration that only contains the body of the function.
boxedAddLClause :: Int -> Name -> Dec
boxedAddLClause = ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Name -> Dec
_addLClause [Pat] -> Pat
TupP [Maybe Exp] -> Exp
TupE

-- | Create a function declaration to add an item to the left side of an unboxed tuple in a new unboxed tuple. This only contains a declaration for the /body/ of the function, not a type signature.
unboxedAddLClause
  :: Int  -- The number of items of the unboxed tuple to add an item to.
  -> Name  -- ^ The name of the function to define.
  -> Dec  -- ^ A function declaration that only contains the body of the function.
unboxedAddLClause :: Int -> Name -> Dec
unboxedAddLClause = ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Name -> Dec
_addLClause [Pat] -> Pat
UnboxedTupP [Maybe Exp] -> Exp
UnboxedTupE

-- | Create a function declaration to add an item to the right side of a boxed tuple in a new boxed tuple. This only contains a declaration for the /body/ of the function, not a type signature.
boxedAddRClause
  :: Int  -- The number of items of the boxed tuple to add an item to.
  -> Name  -- ^ The name of the function to define.
  -> Dec  -- ^ A function declaration that only contains the body of the function.
boxedAddRClause :: Int -> Name -> Dec
boxedAddRClause = ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Name -> Dec
_addRClause [Pat] -> Pat
TupP [Maybe Exp] -> Exp
TupE

-- | Create a function declaration to add an item to the right side of an unboxed tuple in a new unboxed tuple. This only contains a declaration for the /body/ of the function, not a type signature.
unboxedAddRClause
  :: Int  -- The number of items of the unboxed tuple to add an item to.
  -> Name  -- ^ The name of the function to define.
  -> Dec  -- ^ A function declaration that only contains the body of the function.
unboxedAddRClause :: Int -> Name -> Dec
unboxedAddRClause = ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Name -> Dec
_addRClause [Pat] -> Pat
UnboxedTupP [Maybe Exp] -> Exp
UnboxedTupE

_tupleB :: [Name] -> Body
_tupleB :: [Name] -> Body
_tupleB = ([Maybe Exp] -> Exp) -> [Name] -> Body
_tupleB' [Maybe Exp] -> Exp
TupE

_utupleB :: [Name] -> Body
_utupleB :: [Name] -> Body
_utupleB = ([Maybe Exp] -> Exp) -> [Name] -> Body
_tupleB' [Maybe Exp] -> Exp
UnboxedTupE

_arr :: Type -> Type -> Type
_arr :: Type -> Type -> Type
_arr Type
l Type
r = Type
ArrowT Type -> Type -> Type
`AppT` Type
l Type -> Type -> Type
`AppT` Type
r

_tupType :: [Type] -> Type
_tupType :: [Type] -> Type
_tupType [Type]
ns = (Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Int -> Type
TupleT ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ns)) [Type]
ns

_utupType :: [Type] -> Type
_utupType :: [Type] -> Type
_utupType [Type]
ns = (Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Int -> Type
UnboxedTupleT ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ns)) [Type]
ns

_signature :: Name -> Type -> Type -> Type -> Dec
_signature :: Name -> Type -> Type -> Type -> Dec
_signature Name
nm Type
ta Type
tb Type
tc = Name -> Type -> Dec
SigD Name
nm (Type
ta Type -> Type -> Type
`_arr` (Type
tb Type -> Type -> Type
`_arr` Type
tc))

-- | Create a function declaration with signature to append a boxed tuple with the types of the first list with a boxed tuple with the types of the second list. This will contain two 'Dec' items: one for the signature and one for the function declaration itself.
boxedTupleAppendFun
  :: Name  -- ^ The name of the function to construct.
  -> [Type]  -- ^ The types of the first boxed tuple, should contain at least two elements.
  -> [Type]  -- ^ The types of the second boxed tuple, should contain at least two elements.
  -> [Dec]  -- ^ A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
boxedTupleAppendFun :: Name -> [Type] -> [Type] -> [Dec]
boxedTupleAppendFun Name
nm [Type]
l [Type]
r = [
    Name -> Type -> Type -> Type -> Dec
_signature Name
nm ([Type] -> Type
_tupType [Type]
l) ([Type] -> Type
_tupType [Type]
r) ([Type] -> Type
_tupType ([Type]
l [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Type]
r))
  , Int -> Int -> Name -> Dec
boxedAppendClause ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
l) ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
r) Name
nm
  ]

-- | Create a function declaration with signature to append an unboxed tuple with the types of the first list with an unboxed tuple with the types of the second list. This will contain two 'Dec' items: one for the signature and one for the function declaration itself.
unboxedTupleAppendFun
  :: Name  -- ^ The name of the function to construct.
  -> [Type]  -- ^ The types of the first boxed tuple, should contain at least two elements, all types can be lifted or unlifted types or type variables.
  -> [Type]  -- ^ The types of the second boxed tuple, should contain at least two elements, all types can be lifted or unlifted types or type variables.
  -> [Dec]  -- ^ A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
unboxedTupleAppendFun :: Name -> [Type] -> [Type] -> [Dec]
unboxedTupleAppendFun Name
nm [Type]
l [Type]
r = [
    Name -> Type -> Type -> Type -> Dec
_signature Name
nm ([Type] -> Type
_utupType [Type]
l) ([Type] -> Type
_utupType [Type]
r) ([Type] -> Type
_utupType ([Type]
l [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Type]
r))
  , Int -> Int -> Name -> Dec
unboxedAppendClause ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
l) ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
r) Name
nm
  ]

-- | Create a function declaration with signature to add an item with a given type to the left side of a boxed tuple with the types of the given list. This will contain two 'Dec' items: one for the signature and one for the function declaration itself.
boxedTupleAddLFun
  :: Name  -- ^ The name of the function to construct.
  -> Type  -- ^ The type of the item to add to the tuple.
  -> [Type]  -- ^ The types of the boxed tuple, should contain at least two elements.
  -> [Dec]  -- ^ A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
boxedTupleAddLFun :: Name -> Type -> [Type] -> [Dec]
boxedTupleAddLFun Name
nm Type
t [Type]
ts = [
    Name -> Type -> Type -> Type -> Dec
_signature Name
nm Type
t ([Type] -> Type
_tupType [Type]
ts) ([Type] -> Type
_tupType (Type
t Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type]
ts))
  , Int -> Name -> Dec
boxedAddLClause ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts) Name
nm
  ]

-- | Create a function declaration with signature to add an item with a given type to the left side of an unboxed tuple with the types of the given list. This will contain two 'Dec' items: one for the signature and one for the function declaration itself.
unboxedTupleAddLFun
  :: Name  -- ^ The name of the function to construct.
  -> Type  -- ^ The type of the item to add to the tuple, this can be a lifted or unlifted type or a type variable.
  -> [Type]  -- ^ The types of the boxed tuple, should contain at least two elements, all types can be lifted or unlifted types or type variables.
  -> [Dec]  -- ^ A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
unboxedTupleAddLFun :: Name -> Type -> [Type] -> [Dec]
unboxedTupleAddLFun Name
nm Type
t [Type]
ts = [
    Name -> Type -> Type -> Type -> Dec
_signature Name
nm Type
t ([Type] -> Type
_utupType [Type]
ts) ([Type] -> Type
_utupType (Type
t Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type]
ts))
  , Int -> Name -> Dec
unboxedAddLClause ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts) Name
nm
  ]

-- | Create a function declaration with signature to add an item with a given type to the right side of a boxed tuple with the types of the given list. This will contain two 'Dec' items: one for the signature and one for the function declaration itself.
boxedTupleAddRFun
  :: Name  -- ^ The name of the function to construct.
  -> [Type]  -- ^ The types of the boxed tuple, should contain at least two elements.
  -> Type  -- ^ The type of the item to add to the tuple.
  -> [Dec]  -- ^ A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
boxedTupleAddRFun :: Name -> [Type] -> Type -> [Dec]
boxedTupleAddRFun Name
nm [Type]
ts Type
t = [
    Name -> Type -> Type -> Type -> Dec
_signature Name
nm ([Type] -> Type
_tupType [Type]
ts) Type
t ([Type] -> Type
_tupType ([Type]
ts [Type] -> Type -> [Type]
forall 𝐯 x 𝐯x. TupleAddR 𝐯 x 𝐯x => 𝐯 -> x -> 𝐯x
++> Type
t))
  , Int -> Name -> Dec
boxedAddRClause ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts) Name
nm
  ]

-- | Create a function declaration with signature to add an item with a given type to the right side of an unboxed tuple with the types of the given list. This will contain two 'Dec' items: one for the signature and one for the function declaration itself.
unboxedTupleAddRFun
  :: Name  -- ^ The name of the function to construct.
  -> [Type]  -- ^ The types of the boxed tuple, should contain at least two elements, all types can be lifted or unlifted types or type variables.
  -> Type  -- ^ The type of the item to add to the tuple, this can be a lifted or unlifted type or a type variable.
  -> [Dec]  -- ^ A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
unboxedTupleAddRFun :: Name -> [Type] -> Type -> [Dec]
unboxedTupleAddRFun Name
nm [Type]
ts Type
t = [
    Name -> Type -> Type -> Type -> Dec
_signature Name
nm ([Type] -> Type
_utupType [Type]
ts) Type
t ([Type] -> Type
_utupType ([Type]
ts [Type] -> Type -> [Type]
forall 𝐯 x 𝐯x. TupleAddR 𝐯 x 𝐯x => 𝐯 -> x -> 𝐯x
++> Type
t))
  , Int -> Name -> Dec
unboxedAddRClause ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts) Name
nm
  ]

-- | Create a function declaration with signature to append a boxed tuple with the types of the first list with a boxed tuple with the types of the second list. This function can be used with template Haskell.
makeBoxedTupleAppendFun
  :: Name  -- ^ The name of the function to construct.
  -> [Type]  -- ^ The types of the first boxed tuple, should contain at least two elements.
  -> [Type]  -- ^ The types of the second boxed tuple, should contain at least two elements.
  -> DecsQ  -- ^ A builder to construct the declaration of the signature and a body of the function to append the tuples.
makeBoxedTupleAppendFun :: Name -> [Type] -> [Type] -> DecsQ
makeBoxedTupleAppendFun Name
nm [Type]
l = [Dec] -> DecsQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> DecsQ) -> ([Type] -> [Dec]) -> [Type] -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Type] -> [Type] -> [Dec]
boxedTupleAppendFun Name
nm [Type]
l

-- | Create a function declaration with signature to append an unboxed tuple with the types of the first list with an unboxed tuple with the types of the second list. This function can be used with template Haskell.
makeUnboxedTupleAppendFun
  :: Name  -- ^ The name of the function to construct.
  -> [Type]  -- ^ The types of the first boxed tuple, should contain at least two elements, all types can be lifted or unlifted types or type variables.
  -> [Type]  -- ^ The types of the second boxed tuple, should contain at least two elements, all types can be lifted or unlifted types or type variables.
  -> DecsQ  -- ^ A builder to construct the declaration of the signature and a body of the function to append the tuples.
makeUnboxedTupleAppendFun :: Name -> [Type] -> [Type] -> DecsQ
makeUnboxedTupleAppendFun Name
nm [Type]
l = [Dec] -> DecsQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> DecsQ) -> ([Type] -> [Dec]) -> [Type] -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Type] -> [Type] -> [Dec]
unboxedTupleAppendFun Name
nm [Type]
l

-- | Create a function declaration with signature to add an item with a given type to the left side of a boxed tuple with the types of the given list. This function can be used with template Haskell.
makeBoxedTupleAddLFun
  :: Name  -- ^ The name of the function to construct.
  -> Type  -- ^ The type of the item to add to the tuple.
  -> [Type]  -- ^ The types of the boxed tuple, should contain at least two elements.
  -> DecsQ  -- ^ A builder to construct the declaration of the signature and a body of the function to add an element at the left side of a tuple.
makeBoxedTupleAddLFun :: Name -> Type -> [Type] -> DecsQ
makeBoxedTupleAddLFun Name
nm Type
t = [Dec] -> DecsQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> DecsQ) -> ([Type] -> [Dec]) -> [Type] -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type -> [Type] -> [Dec]
boxedTupleAddLFun Name
nm Type
t

-- | Create a function declaration with signature to add an item with a given type to the left side of an unboxed tuple with the types of the given list. This function can be used with template Haskell.
makeUnboxedTupleAddLFun
  :: Name  -- ^ The name of the function to construct.
  -> Type  -- ^ The type of the item to add to the tuple, this can be a lifted or unlifted type or a type variable.
  -> [Type]  -- ^ The types of the boxed tuple, should contain at least two elements, all types can be lifted or unlifted types or type variables.
  -> DecsQ  -- ^ A builder to construct the declaration of the signature and a body of the function to add an element at the left side of a tuple.
makeUnboxedTupleAddLFun :: Name -> Type -> [Type] -> DecsQ
makeUnboxedTupleAddLFun Name
nm Type
t = [Dec] -> DecsQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> DecsQ) -> ([Type] -> [Dec]) -> [Type] -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type -> [Type] -> [Dec]
unboxedTupleAddLFun Name
nm Type
t

-- | Create a function declaration with signature to add an item with a given type to the right side of a boxed tuple with the types of the given list. This function can be used with template Haskell.
makeBoxedTupleAddRFun
  :: Name  -- ^ The name of the function to construct.
  -> [Type]  -- ^ The types of the boxed tuple, should contain at least two elements.
  -> Type  -- ^ The type of the item to add to the tuple.
  -> DecsQ  -- ^ A builder to construct the declaration of the signature and a body of the function to add an element at the right side of a tuple.
makeBoxedTupleAddRFun :: Name -> [Type] -> Type -> DecsQ
makeBoxedTupleAddRFun Name
nm [Type]
ts = [Dec] -> DecsQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> DecsQ) -> (Type -> [Dec]) -> Type -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Type] -> Type -> [Dec]
boxedTupleAddRFun Name
nm [Type]
ts

-- | Create a function declaration with signature to add an item with a given type to the right side of an unboxed tuple with the types of the given list. This function can be used with template Haskell.
makeUnboxedTupleAddRFun
  :: Name  -- ^ The name of the function to construct.
  -> [Type]  -- ^ The types of the boxed tuple, should contain at least two elements, all types can be lifted or unlifted types or type variables.
  -> Type  -- ^ The type of the item to add to the tuple, this can be a lifted or unlifted type or a type variable.
  -> DecsQ  -- ^ A builder to construct the declaration of the signature and a body of the function to add an element at the right side of a tuple.
makeUnboxedTupleAddRFun :: Name -> [Type] -> Type -> DecsQ
makeUnboxedTupleAddRFun Name
nm [Type]
ts = [Dec] -> DecsQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> DecsQ) -> (Type -> [Dec]) -> Type -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Type] -> Type -> [Dec]
unboxedTupleAddRFun Name
nm [Type]
ts

_simpleInstance :: Name -> Name -> Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstance :: Name -> Name -> Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstance Name
tc Name
f Type
tca Type
tcb Type
tcc Name -> Dec
d = Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing [] (Name -> Type
ConT Name
tc Type -> Type -> Type
`AppT` Type
tca Type -> Type -> Type
`AppT` Type
tcb Type -> Type -> Type
`AppT` Type
tcc) [Name -> Dec
d Name
f]

_simpleInstanceAppend :: Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstanceAppend :: Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstanceAppend = Name -> Name -> Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstance ''TupleAppend '(+++)

_simpleInstanceAddL :: Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstanceAddL :: Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstanceAddL = Name -> Name -> Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstance ''TupleAddL '(<++)

_simpleInstanceAddR :: Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstanceAddR :: Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstanceAddR = Name -> Name -> Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstance ''TupleAddR '(++>)

-- | Define a typeclass instance for 'TupleAppend' where it appens tuples with /m/ and /n/ items with /m/ and /n/ the parameters of the function.
tupleAppend
  :: Int  -- ^ The length /m/ of the first tuple.
  -> Int  -- ^ The length /n/ of the second tuple.
  -> Dec  -- ^ An instance of the 'TupleAppend' typeclass that appends tuples with lengths /m/ and /n/ to a tuple with length /m+n/.
tupleAppend :: Int -> Int -> Dec
tupleAppend Int
m Int
n = Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstanceAppend (Int -> [Name] -> Type
_tupleVar' Int
m [Name]
_uNames) (Int -> [Name] -> Type
_tupleVar' Int
n [Name]
_vNames) (Int -> [Name] -> Type
_tupleVar' (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
m [Name]
_uNames [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
_vNames)) (Int -> Int -> Name -> Dec
boxedAppendClause Int
m Int
n)

-- | Define typeclass instances for 'TupleAppend' that will append any tuple of at least size two with any tuple of at least size two such that the sum is the given number.
tupleAppendFor
  :: Int  -- ^ The given number /l/ for which typeclass instances of 'TupleAppend' will be made with /m/ and /n/ such that /l=m+n/.
  -> [Dec]  -- ^ A list of typelcass instances for the 'TupleAppend' typeclass.
tupleAppendFor :: Int -> [Dec]
tupleAppendFor Int
l = [Int -> Int -> Dec
tupleAppend Int
m Int
n | Int
m <- Int -> [Int]
_tupleRange Int
l, let n :: Int
n = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m, Int -> Bool
_tupleCheck Int
n ]

-- | Define a typeclass instance for 'TupleAddL' for a tuple with /n/ elements and an item to construct a tuple with /n+1/ elements where the item is added at the left side.
tupleAddL
  :: Int  -- ^ The given length /n/ of the tuples to prepend and append with an element.
  -> Dec  -- ^ A type instance declaration for an instance of the 'TupleAddL' typeclass for an /n/-tuple.
tupleAddL :: Int -> Dec
tupleAddL Int
n = Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstanceAddL Type
_varZZ (Int -> [Name] -> Type
_tupleVar' Int
n [Name]
_vNames) (Int -> [Name] -> Type
_tupleVar' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Name
_nameZZ Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
_vNames)) (Int -> Name -> Dec
boxedAddLClause Int
n)

-- | Define a typeclass instance for 'TupleAddR' for a tuple with /n/ elements and an item to construct a tuple with /n+1/ elements where the item is added at the right side.
tupleAddR
  :: Int  -- ^ The given length /n/ of the tuples to prepend and append with an element.
  -> Dec  -- ^ A type instance declaration for an instance of the 'TupleAddR' typeclass for an /n/-tuple.
tupleAddR :: Int -> Dec
tupleAddR Int
n = Type -> Type -> Type -> (Name -> Dec) -> Dec
_simpleInstanceAddR (Int -> [Name] -> Type
_tupleVar' Int
n [Name]
_vNames) Type
_varZZ (Int -> [Name] -> Type
_tupleVar' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
n [Name]
_vNames [Name] -> Name -> [Name]
forall 𝐯 x 𝐯x. TupleAddR 𝐯 x 𝐯x => 𝐯 -> x -> 𝐯x
++> Name
_nameZZ)) (Int -> Name -> Dec
boxedAddRClause Int
n)

-- | Define typeclass instances for 'TupleAddL' and 'TupleAddR' for a tuple with /n/ elements and an item to construct a tuple with /n+1/ elements where the item is added at the left or the right side.
tupleAdd
  :: Int  -- ^ The given length /n/ of the tuples to prepend and append with an element.
  -> [Dec]  -- ^ A list of two type instance declarations that contains typeclass instances for 'TupleAddL' and 'TupleAddR'.
tupleAdd :: Int -> [Dec]
tupleAdd Int
n
  | Int -> Bool
_tupleCheck Int
n Bool -> Bool -> Bool
&& Int -> Bool
_tupleCheck (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) = [Int -> Dec
tupleAddL Int
n, Int -> Dec
tupleAddR Int
n]
  | Bool
otherwise = []

_errorQuasiQuoter :: a -> Q b
_errorQuasiQuoter :: a -> Q b
_errorQuasiQuoter = Q b -> a -> Q b
forall a b. a -> b -> a
const (String -> Q b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"The quasi quoter can only be used to define declarations")

-- | A 'QuasiQuoter' that constructs instances for 'TupleAddL' and 'TupleAddR' for tuples up to length /n/ where /n/ is read as text input for the quasi quoter.
defineTupleAddUpto
  :: QuasiQuoter  -- ^ A 'QuasiQuoter' that will construct typeclass instance declarations.
defineTupleAddUpto :: QuasiQuoter
defineTupleAddUpto = (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> DecsQ)
-> QuasiQuoter
QuasiQuoter String -> Q Exp
forall a b. a -> Q b
_errorQuasiQuoter String -> Q Pat
forall a b. a -> Q b
_errorQuasiQuoter String -> Q Type
forall a b. a -> Q b
_errorQuasiQuoter (Int -> DecsQ
_defineTupleAddUpTo (Int -> DecsQ) -> (String -> Int) -> String -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read)

_defineTupleAddUpTo :: Int -> DecsQ
_defineTupleAddUpTo :: Int -> DecsQ
_defineTupleAddUpTo Int
n = [Dec] -> DecsQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int -> Dec) -> [Int] -> [Dec]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Dec
tupleAddL [Int]
ns [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
++ (Int -> Dec) -> [Int] -> [Dec]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Dec
tupleAddR [Int]
ns)
    where ns :: [Int]
ns = [Int] -> [Int]
forall a. [a] -> [a]
reverse ((Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Bool
_tupleCheck (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ) (Int -> [Int]
_tupleRange Int
n))

-- | A 'QuasiQuoter' that constructs instances for 'TupleAppend' for tuples up to length /n/ where /n/ is read as text input for the quasi quoter. For a single /n/ it thus will construct /n-4/ instances for each tuple length.
defineTupleAppendUpto
  :: QuasiQuoter  -- ^ A 'QuasiQuoter' that will construct typeclass instance declarations.
defineTupleAppendUpto :: QuasiQuoter
defineTupleAppendUpto = (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> DecsQ)
-> QuasiQuoter
QuasiQuoter String -> Q Exp
forall a b. a -> Q b
_errorQuasiQuoter String -> Q Pat
forall a b. a -> Q b
_errorQuasiQuoter String -> Q Type
forall a b. a -> Q b
_errorQuasiQuoter ([Dec] -> DecsQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> DecsQ) -> (String -> [Dec]) -> String -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Dec]
tupleAppendFor (Int -> [Dec]) -> (String -> [Int]) -> String -> [Dec]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Int -> Int -> [Int]
forall a. Enum a => a -> a -> [a]
enumFromTo Int
0 (Int -> [Int]) -> (String -> Int) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read))

-- | A 'QuasiQuoter' that constructs instances for 'TupleAppend' for tuples up to length /n/ where /n/ is read as text input for the quasi quoter. For a single /n/ it thus will construct /n-4/ instances for each tuple length.
defineUnboxedTupleAppendFunctionsUpto
  :: QuasiQuoter  -- ^ A 'QuasiQuoter' that will construct typeclass instance declarations.
defineUnboxedTupleAppendFunctionsUpto :: QuasiQuoter
defineUnboxedTupleAppendFunctionsUpto = (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> DecsQ)
-> QuasiQuoter
QuasiQuoter String -> Q Exp
forall a b. a -> Q b
_errorQuasiQuoter String -> Q Pat
forall a b. a -> Q b
_errorQuasiQuoter String -> Q Type
forall a b. a -> Q b
_errorQuasiQuoter (Int -> DecsQ
_unboxedTupleConcats (Int -> DecsQ) -> (String -> Int) -> String -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read)

_unboxedTupleConcats :: Int -> DecsQ
_unboxedTupleConcats :: Int -> DecsQ
_unboxedTupleConcats Int
r = [Dec] -> DecsQ
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ Dec
u | Int
m <- [Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2, Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3 .. Int
2], Int
n <- [Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2, Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3 .. Int
2], Dec
u <- Name -> [Type] -> [Type] -> [Dec]
unboxedTupleAppendFun (String -> Name
mkName (String
"unboxedAppend_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)) ((Name -> Type) -> [Name] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
m [Name]
_uNames)) ((Name -> Type) -> [Name] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
n [Name]
_vNames)) ]