{-# Language TemplateHaskellQuotes #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Data.SwizzleSet.Class.TH.Internal where

import GHC.Generics
import Language.Haskell.TH
import Data.Bool
import Data.Char

classSwizzle :: Int -> DecsQ
classSwizzle :: Int -> DecsQ
classSwizzle Int
i = [Q Dec] -> DecsQ
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Q Dec] -> DecsQ) -> [Q Dec] -> DecsQ
forall a b. (a -> b) -> a -> b
$ (([Q Dec] -> [Q Dec])
-> ([Q Dec] -> [Q Dec]) -> Bool -> [Q Dec] -> [Q Dec]
forall a. a -> a -> Bool -> a
bool [Q Dec] -> [Q Dec]
forall a. a -> a
id (Q Dec
instanceGswizzle1K1 Q Dec -> [Q Dec] -> [Q Dec]
forall a. a -> [a] -> [a]
:) (Bool -> [Q Dec] -> [Q Dec]) -> Bool -> [Q Dec] -> [Q Dec]
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) [
	Int -> Q Dec
classGswizzle Int
i,
	Int -> Q Dec
instanceGswizzleM1 Int
i,
	Int -> Q Dec
instanceGswizzleProd Int
i,
	Int -> Q Dec
instanceGswizzleProdProd Int
i,
	Int -> Q Dec
classSwizzleClass Int
i ]

instanceSwizzleTuple :: Int -> DecsQ
instanceSwizzleTuple :: Int -> DecsQ
instanceSwizzleTuple Int
n = [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
(++)
	([Dec] -> [Dec] -> [Dec]) -> DecsQ -> Q ([Dec] -> [Dec])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int -> Q Dec
`instanceSwizzleTuple_` Int
n) (Int -> Q Dec) -> [Int] -> DecsQ
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [Int
1 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
26]
	Q ([Dec] -> [Dec]) -> DecsQ -> DecsQ
forall a b. Q (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> DecsQ
deriveGeneric Int
n

classGswizzle :: Int -> Q Dec
classGswizzle :: Int -> Q Dec
classGswizzle Int
i = String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"a" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
a -> Q Cxt -> Name -> [TyVarBndr ()] -> [FunDep] -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> Name -> [TyVarBndr ()] -> [FunDep] -> [m Dec] -> m Dec
classD ([Q Pred] -> Q Cxt
forall (m :: * -> *). Quote m => [m Pred] -> m Cxt
cxt [])
	(Int -> Name
nameGswizzle Int
i) [Name -> TyVarBndr ()
plainTV (Name -> TyVarBndr ()) -> Name -> TyVarBndr ()
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"f"] [] [Int -> Q Dec
typeGx Int
i, Int -> Name -> Q Dec
sigGx Int
i Name
a]

typeGx :: Int -> Q Dec
typeGx :: Int -> Q Dec
typeGx Int
i = Name
-> [TyVarBndr ()]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> Q Dec
forall (m :: * -> *).
Quote m =>
Name
-> [TyVarBndr ()]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> m Dec
openTypeFamilyD (Int -> Name
nameGxU Int
i) [Name -> TyVarBndr ()
plainTV (Name -> TyVarBndr ()) -> Name -> TyVarBndr ()
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"f"] FamilyResultSig
noSig Maybe InjectivityAnn
forall a. Maybe a
Nothing

sigGx :: Int -> Name -> Q Dec
sigGx :: Int -> Name -> Q Dec
sigGx Int
i Name
a = Name -> Q Pred -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Pred -> m Dec
sigD (Int -> Name
nameGxL Int
i) (Q Pred -> Q Dec) -> Q Pred -> Q Dec
forall a b. (a -> b) -> a -> b
$
	(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGxU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT (String -> Name
mkName String
"f"))
	Q Pred -> Q Pred -> Q Pred
`arrT`
	(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT (String -> Name
mkName String
"f") Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a)
	Q Pred -> Q Pred -> Q Pred
`arrT`
	(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT (String -> Name
mkName String
"f") Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a)

infixr 7 `arrT`

instanceGswizzle1K1 :: Q Dec
instanceGswizzle1K1 :: Q Dec
instanceGswizzle1K1 = String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"a" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
a ->
	Q Cxt -> Q Pred -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Pred -> [m Dec] -> m Dec
instanceD ([Q Pred] -> Q Cxt
forall (m :: * -> *). Quote m => [m Pred] -> m Cxt
cxt []) (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (String -> Name
mkName String
"GSwizzleSet1") Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
k1ia Name
a) [
		Name -> Q Dec
typeGxK1 Name
a,
		Name -> Q Dec
funGxK1 Name
a ]

k1ia :: Name -> TypeQ
k1ia :: Name -> Q Pred
k1ia Name
a = Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT ''K1 Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT (String -> Name
mkName String
"i") Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a

typeGxK1 :: Name -> Q Dec
typeGxK1 :: Name -> Q Dec
typeGxK1 Name
a = Q TySynEqn -> Q Dec
forall (m :: * -> *). Quote m => m TySynEqn -> m Dec
tySynInstD
	(Q TySynEqn -> Q Dec) -> Q TySynEqn -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe [TyVarBndr ()] -> Q Pred -> Q Pred -> Q TySynEqn
forall (m :: * -> *).
Quote m =>
Maybe [TyVarBndr ()] -> m Pred -> m Pred -> m TySynEqn
tySynEqn Maybe [TyVarBndr ()]
forall a. Maybe a
Nothing (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (String -> Name
mkName String
"GX") Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
k1ia Name
a) (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a)

funGxK1 :: Name -> Q Dec
funGxK1 :: Name -> Q Dec
funGxK1 Name
a = Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD (String -> Name
mkName String
"gx") [
	[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
a, Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP 'K1 [Q Pat
forall (m :: * -> *). Quote m => m Pat
wildP]] (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
forall a b. (a -> b) -> a -> b
$ Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE 'K1 Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
a) [] ]

