{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
module Data.GADT.Compare.TH
    ( DeriveGEQ(..)
    , DeriveGCompare(..)
    , module Data.GADT.Compare.Monad
    ) where

import Control.Monad
import Control.Monad.Writer
import Data.GADT.TH.Internal
import Data.Functor.Identity
import Data.GADT.Compare
import Data.GADT.Compare.Monad
import Data.Type.Equality ((:~:) (..))
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Map as Map
import qualified Data.Map.Merge.Lazy as Map
import Data.Map (Map)
import Language.Haskell.TH
import Language.Haskell.TH.Datatype

-- A type class purely for overloading purposes
class DeriveGEQ t where
    deriveGEq :: t -> Q [Dec]

instance DeriveGEQ Name where
  deriveGEq :: Name -> Q [Dec]
deriveGEq Name
typeName = do
    typeInfo <- Name -> Q DatatypeInfo
reifyDatatype Name
typeName
    let instTypes = DatatypeInfo -> Cxt
datatypeInstTypes DatatypeInfo
typeInfo
        paramVars = [Set Name] -> Set Name
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Type -> Set Name
freeTypeVariables Type
t | Type
t <- Cxt
instTypes]
        instTypes' = case Cxt -> Cxt
forall a. [a] -> [a]
reverse Cxt
instTypes of
          [] -> String -> Cxt
forall a. String -> [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"deriveGEq: Not enough type parameters"
          (Type
_:Cxt
xs) -> Cxt -> Cxt
forall a. [a] -> [a]
reverse Cxt
xs
        instanceHead = Type -> Type -> Type
AppT (Name -> Type
ConT ''GEq) ((Type -> Type -> Type) -> Type -> Cxt -> Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT Name
typeName) Cxt
instTypes')
    (clauses, cxt) <- runWriterT (mapM (geqClause paramVars) (datatypeCons typeInfo))

    return [InstanceD Nothing cxt instanceHead [geqFunction clauses]]

instance DeriveGEQ Dec where
    deriveGEq :: Dec -> Q [Dec]
deriveGEq = Name -> (DatatypeInfo -> WriterT Cxt Q Dec) -> Dec -> Q [Dec]
deriveForDec ''GEq ((DatatypeInfo -> WriterT Cxt Q Dec) -> Dec -> Q [Dec])
-> (DatatypeInfo -> WriterT Cxt Q Dec) -> Dec -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ \DatatypeInfo
typeInfo -> do
      let
        instTypes :: Cxt
instTypes = DatatypeInfo -> Cxt
datatypeInstTypes DatatypeInfo
typeInfo
        paramVars :: Set Name
paramVars = [Set Name] -> Set Name
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Type -> Set Name
freeTypeVariables Type
t | Type
t <- Cxt
instTypes]
      clauses <- (ConstructorInfo -> WriterT Cxt Q Clause)
-> [ConstructorInfo] -> WriterT Cxt Q [Clause]
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 (Set Name -> ConstructorInfo -> WriterT Cxt Q Clause
geqClause Set Name
paramVars) (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
typeInfo)
      return $ geqFunction clauses

instance DeriveGEQ t => DeriveGEQ [t] where
  deriveGEq :: [t] -> Q [Dec]
deriveGEq [t
it] = t -> Q [Dec]
forall t. DeriveGEQ t => t -> Q [Dec]
deriveGEq t
it
  deriveGEq [t]
_ = String -> Q [Dec]
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"deriveGEq: [] instance only applies to single-element lists"

instance DeriveGEQ t => DeriveGEQ (Q t) where
  deriveGEq :: Q t -> Q [Dec]
