{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}

-- | Given a file, guess settings from it by looking at the hints.
module Config.Compute(computeSettings) where

import GHC.All
import GHC.Util
import Config.Type
import Fixity
import Data.Generics.Uniplate.DataOnly
import GHC.Hs hiding (Warning)
import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Data.Bag
import GHC.Types.SrcLoc
import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
import Prelude


-- | Given a source file, guess some hints that might apply.
--   Returns the text of the hints (if you want to save it down) along with the settings to be used.
computeSettings :: ParseFlags -> FilePath -> IO (String, [Setting])
computeSettings :: ParseFlags -> String -> IO (String, [Setting])
computeSettings ParseFlags
flags String
file = do
    Either ParseError ModuleEx
x <- ParseFlags
-> String -> Maybe String -> IO (Either ParseError ModuleEx)
parseModuleEx ParseFlags
flags String
file Maybe String
forall a. Maybe a
Nothing
    case Either ParseError ModuleEx
x of
        Left (ParseError SrcSpan
sl String
msg String
_) ->
            (String, [Setting]) -> IO (String, [Setting])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
"# Parse error " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SrcSpan -> String
showSrcSpan SrcSpan
sl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg, [])
        Right ModuleEx{ghcModule :: ModuleEx -> Located (HsModule GhcPs)
ghcModule=Located (HsModule GhcPs)
m} -> do
            let xs :: [Setting]
xs = (LocatedA (HsDecl GhcPs) -> [Setting])
-> [LocatedA (HsDecl GhcPs)] -> [Setting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LocatedA (HsDecl GhcPs) -> [Setting]
findSetting (HsModule GhcPs -> [LHsDecl GhcPs]
forall p. HsModule p -> [LHsDecl p]
hsmodDecls (HsModule GhcPs -> [LHsDecl GhcPs])
-> HsModule GhcPs -> [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ Located (HsModule GhcPs) -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc Located (HsModule GhcPs)
m)
                s :: String
s = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String
"# hints found in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Setting -> [String]) -> [Setting] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Setting -> [String]
renderSetting [Setting]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"# no hints found" | [Setting] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Setting]
xs]
            (String, [Setting]) -> IO (String, [Setting])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
s,[Setting]
xs)


renderSetting :: Setting -> [String]
-- Only need to convert the subset of Setting we generate
renderSetting :: Setting -> [String]
renderSetting (SettingMatchExp HintRule{String
[Note]
Maybe (HsExtendInstances (LHsExpr GhcPs))
HsExtendInstances (LHsExpr GhcPs)
Scope
Severity
hintRuleSeverity :: Severity
hintRuleName :: String
hintRuleNotes :: [Note]
hintRuleScope :: Scope
hintRuleLHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS :: HsExtendInstances (LHsExpr GhcPs)
hintRuleSide :: Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleSeverity :: HintRule -> Severity
hintRuleName :: HintRule -> String
hintRuleNotes :: HintRule -> [Note]
hintRuleScope :: HintRule -> Scope
hintRuleLHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS :: HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleSide :: HintRule -> Maybe (HsExtendInstances (LHsExpr GhcPs))
..}) =
    [String
"- warn: {lhs: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint HsExtendInstances (LHsExpr GhcPs)
HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleLHS) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", rhs: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint HsExtendInstances (LHsExpr GhcPs)
HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
hintRuleRHS) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"]
renderSetting (Infix FixityInfo
x) =
    [String
"- fixity: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (FixitySig GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (FixitySig GhcPs -> String) -> FixitySig GhcPs -> String
forall a b. (a -> b) -> a -> b
$ FixityInfo -> FixitySig GhcPs
toFixitySig FixityInfo
x)]
renderSetting Setting
_ = []