instanceGswizzleM1 :: Int -> Q Dec
instanceGswizzleM1 :: Int -> Q Dec
instanceGswizzleM1 Int
i = String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"v" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
v ->
	String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"a" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
a -> String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"c" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
c ->
	Q Cxt -> Q Pred -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Pred -> [m Dec] -> m Dec
instanceD (Int -> Name -> Q Cxt
cxtGswizzleM1 Int
i Name
a) (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGswizzle Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Name -> Q Pred
m1ica Name
a Name
c) [
		Int -> Name -> Name -> Q Dec
typeGxM1 Int
i Name
a Name
c,
		Int -> Name -> Name -> Q Dec
funGxM1 Int
i Name
a Name
v
		]

cxtGswizzleM1 :: Int -> Name -> CxtQ
cxtGswizzleM1 :: Int -> Name -> Q Cxt
cxtGswizzleM1 Int
i Name
a = [Q Pred] -> Q Cxt
forall (m :: * -> *). Quote m => [m Pred] -> m Cxt
cxt [Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGswizzle Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a]

m1ica :: Name -> Name -> TypeQ
m1ica :: Name -> Name -> Q Pred
m1ica Name
a Name
c = Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT ''M1 Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT`
	Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT (String -> Name
mkName String
"i") Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
c Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a

typeGxM1 :: Int -> Name -> Name -> Q Dec
typeGxM1 :: Int -> Name -> Name -> Q Dec
typeGxM1 Int
i Name
a Name
c = Q TySynEqn -> Q Dec
forall (m :: * -> *). Quote m => m TySynEqn -> m Dec
tySynInstD (Q TySynEqn -> Q Dec) -> Q TySynEqn -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe [TyVarBndr ()] -> Q Pred -> Q Pred -> Q TySynEqn
forall (m :: * -> *).
Quote m =>
Maybe [TyVarBndr ()] -> m Pred -> m Pred -> m TySynEqn
tySynEqn Maybe [TyVarBndr ()]
forall a. Maybe a
Nothing
	(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGxU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Name -> Q Pred
m1ica Name
a Name
c)
	(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGxU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a)

funGxM1 :: Int -> Name -> Name -> Q Dec
funGxM1 :: Int -> Name -> Name -> Q Dec
funGxM1 Int
i Name
a Name
v = Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD (Int -> Name
nameGxL Int
i) [[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
	[Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
v, Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP 'M1 [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
a]]
	(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
forall a b. (a -> b) -> a -> b
$ Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE 'M1 Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE`
		(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Int -> Name
nameGxL Int
i) Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
v Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
a)) []]