deriveGEq = (Q t -> (t -> 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
>>= t -> Q [Dec]
forall t. DeriveGEQ t => t -> Q [Dec]
deriveGEq)

geqFunction :: [Clause] -> Dec
geqFunction :: [Clause] -> Dec
geqFunction [Clause]
clauses = Name -> [Clause] -> Dec
FunD 'geq ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ [Clause]
clauses [Clause] -> [Clause] -> [Clause]
forall a. [a] -> [a] -> [a]
++ [ [Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP, Pat
WildP] (Exp -> Body
NormalB (Name -> Exp
ConE 'Nothing)) [] ]
 -- TODO: only include last clause if there's more than one constructor?

geqClause :: Set Name -> ConstructorInfo -> WriterT Cxt Q Clause
geqClause :: Set Name -> ConstructorInfo -> WriterT Cxt Q Clause
geqClause Set Name
paramVars ConstructorInfo
con = do
  let conName :: Name
conName = ConstructorInfo -> Name
constructorName ConstructorInfo
con
      argTypes :: Cxt
argTypes = ConstructorInfo -> Cxt
constructorFields ConstructorInfo
con
      conTyVars :: Set Name
conTyVars = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList ((TyVarBndr_ () -> Name) -> [TyVarBndr_ ()] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr_ () -> Name
forall flag. TyVarBndr_ flag -> Name
tvName (ConstructorInfo -> [TyVarBndr_ ()]
constructorVars ConstructorInfo
con))
      needsGEq :: Type -> Bool
needsGEq Type
argType = Bool -> Bool
not (Bool -> Bool) -> (Set Name -> Bool) -> Set Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Name -> Bool
forall a. Set a -> Bool
Set.null (Set Name -> Bool) -> Set Name -> Bool
forall a b. (a -> b) -> a -> b
$
        Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (Type -> Set Name
freeTypeVariables Type
argType) (Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Name
paramVars Set Name
conTyVars)
  lArgNames <- Cxt -> (Type -> WriterT Cxt Q Name) -> WriterT Cxt Q [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Cxt
argTypes ((Type -> WriterT Cxt Q Name) -> WriterT Cxt Q [Name])
-> (Type -> WriterT Cxt Q Name) -> WriterT Cxt Q [Name]
forall a b. (a -> b) -> a -> b
$ \Type
_ -> Q Name -> WriterT Cxt Q Name
forall (m :: * -> *) a. Monad m => m a -> WriterT Cxt m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Name -> WriterT Cxt Q Name) -> Q Name -> WriterT Cxt Q Name
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"x"
  rArgNames <- forM argTypes $ \Type
_ -> Q Name -> WriterT Cxt Q Name
forall (m :: * -> *) a. Monad m => m a -> WriterT Cxt m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Name -> WriterT Cxt Q Name) -> Q Name -> WriterT Cxt Q Name
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"y"

  stmts <- forM (zip3 lArgNames rArgNames argTypes) $ \(Name
l, Name
r, Type
t) -> do
    case Type
t of
      AppT Type
tyFun Type
tyArg | Type -> Bool
needsGEq Type
t -> do
        u <- Q [Dec] -> WriterT Cxt Q [Dec]
forall (m :: * -> *) a. Monad m => m a -> WriterT Cxt m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q [Dec] -> WriterT Cxt Q [Dec]) -> Q [Dec] -> WriterT Cxt Q [Dec]
forall a b. (a -> b) -> a -> b
$ Set Name -> Name -> Cxt -> Q [Dec]
reifyInstancesWithRigids Set Name
paramVars ''GEq [Type
tyFun]
        case u of
          [] -> Cxt -> WriterT Cxt Q ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Type -> Type -> Type
AppT (Name -> Type
ConT ''GEq) Type
tyFun]
          [(InstanceD Maybe Overlap
_ Cxt
cxt Type
_ [Dec]
_)] -> Cxt -> WriterT Cxt Q ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Cxt
cxt
          [Dec]
_ -> String -> WriterT Cxt Q ()
forall a. String -> WriterT Cxt Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WriterT Cxt Q ()) -> String -> WriterT Cxt Q ()
forall a b. (a -> b) -> a -> b
$ String
"More than one instance found for GEq (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
forall a. Show a => a -> String
show (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
tyFun) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"), and unsure what to do. Please report this."
        lift $ bindS (conP 'Refl []) [| geq $(varE l) $(varE r) |]
      Type
_ -> Q Stmt -> WriterT Cxt Q Stmt
forall (m :: * -> *) a. Monad m => m a -> WriterT Cxt m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Stmt -> WriterT Cxt Q Stmt) -> Q Stmt -> WriterT Cxt Q Stmt
forall a b. (a -> b) -> a -> b
$ Q Exp -> Q Stmt
forall (m :: * -> *). Quote m => m Exp -> m Stmt
noBindS [| guard ($(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
l) == $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
r)) |]
  ret <- lift $ noBindS [| return Refl |]

  pats <- lift $ sequence
    [ conP conName (map varP lArgNames)
    , conP conName (map varP rArgNames)
    ]
  pure $ Clause pats
    (NormalB (doUnqualifiedE (stmts ++ [ret])))
    []

class DeriveGCompare t where
    deriveGCompare :: t -> Q [Dec]

instance DeriveGCompare Name where
    deriveGCompare :: Name -> Q [Dec]
deriveGCompare Name
typeName = do
      typeInfo <- Name -> Q DatatypeInfo
