{-# LANGUAGE CPP #-}
module Composite.Aeson.Formats.InternalTH
  ( makeTupleDefaults, makeTupleFormats, makeNamedTupleFormats
  ) where

import Composite.Aeson.Base (JsonFormat(JsonFormat), JsonProfunctor(JsonProfunctor))
import Control.Monad.Except (throwError)
import qualified Data.Aeson as Aeson
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as Aeson.Key
import qualified Data.Aeson.KeyMap as Aeson.KeyMap
#else
import qualified Data.HashMap.Lazy as HM
#endif
import qualified Data.Aeson.BetterErrors as ABE
import Data.List (foldl')
import Data.Text (Text)
import qualified Data.Vector as V
import Language.Haskell.TH
  ( Name, mkName, newName, tupleDataName
  , Q
  , cxt, clause, normalB
  , Dec, funD, instanceD, sigD, valD
  , Exp(AppE, ConE, VarE), appE, doE, lamE, listE, varE
  , conP, varP, wildP
  , bindS, noBindS
  , Type(AppT, ArrowT, ConT, ForallT, TupleT, VarT), appT, conT, varT
  , TyVarBndr(PlainTV)
#if MIN_VERSION_template_haskell(2,17,0)
  , Specificity(SpecifiedSpec)
#endif
  )
import Language.Haskell.TH.Syntax (lift)

djfClassName :: Name
djfClassName :: Name
djfClassName = String -> Name
mkName String
"Composite.Aeson.Formats.Default.DefaultJsonFormat"

djfFunName :: Name
djfFunName :: Name
djfFunName = String -> Name
mkName String
"Composite.Aeson.Formats.Default.defaultJsonFormat"

-- |Splice which inserts the @DefaultJsonFormat@ instances for tuples.
makeTupleDefaults :: Q [Dec]
makeTupleDefaults :: Q [Dec]
makeTupleDefaults = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *}. Quote m => Int -> m Dec
makeTupleDefault [Int
2..Int
59]
  where
    makeTupleDefault :: Int -> m Dec
makeTupleDefault Int
arity = do
      [Name]
names <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). Quote m => String -> m Name
newName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"a" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
arity]
      let constraints :: [m Type]
constraints = forall a b. (a -> b) -> [a] -> [b]
map (\ Name
n -> forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (forall (m :: * -> *). Quote m => Name -> m Type
conT Name
djfClassName) (forall (m :: * -> *). Quote m => Name -> m Type
varT Name
n)) [Name]
names
          instanceHead :: m Type
instanceHead = forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (forall (m :: * -> *). Quote m => Name -> m Type
conT Name
djfClassName) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppT (Int -> Type
TupleT Int
arity) (forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT [Name]
names))
          implName :: Name
implName = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ String
"Composite.Aeson.Formats.Provided.tuple" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
arity forall a. Semigroup a => a -> a -> a
<> String
"JsonFormat"
      forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD (forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt [m Type]
constraints) m Type
instanceHead
        [ forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD (String -> Name
mkName String
"defaultJsonFormat")
          [ forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
              []
              (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ Exp
lhs Int
_ -> Exp -> Exp -> Exp
AppE Exp
lhs (Name -> Exp
VarE Name
djfFunName)) (Name -> Exp
VarE Name
implName) [Int
1..Int
arity]))
              []
          ]
        ]

-- |Splice which inserts the @tupleNJsonFormat@ implementations for tuples.
makeTupleFormats :: Q [Dec]
makeTupleFormats :: Q [Dec]
makeTupleFormats = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *}. Quote m => Int -> m [Dec]
makeTupleFormat [Int
2..Int
59]
  where
    makeTupleFormat :: Int -> m [Dec]
makeTupleFormat Int
arity = do
      [Name]
tyNames   <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). Quote m => String -> m Name
newName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"t" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
arity]
      [Name]
oNames    <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). Quote m => String -> m Name
newName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"o" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
arity]
      [Name]
iNames    <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). Quote m => String -> m Name
newName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"i" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
arity]
      Name
oTupName  <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"oTup"
      Name
iTupName  <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"iTup"
      [Name]
valNames  <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). Quote m => String -> m Name
newName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"v" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
arity]
      Name
tyErrName <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"e"

      let name :: Name
name = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ String
"tuple" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
arity forall a. Semigroup a => a -> a -> a
<> String
"JsonFormat"
          tupleType :: Type
tupleType = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppT (Int -> Type
TupleT Int
arity) (forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT [Name]
tyNames)
          funType :: Type
funType =
            [TyVarBndr Specificity] -> Cxt -> Type -> Type
ForallT
#if MIN_VERSION_template_haskell(2,17,0)
              (forall flag. Name -> flag -> TyVarBndr flag
PlainTV Name
tyErrName Specificity
SpecifiedSpec forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall flag. Name -> flag -> TyVarBndr flag
PlainTV Specificity
SpecifiedSpec) [Name]
tyNames)
#else
              (PlainTV tyErrName : map PlainTV tyNames)
#endif
              []
              (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ Type
tyName Type
rest -> Type
ArrowT Type -> Type -> Type
`AppT` (Name -> Type
ConT ''JsonFormat Type -> Type -> Type
`AppT` Name -> Type
VarT Name
tyErrName Type -> Type -> Type
`AppT` Type
tyName) Type -> Type -> Type
`AppT` Type
rest)
                     (Name -> Type
ConT ''JsonFormat Type -> Type -> Type
`AppT` Name -> Type
VarT Name
tyErrName Type -> Type -> Type
`AppT` Type
tupleType)
                     (forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT [Name]
tyNames))
          oTupImpl :: m Exp
oTupImpl =
            forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE
              [forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (Int -> Name
tupleDataName Int
arity) (forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). Quote m => Name -> m Pat
varP [Name]
valNames)]
              [| (Aeson.Array . V.fromList) $(listE $ map (\ (varName, oName) -> appE (varE oName) (varE varName)) (zip valNames oNames)) |]
          iTupImpl :: m Exp
iTupImpl =
            forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
doE
              forall a b. (a -> b) -> a -> b
$  [ forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Stmt
bindS forall (m :: * -> *). Quote m => m Pat
wildP [|
                     ABE.withArray Right >>= \ a ->
                       if V.length a == $(lift arity)
                         then pure ()
                         else throwError $ ABE.InvalidJSON $  $(lift $ "expected an array of exactly " <> show arity <> " elements")
                     |]
                 ]
              forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ( \ (Int
n, Name
valName, Name
iName) ->
                       forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Stmt
bindS (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
valName) [| ABE.nth $(lift (n :: Int)) $(varE iName) |] )
                     (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..] [Name]
valNames [Name]
iNames)
              forall a. [a] -> [a] -> [a]
++ [ forall (m :: * -> *). Quote m => m Exp -> m Stmt
noBindS (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (forall (m :: * -> *). Quote m => Name -> m Exp
varE 'pure) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Exp -> Exp -> Exp
AppE (Name -> Exp
ConE (Int -> Name
tupleDataName Int
arity)) (forall a b. (a -> b) -> [a] -> [b]
map Name -> Exp
VarE [Name]
valNames))) ]
      forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
name (forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
funType)
        , forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
name
          [ forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
              (forall a b. (a -> b) -> [a] -> [b]
map (\ (Name
oName, Name
iName) -> forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP 'JsonFormat [forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP 'JsonProfunctor [forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
oName, forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
iName]]) (forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
oNames [Name]
iNames))
              (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [| JsonFormat (JsonProfunctor $(varE oTupName) $(varE iTupName)) |])
              [ forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
oTupName) (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB m Exp
oTupImpl) []
              , forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
iTupName) (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB m Exp
iTupImpl) []
              ]
          ]
        ]

-- |Splice which inserts the @namedTupleNJsonFormat@ implementations for tuples.
makeNamedTupleFormats :: Q [Dec]
makeNamedTupleFormats :: Q [Dec]
makeNamedTupleFormats = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *}. Quote m => Int -> m [Dec]
makeNamedTupleFormat [Int
2..Int
59]
  where
    makeNamedTupleFormat :: Int -> m [Dec]
makeNamedTupleFormat Int
arity = do
      [Name]
tyNames   <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). Quote m => String -> m Name
newName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"t" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
arity]
      [Name]
fNames    <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). Quote m => String -> m Name
newName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"f" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
arity]
      [Name]
oNames    <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). Quote m => String -> m Name
newName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"o" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
arity]
      [Name]