instanceGswizzleProd :: Int -> Q Dec
instanceGswizzleProd :: Int -> Q Dec
instanceGswizzleProd Int
i = String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"v" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
v ->
	String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"a" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
a -> String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"b" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
b -> String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"c" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
c ->
	Q Cxt -> Q Pred -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Pred -> [m Dec] -> m Dec
instanceD (Int -> Name -> Name -> Q Cxt
cxtGswizzleProd Int
i Name
a Name
b) (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGswizzle Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Name -> Name -> Q Pred
aProdB Name
a Name
b Name
c) [
		Int -> Name -> Name -> Name -> Q Dec
typeGxProd Int
i Name
a Name
b Name
c,
		Int -> Name -> Name -> Name -> Q Dec
funGxProd Int
i Name
v Name
a Name
b
		]

funGxProd :: Int -> Name -> Name -> Name -> Q Dec
funGxProd :: Int -> Name -> Name -> Name -> Q Dec
funGxProd Int
i Name
v Name
a Name
b = Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD (Int -> Name
nameGxL Int
i) [
	[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
v, Q Pat -> Name -> Q Pat -> Q Pat
forall (m :: * -> *). Quote m => m Pat -> Name -> m Pat -> m Pat
infixP (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
a) '(:*:) (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
b)] (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
		(Q Exp -> Q Body) -> (Q Exp -> Q Exp) -> Q Exp -> Q Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Q Exp -> Q Exp -> Q Exp
prodPostOrPre Int
i (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ Int -> Name -> Name -> Name
nameBOrA Int
i Name
a Name
b)
		(Q Exp -> Q Body) -> Q Exp -> Q Body
forall a b. (a -> b) -> a -> b
$ Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Int -> Name
nameGxxyL Int
i) Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
v Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Int -> Name -> Name -> Name
nameAOrB Int
i Name
a Name
b)) [] ]

prodPostOrPre :: Int -> ExpQ -> ExpQ -> ExpQ
prodPostOrPre :: Int -> Q Exp -> Q Exp -> Q Exp
prodPostOrPre Int
1 Q Exp
e Q Exp
b = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just Q Exp
b) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE '(:*:)) (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just Q Exp
e)
prodPostOrPre Int
_ Q Exp
e Q Exp
b = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just Q Exp
e) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE '(:*:)) (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just Q Exp
b)

cxtGswizzleProd :: Int -> Name -> Name -> CxtQ
cxtGswizzleProd :: Int -> Name -> Name -> Q Cxt
cxtGswizzleProd Int
i Name
a Name
b = case Int
i of
	Int
1 -> [Q Pred] -> Q Cxt
forall (m :: * -> *). Quote m => [m Pred] -> m Cxt
cxt [Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGswizzle Int
1) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a]
	Int
_ -> [Q Pred] -> Q Cxt
forall (m :: * -> *). Quote m => [m Pred] -> m Cxt
cxt [Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGswizzle (Int -> Name) -> Int -> Name
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
b]

instanceGswizzleProdProd :: Int -> Q Dec
instanceGswizzleProdProd :: Int -> Q Dec
instanceGswizzleProdProd Int
i = String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"v" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
v ->
	String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"a" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
a -> String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"b" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
b -> String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"c" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
c ->
	Q Cxt -> Q Pred -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Pred -> [m Dec] -> m Dec
instanceD (Int -> Name -> Name -> Name -> Q Cxt
cxtGswizzleProdProd Int
i Name
a Name
b Name
c) (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGswizzle Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Name -> Name -> Q Pred
aProdBProdCT' Name
a Name
b Name
c) [
		Int -> Name -> Name -> Name -> Q Dec
typeGxProdProd Int
i Name
a Name
b Name
c,
		Int -> Name -> Name -> Name -> Name -> Q Dec
funGxProdProd Int
i Name
v Name
a Name
b Name
c
		]