reifyDatatype Name
typeName
      let instTypes = DatatypeInfo -> Cxt
datatypeInstTypes DatatypeInfo
typeInfo
          paramVars = [Set Name] -> Set Name
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Type -> Set Name
freeTypeVariables Type
t | Type
t <- Cxt
instTypes]
          instTypes' = case Cxt -> Cxt
forall a. [a] -> [a]
reverse Cxt
instTypes of
            [] -> String -> Cxt
forall a. String -> [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"deriveGCompare: Not enough type parameters"
            (Type
_:Cxt
xs) -> Cxt -> Cxt
forall a. [a] -> [a]
reverse Cxt
xs
          instanceHead = Type -> Type -> Type
AppT (Name -> Type
ConT ''GCompare) ((Type -> Type -> Type) -> Type -> Cxt -> Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT Name
typeName) Cxt
instTypes')
      (clauses, cxt) <- runWriterT (fmap concat $ mapM (gcompareClauses paramVars) (datatypeCons typeInfo))
      dec <- gcompareFunction clauses
      return [InstanceD Nothing cxt instanceHead [dec]]

instance DeriveGCompare Dec where
    deriveGCompare :: Dec -> Q [Dec]
deriveGCompare = Name -> (DatatypeInfo -> WriterT Cxt Q Dec) -> Dec -> Q [Dec]
deriveForDec ''GCompare ((DatatypeInfo -> WriterT Cxt Q Dec) -> Dec -> Q [Dec])
-> (DatatypeInfo -> WriterT Cxt Q Dec) -> Dec -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ \DatatypeInfo
typeInfo -> do
      let
        instTypes :: Cxt
instTypes = DatatypeInfo -> Cxt
datatypeInstTypes DatatypeInfo
typeInfo
        paramVars :: Set Name
paramVars = [Set Name] -> Set Name
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Type -> Set Name
freeTypeVariables Type
t | Type
t <- Cxt
instTypes]
      clauses <- (ConstructorInfo -> WriterT Cxt Q [Clause])
-> [ConstructorInfo] -> WriterT Cxt Q [[Clause]]
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 (Set Name -> ConstructorInfo -> WriterT Cxt Q [Clause]
gcompareClauses Set Name
paramVars) (DatatypeInfo -> [ConstructorInfo]
datatypeCons DatatypeInfo
typeInfo)
      lift $ gcompareFunction (concat clauses)

instance DeriveGCompare t => DeriveGCompare [t] where
    deriveGCompare :: [t] -> Q [Dec]
deriveGCompare [t
it] = t -> Q [Dec]
forall t. DeriveGCompare t => t -> Q [Dec]
deriveGCompare t
it
    deriveGCompare [t]
_ = String -> Q [Dec]
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"deriveGCompare: [] instance only applies to single-element lists"

instance DeriveGCompare t => DeriveGCompare (Q t) where
    deriveGCompare :: Q t -> Q [Dec]
deriveGCompare = (Q t -> (t -> 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
>>= t -> Q [Dec]
forall t. DeriveGCompare t => t -> Q [Dec]
deriveGCompare)

gcompareFunction :: [Clause] -> Q Dec
gcompareFunction :: [Clause] -> Q Dec
gcompareFunction [] = Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD 'gcompare [[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [] (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [| \x y -> seq x (seq y undefined) |]) []]
gcompareFunction [Clause]
clauses = Dec -> Q Dec
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Clause] -> Dec
FunD 'gcompare [Clause]
clauses

gcompareClauses :: Set Name -> ConstructorInfo -> WriterT Cxt Q [Clause]
gcompareClauses :: Set Name -> ConstructorInfo -> WriterT Cxt Q [Clause]
gcompareClauses Set Name
paramVars ConstructorInfo
con = do
  let conName :: Name
conName = ConstructorInfo -> Name
constructorName ConstructorInfo
con
      argTypes :: Cxt
argTypes = ConstructorInfo -> Cxt
constructorFields ConstructorInfo
con
      conTyVars :: Set Name
conTyVars = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList ((TyVarBndr_ () -> Name) -> [TyVarBndr_ ()] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr_ () -> Name
forall flag. TyVarBndr_ flag -> Name
tvName (ConstructorInfo -> [TyVarBndr_ ()]
constructorVars ConstructorInfo
con))
      needsGCompare :: Type -> Bool
