+

+

+--------------------------------------------------------------------------------

+-- * Constraint predicates (deprecated)

+

+{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}

+classP :: Quote m => Name -> [m Type] -> m Pred

+classP cla tys

+  = do

+      tysl <- sequenceA tys

+      pure (foldl AppT (ConT cla) tysl)

+

+{-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-}

+equalP :: Quote m => m Type -> m Type -> m Pred

+equalP tleft tright

+  = do

+      tleft1  <- tleft

+      tright1 <- tright

+      eqT <- equalityT

+      pure (foldl AppT eqT [tleft1, tright1])

+

+--------------------------------------------------------------------------------

+-- * Strictness queries (deprecated)

+{-# DEPRECATED isStrict

+    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",

+     "Example usage: 'bang noSourceUnpackedness sourceStrict'"] #-}

+{-# DEPRECATED notStrict

+    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",

+     "Example usage: 'bang noSourceUnpackedness noSourceStrictness'"] #-}

+{-# DEPRECATED unpacked

+    ["Use 'bang'. See https://gitlab.haskell.org/ghc/ghc/wikis/migration/8.0. ",

+     "Example usage: 'bang sourceUnpack sourceStrict'"] #-}

+isStrict, notStrict, unpacked :: Quote m => m Strict

+isStrict = bang noSourceUnpackedness sourceStrict

+notStrict = bang noSourceUnpackedness noSourceStrictness

+unpacked = bang sourceUnpack sourceStrict

+

+{-# DEPRECATED strictType

+               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead." #-}

+strictType :: Quote m => m Strict -> m Type -> m StrictType

+strictType = bangType

+

+{-# DEPRECATED varStrictType

+               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead." #-}

+varStrictType :: Quote m => Name -> m StrictType -> m VarStrictType

+varStrictType = varBangType

+

+--------------------------------------------------------------------------------

+-- * Specialisation pragmas (deprecated)

+

+{-# DEPRECATED pragSpecD "Please use 'pragSpecED' instead. 'pragSpecD' will be removed in GHC 9.18." #-}

+pragSpecD :: Quote m => Name -> m Type -> Phases -> m Dec

+pragSpecD n ty phases

+  = do

+      ty1    <- ty

+      pure $ PragmaD $ SpecialiseP n ty1 Nothing phases

+

+{-# DEPRECATED pragSpecInlD "Please use 'pragSpecInlED' instead. 'pragSpecInlD' will be removed in GHC 9.18." #-}

+pragSpecInlD :: Quote m => Name -> m Type -> Inline -> Phases -> m Dec

+pragSpecInlD n ty inline phases

+  = do

+      ty1    <- ty

+      pure $ PragmaD $ SpecialiseP n ty1 (Just inline) phases

+  , dataToQa, dataToExpQ, dataToPatQ

+import Language.Haskell.TH.Syntax (dataToQa, dataToExpQ, dataToPatQ)

+{-# LANGUAGE RankNTypes #-}

+{-# LANGUAGE ScopedTypeVariables #-}

+{-# LANGUAGE Trustworthy #-}

+    -- * Notes

+    -- ** Unresolved Infix

+    -- $infix

+import Data.Data hiding (Fixity(..))

+import Data.List.NonEmpty (NonEmpty(..))

+import GHC.Lexeme ( startsVarSym, startsVarId )

+-- |

+addForeignFile :: ForeignSrcLang -> String -> Q ()

+addForeignFile = addForeignSource

+{-# DEPRECATED addForeignFile

+               "Use 'Language.Haskell.TH.Syntax.addForeignSource' instead"

+  #-} -- deprecated in 8.6

+

+

+trueName, falseName :: Name

+trueName  = 'True

+falseName = 'False

+

+nothingName, justName :: Name

+nothingName = 'Nothing

+justName    = 'Just

+

+leftName, rightName :: Name

+leftName  = 'Left

+rightName = 'Right

+

+nonemptyName :: Name

+nonemptyName = '(:|)

+

+-----------------------------------------------------

+--

+--              Generic Lift implementations

+--

+-----------------------------------------------------

+

+-- | 'dataToQa' is an internal utility function for constructing generic

+-- conversion functions from types with 'Data' instances to various

+-- quasi-quoting representations.  See the source of 'dataToExpQ' and

+-- 'dataToPatQ' for two example usages: @mkCon@, @mkLit@

+-- and @appQ@ are overloadable to account for different syntax for

+-- expressions and patterns; @antiQ@ allows you to override type-specific

+-- cases, a common usage is just @const Nothing@, which results in

+-- no overloading.

+dataToQa  ::  forall m a k q. (Quote m, Data a)

+          =>  (Name -> k)

+          ->  (Lit -> m q)

+          ->  (k -> [m q] -> m q)

+          ->  (forall b . Data b => b -> Maybe (m q))

+          ->  a

+          ->  m q

+dataToQa mkCon mkLit appCon antiQ t =

+    case antiQ t of

+      Nothing ->

+          case constrRep constr of

+            AlgConstr _ ->

+                appCon (mkCon funOrConName) conArgs

+              where

+                funOrConName :: Name

+                funOrConName =

+                    case showConstr constr of

+                      "(:)"       -> Name (mkOccName ":")

+                                          (NameG DataName

+                                                (mkPkgName "ghc-internal")

+                                                (mkModName "GHC.Internal.Types"))

+                      con@"[]"    -> Name (mkOccName con)

+                                          (NameG DataName

+                                                (mkPkgName "ghc-internal")

+                                                (mkModName "GHC.Internal.Types"))

+                      con@('(':_) -> Name (mkOccName con)

+                                          (NameG DataName

+                                                (mkPkgName "ghc-internal")

+                                                (mkModName "GHC.Internal.Tuple"))

+

+                      -- Tricky case: see Note [Data for non-algebraic types]

+                      fun@(x:_)   | startsVarSym x || startsVarId x

+                                  -> mkNameG_v tyconPkg tyconMod fun

+                      con         -> mkNameG_d tyconPkg tyconMod con

+

+                  where

+                    tycon :: TyCon

+                    tycon = (typeRepTyCon . typeOf) t

+

+                    tyconPkg, tyconMod :: String

+                    tyconPkg = tyConPackage tycon

+                    tyconMod = tyConModule  tycon

+

+                conArgs :: [m q]

+                conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t

+            IntConstr n ->

+                mkLit $ IntegerL n

+            FloatConstr n ->

+                mkLit $ RationalL n

+            CharConstr c ->

+                mkLit $ CharL c

+        where

+          constr :: Constr

+          constr = toConstr t

+

+      Just y -> y

+

+

+{- Note [Data for non-algebraic types]

+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

+Class Data was originally intended for algebraic data types.  But

+it is possible to use it for abstract types too.  For example, in

+package `text` we find

+

+  instance Data Text where

+    ...

+    toConstr _ = packConstr

+

+  packConstr :: Constr

+  packConstr = mkConstr textDataType "pack" [] Prefix

+

+Here `packConstr` isn't a real data constructor, it's an ordinary

+function.  Two complications

+

+* In such a case, we must take care to build the Name using

+  mkNameG_v (for values), not mkNameG_d (for data constructors).

+  See #10796.

+

+* The pseudo-constructor is named only by its string, here "pack".

+  But 'dataToQa' needs the TyCon of its defining module, and has

+  to assume it's defined in the same module as the TyCon itself.

+  But nothing enforces that; #12596 shows what goes wrong if

+  "pack" is defined in a different module than the data type "Text".

+  -}

+

+-- | A typed variant of 'dataToExpQ'.

+dataToCodeQ :: (Quote m, Data a)

+            => (forall b . Data b => b -> Maybe (Code m b))

+            ->                       a ->        Code m a

+dataToCodeQ f = unsafeCodeCoerce . dataToExpQ (fmap unTypeCode . f)

+

+-- | 'dataToExpQ' converts a value to a 'Exp' representation of the

+-- same value, in the SYB style. It is generalized to take a function

+-- override type-specific cases; see 'liftData' for a more commonly

+-- used variant.

+dataToExpQ  ::  (Quote m, Data a)

+            =>  (forall b . Data b => b -> Maybe (m Exp))

+            ->  a

+            ->  m Exp

+dataToExpQ = dataToQa varOrConE litE (foldl appE)

+    where

+          -- Make sure that VarE is used if the Constr value relies on a

+          -- function underneath the surface (instead of a constructor).

+          -- See #10796.

+          varOrConE s =

+            case nameSpace s of

+                 Just VarName      -> return (VarE s)

+                 Just (FldName {}) -> return (VarE s)

+                 Just DataName     -> return (ConE s)

+                 _ -> error $ "Can't construct an expression from name "

+                           ++ showName s

+          appE x y = do { a <- x; b <- y; return (AppE a b)}

+          litE c = return (LitE c)

+

+-- | A typed variant of 'liftData'.

+liftDataTyped :: (Quote m, Data a) => a -> Code m a

+liftDataTyped = dataToCodeQ (const Nothing)

+

+-- | 'liftData' is a variant of 'lift' in the 'Lift' type class which

+-- works for any type with a 'Data' instance.

+liftData :: (Quote m, Data a) => a -> m Exp

+liftData = dataToExpQ (const Nothing)

+

+-- | 'dataToPatQ' converts a value to a 'Pat' representation of the same

+-- value, in the SYB style. It takes a function to handle type-specific cases,

+-- alternatively, pass @const Nothing@ to get default behavior.

+dataToPatQ  ::  (Quote m, Data a)

+            =>  (forall b . Data b => b -> Maybe (m Pat))

+            ->  a

+            ->  m Pat

+dataToPatQ = dataToQa id litP conP

+    where litP l = return (LitP l)

+          conP n ps =

+            case nameSpace n of

+                Just DataName -> do

+                    ps' <- sequence ps

+                    return (ConP n [] ps')

+                _ -> error $ "Can't construct a pattern from name "

+                          ++ showName n

+

+{-

+Note [Unresolved infix]

+~~~~~~~~~~~~~~~~~~~~~~~

+-}

+{- $infix #infix#

+

+When implementing antiquotation for quasiquoters, one often wants

+to parse strings into expressions:

+

+> parse :: String -> Maybe Exp

+

+But how should we parse @a + b * c@? If we don't know the fixities of

+@+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a

++ b) * c@.

+

+In cases like this, use 'UInfixE', 'UInfixP', 'UInfixT', or 'PromotedUInfixT',

+which stand for \"unresolved infix expression / pattern / type / promoted

+constructor\", respectively. When the compiler is given a splice containing a

+tree of @UInfixE@ applications such as

+

+> UInfixE

+>   (UInfixE e1 op1 e2)

+>   op2

+>   (UInfixE e3 op3 e4)

+

+it will look up and the fixities of the relevant operators and

+reassociate the tree as necessary.

+

+  * trees will not be reassociated across 'ParensE', 'ParensP', or 'ParensT',

+    which are of use for parsing expressions like

+

+    > (a + b * c) + d * e

+

+  * 'InfixE', 'InfixP', 'InfixT', and 'PromotedInfixT' expressions are never

+    reassociated.

+

+  * The 'UInfixE' constructor doesn't support sections. Sections

+    such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer

+    sections such as @(a + b * c -)@, use an 'InfixE' constructor for the

+    outer-most section, and use 'UInfixE' constructors for all

+    other operators:

+

+    > InfixE

+    >   Just (UInfixE ...a + b * c...)

+    >   op

+    >   Nothing

+

+    Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered

+    into 'Exp's differently:

+

+    > (+ a + b)   ---> InfixE Nothing + (Just $ UInfixE a + b)

+    >                    -- will result in a fixity error if (+) is left-infix

+    > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)

+    >                    -- no fixity errors

+

+  * Quoted expressions such as

+

+    > [| a * b + c |] :: Q Exp

+    > [p| a : b : c |] :: Q Pat

+    > [t| T + T |] :: Q Type

+

+    will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'PromotedUInfixT',

+    'InfixT', 'PromotedInfixT, 'ParensE', 'ParensP', or 'ParensT' constructors.

+

+-}

+test('dataToExpQUnit', [omit_ways(prof_ways), req_th], compile, ['-package template-haskell -v0'])

+test('dataToCodeQUnit', [omit_ways(prof_ways), req_th], compile, ['-package template-haskell -v0'])

+  -- Safety: Trustworthy

+     compile_and_run, ['-package template-haskell'])

+	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -package template-haskell -v0 -c T7445a.hs

+	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -package template-haskell -v0 -c T7445.hs