{-# LANGUAGE CPP                 #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
-- |
-- Module      : Language.Haskell.TH.Extra
-- Copyright   : [2019..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Language.Haskell.TH.Extra (

  module Language.Haskell.TH,
  module Language.Haskell.TH.Extra,

) where

#if MIN_VERSION_template_haskell(2,17,0)
import Language.Haskell.TH                                          hiding ( plainInvisTV, tupP, tupE )
#else
import Language.Haskell.TH                                          hiding ( TyVarBndr, tupP, tupE )
import Language.Haskell.TH.Syntax                                   ( unTypeQ, unsafeTExpCoerce )
#if MIN_VERSION_template_haskell(2,16,0)
import GHC.Exts                                                     ( RuntimeRep, TYPE )
#endif
#endif
import qualified Language.Haskell.TH                                as TH


tupT :: [TypeQ] -> TypeQ
tupT :: [TypeQ] -> TypeQ
tupT [TypeQ
t] = TypeQ
t
tupT [TypeQ]
tup =
  let n :: Int
n = [TypeQ] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeQ]
tup
   in (TypeQ -> TypeQ -> TypeQ) -> TypeQ -> [TypeQ] -> TypeQ
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\TypeQ
ts TypeQ
t -> [t| $TypeQ
ts $TypeQ
t |]) (Int -> TypeQ
forall (m :: * -> *). Quote m => Int -> m Type
tupleT Int
n) [TypeQ]
tup

tupP :: [PatQ] -> PatQ
tupP :: [PatQ] -> PatQ
tupP [PatQ
p] = PatQ
p
tupP [PatQ]
ps  = [PatQ] -> PatQ
forall (m :: * -> *). Quote m => [m Pat] -> m Pat
TH.tupP [PatQ]
ps

tupE :: [ExpQ] -> ExpQ
tupE :: [ExpQ] -> ExpQ
tupE [ExpQ
t] = ExpQ
t
tupE [ExpQ]
ts  = [ExpQ] -> ExpQ
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.tupE [ExpQ]
ts


#if MIN_VERSION_template_haskell(2,17,0)

tyVarBndrName :: TyVarBndr flag -> Name
tyVarBndrName :: forall flag. TyVarBndr flag -> Name
tyVarBndrName (PlainTV  Name
n flag
_)   = Name
n
tyVarBndrName (KindedTV Name
n flag
_ Type
_) = Name
n

plainInvisTV :: Name -> Specificity -> TyVarBndr Specificity
plainInvisTV :: Name -> Specificity -> TyVarBndr Specificity
plainInvisTV = Name -> Specificity -> TyVarBndr Specificity
forall flag. Name -> flag -> TyVarBndr flag
PlainTV

#else

type CodeQ a = Q (TExp a)

type TyVarBndr flag = TH.TyVarBndr

data Specificity = SpecifiedSpec | InferredSpec

specifiedSpec :: Specificity
specifiedSpec = SpecifiedSpec

tyVarBndrName :: TyVarBndr flag -> Name
tyVarBndrName (PlainTV  n)   = n
tyVarBndrName (KindedTV n _) = n

plainInvisTV :: Name -> Specificity -> TyVarBndr Specificity
plainInvisTV n _ = PlainTV n

#if MIN_VERSION_template_haskell(2,16,0)
unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r). Q Exp -> Q (TExp a)
#else
unsafeCodeCoerce :: Q Exp -> Q (TExp a)
#endif
unsafeCodeCoerce = unsafeTExpCoerce

#if MIN_VERSION_template_haskell(2,16,0)
unTypeCode :: forall (r :: RuntimeRep) (a :: TYPE r). Q (TExp a) -> Q Exp
#else
unTypeCode :: Q (TExp a) -> Q Exp
#endif
unTypeCode = unTypeQ

#endif