findSetting :: LocatedA (HsDecl GhcPs) -> [Setting]
findSetting :: LocatedA (HsDecl GhcPs) -> [Setting]
findSetting (L SrcSpanAnnA
_ (ValD XValD GhcPs
_ HsBind GhcPs
x)) = HsBind GhcPs -> [Setting]
findBind HsBind GhcPs
x
findSetting (L SrcSpanAnnA
_ (InstD XInstD GhcPs
_ (ClsInstD XClsInstD GhcPs
_ ClsInstDecl{LHsBinds GhcPs
cid_binds :: LHsBinds GhcPs
cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_binds}))) =
    (GenLocated SrcSpanAnnA (HsBind GhcPs) -> [Setting])
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)] -> [Setting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HsBind GhcPs -> [Setting]
findBind (HsBind GhcPs -> [Setting])
-> (GenLocated SrcSpanAnnA (HsBind GhcPs) -> HsBind GhcPs)
-> GenLocated SrcSpanAnnA (HsBind GhcPs)
-> [Setting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsBind GhcPs) -> HsBind GhcPs
forall l e. GenLocated l e -> e
unLoc) ([GenLocated SrcSpanAnnA (HsBind GhcPs)] -> [Setting])
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)] -> [Setting]
forall a b. (a -> b) -> a -> b
$ Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBinds GhcPs
Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
cid_binds
findSetting (L SrcSpanAnnA
_ (SigD XSigD GhcPs
_ (FixSig XFixSig GhcPs
_ FixitySig GhcPs
x))) = (FixityInfo -> Setting) -> [FixityInfo] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map FixityInfo -> Setting
Infix ([FixityInfo] -> [Setting]) -> [FixityInfo] -> [Setting]
forall a b. (a -> b) -> a -> b
$ FixitySig GhcPs -> [FixityInfo]
fromFixitySig FixitySig GhcPs
x
findSetting LocatedA (HsDecl GhcPs)
x = []


findBind :: HsBind GhcPs -> [Setting]
findBind :: HsBind GhcPs -> [Setting]
findBind VarBind{IdP GhcPs
var_id :: IdP GhcPs
var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id, LHsExpr GhcPs
var_rhs :: LHsExpr GhcPs
var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
var_rhs} = IdP GhcPs -> [String] -> HsExpr GhcPs -> [Setting]
findExp IdP GhcPs
var_id [] (HsExpr GhcPs -> [Setting]) -> HsExpr GhcPs -> [Setting]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
var_rhs
findBind FunBind{LIdP GhcPs
fun_id :: LIdP GhcPs
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id, MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches :: MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches} = IdP GhcPs -> [String] -> HsExpr GhcPs -> [Setting]
findExp (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fun_id) [] (HsExpr GhcPs -> [Setting]) -> HsExpr GhcPs -> [Setting]
forall a b. (a -> b) -> a -> b
$ XLam GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcPs
NoExtField
noExtField MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches
findBind HsBind GhcPs
_ = []

