{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Unused LANGUAGE pragma" #-}

-- |
-- Module      :   Grisette.Internal.TH.Util
-- Copyright   :   (c) Sirui Lu 2024
-- License     :   BSD-3-Clause (see the LICENSE file)
--
-- Maintainer  :   siruilu@cs.washington.edu
-- Stability   :   Experimental
-- Portability :   GHC only
module Grisette.Internal.TH.Util
  ( occName,
    constructorInfoToType,
    tvIsMode,
    tvIsNat,
    tvIsStar,
    tvIsStarToStar,
    substDataType,
    reifyDatatypeWithFreshNames,
    singleParamClassParamKind,
    binaryClassParamKind,
    getTypeWithMaybeSubst,
    dropLastTypeParam,
    dropNTypeParam,
    classParamKinds,
    allSameKind,
    classNumParam,
    kindNumParam,
    concatPreds,
    putHaddock,
  )
where

#if MIN_VERSION_template_haskell(2,18,0)
import Language.Haskell.TH.Syntax (addModFinalizer, putDoc, DocLoc(DeclDoc))
#endif

import Control.Monad (when)
import qualified Data.Map as M
import GHC.TypeNats (Nat)
import Grisette.Unified.Internal.EvalModeTag (EvalModeTag)
import Language.Haskell.TH
  ( Dec (ClassD),
    Info (ClassI),
    Kind,
    Name,
    Pred,
    Q,
    Type (AppT, ArrowT, ConT, ForallT, StarT, VarT),
    newName,
    pprint,
    reify,
    varT,
  )
import Language.Haskell.TH.Datatype
  ( ConstructorInfo (constructorContext, constructorFields, constructorVars),
    DatatypeInfo (datatypeCons, datatypeInstTypes, datatypeVars),
    TypeSubstitution (applySubstitution),
    datatypeType,
    reifyDatatype,
    tvName,
  )
import Language.Haskell.TH.Datatype.TyVarBndr
  ( Specificity (SpecifiedSpec),
    TyVarBndrUnit,
    TyVarBndr_,
    mapTVFlag,
    mapTVName,
    tvKind,
  )
import Language.Haskell.TH.Syntax (Name (Name), OccName (OccName))

-- | Get the unqualified name of a 'Name'.
occName :: Name -> String
occName :: Name -> String
occName (Name (OccName String
name) NameFlavour
_) = String
name

-- | Convert a 'ConstructorInfo' to a 'Type' of the constructor.
constructorInfoToType :: DatatypeInfo -> ConstructorInfo -> Q Type
constructorInfoToType :: DatatypeInfo -> ConstructorInfo -> Q Type
constructorInfoToType DatatypeInfo
dataType ConstructorInfo
info = do
  let binders :: [TyVarBndr_ Specificity]
binders =
        (() -> Specificity) -> TyVarBndr_ () -> TyVarBndr_ Specificity
forall flag flag'.
(flag -> flag') -> TyVarBndr_ flag -> TyVarBndr_ flag'
mapTVFlag (Specificity -> () -> Specificity
forall a b. a -> b -> a
const Specificity
SpecifiedSpec)
          (TyVarBndr_ () -> TyVarBndr_ Specificity)
-> [TyVarBndr_ ()] -> [TyVarBndr_ Specificity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatatypeInfo -> [TyVarBndr_ ()]
datatypeVars DatatypeInfo
dataType [TyVarBndr_ ()] -> [TyVarBndr_ ()] -> [TyVarBndr_ ()]
forall a. [a] -> [a] -> [a]
++ ConstructorInfo -> [TyVarBndr_ ()]
constructorVars ConstructorInfo
info
  let ctx :: Cxt
ctx = ConstructorInfo -> Cxt
constructorContext ConstructorInfo
info
  let fields :: Cxt
fields = ConstructorInfo -> Cxt
constructorFields ConstructorInfo
info
  let tyBody :: Type
tyBody =
        (Type -> Type -> Type) -> Type -> Cxt -> Type
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type -> Type -> Type
AppT (Type -> Type -> Type) -> (Type -> Type) -> Type -> Type -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type -> Type
AppT Type
ArrowT) (DatatypeInfo -> Type
datatypeType DatatypeInfo
dataType) Cxt
fields
  if [TyVarBndr_ Specificity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBndr_ Specificity]
binders then Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
tyBody else Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ [TyVarBndr_ Specificity] -> Cxt -> Type -> Type
ForallT [TyVarBndr_ Specificity]
binders Cxt
ctx Type
tyBody

-- | Check if a type variable is of kind 'EvalModeTag'.
tvIsMode :: TyVarBndr_ flag -> Bool
tvIsMode :: forall flag. TyVarBndr_ flag -> Bool
tvIsMode = (Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Type
ConT ''EvalModeTag) (Type -> Bool)
-> (TyVarBndr_ flag -> Type) -> TyVarBndr_ flag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVarBndr_ flag -> Type
forall flag. TyVarBndr_ flag -> Type
tvKind

-- | Check if a type variable is of kind 'Nat'.
tvIsNat :: TyVarBndr_ flag -> Bool
tvIsNat :: forall flag. TyVarBndr_ flag -> Bool
tvIsNat = (Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Type
ConT ''Nat) (Type -> Bool)
-> (TyVarBndr_ flag -> Type) -> TyVarBndr_ flag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVarBndr_ flag -> Type
forall flag. TyVarBndr_ flag -> Type
tvKind

-- | Check if a type variable is of kind 'Data.Kind.Type'.
tvIsStar :: TyVarBndr_ flag -> Bool
tvIsStar :: forall flag. TyVarBndr_ flag -> Bool
tvIsStar = (Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
StarT) (Type -> Bool)
-> (TyVarBndr_ flag -> Type) -> TyVarBndr_ flag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVarBndr_ flag -> Type
forall flag. TyVarBndr_ flag -> Type
tvKind

-- | Check if a type variable is of kind 'Data.Kind.Type -> Data.Kind.Type'.
tvIsStarToStar :: TyVarBndr_ flag -> Bool
tvIsStarToStar :: forall flag. TyVarBndr_ flag -> Bool
tvIsStarToStar = (Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
StarT) Type
StarT)) (Type -> Bool)
-> (TyVarBndr_ flag -> Type) -> TyVarBndr_ flag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVarBndr_ flag -> Type
forall flag. TyVarBndr_ flag -> Type
tvKind

