summaryrefslogtreecommitdiff
path: root/libraries/template-haskell/Language/Haskell/TH/Lib.hs
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/template-haskell/Language/Haskell/TH/Lib.hs')
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Lib.hs86
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