cxtGswizzleProdProd :: Int -> Name -> Name -> Name -> CxtQ
cxtGswizzleProdProd :: Int -> Name -> Name -> Name -> Q Cxt
cxtGswizzleProdProd Int
i Name
a Name
b Name
c = [Q Pred] -> Q Cxt
forall (m :: * -> *). Quote m => [m Pred] -> m Cxt
cxt [Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGswizzle Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Name -> Name -> Q Pred
aProdBProdCT Name
a Name
b Name
c]

typeGxProdProd :: Int -> Name -> Name -> Name -> Q Dec
typeGxProdProd :: Int -> Name -> Name -> Name -> Q Dec
typeGxProdProd Int
i Name
a Name
b Name
c = Q TySynEqn -> Q Dec
forall (m :: * -> *). Quote m => m TySynEqn -> m Dec
tySynInstD (Q TySynEqn -> Q Dec) -> Q TySynEqn -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe [TyVarBndr ()] -> Q Pred -> Q Pred -> Q TySynEqn
forall (m :: * -> *).
Quote m =>
Maybe [TyVarBndr ()] -> m Pred -> m Pred -> m TySynEqn
tySynEqn Maybe [TyVarBndr ()]
forall a. Maybe a
Nothing
	(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGxU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Name -> Name -> Q Pred
aProdBProdCT' Name
a Name
b Name
c)
	(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGxU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Name -> Name -> Q Pred
aProdBProdCT Name
a Name
b Name
c)

funGxProdProd :: Int -> Name -> Name -> Name -> Name -> Q Dec
funGxProdProd :: Int -> Name -> Name -> Name -> Name -> Q Dec
funGxProdProd Int
i Name
v Name
a Name
b Name
c = Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD (Int -> Name
nameGxL Int
i) [[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
	[Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
v, Name -> Name -> Name -> Q Pat
aProdBProdCP' Name
a Name
b Name
c]
	(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
forall a b. (a -> b) -> a -> b
$ Int -> Name -> Name -> Name -> Name -> Q Exp
letProdProd Int
i Name
v Name
a Name
b Name
c) []]
--	(normalB $ varE (nameGxL i) `appE` varE v `appE` aProdBProdCE b c) []]