findExp :: IdP GhcPs -> [String] -> HsExpr GhcPs -> [Setting]
findExp :: IdP GhcPs -> [String] -> HsExpr GhcPs -> [Setting]
findExp IdP GhcPs
name [String]
vs (HsLam XLam GhcPs
_ MG{mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts=L SrcSpanAnnL
_ [L SrcSpanAnnA
_ Match{[LPat GhcPs]
m_pats :: [LPat GhcPs]
m_pats :: forall p body. Match p body -> [LPat p]
m_pats, m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss=GRHSs{grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs=[L SrcAnn NoEpAnns
_ (GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [] GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)], grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds=(EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_)}}]})
    = if [GenLocated SrcSpanAnnA (Pat GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ps then IdP GhcPs -> [String] -> HsExpr GhcPs -> [Setting]
findExp IdP GhcPs
name ([String]
vs[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String]
ps) (HsExpr GhcPs -> [Setting]) -> HsExpr GhcPs -> [Setting]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
x else []
    where ps :: [String]
ps = [GenLocated SrcSpanAnnN RdrName -> String
rdrNameStr LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
x | L SrcSpanAnnA
_ (VarPat XVarPat GhcPs
_ LIdP GhcPs
x) <- [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
m_pats]
findExp IdP GhcPs
name [String]
vs HsLam{} = []
findExp IdP GhcPs
name [String]
vs HsVar{} = []
findExp IdP GhcPs
name [String]
vs (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
dot LHsExpr GhcPs
y) | LHsExpr GhcPs -> Bool
isDot LHsExpr GhcPs
dot = IdP GhcPs -> [String] -> HsExpr GhcPs -> [Setting]
findExp IdP GhcPs
name ([String]
vs[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
"_hlint"]) (HsExpr GhcPs -> [Setting]) -> HsExpr GhcPs -> [Setting]
forall a b. (a -> b) -> a -> b
$
    XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsPar (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
y (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ String -> HsExpr GhcPs
mkVar String
"_hlint"

findExp IdP GhcPs
name [String]
vs HsExpr GhcPs
bod = [HintRule -> Setting
SettingMatchExp (HintRule -> Setting) -> HintRule -> Setting
forall a b. (a -> b) -> a -> b
$
        Severity
-> String
-> [Note]
-> Scope
-> HsExtendInstances (LHsExpr GhcPs)
-> HsExtendInstances (LHsExpr GhcPs)
-> Maybe (HsExtendInstances (LHsExpr GhcPs))
-> HintRule
HintRule Severity
Warning String
defaultHintName []
        Scope
forall a. Monoid a => a
mempty (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> HsExtendInstances a
extendInstances GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs) (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> HsExtendInstances a
extendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs) Maybe (HsExtendInstances (LHsExpr GhcPs))
Maybe (HsExtendInstances (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. Maybe a
Nothing]
    where
        lhs :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs = GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ (HsExpr GhcPs -> HsExpr GhcPs) -> HsExpr GhcPs -> HsExpr GhcPs
forall on. Uniplate on => (on -> on) -> on -> on
transform HsExpr GhcPs -> HsExpr GhcPs
f HsExpr GhcPs
bod
        rhs :: LHsExpr GhcPs
rhs = [LHsExpr GhcPs] -> LHsExpr GhcPs
apps ([LHsExpr GhcPs] -> LHsExpr GhcPs)
-> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ (HsExpr GhcPs -> LHsExpr GhcPs)
-> [HsExpr GhcPs] -> [LHsExpr GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map HsExpr GhcPs -> LHsExpr GhcPs
HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA ([HsExpr GhcPs] -> [LHsExpr GhcPs])
-> [HsExpr GhcPs] -> [LHsExpr GhcPs]
forall a b. (a -> b) -> a -> b
$ XVar GhcPs -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
noLocA IdP GhcPs
RdrName
name) HsExpr GhcPs -> [HsExpr GhcPs] -> [HsExpr GhcPs]
forall a. a -> [a] -> [a]
: ((String, HsExpr GhcPs) -> HsExpr GhcPs)
-> [(String, HsExpr GhcPs)] -> [HsExpr GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map (String, HsExpr GhcPs) -> HsExpr GhcPs
forall a b. (a, b) -> b
snd [(String, HsExpr GhcPs)]
rep

        rep :: [(String, HsExpr GhcPs)]
rep = [String] -> [HsExpr GhcPs] -> [(String, HsExpr GhcPs)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
vs ([HsExpr GhcPs] -> [(String, HsExpr GhcPs)])
-> [HsExpr GhcPs] -> [(String, HsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ (Char -> HsExpr GhcPs) -> String -> [HsExpr GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map (String -> HsExpr GhcPs
mkVar (String -> HsExpr GhcPs)
-> (Char -> String) -> Char -> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [Char
'a'..]
        f :: HsExpr GhcPs -> HsExpr GhcPs
f (HsVar XVar GhcPs
_ LIdP GhcPs
x) | Just HsExpr GhcPs
y <- String -> [(String, HsExpr GhcPs)] -> Maybe (HsExpr GhcPs)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (GenLocated SrcSpanAnnN RdrName -> String
rdrNameStr LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
x) [(String, HsExpr GhcPs)]
rep = HsExpr GhcPs
y
        f (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
dol LHsExpr GhcPs
y) | LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
dol = XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsPar LHsExpr GhcPs
y
        f HsExpr GhcPs
x = HsExpr GhcPs
x


mkVar :: String -> HsExpr GhcPs
mkVar :: String -> HsExpr GhcPs
mkVar = XVar GhcPs -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
noExtField (GenLocated SrcSpanAnnN RdrName -> HsExpr GhcPs)
-> (String -> GenLocated SrcSpanAnnN RdrName)
-> String
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
noLocA (RdrName -> GenLocated SrcSpanAnnN RdrName)
-> (String -> RdrName) -> String -> GenLocated SrcSpanAnnN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> RdrName
Unqual (OccName -> RdrName) -> (String -> OccName) -> String -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OccName
mkVarOcc