{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE 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,
    defineSequenceTupleUpTo,
    defineFoldTupleUpTo,

    -- * Quasiquoters for unboxed tuples
    defineUnboxedTupleAppendFunctionsUpto,

    -- * Functions to construct typeclass instance declarations
    tupleAddL,
    tupleAddR,
    tupleAdd,
    tupleAppend,
    tupleAppendFor,
    sequenceTuple,
    sequenceTupleFor,
    foldTuple,
    foldTupleFor,

    -- * 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,
    sequenceClauseA,
    sequenceClauseA_,
    foldlClause,
    foldrClause,
    foldMapClause,

    -- ** Unboxed tuples
    unboxedAddLClause,
    unboxedAddRClause,
    unboxedAppendClause,
  )
where

import Control.Monad ((<=<))
import Data.Char (chr, ord)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Tuple.Append.Class (FoldTuple (foldMapTuple, foldlTuple, foldrTuple), SequenceTuple (sequenceTupleA, sequenceTupleA_), 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),
    Cxt,
    Dec (FunD, InstanceD, SigD),
    Exp (AppE, ConE, TupE, UnboxedTupE, VarE),
    Name,
    Pat (TildeP, TupP, UnboxedTupP, VarP),
    Q,
    Type (AppT, ArrowT, ConT, TupleT, UnboxedTupleT, VarT),
    mkName,
    tupleDataName,
  )

_nameVV :: Name
_nameVV :: Name
_nameVV = String -> Name
mkName String
"v"

_varVV :: Type
_varVV :: Type
_varVV = Name -> Type
VarT Name
_nameVV

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

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

_expZZ :: Exp
_expZZ :: Exp
_expZZ = Name -> Exp
VarE Name
_nameZZ

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

_nameFF :: Name
_nameFF :: Name
_nameFF = String -> Name
mkName String
"f"

_patFF :: Pat
_patFF :: Pat
_patFF = Name -> Pat
VarP Name
_nameFF

_varFF :: Type
_varFF :: Type
_varFF = Name -> Type
VarT Name
_nameFF

_expFF :: Exp
_expFF :: Exp
_expFF = Name -> Exp
VarE Name
_nameFF

_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
0x2050 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))

_tupleVar'' :: Int -> Type -> [Name] -> Type
_tupleVar'' :: Int -> Type -> [Name] -> Type
_tupleVar'' Int
n Type
f [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 ((Type
f Type -> Type -> Type
`AppT`) (Type -> Type) -> (Name -> Type) -> Name -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: Int -> [Int]
_tupleRange = Int -> Int -> [Int]
forall a. Enum a => a -> a -> [a]
enumFromTo Int
0  -- 0 .. n
#else
_tupleRange = (0 :) . enumFromTo 2  -- 0 and 2 .. n
#endif

_tupleCheck :: Int -> Bool
#if MIN_VERSION_ghc_prim(0,7,0)
_tupleCheck :: Int -> Bool
_tupleCheck = (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=)
#else
_tupleCheck 0 = True
_tupleCheck n = 2 <= 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 []])

_sequenceExprA :: Int -> [Name] -> Exp
_sequenceExprA :: Int -> [Name] -> Exp
_sequenceExprA Int
n [Name]
xs = (Exp -> (Exp -> Exp) -> Exp) -> Exp -> [Exp -> Exp] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Exp -> Exp) -> Exp -> Exp) -> Exp -> (Exp -> Exp) -> Exp
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
($)) (Name -> Exp
ConE (Int -> Name
tupleDataName Int
n)) [Exp -> Exp]
exps'
  where
    exps :: [Exp -> Exp]
exps = (Name -> Exp -> Exp) -> [Name] -> [Exp -> Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp) -> (Name -> Exp) -> Name -> Exp -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Exp
VarE) ('(<$>) Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: Name -> [Name]
forall a. a -> [a]
repeat '(<*>)) :: [Exp -> Exp]
    exps' :: [Exp -> Exp]
exps' = ((Exp -> Exp) -> Name -> Exp -> Exp)
-> [Exp -> Exp] -> [Name] -> [Exp -> Exp]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Exp -> Exp
f Name
x Exp
y -> Exp -> Exp
f Exp
y Exp -> Exp -> Exp
`AppE` Name -> Exp
VarE Name
x) [Exp -> Exp]
exps [Name]
xs :: [Exp -> Exp]