needsGCompare Type
argType = Bool -> Bool
not (Bool -> Bool) -> (Set Name -> Bool) -> Set Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Name -> Bool
forall a. Set a -> Bool
Set.null (Set Name -> Bool) -> Set Name -> Bool
forall a b. (a -> b) -> a -> b
$
        Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (Type -> Set Name
freeTypeVariables Type
argType) (Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Name
paramVars Set Name
conTyVars)

  lArgNames <- Cxt -> (Type -> WriterT Cxt Q Name) -> WriterT Cxt Q [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Cxt
argTypes ((Type -> WriterT Cxt Q Name) -> WriterT Cxt Q [Name])
-> (Type -> WriterT Cxt Q Name) -> WriterT Cxt Q [Name]
forall a b. (a -> b) -> a -> b
$ \Type
_ -> Q Name -> WriterT Cxt Q Name
forall (m :: * -> *) a. Monad m => m a -> WriterT Cxt m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Name -> WriterT Cxt Q Name) -> Q Name -> WriterT Cxt Q Name
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"x"
  rArgNames <- forM argTypes $ \Type
_ -> Q Name -> WriterT Cxt Q Name
forall (m :: * -> *) a. Monad m => m a -> WriterT Cxt m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Name -> WriterT Cxt Q Name) -> Q Name -> WriterT Cxt Q Name
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"y"

  stmts <- forM (zip3 lArgNames rArgNames argTypes) $ \(Name
lArg, Name
rArg, Type
argType) ->
    case Type
argType of
      AppT Type
tyFun Type
tyArg | Type -> Bool
needsGCompare Type
argType -> do
        u <- Q [Dec] -> WriterT Cxt Q [Dec]
forall (m :: * -> *) a. Monad m => m a -> WriterT Cxt m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q [Dec] -> WriterT Cxt Q [Dec]) -> Q [Dec] -> WriterT Cxt Q [Dec]
forall a b. (a -> b) -> a -> b
$ Set Name -> Name -> Cxt -> Q [Dec]
reifyInstancesWithRigids Set Name
paramVars ''GCompare [Type
tyFun]
        case u of
          [] -> Cxt -> WriterT Cxt Q ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Type -> Type -> Type
AppT (Name -> Type
ConT ''GCompare) Type
tyFun]
          [(InstanceD Maybe Overlap
_ Cxt
cxt Type
_ [Dec]
_)] -> Cxt -> WriterT Cxt Q ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Cxt
cxt -- this might not be enough, may want to do full instance resolution.
          [Dec]
_ -> String -> WriterT Cxt Q ()
forall a. String -> WriterT Cxt Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> WriterT Cxt Q ()) -> String -> WriterT Cxt Q ()
forall a b. (a -> b) -> a -> b
$ String
"More than one instance of GCompare (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
forall a. Show a => a -> String
show (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
tyFun) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") found, and unsure what to do. Please report this."
        lift $ bindS (conP 'Refl []) [| geq' $(varE lArg) $(varE rArg) |]
      Type
_ -> Q Stmt -> WriterT Cxt Q Stmt
forall (m :: * -> *) a. Monad m => m a -> WriterT Cxt m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Stmt -> WriterT Cxt Q Stmt) -> Q Stmt -> WriterT Cxt Q Stmt
forall a b. (a -> b) -> a -> b
$ Q Exp -> Q Stmt
forall (m :: * -> *). Quote m => m Exp -> m Stmt
noBindS [| compare' $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
lArg) $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
rArg) |]

  ret <- lift $ noBindS [| return GEQ |]


  pats <- lift $ sequence
        [ conP conName (map varP lArgNames)
        , conP conName (map varP rArgNames)
        ]
  let main = [Pat] -> Body -> [Dec] -> Clause
Clause [Pat]
pats
        (Exp -> Body
NormalB (Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'runGComparing) ([Stmt] -> Exp
doUnqualifiedE ([Stmt]
stmts [Stmt] -> [Stmt] -> [Stmt]
forall a. [a] -> [a] -> [a]
++ [Stmt
ret]))))
        []
      lt = [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [FieldPat] -> Pat
RecP Name
conName [], Pat
WildP] (Exp -> Body
NormalB (Name -> Exp
ConE 'GLT)) []
      gt = [Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP, Name -> [FieldPat] -> Pat
RecP Name
conName []] (Exp -> Body
NormalB (Name -> Exp
ConE 'GGT)) []
  return [main, lt, gt]

#if MIN_VERSION_template_haskell(2,17,0)
doUnqualifiedE :: [Stmt] -> Exp
doUnqualifiedE = Maybe ModName -> [Stmt] -> Exp
DoE Maybe ModName
forall a. Maybe a
Nothing
#else
doUnqualifiedE = DoE
#endif