{-# LANGUAGE RankNTypes #-}
-- | Source-level sugar for "Stock.Override": a @parsedResultAction@ that lowers
-- the lowercase, no-backtick surface
--
-- > Override [ x via Sum, Coord at 0 via Sum ] T
--
-- into the honest marker form the type-checker plugin reads
--
-- > Override [ "x" := Sum, At Coord 0 := Sum ] T
--
-- keeping a single infix operator (@:=@); @at@ becomes the prefix marker @At@,
-- and a bare lowercase selector becomes a 'Symbol' literal.  The rewrite is
-- /scoped to @Override@ applications/, runs before renaming, and reuses the
-- original sub-trees (so spans survive); @via@\/@at@ elsewhere are untouched.
-- Enabled by the same @-fplugin Stock@ as the solver.
module Stock.Surface (lowerOverrides) where

import GHC.Plugins
import GHC.Hs
import GHC.Types.SourceText (SourceText(NoSourceText))
import Data.Char (isLower)
import Data.Data (Data, gmapT)
import Data.Typeable (Typeable, cast)
import Data.Maybe (fromMaybe)

-- A two-line slice of @syb@ over @base@'s 'Data'/'Typeable' (the GHC AST derives
-- 'Data'), so we depend on no extra package.

-- | Apply @f@ at every subterm, bottom-up.  An endofunction on the type of
-- type-preserving polymorphic transformations.
everywhere :: (forall x. Data x => x -> x) -> (forall x. Data x => x -> x)
everywhere :: (forall x. Data x => x -> x) -> forall x. Data x => x -> x
everywhere forall x. Data x => x -> x
f = x -> x
forall x. Data x => x -> x
f (x -> x) -> (x -> x) -> x -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Data x => x -> x) -> x -> x
forall a. Data a => (forall x. Data x => x -> x) -> a -> a
gmapT ((forall x. Data x => x -> x) -> forall x. Data x => x -> x
everywhere x -> x
forall x. Data x => x -> x
f)