_sequenceExprA_ :: [Name] -> Exp
_sequenceExprA_ :: [Name] -> Exp
_sequenceExprA_ = (Name -> Exp -> Exp) -> Exp -> [Name] -> Exp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp) -> (Exp -> Exp) -> Exp -> Exp -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> Exp -> Exp
AppE (Name -> Exp
VarE '(*>))) (Exp -> Exp -> Exp) -> (Name -> Exp) -> Name -> Exp -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Exp
VarE) (Name -> Exp
VarE 'pure Exp -> Exp -> Exp
`AppE` Name -> Exp
ConE '())

-- | Produce a function for sequencing a tuple of a given length of tuples with a given name.
sequenceClauseA ::
  -- | The given number /n/ for which a function is produced that sequences /n/-tuples.
  Int ->
  -- | The name for the function that is generated.
  Name ->
  -- | A declaration for a function that sequences the tuple.
  Dec
sequenceClauseA :: Int -> Name -> Dec
sequenceClauseA Int
n = [Pat] -> Body -> Name -> Dec
_clause [[Name] -> Pat
_tupleP' [Name]
vn] (Exp -> Body
NormalB (Int -> [Name] -> Exp
_sequenceExprA Int
n [Name]
vn))
  where
    vn :: [Name]
vn = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
n [Name]
_vNames

-- | Produce a function for sequencing a tuple of a given length of tuples and return the unit value with a given name.
sequenceClauseA_ ::
  -- | The given number /n/ for which a function is produced that sequences /n/-tuples.
  Int ->
  -- | The name for the function that is generated.
  Name ->
  -- | A declaration for a function that sequences the tuple and returns the unit value.
  Dec
sequenceClauseA_ :: Int -> Name -> Dec
sequenceClauseA_ Int
n = [Pat] -> Body -> Name -> Dec
_clause [[Name] -> Pat
_tupleP' [Name]
vn] (Exp -> Body
NormalB ([Name] -> Exp
_sequenceExprA_ [Name]
vn))
  where
    vn :: [Name]
vn = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
n [Name]
_vNames

#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

_foldlClause :: ([Pat] -> Pat) -> Int -> Name -> Dec
_foldlClause :: ([Pat] -> Pat) -> Int -> Name -> Dec
_foldlClause [Pat] -> Pat
fp Int
n = [Pat] -> Body -> Name -> Dec
_clause [Pat
_patFF, Pat
_patZZ, ([Pat] -> Pat) -> [Name] -> Pat
_tupleP'' [Pat] -> Pat
fp [Name]
vars] (Exp -> Body
NormalB ((Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Exp
x₁ Exp
x₂ -> Exp
_expFF Exp -> Exp -> Exp
`AppE` Exp
x₁ Exp -> Exp -> Exp
`AppE` Exp
x₂) Exp
_expZZ ((Name -> Exp) -> [Name] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Exp
VarE [Name]
vars)))
  where
    vars :: [Name]
vars = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
n [Name]
_vNames

_foldrClause :: ([Pat] -> Pat) -> Int -> Name -> Dec
_foldrClause :: ([Pat] -> Pat) -> Int -> Name -> Dec
_foldrClause [Pat] -> Pat
fp Int
n = [Pat] -> Body -> Name -> Dec
_clause [Pat
_patFF, Pat
_patZZ, ([Pat] -> Pat) -> [Name] -> Pat
_tupleP'' [Pat] -> Pat
fp [Name]
vars] (Exp -> Body
NormalB ((Name -> Exp -> Exp) -> Exp -> [Name] -> Exp
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((\Exp
x₁ Exp
x₂ -> Exp
_expFF Exp -> Exp -> Exp
`AppE` Exp
x₁ Exp -> Exp -> Exp
`AppE` Exp
x₂) (Exp -> Exp -> Exp) -> (Name -> Exp) -> Name -> Exp -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Exp
VarE) Exp
_expZZ [Name]
vars))
  where
    vars :: [Name]
vars = Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
n [Name]
_vNames

_foldMapClause :: ([Pat] -> Pat) -> Int -> Name -> Dec
_foldMapClause :: ([Pat] -> Pat) -> Int -> Name -> Dec
_foldMapClause [Pat] -> Pat
fp Int
n = [Pat] -> Body -> Name -> Dec
_clause [Pat
_patFF, ([Pat] -> Pat) -> [Name] -> Pat
_tupleP'' [Pat] -> Pat
fp [Name]
vars] (Exp -> Body
NormalB ((Exp -> Exp -> Exp) -> [Exp] -> Exp
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Exp
x₁ Exp
x₂ -> Name -> Exp
VarE '(<>) Exp -> Exp -> Exp
`AppE` Exp
x₁ Exp -> Exp -> Exp
`AppE` Exp
x₂) ((Name -> Exp) -> [Name] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Exp -> Exp -> Exp
AppE Exp
_expFF (Exp -> Exp) -> (Name -> Exp) -> Name -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Exp
VarE) [Name]
vars)))
  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 ::
  -- | The number of items for the first boxed tuple parameter.
  Int ->
  -- | The number of items for the second boxed tuple parameter.
  Int ->
  -- | The name of the function to define.
  Name ->
  -- | A function declaration that only contains the body of the function.
  Dec