-- | Substitute the type variables in a 'DatatypeInfo' with the given
-- substitution map.
substDataType :: DatatypeInfo -> M.Map Name Type -> DatatypeInfo
substDataType :: DatatypeInfo -> Map Name Type -> DatatypeInfo
substDataType DatatypeInfo
d Map Name Type
substMap =
  DatatypeInfo
d
    { datatypeInstTypes = applySubstitution substMap <$> datatypeInstTypes d,
      datatypeCons = applySubstitution substMap <$> datatypeCons d
    }

-- | Convert a 'DatatypeInfo' to a 'DatatypeInfo' with fresh type variable
-- names.
datatypeToFreshNames :: DatatypeInfo -> Q DatatypeInfo
datatypeToFreshNames :: DatatypeInfo -> Q DatatypeInfo
datatypeToFreshNames DatatypeInfo
d = do
  let vars :: [TyVarBndr_ ()]
vars = DatatypeInfo -> [TyVarBndr_ ()]
datatypeVars DatatypeInfo
d
  let names :: [Name]
names = TyVarBndr_ () -> Name
forall flag. TyVarBndr_ flag -> Name
tvName (TyVarBndr_ () -> Name) -> [TyVarBndr_ ()] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TyVarBndr_ ()]
vars
  [Name]
freshNames <- (Name -> Q Name) -> [Name] -> Q [Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName (String -> Q Name) -> (Name -> String) -> Name -> Q Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
forall a. Show a => a -> String
show) [Name]
names
  let newDTVars :: [TyVarBndr_ ()]
newDTVars = (TyVarBndr_ () -> Name -> TyVarBndr_ ())
-> [TyVarBndr_ ()] -> [Name] -> [TyVarBndr_ ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\TyVarBndr_ ()
v Name
n -> (Name -> Name) -> TyVarBndr_ () -> TyVarBndr_ ()
forall flag. (Name -> Name) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVName (Name -> Name -> Name
forall a b. a -> b -> a
const Name
n) TyVarBndr_ ()
v) [TyVarBndr_ ()]
vars [Name]
freshNames
  let substMap :: Map Name Type