letProdProd :: Int -> Name -> Name -> Name -> Name -> ExpQ
letProdProd :: Int -> Name -> Name -> Name -> Name -> Q Exp
letProdProd Int
i Name
v Name
a Name
b Name
c = String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"x" Q Name -> (Name -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
x -> String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"y" Q Name -> (Name -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
y -> String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"z" Q Name -> (Name -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
z ->
	[Q Dec] -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => [m Dec] -> m Exp -> m Exp
letE [Q Pat -> Q Body -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (Name -> Name -> Name -> Q Pat
aProdBProdCP Name
x Name
y Name
z) (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
forall a b. (a -> b) -> a -> b
$ Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Int -> Name
nameGxL Int
i) Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
v Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> Name -> Name -> Q Exp
aProdBProdCE Name
a Name
b Name
c) []]
		(Name -> Name -> Name -> Q Exp
aProdBProdCE2 Name
x Name
y Name
z)

aProdBProdCT, aProdBProdCT' :: Name -> Name -> Name -> TypeQ
aProdBProdCT :: Name -> Name -> Name -> Q Pred
aProdBProdCT Name
a Name
b Name
c = Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a Q Pred -> Q Pred -> Q Pred
`prodT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
b Q Pred -> Q Pred -> Q Pred
`prodT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
c
aProdBProdCT' :: Name -> Name -> Name -> Q Pred
aProdBProdCT' Name
a Name
b Name
c = (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a Q Pred -> Q Pred -> Q Pred
`prodT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
b) Q Pred -> Q Pred -> Q Pred
`prodT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
c

aProdBProdCE2 :: Name -> Name -> Name -> ExpQ
aProdBProdCE2 :: Name -> Name -> Name -> Q Exp
aProdBProdCE2 Name
a Name
b Name
c = (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
a Q Exp -> Q Exp -> Q Exp
`prodE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
b) Q Exp -> Q Exp -> Q Exp
`prodE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
c

aProdBProdCE :: Name -> Name -> Name -> ExpQ
aProdBProdCE :: Name -> Name -> Name -> Q Exp
aProdBProdCE Name
a Name
b Name
c = Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
a Q Exp -> Q Exp -> Q Exp
`prodE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
b Q Exp -> Q Exp -> Q Exp
`prodE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
c

aProdBProdCP :: Name -> Name -> Name -> PatQ
aProdBProdCP :: Name -> Name -> Name -> Q Pat
aProdBProdCP Name
a Name
b Name
c = Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
a Q Pat -> Q Pat -> Q Pat
`prodP` (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
b Q Pat -> Q Pat -> Q Pat
`prodP` Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
c)

aProdBProdCP' :: Name -> Name -> Name -> PatQ
aProdBProdCP' :: Name -> Name -> Name -> Q Pat
aProdBProdCP' Name
a Name
b Name
c = (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
a Q Pat -> Q Pat -> Q Pat
`prodP` Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
b) Q Pat -> Q Pat -> Q Pat
`prodP` Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
c

aProdB :: Name -> Name -> Name -> TypeQ
aProdB :: Name -> Name -> Name -> Q Pred
aProdB Name
a Name
b Name
c =
	(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT ''M1 Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT (String -> Name
mkName String
"i") Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
c Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a) Q Pred -> Q Pred -> Q Pred
`prodT`
	Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
b

infixr 9 `prodT`, `prodE`, `prodP`

prodT :: TypeQ -> TypeQ -> TypeQ
Q Pred
t1 prodT :: Q Pred -> Q Pred -> Q Pred
`prodT` Q Pred
t2 = Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT ''(:*:) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Q Pred
t1 Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Q Pred
t2

prodE :: ExpQ -> ExpQ -> ExpQ
Q Exp
e1 prodE :: Q Exp -> Q Exp -> Q Exp
`prodE` Q Exp
e2 = Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE '(:*:) Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Q Exp
e1 Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Q Exp
e2

prodP :: PatQ -> PatQ -> PatQ
Q Pat
p1 prodP :: Q Pat -> Q Pat -> Q Pat
`prodP` Q Pat
p2 = Q Pat -> Name -> Q Pat -> Q Pat
forall (m :: * -> *). Quote m => m Pat -> Name -> m Pat -> m Pat
infixP Q Pat
p1 '(:*:) Q Pat
p2

typeGxProd :: Int -> Name -> Name -> Name -> Q Dec
typeGxProd :: Int -> Name -> Name -> Name -> Q Dec
typeGxProd Int
i Name
a Name
b Name
c = Q TySynEqn -> Q Dec
forall (m :: * -> *). Quote m => m TySynEqn -> m Dec
tySynInstD
	(Q TySynEqn -> Q Dec) -> Q TySynEqn -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe [TyVarBndr ()] -> Q Pred -> Q Pred -> Q TySynEqn
forall (m :: * -> *).
Quote m =>
Maybe [TyVarBndr ()] -> m Pred -> m Pred -> m TySynEqn
tySynEqn Maybe [TyVarBndr ()]
forall a. Maybe a
Nothing (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGxU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Name -> Name -> Q Pred
aProdB Name
a Name
b Name
c) (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGxxyU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT (Int -> Name -> Name -> Name
nameAOrB Int
i Name
a Name
b))

arrT :: TypeQ -> TypeQ -> TypeQ
Q Pred
t1 arrT :: Q Pred -> Q Pred -> Q Pred
`arrT` Q Pred
t2 = Q Pred
forall (m :: * -> *). Quote m => m Pred
arrowT Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Q Pred
t1 Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Q Pred
t2

nameGswizzle :: Int -> Name
nameGswizzle :: Int -> Name
nameGswizzle = String -> Name
mkName (String -> Name) -> (Int -> String) -> Int -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"GSwizzleSet" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (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

nameGxU :: Int -> Name
nameGxU :: Int -> Name
nameGxU Int
i = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"G" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char -> Char
toUpper (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
alphabet Int
i]

nameGxL :: Int -> Name
nameGxL :: Int -> Name
nameGxL Int
i = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"g" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int -> Char
alphabet Int
i]

nameGxxyU :: Int -> Name
nameGxxyU :: Int -> Name
nameGxxyU = \case Int
1 -> Int -> Name
nameGxU Int
1; Int
i -> Int -> Name
nameGxU (Int -> Name) -> Int -> Name
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

nameAOrB :: Int -> Name -> Name -> Name
nameAOrB :: Int -> Name -> Name -> Name
nameAOrB Int
i Name
a Name
b = case Int
i of Int
1 -> Name
a; Int
_ -> Name
b

nameBOrA :: Int -> Name -> Name -> Name
nameBOrA :: Int -> Name -> Name -> Name
nameBOrA Int
i Name
a Name
b = case Int
i of Int
1 -> Name
b; Int
_ -> Name
a

aOrWildP :: Int -> Name -> PatQ
aOrWildP :: Int -> Name -> Q Pat
aOrWildP Int
i Name
a = case Int
i of Int
1 -> Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
a; Int
_ -> Q Pat
forall (m :: * -> *). Quote m => m Pat
wildP

bOrWildP :: Int -> Name -> PatQ
bOrWildP :: Int -> Name -> Q Pat
bOrWildP Int
i Name
b = case Int
i of Int
1 -> Q Pat
forall (m :: * -> *). Quote m => m Pat
wildP; Int
_ -> Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
b

nameGxxyL :: Int -> Name
nameGxxyL :: Int -> Name
nameGxxyL = \case Int
1 -> Int -> Name
nameGxL Int
1; Int
i -> Int -> Name
nameGxL (Int -> Name) -> Int -> Name
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

alphabet :: Int -> Char
alphabet :: Int -> Char
alphabet Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
26 = String -> Char
forall a. HasCallStack => String -> a
error (String -> Char) -> String -> Char
forall a b. (a -> b) -> a -> b
$ String
"no such alphabet: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
alphabet Int
i = ((String
"xyz" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. [a] -> [a]
reverse [Char
'a' .. Char
'w']) String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!!) (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 Int
i

classSwizzleClass :: Int -> Q Dec
classSwizzleClass :: Int -> Q Dec
classSwizzleClass Int
i = String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"v" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
v -> String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"a" Q Name -> (Name -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
a ->
	Q Cxt -> Name -> [TyVarBndr ()] -> [FunDep] -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> Name -> [TyVarBndr ()] -> [FunDep] -> [m Dec] -> m Dec
classD (Int -> Name -> Q Cxt
classSwizzleContext Int
i Name
a) (Int -> Name
nameSwizzle Int
i) [Name -> TyVarBndr ()
plainTV Name
a] [] [
		Int -> Name -> Q Dec
typeX Int
i Name
a,
		Int -> Name -> Q Dec
sigX Int
i Name
a,
		Int -> Name -> Q Dec
defaultX Int
i Name
a,
		Int -> Name -> Q Dec
defaultFunX Int
i Name
v ]

classSwizzleContext :: Int -> Name -> CxtQ
classSwizzleContext :: Int -> Name -> Q Cxt
classSwizzleContext Int
i Name
a = case Int
i of
	Int
1 -> [Q Pred] -> Q Cxt
forall (m :: * -> *). Quote m => [m Pred] -> m Cxt
cxt []
	Int
_ -> [Q Pred] -> Q Cxt
forall (m :: * -> *). Quote m => [m Pred] -> m Cxt
cxt [Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameSwizzle (Int -> Name) -> Int -> Name
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a]

nameSwizzle :: Int -> Name
nameSwizzle :: Int -> Name
nameSwizzle = String -> Name
mkName (String -> Name) -> (Int -> String) -> Int -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"SwizzleSet" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (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

typeX :: Int -> Name -> Q Dec
typeX :: Int -> Name -> Q Dec
typeX Int
i Name
a = Name
-> [TyVarBndr ()]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> Q Dec
forall (m :: * -> *).
Quote m =>
Name
-> [TyVarBndr ()]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> m Dec
openTypeFamilyD (Int -> Name
nameXU Int
i) [Name -> TyVarBndr ()
plainTV Name
a] FamilyResultSig
noSig Maybe InjectivityAnn
forall a. Maybe a
Nothing

nameXU :: Int -> Name
nameXU :: Int -> Name
nameXU = String -> Name
mkName (String -> Name) -> (Int -> String) -> Int -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
: String
"") (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper (Char -> Char) -> (Int -> Char) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
alphabet

sigX :: Int -> Name -> Q Dec
sigX :: Int -> Name -> Q Dec
sigX Int
i Name
a = Name -> Q Pred -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Pred -> m Dec
sigD (Int -> Name
nameXL Int
i) (Q Pred -> Q Dec) -> Q Pred -> Q Dec
forall a b. (a -> b) -> a -> b
$
	(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameXU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a)
	Q Pred -> Q Pred -> Q Pred
`arrT`
	Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a
	Q Pred -> Q Pred -> Q Pred
`arrT`
	Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a

nameXL :: Int -> Name
nameXL :: Int -> Name
nameXL = String -> Name
mkName (String -> Name) -> (Int -> String) -> Int -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
: String
"") (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
alphabet

defaultX :: Int -> Name -> Q Dec
defaultX :: Int -> Name -> Q Dec
defaultX Int
i Name
a = Name -> Q Pred -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Pred -> m Dec
defaultSigD (Int -> Name
nameXL Int
i) (Q Pred -> Q Dec) -> (Q Pred -> Q Pred) -> Q Pred -> Q Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TyVarBndr Specificity] -> Q Cxt -> Q Pred -> Q Pred
forall (m :: * -> *).
Quote m =>
[TyVarBndr Specificity] -> m Cxt -> m Pred -> m Pred
forallT [] (Int -> Name -> Q Cxt
defaultXContext Int
i Name
a) (Q Pred -> Q Dec) -> Q Pred -> Q Dec
forall a b. (a -> b) -> a -> b
$
	((Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameXU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a)
	Q Pred -> Q Pred -> Q Pred
`arrT`
	Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a
	Q Pred -> Q Pred -> Q Pred
`arrT`
	Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a
	)

defaultXContext :: Int -> Name -> CxtQ
defaultXContext :: Int -> Name -> Q Cxt
defaultXContext Int
i Name
a = [Q Pred] -> Q Cxt
forall (m :: * -> *). Quote m => [m Pred] -> m Cxt
cxt [
	Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT ''Generic Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a,
	Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGswizzle Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT ''Rep Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a),
	(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameXU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a) Q Pred -> Q Pred -> Q Pred
`eqT`
		(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameGxU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT ''Rep Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT Name
a))
	]

defaultFunX :: Int -> Name -> Q Dec
defaultFunX :: Int -> Name -> Q Dec
defaultFunX Int
i Name
v = Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD (Int -> Name
nameXL Int
i) [[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
v]
	(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
forall a b. (a -> b) -> a -> b
$ Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'to Q Exp -> Q Exp -> Q Exp
`comE` (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Int -> Name
nameGxL Int
i) Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
v) Q Exp -> Q Exp -> Q Exp
`comE` Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'from) []]
--	[]
--	$ infixE (Just . varE $ nameGxL i) (varE '(.)) (Just $ varE 'from)) []

eqT :: TypeQ -> TypeQ -> TypeQ
Q Pred
t1 eqT :: Q Pred -> Q Pred -> Q Pred
`eqT` Q Pred
t2 = Q Pred
forall (m :: * -> *). Quote m => m Pred
equalityT Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Q Pred
t1 Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Q Pred
t2

infixr 7 `comE`

comE :: ExpQ -> ExpQ -> ExpQ
Q Exp
e1 comE :: Q Exp -> Q Exp -> Q Exp
`comE` Q Exp
e2 = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just Q Exp
e1) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(.)) (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just Q Exp
e2)

instanceSwizzleTuple_ :: Int -> Int -> Q Dec
instanceSwizzleTuple_ :: Int -> Int -> Q Dec
instanceSwizzleTuple_ Int
i Int
n = (Int -> Q Name) -> [Int] -> Q [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName (String -> Q Name) -> (Int -> String) -> Int -> Q Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String]
vars [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!!)) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] Q [Name] -> ([Name] -> Q Dec) -> Q Dec
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Name]
ns ->
	Q Cxt -> Q Pred -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Pred -> [m Dec] -> m Dec