boxedAppendClause :: Int -> Int -> Name -> Dec
boxedAppendClause = ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Int -> Name -> Dec
_appendClause (Pat -> Pat
TildeP (Pat -> Pat) -> ([Pat] -> Pat) -> [Pat] -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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 ::
  -- | The number of items for the first unboxed tuple parameter.
  Int ->
  -- | The number of items for the second unboxed tuple parameter.
  Int ->
  -- | The name of the function to define.
  Name ->
  -- | A function declaration that only contains the body of the function.
  Dec
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 ::
  -- | The number of items of the boxed tuple to add an item to.
  Int ->
  -- | The name of the function to define.
  Name ->
  -- | A function declaration that only contains the body of the function.
  Dec
boxedAddLClause :: Int -> Name -> Dec
boxedAddLClause = ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Name -> Dec
_addLClause (Pat -> Pat
TildeP (Pat -> Pat) -> ([Pat] -> Pat) -> [Pat] -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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 ::
  -- | The number of items of the unboxed tuple to add an item to.
  Int ->
  -- | The name of the function to define.
  Name ->
  -- | A function declaration that only contains the body of the function.
  Dec
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 ::
  -- | The number of items of the boxed tuple to add an item to.
  Int ->
  -- | The name of the function to define.
  Name ->
  -- | A function declaration that only contains the body of the function.
  Dec
boxedAddRClause :: Int -> Name -> Dec
boxedAddRClause = ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Name -> Dec
_addRClause (Pat -> Pat
TildeP (Pat -> Pat) -> ([Pat] -> Pat) -> [Pat] -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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 ::
  -- | The number of items of the unboxed tuple to add an item to.
  Int ->
  -- | The name of the function to define.
  Name ->
  -- | A function declaration that only contains the body of the function.
  Dec
unboxedAddRClause :: Int -> Name -> Dec
unboxedAddRClause = ([Pat] -> Pat) -> ([Maybe Exp] -> Exp) -> Int -> Name -> Dec
_addRClause [Pat] -> Pat
UnboxedTupP [Maybe Exp] -> Exp
UnboxedTupE

-- | Create a function declaration to fold a boxed tuple left-to-right. This only contains a declaration for the /body/ of the function, not a type signature.
foldlClause ::
  -- | The number of items of the boxed tuple to fold.
  Int ->
  -- | The name of the function to define.
  Name ->
  -- | A function declaration that only contains the body of the function.
  Dec
foldlClause :: Int -> Name -> Dec
foldlClause = ([Pat] -> Pat) -> Int -> Name -> Dec
_foldlClause (Pat -> Pat
TildeP (Pat -> Pat) -> ([Pat] -> Pat) -> [Pat] -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pat] -> Pat
TupP)

-- | Create a function declaration to fold a boxed tuple right-to-left. This only contains a declaration for the /body/ of the function, not a type signature.
foldrClause ::
  -- | The number of items of the boxed tuple to fold.
  Int ->
  -- | The name of the function to define.
  Name ->
  -- | A function declaration that only contains the body of the function.
  Dec
foldrClause :: Int -> Name -> Dec
foldrClause = ([Pat] -> Pat) -> Int -> Name -> Dec
_foldrClause (Pat -> Pat
TildeP (Pat -> Pat) -> ([Pat] -> Pat) -> [Pat] -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pat] -> Pat
TupP)

-- | Create a function declaration to 'foldMap' a boxed tuple. This only contains a declaration for the /body/ of the function, not a type signature.
foldMapClause ::
  -- | The number of items of the boxed tuple to 'foldMap'.
  Int ->
  -- | The name of the function to define.
  Name ->
  -- | A function declaration that only contains the body of the function.
  Dec
foldMapClause :: Int -> Name -> Dec
foldMapClause = ([Pat] -> Pat) -> Int -> Name -> Dec
_foldMapClause (Pat -> Pat
TildeP (Pat -> Pat) -> ([Pat] -> Pat) -> [Pat] -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pat] -> Pat
TupP)