iNames    <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). Quote m => String -> m Name
newName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"i" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
arity]
      Name
oTupName  <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"oTup"
      Name
iTupName  <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"iTup"
      [Name]
valNames  <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *). Quote m => String -> m Name
newName forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"v" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
arity]
      Name
tyErrName <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"e"

      let name :: Name
name = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ String
"namedTuple" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
arity forall a. Semigroup a => a -> a -> a
<> String
"JsonFormat"
          tupleType :: Type
tupleType = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppT (Int -> Type
TupleT Int
arity) (forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT [Name]
tyNames)
          funType :: Type
funType =
            [TyVarBndr Specificity] -> Cxt -> Type -> Type
ForallT
#if MIN_VERSION_template_haskell(2,17,0)
              (forall flag. Name -> flag -> TyVarBndr flag
PlainTV Name
tyErrName Specificity
SpecifiedSpec forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall flag. Name -> flag -> TyVarBndr flag
PlainTV Specificity
SpecifiedSpec) [Name]
tyNames)
#else
              (PlainTV tyErrName : map PlainTV tyNames)
#endif
              []
              (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ Type
tyName Type
rest -> Type
ArrowT Type -> Type -> Type
`AppT` Name -> Type
ConT ''Text Type -> Type -> Type
`AppT` (Type
ArrowT Type -> Type -> Type
`AppT` (Name -> Type
ConT ''JsonFormat Type -> Type -> Type
`AppT` Name -> Type
VarT Name
tyErrName Type -> Type -> Type
`AppT` Type
tyName) Type -> Type -> Type
`AppT` Type
rest))
                     (Name -> Type
ConT ''JsonFormat Type -> Type -> Type
`AppT` Name -> Type
VarT Name
tyErrName Type -> Type -> Type
`AppT` Type
tupleType)
                     (forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
VarT [Name]
tyNames))
          oTupImpl :: m Exp
oTupImpl =
            forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE
              [forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (Int -> Name
tupleDataName Int
arity) (forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *). Quote m => Name -> m Pat
varP [Name]
valNames)]
#if MIN_VERSION_aeson(2,0,0)
              [| (Aeson.Object . Aeson.KeyMap.fromList)
                 $(listE $ map (\ (fName, varName, oName) -> [| (Aeson.Key.fromText $(varE fName), $(varE oName) $(varE varName)) |])
#else
              [| (Aeson.Object . HM.fromList)
                 $(listE $ map (\ (fName, varName, oName) -> [| ($(varE fName), $(varE oName) $(varE varName)) |])
#endif
                               (zip3 fNames valNames oNames)) |]
          iTupImpl :: m Exp
iTupImpl =
            forall (m :: * -> *). Quote m => [m Stmt] -> m Exp
doE
              forall a b. (a -> b) -> a -> b
$  forall a b. (a -> b) -> [a] -> [b]
map ( \ (Name
fName, Name
valName, Name
iName) ->
                       forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Stmt
bindS (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
valName) [| ABE.key $(varE fName) $(varE iName) |] )
                     (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Name]
fNames [Name]
valNames [Name]
iNames)
              forall a. [a] -> [a] -> [a]
++ [ forall (m :: * -> *). Quote m => m Exp -> m Stmt
noBindS (forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (forall (m :: * -> *). Quote m => Name -> m Exp
varE 'pure) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Exp -> Exp -> Exp
AppE (Name -> Exp
ConE (Int -> Name
tupleDataName Int
arity)) (forall a b. (a -> b) -> [a] -> [b]
map Name -> Exp
VarE [Name]
valNames))) ]
      forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
name (forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
funType)
        , forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
name
          [ forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
              (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (Name
fName, Name
oName, Name
iName) [m Pat]
rest -> forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
fName forall a. a -> [a] -> [a]
: forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP 'JsonFormat [forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP 'JsonProfunctor [forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
oName, forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
iName]] forall a. a -> [a] -> [a]
: [m Pat]
rest)
                     []
                     (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Name]
fNames [Name]
oNames [Name]
iNames))
              (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [| JsonFormat (JsonProfunctor $(varE oTupName) $(varE iTupName)) |])
              [ forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
oTupName) (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB m Exp
oTupImpl) []
              , forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
iTupName) (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB m Exp
iTupImpl) []
              ]
          ]
        ]