instanceD ([Q Pred] -> Q Cxt
forall (m :: * -> *). Quote m => [m Pred] -> m Cxt
cxt []) (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameSwizzle Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` [Name] -> Q Pred
tupT [Name]
ns) [Int -> [Name] -> Q Dec
typeXFromTuple Int
i [Name]
ns]

vars :: [String]
vars :: [String]
vars = ((Char -> String -> String
forall a. a -> [a] -> [a]
: String
"") (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'a' .. Char
'z']) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c] | String
cs <- [String]
vars, Char
c <- [Char
'a' .. Char
'z'] ]

typeXFromTuple :: Int -> [Name] -> Q Dec
typeXFromTuple :: Int -> [Name] -> Q Dec
typeXFromTuple Int
i [Name]
ns = Q TySynEqn -> Q Dec
forall (m :: * -> *). Quote m => m TySynEqn -> m Dec
tySynInstD (Q TySynEqn -> Q Dec) -> Q TySynEqn -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe [TyVarBndr ()] -> Q Pred -> Q Pred -> Q TySynEqn
forall (m :: * -> *).
Quote m =>
Maybe [TyVarBndr ()] -> m Pred -> m Pred -> m TySynEqn
tySynEqn Maybe [TyVarBndr ()]
forall a. Maybe a
Nothing (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT (Int -> Name
nameXU Int
i) Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` [Name] -> Q Pred
tupT [Name]
ns) (Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT (Name -> Q Pred) -> Name -> Q Pred
forall a b. (a -> b) -> a -> b
$ [Name]
ns [Name] -> Int -> Name
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

tupT :: [Name] -> TypeQ
tupT :: [Name] -> Q Pred
tupT [Name]
ns = (Q Pred -> Q Pred -> Q Pred) -> Q Pred -> [Q Pred] -> Q Pred
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
appT (Int -> Q Pred
forall (m :: * -> *). Quote m => Int -> m Pred
tupleT (Int -> Q Pred) -> Int -> Q Pred
forall a b. (a -> b) -> a -> b
$ [Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
ns) ([Q Pred] -> Q Pred) -> [Q Pred] -> Q Pred
forall a b. (a -> b) -> a -> b
$ Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
varT (Name -> Q Pred) -> [Name] -> [Q Pred]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
ns

deriveGeneric :: Int -> DecsQ
deriveGeneric :: Int -> DecsQ
deriveGeneric Int
i = do
	Pred
t <- [Name] -> Q Pred
tupT ([Name] -> Q Pred) -> Q [Name] -> Q Pred
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Q [Name]
newNameAbc Int
i
	Name -> Cxt -> Q Bool
isInstance ''Generic [Pred
t] Q Bool -> (Bool -> DecsQ) -> DecsQ
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecsQ -> DecsQ -> Bool -> DecsQ
forall a. a -> a -> Bool -> a
bool
		((Dec -> [Dec] -> [Dec]
forall a. a -> [a] -> [a]
: []) (Dec -> [Dec]) -> Q Dec -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt -> Q Pred -> Q Dec
forall (m :: * -> *). Quote m => m Cxt -> m Pred -> m Dec
standaloneDerivD ([Q Pred] -> Q Cxt
forall (m :: * -> *). Quote m => [m Pred] -> m Cxt
cxt [])
			(Name -> Q Pred
forall (m :: * -> *). Quote m => Name -> m Pred
conT ''Generic Q Pred -> Q Pred -> Q Pred
forall (m :: * -> *). Quote m => m Pred -> m Pred -> m Pred
`appT` Pred -> Q Pred
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pred
t))
		([Dec] -> DecsQ
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])

newNameAbc :: Int -> Q [Name]
newNameAbc :: Int -> Q [Name]
newNameAbc Int
i = String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName (String -> Q Name) -> [String] -> Q [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
i [String]
vars