diff options
Diffstat (limited to 'libraries/template-haskell/Language/Haskell/TH/Lib.hs')
-rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Lib.hs | 86 |
1 files changed, 68 insertions, 18 deletions
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs index 5d2b08c671..fd5dd70802 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs @@ -2,12 +2,14 @@ -- TH.Lib contains lots of useful helper functions for -- generating and manipulating Template Haskell terms +{-# LANGUAGE CPP #-} + module Language.Haskell.TH.Lib where -- All of the exports from this module should -- be "public" functions. The main module TH -- re-exports them all. -import Language.Haskell.TH.Syntax hiding (Role) +import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn) import qualified Language.Haskell.TH.Syntax as TH import Control.Monad( liftM, liftM2 ) import Data.Word( Word8 ) @@ -40,6 +42,7 @@ type FieldExpQ = Q FieldExp type RuleBndrQ = Q RuleBndr type TySynEqnQ = Q TySynEqn type Role = TH.Role -- must be defined here for DsMeta to find it +type InjectivityAnn = TH.InjectivityAnn ---------------------------------------------------------- -- * Lowercase pattern syntax functions @@ -201,11 +204,6 @@ clause ps r ds = do { ps' <- sequence ps; dyn :: String -> ExpQ dyn s = return (VarE (mkName s)) -global :: Name -> ExpQ -{-# DEPRECATED global "Use varE instead" #-} --- Trac #8656; I have no idea why this function is duplicated -global s = return (VarE s) - varE :: Name -> ExpQ varE s = return (VarE s) @@ -422,12 +420,6 @@ pragAnnD target expr pragLineD :: Int -> String -> DecQ pragLineD line file = return $ PragmaD $ LineP line file -familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ -familyNoKindD flav tc tvs = return $ FamilyD flav tc tvs Nothing - -familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ -familyKindD flav tc tvs k = return $ FamilyD flav tc tvs (Just k) - dataInstD :: CxtQ -> Name -> [TypeQ] -> [ConQ] -> [Name] -> DecQ dataInstD ctxt tc tys cons derivs = do @@ -450,17 +442,57 @@ tySynInstD tc eqn = eqn1 <- eqn return (TySynInstD tc eqn1) +dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ +dataFamilyD tc tvs kind + = return $ DataFamilyD tc tvs kind + +openTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig + -> Maybe InjectivityAnn -> DecQ +openTypeFamilyD tc tvs res inj + = return $ OpenTypeFamilyD tc tvs res inj + +closedTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig + -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ +closedTypeFamilyD tc tvs result injectivity eqns = + do eqns1 <- sequence eqns + return (ClosedTypeFamilyD tc tvs result injectivity eqns1) + +-- These were deprecated in GHC 7.12 with a plan to remove them in 7.14. If you +-- remove this check please also: +-- 1. remove deprecated functions +-- 2. remove CPP language extension from top of this module +-- 3. remove the FamFlavour data type from Syntax module +-- 4. make sure that all references to FamFlavour are gone from DsMeta, +-- Convert, TcSplice (follows from 3) +#if __GLASGOW_HASKELL__ > 712 +#error Remove deprecated familyNoKindD, familyKindD, closedTypeFamilyNoKindD and closedTypeFamilyKindD +#endif + +{-# DEPRECATED familyNoKindD, familyKindD + "This function will be removed in the next stable release. Use openTypeFamilyD/dataFamilyD instead." #-} +familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ +familyNoKindD flav tc tvs = + case flav of + TypeFam -> return $ OpenTypeFamilyD tc tvs NoSig Nothing + DataFam -> return $ DataFamilyD tc tvs Nothing + +familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ +familyKindD flav tc tvs k = + case flav of + TypeFam -> return $ OpenTypeFamilyD tc tvs (KindSig k) Nothing + DataFam -> return $ DataFamilyD tc tvs (Just k) + +{-# DEPRECATED closedTypeFamilyNoKindD, closedTypeFamilyKindD + "This function will be removed in the next stable release. Use closedTypeFamilyD instead." #-} closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ closedTypeFamilyNoKindD tc tvs eqns = - do - eqns1 <- sequence eqns - return (ClosedTypeFamilyD tc tvs Nothing eqns1) + do eqns1 <- sequence eqns + return (ClosedTypeFamilyD tc tvs NoSig Nothing eqns1) closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ closedTypeFamilyKindD tc tvs kind eqns = - do - eqns1 <- sequence eqns - return (ClosedTypeFamilyD tc tvs (Just kind) eqns1) + do eqns1 <- sequence eqns + return (ClosedTypeFamilyD tc tvs (KindSig kind) Nothing eqns1) roleAnnotD :: Name -> [Role] -> DecQ roleAnnotD name roles = return $ RoleAnnotD name roles @@ -653,6 +685,24 @@ constraintK :: Kind constraintK = ConstraintT ------------------------------------------------------------------------------- +-- * Type family result + +noSig :: FamilyResultSig +noSig = NoSig + +kindSig :: Kind -> FamilyResultSig +kindSig = KindSig + +tyVarSig :: TyVarBndr -> FamilyResultSig +tyVarSig = TyVarSig + +------------------------------------------------------------------------------- +-- * Injectivity annotation + +injectivityAnn :: Name -> [Name] -> InjectivityAnn +injectivityAnn = TH.InjectivityAnn + +------------------------------------------------------------------------------- -- * Role nominalR, representationalR, phantomR, inferR :: Role |