substMap = [(Name, Type)] -> Map Name Type
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Type)] -> Map Name Type)
-> [(Name, Type)] -> Map Name Type
forall a b. (a -> b) -> a -> b
$ [Name] -> Cxt -> [(Name, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
names (Name -> Type
VarT (Name -> Type) -> [Name] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
freshNames)
  DatatypeInfo -> Q DatatypeInfo
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (DatatypeInfo -> Q DatatypeInfo) -> DatatypeInfo -> Q DatatypeInfo
forall a b. (a -> b) -> a -> b
$ DatatypeInfo -> Map Name Type -> DatatypeInfo
substDataType DatatypeInfo
d {datatypeVars = newDTVars} Map Name Type
substMap

-- | Reify a datatype with fresh type variable names.
reifyDatatypeWithFreshNames :: Name -> Q DatatypeInfo
reifyDatatypeWithFreshNames :: Name -> Q DatatypeInfo
reifyDatatypeWithFreshNames Name
name = do
  DatatypeInfo
d <- Name -> Q DatatypeInfo
reifyDatatype Name
name
  DatatypeInfo -> Q DatatypeInfo
datatypeToFreshNames DatatypeInfo
d

-- | Check if all type variables have the same kind.
allSameKind :: [TyVarBndrUnit] -> Bool
allSameKind :: [TyVarBndr_ ()] -> Bool
allSameKind [] = Bool
True
allSameKind (TyVarBndr_ ()
x : [TyVarBndr_ ()]
xs) = (TyVarBndr_ () -> Bool) -> [TyVarBndr_ ()] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== TyVarBndr_ () -> Type
forall flag. TyVarBndr_ flag -> Type
tvKind TyVarBndr_ ()
x) (Type -> Bool) -> (TyVarBndr_ () -> Type) -> TyVarBndr_ () -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVarBndr_ () -> Type
forall flag. TyVarBndr_ flag -> Type
tvKind) [TyVarBndr_ ()]
xs

-- | Get the kinds of the type parameters of a class.
classParamKinds :: Name -> Q [Kind]
classParamKinds :: Name -> Q Cxt
classParamKinds Name
className = do
  Info
cls <- Name -> Q Info
reify Name
className
  case Info
cls of
    ClassI (ClassD Cxt
_ Name
_ [TyVarBndr_ ()]
bndrs [FunDep]
_ [Dec]
_) [Dec]
_ -> Cxt -> Q Cxt
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cxt -> Q Cxt) -> Cxt -> Q Cxt
forall a b. (a -> b) -> a -> b
$ TyVarBndr_ () -> Type
forall flag. TyVarBndr_ flag -> Type
tvKind (TyVarBndr_ () -> Type) -> [TyVarBndr_ ()] -> Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TyVarBndr_ ()]
bndrs
    Info
_ ->
      String -> Q Cxt
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Cxt) -> String -> Q Cxt
forall a b. (a -> b) -> a -> b
$
        String
"symmetricClassParamKind:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
className String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is not a class"

-- | Get the number of type parameters of a class.
classNumParam :: Name -> Q Int
classNumParam :: Name -> Q Int
classNumParam Name
className = do
  Info
cls <- Name -> Q Info
reify Name
className
  case Info
cls of
    ClassI (ClassD Cxt
_ Name
_ [TyVarBndr_ ()]
bndrs [FunDep]
_ [Dec]
_) [Dec]
_ -> Int -> Q Int
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Q Int) -> Int -> Q Int
forall a b. (a -> b) -> a -> b
$ [TyVarBndr_ ()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TyVarBndr_ ()]
bndrs
    Info
_ ->
      String -> Q Int
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Int) -> String -> Q Int
forall a b. (a -> b) -> a -> b
$
        String
"classNumParam:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
className String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is not a class"

-- | Get the kind of the single type parameter of a class.
singleParamClassParamKind :: Name -> Q Kind
singleParamClassParamKind :: Name -> Q Type
singleParamClassParamKind Name
className = do
  Info
cls <- Name -> Q Info
reify Name
className
  case Info
cls of
    ClassI (ClassD Cxt
_ Name
_ [TyVarBndr_ ()]
bndrs [FunDep]
_ [Dec]
_) [Dec]
_ ->
      case [TyVarBndr_ ()]
bndrs of
        [TyVarBndr_ ()
x] -> Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ TyVarBndr_ () -> Type
forall flag. TyVarBndr_ flag -> Type
tvKind TyVarBndr_ ()
x
        [TyVarBndr_ ()]
_ ->
          String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Type) -> String -> Q Type
forall a b. (a -> b) -> a -> b
$
            String
"singleParamClassParamKind: only support classes with one type "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"parameter, but "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
className
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" has "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([TyVarBndr_ ()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TyVarBndr_ ()]
bndrs)
    Info
_ ->
      String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Type) -> String -> Q Type
forall a b. (a -> b) -> a -> b
$
        String
"singleParamClassParamKind:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
className String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is not a class"

-- | Get the kind of the binary type parameter of a class.
binaryClassParamKind :: Name -> Q Kind
binaryClassParamKind :: Name -> Q Type
binaryClassParamKind Name
className = do
  Info
cls <- Name -> Q Info
reify Name
className
  case Info
cls of
    ClassI (ClassD Cxt
_ Name
_ [TyVarBndr_ ()]
bndrs [FunDep]
_ [Dec]
_) [Dec]
_ ->
      case [TyVarBndr_ ()]