_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 ::
  -- | The name of the function to construct.
  Name ->
  -- | The types of the first boxed tuple, all types should be lifted types.
  [Type] ->
  -- | The types of the second boxed tuple, all types should be lifted types.
  [Type] ->
  -- | A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
  [Dec]
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 ::
  -- | The name of the function to construct.
  Name ->
  -- | The types of the first boxed tuple, all types can be lifted or unlifted types or type variables.
  [Type] ->
  -- | The types of the second boxed tuple, all types can be lifted or unlifted types or type variables.
  [Type] ->
  -- | A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
  [Dec]
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 ::
  -- | The name of the function to construct.
  Name ->
  -- | The type of the item to add to the tuple, should be a lifted type.
  Type ->
  -- | The types of the boxed tuple, all items should be lifted types.
  [Type] ->
  -- | A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
  [Dec]
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 ::
  -- | The name of the function to construct.
  Name ->
  -- | 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, all types can be lifted or unlifted types or type variables.
  [Type] ->
  -- | A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
  [Dec]
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 ::
  -- | The name of the function to construct.
  Name ->
  -- | The types of the boxed tuple, all types should be lifted types.
  [Type] ->
  -- | The type of the item to add to the tuple, should be a lifted type.
  Type ->
  -- | A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
  [Dec]
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 ::
  -- | The name of the function to construct.
  Name ->
  -- | The types of the boxed tuple, 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.
  Type ->
  -- | A list that contains two 'Dec' objects: one for the function signature declaration, and one for the function declaration.
  [Dec]
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 ::
  -- | The name of the function to construct.
  Name ->
  -- | The types of the first boxed tuple, all types should be lifted types.
  [Type] ->
  -- | The types of the second boxed tuple, all types should be lifted types.
  [Type] ->
  -- | A builder to construct the declaration of the signature and a body of the function to append the tuples.
  DecsQ
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 ::
  -- | The name of the function to construct.
  Name ->
  -- | The types of the first boxed tuple, all types can be lifted or unlifted types or type variables.
  [Type] ->
  -- | The types of the second boxed tuple, all types can be lifted or unlifted types or type variables.
  [Type] ->
  -- | A builder to construct the declaration of the signature and a body of the function to append the tuples.
  DecsQ
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 ::
  -- | The name of the function to construct.
  Name ->
  -- | The type of the item to add to the tuple, should be a lifted type.
  Type ->
  -- | The types of the boxed tuple, all types should be lifted types.
  [Type] ->
  -- | 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.
  DecsQ
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 ::
  -- | The name of the function to construct.
  Name ->
  -- | 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, all types can be lifted or unlifted types or type variables.
  [Type] ->
  -- | 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.
  DecsQ
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 ::
  -- | The name of the function to construct.
  Name ->
  -- | The types of the boxed tuple, all types should be lifted types.
  [Type] ->
  -- | The type of the item to add to the tuple, should be a lifted type.
  Type ->
  -- | 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.
  DecsQ
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 ::
  -- | The name of the function to construct.
  Name ->
  -- | The types of the boxed tuple, 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.
  Type ->
  -- | 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.
  DecsQ
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'' :: Cxt -> Name -> Type -> Type -> Type -> [Dec] -> Dec
_simpleInstance'' :: [Type] -> Name -> Type -> Type -> Type -> [Dec] -> Dec
_simpleInstance'' [Type]
cxt Name
tc Type
tca Type
tcb Type
tcc = Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing [Type]
cxt (Name -> Type
ConT Name
tc Type -> Type -> Type
`AppT` Type
tca Type -> Type -> Type
`AppT` Type
tcb Type -> Type -> Type
`AppT` Type
tcc)

