{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module GHC.Util.Scope (
Scope'
,scopeCreate',scopeImports',scopeMatch',scopeMove'
) where
import HsSyn
import SrcLoc
import BasicTypes
import Module
import FastString
import RdrName
import OccName
import GHC.Util.Module
import GHC.Util.RdrName
import Outputable
import Data.List
import Data.List.Extra
import Data.Maybe
newtype Scope' = Scope' [LImportDecl GhcPs]
deriving (Rational -> Scope' -> SDoc
Scope' -> SDoc
(Scope' -> SDoc)
-> (Rational -> Scope' -> SDoc) -> Outputable Scope'
forall a. (a -> SDoc) -> (Rational -> a -> SDoc) -> Outputable a
pprPrec :: Rational -> Scope' -> SDoc
$cpprPrec :: Rational -> Scope' -> SDoc
ppr :: Scope' -> SDoc
$cppr :: Scope' -> SDoc
Outputable, Semigroup Scope'
Scope'
Semigroup Scope' =>
Scope'
-> (Scope' -> Scope' -> Scope')
-> ([Scope'] -> Scope')
-> Monoid 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'
$cp1Monoid :: Semigroup Scope'
Monoid, b -> Scope' -> Scope'
NonEmpty Scope' -> Scope'
Scope' -> Scope' -> Scope'
(Scope' -> Scope' -> Scope')
-> (NonEmpty Scope' -> Scope')
-> (forall b. Integral b => b -> Scope' -> Scope')
-> Semigroup 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 :: 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)
scopeCreate' :: HsModule GhcPs -> Scope'
scopeCreate' :: HsModule GhcPs -> Scope'
scopeCreate' xs :: HsModule GhcPs
xs = [LImportDecl GhcPs] -> Scope'
Scope' ([LImportDecl GhcPs] -> Scope') -> [LImportDecl GhcPs] -> Scope'
forall a b. (a -> b) -> a -> b
$ [LImportDecl GhcPs
prelude | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (LImportDecl GhcPs -> Bool) -> [LImportDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LImportDecl GhcPs -> Bool
isPrelude [LImportDecl GhcPs]
res] [LImportDecl GhcPs] -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. [a] -> [a] -> [a]
++ [LImportDecl GhcPs]
res
where
pkg :: LImportDecl GhcPs -> Maybe StringLiteral
pkg :: LImportDecl GhcPs -> Maybe StringLiteral
pkg (LL _ x :: SrcSpanLess (LImportDecl GhcPs)
x) = ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual SrcSpanLess (LImportDecl GhcPs)
ImportDecl GhcPs
x
pkg _ = Maybe StringLiteral
forall a. Maybe a
Nothing
res :: [LImportDecl GhcPs]
res :: [LImportDecl GhcPs]
res = [LImportDecl GhcPs
x | LImportDecl GhcPs
x <- HsModule GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports HsModule GhcPs
xs , LImportDecl GhcPs -> Maybe StringLiteral
pkg LImportDecl GhcPs
x Maybe StringLiteral -> Maybe StringLiteral -> Bool
forall a. Eq a => a -> a -> Bool
/= StringLiteral -> Maybe StringLiteral
forall a. a -> Maybe a
Just (SourceText -> FastString -> StringLiteral
StringLiteral SourceText
NoSourceText (String -> FastString
fsLit "hint"))]
prelude :: LImportDecl GhcPs
prelude :: LImportDecl GhcPs
prelude = SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs)
-> SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs
forall a b. (a -> b) -> a -> b
$ ModuleName -> ImportDecl GhcPs
forall (p :: Pass). ModuleName -> ImportDecl (GhcPass p)
simpleImportDecl (String -> ModuleName
mkModuleName "Prelude")
isPrelude :: LImportDecl GhcPs -> Bool
isPrelude :: LImportDecl GhcPs -> Bool
isPrelude (LL _ x :: SrcSpanLess (LImportDecl GhcPs)
x) = Located ModuleName -> String
fromModuleName' (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName SrcSpanLess (LImportDecl GhcPs)
ImportDecl GhcPs
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "Prelude"
isPrelude _ = Bool
False
scopeImports' :: Scope' -> [LImportDecl GhcPs]
scopeImports' :: Scope' -> [LImportDecl GhcPs]
scopeImports' (Scope' x :: [LImportDecl GhcPs]
x) = [LImportDecl GhcPs]
x
scopeMatch' :: (Scope', Located RdrName) -> (Scope', Located RdrName) -> Bool
scopeMatch' :: (Scope', Located RdrName) -> (Scope', Located RdrName) -> Bool
scopeMatch' (a :: Scope'
a, x :: Located RdrName
x) (b :: Scope'
b, y :: Located RdrName
y)
| Located RdrName -> Bool
isSpecial' Located RdrName
x Bool -> Bool -> Bool
&& Located RdrName -> Bool
isSpecial' Located RdrName
y = Located RdrName -> String
rdrNameStr' Located RdrName
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Located RdrName -> String
rdrNameStr' Located RdrName
y
| Located RdrName -> Bool
isSpecial' Located RdrName
x Bool -> Bool -> Bool
|| Located RdrName -> Bool
isSpecial' Located RdrName
y = Bool
False
| Bool
otherwise =
Located RdrName -> String
rdrNameStr' (Located RdrName -> Located RdrName
unqual' Located RdrName
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Located RdrName -> String
rdrNameStr' (Located RdrName -> Located RdrName
unqual' Located RdrName
y) Bool -> Bool -> Bool
&& Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Scope' -> Located RdrName -> [String]
possModules' Scope'
a Located RdrName
x [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` Scope' -> Located RdrName -> [String]
possModules' Scope'
b Located RdrName
y)
scopeMove' :: (Scope', Located RdrName) -> Scope' -> Located RdrName
scopeMove' :: (Scope', Located RdrName) -> Scope' -> Located RdrName
scopeMove' (a :: Scope'
a, x :: Located RdrName
x@(Located RdrName -> Maybe OccName
fromQual' -> Just name :: OccName
name)) (Scope' b :: [LImportDecl GhcPs]
b) = case [ImportDecl GhcPs]
imps of
[] -> [Located RdrName] -> Located RdrName
forall a. [a] -> a
head ([Located RdrName] -> Located RdrName)
-> [Located RdrName] -> Located RdrName
forall a b. (a -> b) -> a -> b
$ [Located RdrName]
real [Located RdrName] -> [Located RdrName] -> [Located RdrName]
forall a. [a] -> [a] -> [a]
++ [Located RdrName
x]
imp :: ImportDecl GhcPs
imp:_ | (ImportDecl GhcPs -> Bool) -> [ImportDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
ideclQualified [ImportDecl GhcPs]
imps -> SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located RdrName) -> Located RdrName)
-> SrcSpanLess (Located RdrName) -> Located RdrName
forall a b. (a -> b) -> a -> b
$ ModuleName -> OccName -> RdrName
mkRdrQual (Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> ModuleName)
-> (Maybe (Located ModuleName) -> Located ModuleName)
-> Maybe (Located ModuleName)
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModuleName
-> Maybe (Located ModuleName) -> Located ModuleName
forall a. a -> Maybe a -> a
fromMaybe (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
imp) (Maybe (Located ModuleName) -> ModuleName)
-> Maybe (Located ModuleName) -> ModuleName
forall a b. (a -> b) -> a -> b
$ (ImportDecl GhcPs -> Maybe (Located ModuleName))
-> [ImportDecl GhcPs] -> Maybe (Located ModuleName)
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs [ImportDecl GhcPs]
imps) OccName
name
| Bool
otherwise -> Located RdrName -> Located RdrName
unqual' Located RdrName
x
where
real :: [Located RdrName]
real :: [Located RdrName]
real = [SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located RdrName) -> Located RdrName)
-> SrcSpanLess (Located RdrName) -> Located RdrName
forall a b. (a -> b) -> a -> b
$ ModuleName -> OccName -> RdrName
mkRdrQual (String -> ModuleName
mkModuleName String
m) OccName
name | String
m <- Scope' -> Located RdrName -> [String]
possModules' Scope'
a Located RdrName
x]
imps :: [ImportDecl GhcPs]
imps :: [ImportDecl GhcPs]
imps = [LImportDecl GhcPs -> SrcSpanLess (LImportDecl GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LImportDecl GhcPs
i | Located RdrName
r <- [Located RdrName]
real, LImportDecl GhcPs
i <- [LImportDecl GhcPs]
b, LImportDecl GhcPs -> Located RdrName -> Bool
possImport' LImportDecl GhcPs
i Located RdrName
r]
scopeMove' (_, x :: Located RdrName
x) _ = Located RdrName
x
possModules' :: Scope' -> Located RdrName -> [String]
possModules' :: Scope' -> Located RdrName -> [String]
possModules' (Scope' is :: [LImportDecl GhcPs]
is) x :: Located RdrName
x = Located RdrName -> [String]
f Located RdrName
x
where
res :: [String]
res :: [String]
res = [Located ModuleName -> String
fromModuleName' (Located ModuleName -> String) -> Located ModuleName -> String
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName (LImportDecl GhcPs -> SrcSpanLess (LImportDecl GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LImportDecl GhcPs
i) | LImportDecl GhcPs
i <- [LImportDecl GhcPs]
is, LImportDecl GhcPs -> Located RdrName -> Bool
possImport' LImportDecl GhcPs
i Located RdrName
x]
f :: Located RdrName -> [String]
f :: Located RdrName -> [String]
f n :: Located RdrName
n | Located RdrName -> Bool
isSpecial' Located RdrName
n = [""]
f (L _ (Qual mod :: ModuleName
mod _)) = [ModuleName -> String
moduleNameString ModuleName
mod | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
res] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
res
f _ = [String]
res
possImport' :: LImportDecl GhcPs -> Located RdrName -> Bool
possImport' :: LImportDecl GhcPs -> Located RdrName -> Bool
possImport' i :: LImportDecl GhcPs
i n :: Located RdrName
n | Located RdrName -> Bool
isSpecial' Located RdrName
n = Bool
False
possImport' (LL _ i :: SrcSpanLess (LImportDecl GhcPs)
i) (L _ (Qual mod :: ModuleName
mod x :: OccName
x)) =
ModuleName -> String
moduleNameString ModuleName
mod String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Located ModuleName -> String) -> [Located ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Located ModuleName -> String
fromModuleName' [Located ModuleName]
ms Bool -> Bool -> Bool
&& LImportDecl GhcPs -> Located RdrName -> Bool
possImport' (SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LImportDecl GhcPs)
ImportDecl GhcPs
i{ideclQualified :: Bool
ideclQualified=Bool
False}) (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located RdrName) -> Located RdrName)
-> SrcSpanLess (Located RdrName) -> Located RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual OccName
x)
where ms :: [Located ModuleName]
ms = ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName SrcSpanLess (LImportDecl GhcPs)
ImportDecl GhcPs
i Located ModuleName -> [Located ModuleName] -> [Located ModuleName]
forall a. a -> [a] -> [a]
: Maybe (Located ModuleName) -> [Located ModuleName]
forall a. Maybe a -> [a]
maybeToList (ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs SrcSpanLess (LImportDecl GhcPs)
ImportDecl GhcPs
i)
possImport' (LL _ i :: SrcSpanLess (LImportDecl GhcPs)
i) (L _ (Unqual x :: OccName
x)) = Bool -> Bool
not (ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
ideclQualified SrcSpanLess (LImportDecl GhcPs)
ImportDecl GhcPs
i) Bool -> Bool -> Bool
&& Bool
-> ((Bool, Located [LIE GhcPs]) -> Bool)
-> Maybe (Bool, Located [LIE GhcPs])
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool, Located [LIE GhcPs]) -> Bool
f (ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding SrcSpanLess (LImportDecl GhcPs)
ImportDecl GhcPs
i)
where
f :: (Bool, Located [LIE GhcPs]) -> Bool
f :: (Bool, Located [LIE GhcPs]) -> Bool
f (hide :: Bool
hide, L _ xs :: [LIE GhcPs]
xs) =
if Bool
hide then
Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> [Maybe Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Maybe Bool]
ms
else
Maybe Bool
forall a. Maybe a
Nothing Maybe Bool -> [Maybe Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Bool]
ms Bool -> Bool -> Bool
|| Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> [Maybe Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Bool]
ms
where ms :: [Maybe Bool]
ms = (LIE GhcPs -> Maybe Bool) -> [LIE GhcPs] -> [Maybe Bool]
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 _ (IEVar _ y :: LIEWrappedName (IdP GhcPs)
y)) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== LIEWrappedName RdrName -> String
unwrapName LIEWrappedName RdrName
LIEWrappedName (IdP GhcPs)
y
g (L _ (IEThingAbs _ y :: LIEWrappedName (IdP GhcPs)
y)) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== LIEWrappedName RdrName -> String
unwrapName LIEWrappedName RdrName
LIEWrappedName (IdP GhcPs)
y
g (L _ (IEThingAll _ y :: LIEWrappedName (IdP GhcPs)
y)) = if String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== LIEWrappedName RdrName -> String
unwrapName LIEWrappedName RdrName
LIEWrappedName (IdP GhcPs)
y then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing
g (L _ (IEThingWith _ y :: LIEWrappedName (IdP GhcPs)
y _wildcard :: IEWildcard
_wildcard ys :: [LIEWrappedName (IdP GhcPs)]
ys _fields :: [Located (FieldLbl (IdP GhcPs))]
_fields)) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ String
tag String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LIEWrappedName RdrName -> String
unwrapName LIEWrappedName RdrName
LIEWrappedName (IdP GhcPs)
y String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (LIEWrappedName RdrName -> String)
-> [LIEWrappedName RdrName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map LIEWrappedName RdrName -> String
unwrapName [LIEWrappedName RdrName]
[LIEWrappedName (IdP GhcPs)]
ys
g _ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
unwrapName :: LIEWrappedName RdrName -> String
unwrapName :: LIEWrappedName RdrName -> String
unwrapName x :: LIEWrappedName RdrName
x = OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> RdrName
forall name. IEWrappedName name -> name
ieWrappedName (LIEWrappedName RdrName -> SrcSpanLess (LIEWrappedName RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LIEWrappedName RdrName
x))
possImport' _ _ = Bool
False