{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE Trustworthy #-}
module Grisette.Core.THCompat (augmentFinalType) where
import Data.Bifunctor (Bifunctor (second))
import Grisette.Core.Control.Monad.UnionM (UnionM)
import Grisette.Core.Data.Class.Mergeable (Mergeable)
#if MIN_VERSION_template_haskell(2,17,0)
import Language.Haskell.TH.Syntax
( Pred,
Q,
Specificity,
TyVarBndr,
Type
( AppT,
ArrowT,
MulArrowT
),
)
#else
import Language.Haskell.TH.Syntax
( Pred,
Q,
TyVarBndr,
Type
( AppT,
ArrowT
),
)
#endif
#if MIN_VERSION_template_haskell(2,17,0)
augmentFinalType :: Type -> Q (([TyVarBndr Specificity], [Pred]), Type)
#else
augmentFinalType :: Type -> Q (([TyVarBndr], [Pred]), Type)
#endif
augmentFinalType :: Type -> Q (([TyVarBndr Specificity], [Type]), Type)
augmentFinalType (AppT a :: Type
a@(AppT Type
ArrowT Type
_) Type
t) = do
(([TyVarBndr Specificity], [Type]), Type)
tl <- Type -> Q (([TyVarBndr Specificity], [Type]), Type)
augmentFinalType Type
t
(([TyVarBndr Specificity], [Type]), Type)
-> Q (([TyVarBndr Specificity], [Type]), Type)
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return ((([TyVarBndr Specificity], [Type]), Type)
-> Q (([TyVarBndr Specificity], [Type]), Type))
-> (([TyVarBndr Specificity], [Type]), Type)
-> Q (([TyVarBndr Specificity], [Type]), Type)
forall a b. (a -> b) -> a -> b
$ (Type -> Type)
-> (([TyVarBndr Specificity], [Type]), Type)
-> (([TyVarBndr Specificity], [Type]), Type)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Type -> Type -> Type
AppT Type
a) (([TyVarBndr Specificity], [Type]), Type)
tl
#if MIN_VERSION_template_haskell(2,17,0)
augmentFinalType (AppT (AppT (AppT Type
MulArrowT Type
_) Type
var) Type
t) = do
(([TyVarBndr Specificity], [Type]), Type)
tl <- Type -> Q (([TyVarBndr Specificity], [Type]), Type)
augmentFinalType Type
t
(([TyVarBndr Specificity], [Type]), Type)
-> Q (([TyVarBndr Specificity], [Type]), Type)
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return ((([TyVarBndr Specificity], [Type]), Type)
-> Q (([TyVarBndr Specificity], [Type]), Type))
-> (([TyVarBndr Specificity], [Type]), Type)
-> Q (([TyVarBndr Specificity], [Type]), Type)
forall a b. (a -> b) -> a -> b
$ (Type -> Type)
-> (([TyVarBndr Specificity], [Type]), Type)
-> (([TyVarBndr Specificity], [Type]), Type)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
var)) (([TyVarBndr Specificity], [Type]), Type)
tl
#endif
augmentFinalType Type
t = do
Type
unionType <- [t|UnionM|]
Type
mergeable <- [t|Mergeable|]
#if MIN_VERSION_template_haskell(2,17,0)
(([TyVarBndr Specificity], [Type]), Type)
-> Q (([TyVarBndr Specificity], [Type]), Type)
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return
( ( [ ],
[ Type -> Type -> Type
AppT Type
mergeable Type
t
]
),
Type -> Type -> Type
AppT Type
unionType Type
t
)
#elif MIN_VERSION_template_haskell(2,16,0)
return
( ( [ ],
[ AppT mergeable t
]
),
AppT unionType t
)
#endif