_simpleInstance' :: Name -> Type -> Type -> Type -> [Dec] -> Dec
_simpleInstance' :: Name -> Type -> Type -> Type -> [Dec] -> Dec
_simpleInstance' = [Type] -> Name -> Type -> Type -> Type -> [Dec] -> Dec
_simpleInstance'' []

_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 = Name -> Type -> Type -> Type -> [Dec] -> Dec
_simpleInstance' Name
tc Type
tca Type
tcb Type
tcc [Name -> Dec
d Name
f]

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

_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 '(++>)

_simpleInstanceFold :: Type -> Type -> [Dec] -> Dec
_simpleInstanceFold :: Type -> Type -> [Dec] -> Dec
_simpleInstanceFold Type
𝐯 Type
vₖ = Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing [] (Name -> Type
ConT ''FoldTuple Type -> Type -> Type
`AppT` Type
𝐯 Type -> Type -> Type
`AppT` Type
vₖ)

_simpleSequenceInstance :: Type -> Type -> [Dec] -> Dec
_simpleSequenceInstance :: Type -> Type -> [Dec] -> Dec
_simpleSequenceInstance = [Type] -> Name -> Type -> Type -> Type -> [Dec] -> Dec
_simpleInstance'' [Name -> Type
ConT ''Prelude.Applicative Type -> Type -> Type
`AppT` Type
_varFF] ''SequenceTuple Type
_varFF

-- | Define a typeclass instance for 'SequenceTuple' where it sequences a tuple of length /n/.
sequenceTuple ::
  -- | The given length /n/ for the tuple to be sequenced.
  Int ->
  -- | The instance declaraion for that tuple.
  Dec