-- | Lift a single-type transformation to act only where the type matches.
mkT :: (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT :: forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT b -> b
f = (a -> a) -> Maybe (a -> a) -> a -> a
forall a. a -> Maybe a -> a
fromMaybe a -> a
forall a. a -> a
id ((b -> b) -> Maybe (a -> a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast b -> b
f)

-- | Rewrite every @Override [ … ]@ config in the parsed module.
lowerOverrides :: ParsedResult -> ParsedResult
lowerOverrides :: ParsedResult -> ParsedResult
lowerOverrides ParsedResult
pr =
  ParsedResult
pr { parsedResultModule =
         let m = ParsedResult -> HsParsedModule
parsedResultModule ParsedResult
pr
         in m { hpm_module = everywhere (mkT rewriteTy) (hpm_module m) } }

-- | If this type is @Override T CFG@ (or the @Overriding@\/@Overriding1@\/
-- @Overriding2@ synonyms — all type-first), lower the entries of @CFG@.  @CFG@
-- is the /last/ argument here (the wrappers are type-first: @Overriding T cfg@).
rewriteTy :: HsType GhcPs -> HsType GhcPs
rewriteTy :: HsType GhcPs -> HsType GhcPs
rewriteTy HsType GhcPs
ty
  | HsAppTy XAppTy GhcPs
x LHsType GhcPs
f LHsType GhcPs
cfg <- HsType GhcPs
ty            -- (hd T) cfg
  , L SrcSpanAnnA
_ (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
hd LHsType GhcPs
_) <- LHsType GhcPs
f        -- f = hd T
  , Just Maybe ModuleName
mq <- HsType GhcPs -> Maybe (Maybe ModuleName)
overrideHeadQual (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hd)
  , Just LHsType GhcPs
cfg' <- Maybe ModuleName -> LHsType GhcPs -> Maybe (LHsType GhcPs)
lowerConfig Maybe ModuleName
mq LHsType GhcPs
cfg
  = XAppTy GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy GhcPs
x LHsType GhcPs
f LHsType GhcPs
cfg'                 -- keep @hd T@, lower the config
  | Bool
otherwise = HsType GhcPs
ty

-- | If this is an @Override@-family head, report /how it was qualified/ — the
-- module alias if written @S.Override@ (@import Stock.Override qualified as S@),
-- or 'Nothing' if unqualified.  The generated markers (@:=@, @At@, @Keep@) mirror
-- this, so they resolve no matter how the user imported "Stock.Override".
overrideHeadQual :: HsType GhcPs -> Maybe (Maybe ModuleName)
overrideHeadQual :: HsType GhcPs -> Maybe (Maybe ModuleName)
overrideHeadQual (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ (L SrcSpanAnnN
_ RdrName
rdr))
  | OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc RdrName
rdr) String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
      [String
"Override", String
"Overriding", String
"Overriding1", String
"Overriding2"]
  = Maybe ModuleName -> Maybe (Maybe ModuleName)
forall a. a -> Maybe a
Just ((ModuleName, OccName) -> ModuleName
forall a b. (a, b) -> a
fst ((ModuleName, OccName) -> ModuleName)
-> Maybe (ModuleName, OccName) -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> Maybe (ModuleName, OccName)
isQual_maybe RdrName
rdr)
overrideHeadQual HsType GhcPs
_ = Maybe (Maybe ModuleName)
forall a. Maybe a
Nothing

-- | Build a marker constructor name (@:=@, @At@, @Keep@), qualified the same way
-- the @Override@ head was, so it is in scope under any import style.
mkMarker :: Maybe ModuleName -> String -> RdrName
mkMarker :: Maybe ModuleName -> String -> RdrName
mkMarker Maybe ModuleName
Nothing  String
nm = OccName -> RdrName
mkRdrUnqual (String -> OccName
mkTcOcc String
nm)
mkMarker (Just ModuleName
m) String
nm = ModuleName -> OccName -> RdrName
mkRdrQual ModuleName
m  (String -> OccName
mkTcOcc String
nm)

-- | Lower a config list by rewriting each element.  The config is assumed to be
-- an actual type-level list ('HsExplicitListTy') — i.e. @'[ … ]@, or @[ … ]@
-- under @NoListTuplePuns@.  A single-element @[a]@ that parses as the /list
-- type/ is deliberately /not/ reinterpreted (write @'[a]@ instead).
--
-- Two surfaces share this pass: the entry-list form (each element lowered by
-- 'lowerEntry'), and the positional @'[ '[m, _, …] ]@ form whose inner lists
-- carry the @_@ no-op — every type wildcard anywhere in the config is lowered
-- to the @Keep@ marker that the solver reads.
lowerConfig :: Maybe ModuleName -> LHsType GhcPs -> Maybe (LHsType GhcPs)
lowerConfig :: Maybe ModuleName -> LHsType GhcPs -> Maybe (LHsType GhcPs)
lowerConfig Maybe ModuleName
mq (L SrcSpanAnnA
l (HsExplicitListTy XExplicitListTy GhcPs
x PromotionFlag
p [LHsType GhcPs]
es)) =
  GenLocated SrcSpanAnnA (HsType GhcPs)
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> Maybe a
Just ((forall x. Data x => x -> x) -> forall x. Data x => x -> x
everywhere ((HsType GhcPs -> HsType GhcPs) -> x -> x
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT (Maybe ModuleName -> HsType GhcPs -> HsType GhcPs
wildToKeep Maybe ModuleName
mq)) (SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XExplicitListTy GhcPs
-> PromotionFlag -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XExplicitListTy pass
-> PromotionFlag -> [LHsType pass] -> HsType pass
HsExplicitListTy XExplicitListTy GhcPs
x PromotionFlag
p ((GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe ModuleName -> LHsType GhcPs -> LHsType GhcPs
lowerEntry Maybe ModuleName
mq) [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
es))))
lowerConfig Maybe ModuleName
_ LHsType GhcPs
_ = Maybe (LHsType GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. Maybe a
Nothing

-- | The positional no-op: a type wildcard @_@ ('HsWildCardTy') becomes the
-- @Keep@ marker, qualified to match the @Override@ head.  (Bare @Keep@ written by
-- hand is left as-is.)
wildToKeep :: Maybe ModuleName -> HsType GhcPs -> HsType GhcPs
wildToKeep :: Maybe ModuleName -> HsType GhcPs -> HsType GhcPs
wildToKeep Maybe ModuleName
mq (HsWildCardTy XWildCardTy GhcPs
_) =
  GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc (PromotionFlag -> IdP GhcPs -> LHsType GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
NotPromoted (Maybe ModuleName -> String -> RdrName
mkMarker Maybe ModuleName
mq String
"Keep"))
wildToKeep Maybe ModuleName
_ HsType GhcPs
t = HsType GhcPs
t

-- | Lower one entry.  Surfaces:
--
--   * @sel via modifier@ — split the application spine on @via@, rebuild as
--     @(:=) selector modifier@.
--   * @sel via a -> f b@ — @via@ binds looser than @->@: GHC parses this as
--     @(sel via a) -> f b@, so we peel @via@ off the /domain/ and rebuild the
--     modifier as @a -> f b@ (i.e. @sel via (a -> f b)@ without the parens).
--   * @sel := modifier@  — written with the operator directly; lower only the
--     /selector/ (the LHS).
--
-- Anything else is left untouched.
lowerEntry :: Maybe ModuleName -> LHsType GhcPs -> LHsType GhcPs
lowerEntry :: Maybe ModuleName -> LHsType GhcPs -> LHsType GhcPs
lowerEntry Maybe ModuleName
mq (L SrcSpanAnnA
l (HsOpTy XOpTy GhcPs
x PromotionFlag
prom LHsType GhcPs
lhs LIdP GhcPs
op LHsType GhcPs
rhs))
  | String -> RdrName -> Bool
isVarRdr String
":=" (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
op) =
      SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XOpTy GhcPs
-> PromotionFlag
-> LHsType GhcPs
-> LIdP GhcPs
-> LHsType GhcPs
-> HsType GhcPs
forall pass.
XOpTy pass
-> PromotionFlag
-> LHsType pass
-> LIdP pass
-> LHsType pass
-> HsType pass
HsOpTy XOpTy GhcPs
x PromotionFlag
prom (Maybe ModuleName -> [LHsType GhcPs] -> LHsType GhcPs
lowerSelector Maybe ModuleName
mq (LHsType GhcPs -> [LHsType GhcPs]
spine LHsType GhcPs
lhs)) LIdP GhcPs
op LHsType GhcPs
rhs)
lowerEntry Maybe ModuleName
mq (L SrcSpanAnnA
l (HsFunTy XFunTy GhcPs
x HsArrow GhcPs
arr LHsType GhcPs
dom LHsType GhcPs
cod))
  | (sel :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
sel@(GenLocated SrcSpanAnnA (HsType GhcPs)
_ : [GenLocated SrcSpanAnnA (HsType GhcPs)]
_), GenLocated SrcSpanAnnA (HsType GhcPs)
_via : modAtoms :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
modAtoms@(GenLocated SrcSpanAnnA (HsType GhcPs)
_ : [GenLocated SrcSpanAnnA (HsType GhcPs)]
_)) <- (GenLocated SrcSpanAnnA (HsType GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)],
    [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> LHsType GhcPs -> Bool
isVar String
"via") (LHsType GhcPs -> [LHsType GhcPs]
spine LHsType GhcPs
dom) =
      Maybe ModuleName -> String -> [LHsType GhcPs] -> LHsType GhcPs
mkPrefix Maybe ModuleName
mq String
":=" [Maybe ModuleName -> [LHsType GhcPs] -> LHsType GhcPs
lowerSelector Maybe ModuleName
mq [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
sel, SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XFunTy GhcPs
-> HsArrow GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy GhcPs
x HsArrow GhcPs
arr ([LHsType GhcPs] -> LHsType GhcPs
reassemble [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
modAtoms) LHsType GhcPs
cod)]
lowerEntry Maybe ModuleName
mq LHsType GhcPs
e =
  case (GenLocated SrcSpanAnnA (HsType GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)],
    [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> LHsType GhcPs -> Bool
isVar String
"via") (LHsType GhcPs -> [LHsType GhcPs]
spine LHsType GhcPs
e) of
    (sel :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
sel@(GenLocated SrcSpanAnnA (HsType GhcPs)
_ : [GenLocated SrcSpanAnnA (HsType GhcPs)]
_), GenLocated SrcSpanAnnA (HsType GhcPs)
_via : modAtoms :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
modAtoms@(GenLocated SrcSpanAnnA (HsType GhcPs)
_ : [GenLocated SrcSpanAnnA (HsType GhcPs)]
_)) ->
      Maybe ModuleName -> String -> [LHsType GhcPs] -> LHsType GhcPs
mkPrefix Maybe ModuleName
mq String
":=" [Maybe ModuleName -> [LHsType GhcPs] -> LHsType GhcPs
lowerSelector Maybe ModuleName
mq [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
sel, [LHsType GhcPs] -> LHsType GhcPs
reassemble [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
modAtoms]
    ([GenLocated SrcSpanAnnA (HsType GhcPs)],
 [GenLocated SrcSpanAnnA (HsType GhcPs)])
_ -> LHsType GhcPs
e

-- | The selector left of @via@: @con at pos@ ⇒ @At con pos@; a bare lowercase
-- head ⇒ a 'Symbol' literal; otherwise reassembled as a type (type-keyed).
lowerSelector :: Maybe ModuleName -> [LHsType GhcPs] -> LHsType GhcPs
lowerSelector :: Maybe ModuleName -> [LHsType GhcPs] -> LHsType GhcPs
lowerSelector Maybe ModuleName
mq [LHsType GhcPs]
atoms =
  case (GenLocated SrcSpanAnnA (HsType GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> ([GenLocated SrcSpanAnnA (HsType GhcPs)],
    [GenLocated SrcSpanAnnA (HsType GhcPs)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> LHsType GhcPs -> Bool
isVar String
"at") [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
atoms of
    (con :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
con@(GenLocated SrcSpanAnnA (HsType GhcPs)
_ : [GenLocated SrcSpanAnnA (HsType GhcPs)]
_), GenLocated SrcSpanAnnA (HsType GhcPs)
_at : pos :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
pos@(GenLocated SrcSpanAnnA (HsType GhcPs)
_ : [GenLocated SrcSpanAnnA (HsType GhcPs)]
_)) ->
      Maybe ModuleName -> String -> [LHsType GhcPs] -> LHsType GhcPs
mkPrefix Maybe ModuleName
mq String
"At" [[LHsType GhcPs] -> LHsType GhcPs
nameOrType [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
con, [LHsType GhcPs] -> LHsType GhcPs
reassemble [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
pos]
    ([GenLocated SrcSpanAnnA (HsType GhcPs)],
 [GenLocated SrcSpanAnnA (HsType GhcPs)])
_ -> [LHsType GhcPs] -> LHsType GhcPs
nameOrType [LHsType GhcPs]
atoms

-- | A single bare lowercase variable ⇒ field-name 'Symbol' literal; else a type.
nameOrType :: [LHsType GhcPs] -> LHsType GhcPs
nameOrType :: [LHsType GhcPs] -> LHsType GhcPs
nameOrType [L SrcSpanAnnA
l (HsTyVar XTyVar GhcPs
_ PromotionFlag
NotPromoted (L SrcSpanAnnN
_ RdrName
rdr))]
  | RdrName -> Bool
isLowerName RdrName
rdr =
      SrcSpanAnnA
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XTyLit GhcPs -> HsTyLit GhcPs -> HsType GhcPs
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit GhcPs
NoExtField
noExtField (XStrTy GhcPs -> FastString -> HsTyLit GhcPs
forall pass. XStrTy pass -> FastString -> HsTyLit pass
HsStrTy XStrTy GhcPs
SourceText
NoSourceText (OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
rdr))))
nameOrType [LHsType GhcPs]
atoms = [LHsType GhcPs] -> LHsType GhcPs
reassemble [LHsType GhcPs]
atoms

-- ----- application-spine helpers -------------------------------------------

-- | Flatten a left-nested @HsAppTy@ into its atoms (head first).
spine :: LHsType GhcPs -> [LHsType GhcPs]
spine :: LHsType GhcPs -> [LHsType GhcPs]
spine (L SrcSpanAnnA
_ (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
f LHsType GhcPs
a)) = LHsType GhcPs -> [LHsType GhcPs]
spine LHsType GhcPs
f [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. [a] -> [a] -> [a]
++ [LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
a]
spine LHsType GhcPs
t                     = [LHsType GhcPs
t]

-- | Re-nest a non-empty atom list into a left-associated application.
reassemble :: [LHsType GhcPs] -> LHsType GhcPs
reassemble :: [LHsType GhcPs] -> LHsType GhcPs
reassemble = (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
mkHsAppTy

-- | Prefix application of a marker type constructor named @nm@ to @args@,
-- qualified to match the @Override@ head (see 'mkMarker').
mkPrefix :: Maybe ModuleName -> String -> [LHsType GhcPs] -> LHsType GhcPs
mkPrefix :: Maybe ModuleName -> String -> [LHsType GhcPs] -> LHsType GhcPs
mkPrefix Maybe ModuleName
mq String
nm = (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall (p :: Pass).
LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
mkHsAppTy (PromotionFlag -> IdP GhcPs -> LHsType GhcPs
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar PromotionFlag
NotPromoted (Maybe ModuleName -> String -> RdrName
mkMarker Maybe ModuleName
mq String
nm))

-- ----- predicates ----------------------------------------------------------

isVar :: String -> LHsType GhcPs -> Bool
isVar :: String -> LHsType GhcPs -> Bool
isVar String
nm (L SrcSpanAnnA
_ (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ (L SrcSpanAnnN
_ RdrName
rdr))) = String -> RdrName -> Bool
isVarRdr String
nm RdrName
rdr
isVar String
_  LHsType GhcPs
_                             = Bool
False

isVarRdr :: String -> RdrName -> Bool
isVarRdr :: String -> RdrName -> Bool
isVarRdr String
nm RdrName
rdr = OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc RdrName
rdr) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
nm

isLowerName :: RdrName -> Bool
isLowerName :: RdrName -> Bool
isLowerName RdrName
rdr = case OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc RdrName
rdr) of
  (Char
c : String
_) -> Char -> Bool
isLower Char
c
  String
_       -> Bool
False