{-# Language ViewPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module GHC.Util.Scope (
Scope
,scopeCreate,scopeMatch,scopeMove,possModules
) where
import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Types.SourceText
import GHC.Data.FastString
import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence
import GHC.Types.PkgQual
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import Data.List.Extra
import Data.Maybe
import Data.Bifunctor
newtype Scope = Scope [LImportDecl GhcPs]
deriving (Semigroup Scope
Scope
[Scope] -> Scope
Scope -> Scope -> Scope
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Scope] -> Scope
$cmconcat :: [Scope] -> Scope
mappend :: Scope -> Scope -> Scope
$cmappend :: Scope -> Scope -> Scope
mempty :: Scope
$cmempty :: Scope
Monoid, NonEmpty Scope -> Scope
Scope -> Scope -> Scope
forall b. Integral b => b -> Scope -> Scope
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Scope -> Scope
$cstimes :: forall b. Integral b => b -> Scope -> Scope
sconcat :: NonEmpty Scope -> Scope
$csconcat :: NonEmpty Scope -> Scope
<> :: Scope -> Scope -> Scope
$c<> :: Scope -> Scope -> Scope
Semigroup)
instance Show Scope where
show :: Scope -> String
show (Scope [LImportDecl GhcPs]
x) = forall a. Outputable a => a -> String
unsafePrettyPrint [LImportDecl GhcPs]
x
scopeCreate :: HsModule GhcPs -> Scope
scopeCreate :: HsModule GhcPs -> Scope
scopeCreate HsModule GhcPs
xs = [LImportDecl GhcPs] -> Scope
Scope forall a b. (a -> b) -> a -> b
$ [LImportDecl GhcPs
prelude | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LImportDecl GhcPs -> Bool
isPrelude [LImportDecl GhcPs]
res] forall a. [a] -> [a] -> [a]
++ [LImportDecl GhcPs]
res
where
pkg :: LImportDecl GhcPs -> Maybe StringLiteral
pkg :: LImportDecl GhcPs -> Maybe StringLiteral
pkg (L SrcSpanAnnA
_ ImportDecl GhcPs
x) =
case forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual ImportDecl GhcPs
x of
RawPkgQual StringLiteral
s -> forall a. a -> Maybe a
Just StringLiteral
s
RawPkgQual
ImportDeclPkgQual GhcPs
NoRawPkgQual -> forall a. Maybe a
Nothing
res :: [LImportDecl GhcPs]
res :: [LImportDecl GhcPs]
res = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x | GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x <- forall p. HsModule p -> [LImportDecl p]
hsmodImports HsModule GhcPs
xs
, LImportDecl GhcPs -> Maybe StringLiteral
pkg GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just (SourceText -> FastString -> Maybe RealSrcSpan -> StringLiteral
StringLiteral SourceText
NoSourceText (String -> FastString
fsLit String
"hint") forall a. Maybe a
Nothing)
]
prelude :: LImportDecl GhcPs
prelude :: LImportDecl GhcPs
prelude = forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ ModuleName -> ImportDecl GhcPs
simpleImportDecl (String -> ModuleName
mkModuleName String
"Prelude")
isPrelude :: LImportDecl GhcPs -> Bool
isPrelude :: LImportDecl GhcPs -> Bool
isPrelude (L SrcSpanAnnA
_ ImportDecl GhcPs
x) = ModuleName -> String
moduleNameString (forall l e. GenLocated l e -> e
unLoc (forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
x)) forall a. Eq a => a -> a -> Bool
== String
"Prelude"
scopeMatch :: (Scope, LocatedN RdrName) -> (Scope, LocatedN RdrName) -> Bool
scopeMatch :: (Scope, GenLocated SrcSpanAnnN RdrName)
-> (Scope, GenLocated SrcSpanAnnN RdrName) -> Bool
scopeMatch (Scope
a, GenLocated SrcSpanAnnN RdrName
x) (Scope
b, GenLocated SrcSpanAnnN RdrName
y)
| GenLocated SrcSpanAnnN RdrName -> Bool
isSpecial GenLocated SrcSpanAnnN RdrName
x Bool -> Bool -> Bool
&& GenLocated SrcSpanAnnN RdrName -> Bool
isSpecial GenLocated SrcSpanAnnN RdrName
y = GenLocated SrcSpanAnnN RdrName -> String
rdrNameStr GenLocated SrcSpanAnnN RdrName
x forall a. Eq a => a -> a -> Bool
== GenLocated SrcSpanAnnN RdrName -> String
rdrNameStr GenLocated SrcSpanAnnN RdrName
y
| GenLocated SrcSpanAnnN RdrName -> Bool
isSpecial GenLocated SrcSpanAnnN RdrName
x Bool -> Bool -> Bool
|| GenLocated SrcSpanAnnN RdrName -> Bool
isSpecial GenLocated SrcSpanAnnN RdrName
y = Bool
False
| Bool
otherwise =
GenLocated SrcSpanAnnN RdrName -> String
rdrNameStr (GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN RdrName
unqual GenLocated SrcSpanAnnN RdrName
x) forall a. Eq a => a -> a -> Bool
== GenLocated SrcSpanAnnN RdrName -> String
rdrNameStr (GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN RdrName
unqual GenLocated SrcSpanAnnN RdrName
y) Bool -> Bool -> Bool
&& Bool -> Bool
not (Scope -> GenLocated SrcSpanAnnN RdrName -> [ModuleName]
possModules Scope
a GenLocated SrcSpanAnnN RdrName
x forall a. Ord a => [a] -> [a] -> Bool
`disjointOrd` Scope -> GenLocated SrcSpanAnnN RdrName -> [ModuleName]
possModules Scope
b GenLocated SrcSpanAnnN RdrName
y)
scopeMove :: (Scope, LocatedN RdrName) -> Scope -> LocatedN RdrName
scopeMove :: (Scope, GenLocated SrcSpanAnnN RdrName)
-> Scope -> GenLocated SrcSpanAnnN RdrName
scopeMove (Scope
a, x :: GenLocated SrcSpanAnnN RdrName
x@(GenLocated SrcSpanAnnN RdrName -> Maybe OccName
fromQual -> Just OccName
name)) (Scope [LImportDecl GhcPs]
b) = case [ImportDecl GhcPs]
imps of
[] |
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(L SrcSpanAnnN
_ RdrName
x) -> (ModuleName -> String
moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> Maybe (ModuleName, OccName)
isQual_maybe RdrName
x) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"Prelude") [GenLocated SrcSpanAnnN RdrName]
real -> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN RdrName
unqual GenLocated SrcSpanAnnN RdrName
x
| Bool
otherwise -> forall a. a -> [a] -> a
headDef GenLocated SrcSpanAnnN RdrName
x [GenLocated SrcSpanAnnN RdrName]
real
ImportDecl GhcPs
imp:[ImportDecl GhcPs]
_ | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ImportDecl GhcPs
x -> forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
x forall a. Eq a => a -> a -> Bool
/= ImportDeclQualifiedStyle
NotQualified) [ImportDecl GhcPs]
imps -> forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ ModuleName -> OccName -> RdrName
mkRdrQual (forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
imp) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs [ImportDecl GhcPs]
imps) OccName
name
| Bool
otherwise -> GenLocated SrcSpanAnnN RdrName -> GenLocated SrcSpanAnnN RdrName
unqual GenLocated SrcSpanAnnN RdrName
x
where
real :: [LocatedN RdrName]
real :: [GenLocated SrcSpanAnnN RdrName]
real = [forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ ModuleName -> OccName -> RdrName
mkRdrQual ModuleName
m OccName
name | ModuleName
m <- Scope -> GenLocated SrcSpanAnnN RdrName -> [ModuleName]
possModules Scope
a GenLocated SrcSpanAnnN RdrName
x]
imps :: [ImportDecl GhcPs]
imps :: [ImportDecl GhcPs]
imps = [forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i | GenLocated SrcSpanAnnN RdrName
r <- [GenLocated SrcSpanAnnN RdrName]
real, GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i <- [LImportDecl GhcPs]
b, LImportDecl GhcPs -> GenLocated SrcSpanAnnN RdrName -> IsImported
possImport GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i GenLocated SrcSpanAnnN RdrName
r forall a. Eq a => a -> a -> Bool
/= IsImported
NotImported]
scopeMove (Scope
_, GenLocated SrcSpanAnnN RdrName
x) Scope
_ = GenLocated SrcSpanAnnN RdrName
x
possModules :: Scope -> LocatedN RdrName -> [ModuleName]
possModules :: Scope -> GenLocated SrcSpanAnnN RdrName -> [ModuleName]
possModules (Scope [LImportDecl GhcPs]
is) GenLocated SrcSpanAnnN RdrName
x =
[ModuleName
prelude | ModuleName
prelude forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(ModuleName, Bool)]
res, Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a b. (a, b) -> b
snd [(ModuleName, Bool)]
res)] forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(ModuleName, Bool)]
res
where
res0, res :: [(ModuleName, Bool)]
res0 :: [(ModuleName, Bool)]
res0 = [ (forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i, IsImported
isImported forall a. Eq a => a -> a -> Bool
== IsImported
Imported)
| GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i <- [LImportDecl GhcPs]
is, let isImported :: IsImported
isImported = LImportDecl GhcPs -> GenLocated SrcSpanAnnN RdrName -> IsImported
possImport GenLocated SrcSpanAnnA (ImportDecl GhcPs)
i GenLocated SrcSpanAnnN RdrName
x, IsImported
isImported forall a. Eq a => a -> a -> Bool
/= IsImported
NotImported ]
res :: [(ModuleName, Bool)]
res | GenLocated SrcSpanAnnN RdrName -> Bool
isSpecial GenLocated SrcSpanAnnN RdrName
x = [(String -> ModuleName
mkModuleName String
"", Bool
True)]
| L SrcSpanAnnN
_ (Qual ModuleName
mod OccName
_) <- GenLocated SrcSpanAnnN RdrName
x = [(ModuleName
mod, Bool
True) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, Bool)]
res0] forall a. [a] -> [a] -> [a]
++ [(ModuleName, Bool)]
res0
| Bool
otherwise = [(ModuleName, Bool)]
res0
prelude :: ModuleName
prelude = String -> ModuleName
mkModuleName String
"Prelude"
data IsImported = Imported | PossiblyImported | NotImported deriving (IsImported -> IsImported -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsImported -> IsImported -> Bool
$c/= :: IsImported -> IsImported -> Bool
== :: IsImported -> IsImported -> Bool
$c== :: IsImported -> IsImported -> Bool
Eq)
possImport :: LImportDecl GhcPs -> LocatedN RdrName -> IsImported
possImport :: LImportDecl GhcPs -> GenLocated SrcSpanAnnN RdrName -> IsImported
possImport LImportDecl GhcPs
i GenLocated SrcSpanAnnN RdrName
n | GenLocated SrcSpanAnnN RdrName -> Bool
isSpecial GenLocated SrcSpanAnnN RdrName
n = IsImported
NotImported
possImport (L SrcSpanAnnA
_ ImportDecl GhcPs
i) (L SrcSpanAnnN
_ (Qual ModuleName
mod OccName
x)) =
if ModuleName
mod forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
ms Bool -> Bool -> Bool
&& IsImported
NotImported forall a. Eq a => a -> a -> Bool
/= LImportDecl GhcPs -> GenLocated SrcSpanAnnN RdrName -> IsImported
possImport (forall a an. a -> LocatedAn an a
noLocA ImportDecl GhcPs
i{ideclQualified :: ImportDeclQualifiedStyle
ideclQualified=ImportDeclQualifiedStyle
NotQualified}) (forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual OccName
x)
then IsImported
Imported
else IsImported
NotImported
where ms :: [ModuleName]
ms = forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
i forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList (forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs ImportDecl GhcPs
i)
possImport (L SrcSpanAnnA
_ ImportDecl GhcPs
i) (L SrcSpanAnnN
_ (Unqual OccName
x)) =
if forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified ImportDecl GhcPs
i forall a. Eq a => a -> a -> Bool
== ImportDeclQualifiedStyle
NotQualified
then forall b a. b -> (a -> b) -> Maybe a -> b
maybe IsImported
PossiblyImported ((Bool, LocatedL [LIE GhcPs]) -> IsImported
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. Eq a => a -> a -> Bool
== ImportListInterpretation
EverythingBut)) (forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
i)
else IsImported
NotImported
where
f :: (Bool, LocatedL [LIE GhcPs]) -> IsImported
f :: (Bool, LocatedL [LIE GhcPs]) -> IsImported
f (Bool
hide, L SrcSpanAnnL
_ [LIE GhcPs]
xs)
| Bool
hide = if forall a. a -> Maybe a
Just Bool
True forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Bool]
ms then IsImported
NotImported else IsImported
PossiblyImported
| forall a. a -> Maybe a
Just Bool
True forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Bool]
ms = IsImported
Imported
| forall a. Maybe a
Nothing forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Bool]
ms = IsImported
PossiblyImported
| Bool
otherwise = IsImported
NotImported
where ms :: [Maybe Bool]
ms = forall a b. (a -> b) -> [a] -> [b]
map LIE GhcPs -> Maybe Bool
g [LIE GhcPs]
xs
tag :: String
tag :: String
tag = OccName -> String
occNameString OccName
x
g :: LIE GhcPs -> Maybe Bool
g :: LIE GhcPs -> Maybe Bool
g (L SrcSpanAnnA
_ (IEVar XIEVar GhcPs
_ LIEWrappedName GhcPs
y)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
tag forall a. Eq a => a -> a -> Bool
== LIEWrappedName GhcPs -> String
unwrapName LIEWrappedName GhcPs
y
g (L SrcSpanAnnA
_ (IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
y)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
tag forall a. Eq a => a -> a -> Bool
== LIEWrappedName GhcPs -> String
unwrapName LIEWrappedName GhcPs
y
g (L SrcSpanAnnA
_ (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
y)) = if String
tag forall a. Eq a => a -> a -> Bool
== LIEWrappedName GhcPs -> String
unwrapName LIEWrappedName GhcPs
y then forall a. a -> Maybe a
Just Bool
True else forall a. Maybe a
Nothing
g (L SrcSpanAnnA
_ (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
y IEWildcard
_wildcard [LIEWrappedName GhcPs]
ys)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
tag forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LIEWrappedName GhcPs -> String
unwrapName LIEWrappedName GhcPs
y forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map LIEWrappedName GhcPs -> String
unwrapName [LIEWrappedName GhcPs]
ys
g LIE GhcPs
_ = forall a. a -> Maybe a
Just Bool
False
unwrapName :: LIEWrappedName GhcPs -> String
unwrapName :: LIEWrappedName GhcPs -> String
unwrapName LIEWrappedName GhcPs
x = OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc forall a b. (a -> b) -> a -> b
$ forall (p :: Pass). IEWrappedName (GhcPass p) -> IdP (GhcPass p)
ieWrappedName (forall l e. GenLocated l e -> e
unLoc LIEWrappedName GhcPs
x))
possImport LImportDecl GhcPs
_ GenLocated SrcSpanAnnN RdrName
_ = IsImported
NotImported