sequenceTuple :: Int -> Dec
sequenceTuple Int
n = Type -> Type -> [Dec] -> Dec
_simpleSequenceInstance (Int -> Type -> [Name] -> Type
_tupleVar'' Int
n Type
_varFF [Name]
_vNames) (Int -> [Name] -> Type
_tupleVar' Int
n [Name]
_vNames) [Int -> Name -> Dec
sequenceClauseA Int
n 'sequenceTupleA, Int -> Name -> Dec
sequenceClauseA_ Int
n 'sequenceTupleA_]

-- | Define a typeclass instance for 'TupleAppend' where it appends tuples with /m/ and /n/ items with /m/ and /n/ the parameters of the function.
tupleAppend ::
  -- | The length /m/ of the first tuple.
  Int ->
  -- | The length /n/ of the second tuple.
  Int ->
  -- | An instance of the 'TupleAppend' typeclass that appends tuples with lengths /m/ and /n/ to a tuple with length /m+n/.
  Dec
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
m Int -> 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 ::
  -- | The given number /l/ for which typeclass instances of 'TupleAppend' will be made with /m/ and /n/ such that /l=m+n/.
  Int ->
  -- | A list of typeclass instances for the 'TupleAppend' typeclass.
  [Dec]
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 the 'SequenceTuple' typeclass that will sequence over a tuple for the given length.
sequenceTupleFor ::
  -- | The given number /n/ that specifies the *arity* of the tuple for which to construct an instance. Will return an empty list if the number is invalid.
  Int ->
  -- | A list of typeclass instances for the 'SequenceTuple' typeclass.
  [Dec]
sequenceTupleFor :: Int -> [Dec]
sequenceTupleFor Int
n = [Int -> Dec
sequenceTuple Int
n | Int -> Bool
_tupleCheck Int
n]

-- | Define a typeclass instance for the 'FoldTuple' typeclass that will fold over a tuple of given length.
foldTupleFor ::
  -- | The given number /n/ that specifies the *arity* of the tuple for which to construct an instance. Will return an empty list if the number is invalid.
  Int ->
  -- | A list of typeclass instances for the 'FoldTuple' typeclass.
  [Dec]
foldTupleFor :: Int -> [Dec]
foldTupleFor Int
n = [Int -> Dec
foldTuple Int
n | 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 ::
  -- | The given length /n/ of the tuples to prepend an element.
  Int ->
  -- | A type instance declaration for an instance of the 'TupleAddL' typeclass for an /n/-tuple.
  Dec
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
n Int -> 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 ::
  -- | The given length /n/ of the tuples to append with an element.
  Int ->
  -- | A type instance declaration for an instance of the 'TupleAddR' typeclass for an /n/-tuple.
  Dec
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
n Int -> 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 a typeclass instance for 'FoldTuple' for a tuple with /n/ elements that is folded with an arbitrary "fold" function.
foldTuple ::
  -- | The given length /n/ of the tuples to fold.
  Int ->
  -- | A type instance declaration for an instance of the 'FoldTuple' typeclass for an /n/-tuple.
  Dec
foldTuple :: Int -> Dec
foldTuple Int
n = Type -> Type -> [Dec] -> Dec
_simpleInstanceFold Type
_varVV (Int -> [Name] -> Type
_tupleVar' Int
n (Name -> [Name]
forall a. a -> [a]
repeat Name
_nameVV)) [Int -> Name -> Dec
foldlClause Int
n 'foldlTuple, Int -> Name -> Dec
foldrClause Int
n 'foldrTuple, Int -> Name -> Dec
foldMapClause Int
n 'foldMapTuple]

-- | 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 ::
  -- | The given length /n/ of the tuples to prepend and append with an element.
  Int ->
  -- | A list of two type instance declarations that contains typeclass instances for 'TupleAddL' and 'TupleAddR'.
  [Dec]
tupleAdd :: Int -> [Dec]
tupleAdd Int
n
  | Int -> Bool
_tupleCheck Int
n Bool -> Bool -> Bool
&& Int -> Bool
_tupleCheck (Int
n Int -> 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 :: forall a b. 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 ::
  -- | A 'QuasiQuoter' that will construct typeclass instance declarations.
  QuasiQuoter
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+1/ instances for each tuple length.
defineTupleAppendUpto ::
  -- | A 'QuasiQuoter' that will construct typeclass instance declarations.
  QuasiQuoter
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 the 'SequenceTuple' typeclass for tuples up to a length /n/ where /n/ is read as text input for the quasi quoter. For a single /n/ it will thus construct /n/ instances in total.
defineSequenceTupleUpTo ::
  -- | A 'QuasiQuoter' that will construct typeclass instance declarations.
  QuasiQuoter
defineSequenceTupleUpTo :: QuasiQuoter
defineSequenceTupleUpTo = (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]
sequenceTupleFor (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
1 (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 the 'FoldTuple' typeclass for tuples up to a length /n/ where /n/ is read as text input for the quasi quoter. For a single /n/ it will thus construct /n+1/ instances in total.
defineFoldTupleUpTo ::
  -- | A 'QuasiQuoter' that will construct typeclass instance declarations.
  QuasiQuoter
defineFoldTupleUpTo :: QuasiQuoter
defineFoldTupleUpTo = (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]
foldTupleFor (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
1 (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 function declarations with the name @unboxedAppend_i_j@ with /i/ and /j/ the number of items of the unboxed tuples. The items sum up to at most /n/ where /n/ is read as text input for the quasi quoter. For a single /n/ it thus will construct /n+1/ instances for each tuple length.
defineUnboxedTupleAppendFunctionsUpto ::
  -- | A 'QuasiQuoter' that will construct function definitions.
  QuasiQuoter
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
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2, Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3 .. Int
2], Int
n <- [Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2, Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m Int -> 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))]