bndrs of
        [TyVarBndr_ ()
x, TyVarBndr_ ()
y] -> do
          Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TyVarBndr_ () -> Type
forall flag. TyVarBndr_ flag -> Type
tvKind TyVarBndr_ ()
x Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
/= TyVarBndr_ () -> Type
forall flag. TyVarBndr_ flag -> Type
tvKind TyVarBndr_ ()
y) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$
            String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"binaryClassParamKind: type parameters have different kinds"
          Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ TyVarBndr_ () -> Type
forall flag. TyVarBndr_ flag -> Type
tvKind TyVarBndr_ ()
x
        [TyVarBndr_ ()]
_ ->
          String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Type) -> String -> Q Type
forall a b. (a -> b) -> a -> b
$
            String
"binaryClassParamKind: only support classes with two type "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"parameters, but "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
className
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" has "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([TyVarBndr_ ()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TyVarBndr_ ()]
bndrs)
    Info
_ ->
      String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Type) -> String -> Q Type
forall a b. (a -> b) -> a -> b
$
        String
"binaryClassParamKind:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
className String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is not a class"

-- | Get a type with a possible substitution.
getTypeWithMaybeSubst :: TyVarBndrUnit -> Maybe Type -> Q Type
getTypeWithMaybeSubst :: TyVarBndr_ () -> Maybe Type -> Q Type
getTypeWithMaybeSubst TyVarBndr_ ()
tv Maybe Type
Nothing = Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ TyVarBndr_ () -> Name
forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndr_ ()
tv
getTypeWithMaybeSubst TyVarBndr_ ()
_ (Just Type
t) = Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
t

-- | Drop the last instantiated type parameter of a type.
dropLastTypeParam :: Type -> Q Type
dropLastTypeParam :: Type -> Q Type
dropLastTypeParam (AppT Type
c Type
_) = Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
c
dropLastTypeParam Type
v =
  String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Type) -> String -> Q Type
forall a b. (a -> b) -> a -> b
$
    String
"dropLastTypeParam: have no type parameters: "
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Type -> String
forall a. Ppr a => a -> String
pprint Type
v
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" / "
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Type -> String
forall a. Show a => a -> String
show Type
v

-- | Drop the last N instantiated type parameters of a type.
dropNTypeParam :: Int -> Type -> Q Type
dropNTypeParam :: Int -> Type -> Q Type
dropNTypeParam Int
0 Type
t = Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
t
dropNTypeParam Int
n Type
t = Type -> Q Type
dropLastTypeParam Type
t Q Type -> (Type -> Q Type) -> Q Type
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Type -> Q Type
dropNTypeParam (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Get the number of type parameters of a kind.
kindNumParam :: Kind -> Q Int
kindNumParam :: Type -> Q Int
kindNumParam (AppT (AppT Type
ArrowT Type
_) Type
k) = (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Q Int -> Q Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q Int
kindNumParam Type
k
kindNumParam Type
_ = Int -> Q Int
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0

-- | Concatenate two 'Maybe [Pred]'.
concatPreds :: Maybe [Pred] -> Maybe [Pred] -> Maybe [Pred]
concatPreds :: Maybe Cxt -> Maybe Cxt -> Maybe Cxt
concatPreds Maybe Cxt
Nothing Maybe Cxt
Nothing = Maybe Cxt
forall a. Maybe a
Nothing
concatPreds (Just Cxt
ps) Maybe Cxt
Nothing = Cxt -> Maybe Cxt
forall a. a -> Maybe a
Just Cxt
ps
concatPreds Maybe Cxt
Nothing (Just Cxt
ps) = Cxt -> Maybe Cxt
forall a. a -> Maybe a
Just Cxt
ps
concatPreds (Just Cxt
ps1) (Just Cxt
ps2) = Cxt -> Maybe Cxt
forall a. a -> Maybe a
Just (Cxt -> Maybe Cxt) -> Cxt -> Maybe Cxt
forall a b. (a -> b) -> a -> b
$ Cxt
ps1 Cxt -> Cxt -> Cxt
forall a. [a] -> [a] -> [a]
++ Cxt
ps2

#if MIN_VERSION_template_haskell(2,18,0)
-- | Put a haddock comment on a declaration.
putHaddock :: Name -> String -> Q ()
putHaddock :: Name -> String -> Q ()
putHaddock Name
name = Q () -> Q ()
addModFinalizer (Q () -> Q ()) -> (String -> Q ()) -> String -> Q ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocLoc -> String -> Q ()
putDoc (Name -> DocLoc
DeclDoc Name
name) 
#else
-- | Put a haddock comment on a declaration.
-- (No-op because compiling with GHC < 9.2)
putHaddock :: Name -> String -> Q ()
putHaddock _ _ = return ()
#endif