module Language.PureScript.Ide.Usage
( findReexportingModules
, directDependants
, eligibleModules
, applySearch
, findUsages
) where
import Protolude hiding (moduleName)
import Control.Lens (preview)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Language.PureScript as P
import Language.PureScript.Ide.State (getAllModules, getFileState)
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
findUsages
:: (MonadIO m, Ide m)
=> IdeDeclaration
-> P.ModuleName
-> m (ModuleMap (NonEmpty P.SourceSpan))
findUsages :: forall (m :: * -> *).
(MonadIO m, Ide m) =>
IdeDeclaration -> ModuleName -> m (ModuleMap (NonEmpty SourceSpan))
findUsages IdeDeclaration
declaration ModuleName
moduleName = do
ModuleMap [IdeDeclarationAnn]
ms <- forall (m :: * -> *).
Ide m =>
Maybe ModuleName -> m (ModuleMap [IdeDeclarationAnn])
getAllModules forall a. Maybe a
Nothing
Map ModuleName Module
asts <- forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeFileState -> ModuleMap (Module, FilePath)
fsModules forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Ide m => m IdeFileState
getFileState
let elig :: Map ModuleName (NonEmpty Search)
elig = (ModuleName, IdeDeclaration)
-> ModuleMap [IdeDeclarationAnn]
-> Map ModuleName Module
-> Map ModuleName (NonEmpty Search)
eligibleModules (ModuleName
moduleName, IdeDeclaration
declaration) ModuleMap [IdeDeclarationAnn]
ms Map ModuleName Module
asts
forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\ModuleName
mn NonEmpty Search
searches ->
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Module
m -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Module -> Search -> [SourceSpan]
applySearch Module
m) NonEmpty Search
searches) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
mn Map ModuleName Module
asts)) Map ModuleName (NonEmpty Search)
elig
type Search = P.Qualified IdeDeclaration
findReexportingModules
:: (P.ModuleName, IdeDeclaration)
-> ModuleMap [IdeDeclarationAnn]
-> [P.ModuleName]
findReexportingModules :: (ModuleName, IdeDeclaration)
-> ModuleMap [IdeDeclarationAnn] -> [ModuleName]
findReexportingModules (ModuleName
moduleName, IdeDeclaration
declaration) ModuleMap [IdeDeclarationAnn]
decls =
forall k a. Map k a -> [k]
Map.keys (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any IdeDeclarationAnn -> Bool
hasReexport) ModuleMap [IdeDeclarationAnn]
decls)
where
hasReexport :: IdeDeclarationAnn -> Bool
hasReexport IdeDeclarationAnn
d =
(IdeDeclarationAnn
d forall a b. a -> (a -> b) -> b
& IdeDeclarationAnn -> IdeDeclaration
_idaDeclaration forall a b. a -> (a -> b) -> b
& IdeDeclaration -> Text
identifierFromIdeDeclaration) forall a. Eq a => a -> a -> Bool
== IdeDeclaration -> Text
identifierFromIdeDeclaration IdeDeclaration
declaration
Bool -> Bool -> Bool
&& (IdeDeclarationAnn
d forall a b. a -> (a -> b) -> b
& IdeDeclarationAnn -> Annotation
_idaAnnotation forall a b. a -> (a -> b) -> b
& Annotation -> Maybe ModuleName
_annExportedFrom) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ModuleName
moduleName
Bool -> Bool -> Bool
&& (IdeDeclarationAnn
d forall a b. a -> (a -> b) -> b
& IdeDeclarationAnn -> IdeDeclaration
_idaDeclaration forall a b. a -> (a -> b) -> b
& IdeDeclaration -> IdeNamespace
namespaceForDeclaration) forall a. Eq a => a -> a -> Bool
== IdeDeclaration -> IdeNamespace
namespaceForDeclaration IdeDeclaration
declaration
directDependants :: IdeDeclaration -> ModuleMap P.Module -> P.ModuleName -> ModuleMap (NonEmpty Search)
directDependants :: IdeDeclaration
-> Map ModuleName Module
-> ModuleName
-> Map ModuleName (NonEmpty Search)
directDependants IdeDeclaration
declaration Map ModuleName Module
modules ModuleName
mn = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [Search]
go) Map ModuleName Module
modules
where
go :: P.Module -> [Search]
go :: Module -> [Search]
go = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Declaration -> [Search]
isImporting forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [Declaration]
P.getModuleDeclarations
isImporting :: Declaration -> [Search]
isImporting Declaration
d = case Declaration
d of
P.ImportDeclaration SourceAnn
_ ModuleName
mn' ImportDeclarationType
it Maybe ModuleName
qual | ModuleName
mn forall a. Eq a => a -> a -> Bool
== ModuleName
mn' -> forall a. QualifiedBy -> a -> Qualified a
P.Qualified (Maybe ModuleName -> QualifiedBy
P.byMaybeModuleName Maybe ModuleName
qual) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ImportDeclarationType
it of
ImportDeclarationType
P.Implicit -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeDeclaration
declaration
P.Explicit [DeclarationRef]
refs
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (IdeDeclaration
declaration IdeDeclaration -> DeclarationRef -> Bool
`matchesRef`) [DeclarationRef]
refs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeDeclaration
declaration
P.Explicit [DeclarationRef]
_ -> []
P.Hiding [DeclarationRef]
refs
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (IdeDeclaration
declaration IdeDeclaration -> DeclarationRef -> Bool
`matchesRef`) [DeclarationRef]
refs) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeDeclaration
declaration
P.Hiding [DeclarationRef]
_ -> []
Declaration
_ -> []
matchesRef :: IdeDeclaration -> P.DeclarationRef -> Bool
matchesRef :: IdeDeclaration -> DeclarationRef -> Bool
matchesRef IdeDeclaration
declaration DeclarationRef
ref = case IdeDeclaration
declaration of
IdeDeclValue IdeValue
valueDecl -> case DeclarationRef
ref of
P.ValueRef SourceSpan
_ Ident
i -> Ident
i forall a. Eq a => a -> a -> Bool
== IdeValue -> Ident
_ideValueIdent IdeValue
valueDecl
DeclarationRef
_ -> Bool
False
IdeDeclType IdeType
typeDecl -> case DeclarationRef
ref of
P.TypeRef SourceSpan
_ ProperName 'TypeName
tn Maybe [ProperName 'ConstructorName]
_ -> ProperName 'TypeName
tn forall a. Eq a => a -> a -> Bool
== IdeType -> ProperName 'TypeName
_ideTypeName IdeType
typeDecl
DeclarationRef
_ -> Bool
False
IdeDeclTypeSynonym IdeTypeSynonym
synonym -> case DeclarationRef
ref of
P.TypeRef SourceSpan
_ ProperName 'TypeName
tn Maybe [ProperName 'ConstructorName]
_ -> ProperName 'TypeName
tn forall a. Eq a => a -> a -> Bool
== IdeTypeSynonym -> ProperName 'TypeName
_ideSynonymName IdeTypeSynonym
synonym
DeclarationRef
_ -> Bool
False
IdeDeclDataConstructor IdeDataConstructor
dtor -> case DeclarationRef
ref of
P.TypeRef SourceSpan
_ ProperName 'TypeName
tn Maybe [ProperName 'ConstructorName]
dtors
| IdeDataConstructor -> ProperName 'TypeName
_ideDtorTypeName IdeDataConstructor
dtor forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
tn ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (IdeDataConstructor -> ProperName 'ConstructorName
_ideDtorName IdeDataConstructor
dtor)) Maybe [ProperName 'ConstructorName]
dtors
DeclarationRef
_ -> Bool
False
IdeDeclTypeClass IdeTypeClass
typeClass -> case DeclarationRef
ref of
P.TypeClassRef SourceSpan
_ ProperName 'ClassName
name -> ProperName 'ClassName
name forall a. Eq a => a -> a -> Bool
== IdeTypeClass -> ProperName 'ClassName
_ideTCName IdeTypeClass
typeClass
DeclarationRef
_ -> Bool
False
IdeDeclValueOperator IdeValueOperator
valueOperator -> case DeclarationRef
ref of
P.ValueOpRef SourceSpan
_ OpName 'ValueOpName
opName -> OpName 'ValueOpName
opName forall a. Eq a => a -> a -> Bool
== IdeValueOperator -> OpName 'ValueOpName
_ideValueOpName IdeValueOperator
valueOperator
DeclarationRef
_ -> Bool
False
IdeDeclTypeOperator IdeTypeOperator
typeOperator -> case DeclarationRef
ref of
P.TypeOpRef SourceSpan
_ OpName 'TypeOpName
opName -> OpName 'TypeOpName
opName forall a. Eq a => a -> a -> Bool
== IdeTypeOperator -> OpName 'TypeOpName
_ideTypeOpName IdeTypeOperator
typeOperator
DeclarationRef
_ -> Bool
False
IdeDeclModule ModuleName
m -> case DeclarationRef
ref of
P.ModuleRef SourceSpan
_ ModuleName
mn -> ModuleName
m forall a. Eq a => a -> a -> Bool
== ModuleName
mn
DeclarationRef
_ -> Bool
False
eligibleModules
:: (P.ModuleName, IdeDeclaration)
-> ModuleMap [IdeDeclarationAnn]
-> ModuleMap P.Module
-> ModuleMap (NonEmpty Search)
eligibleModules :: (ModuleName, IdeDeclaration)
-> ModuleMap [IdeDeclarationAnn]
-> Map ModuleName Module
-> Map ModuleName (NonEmpty Search)
eligibleModules query :: (ModuleName, IdeDeclaration)
query@(ModuleName
moduleName, IdeDeclaration
declaration) ModuleMap [IdeDeclarationAnn]
decls Map ModuleName Module
modules =
let
searchDefiningModule :: NonEmpty Search
searchDefiningModule = forall a. QualifiedBy -> a -> Qualified a
P.Qualified QualifiedBy
P.ByNullSourcePos IdeDeclaration
declaration forall a. a -> [a] -> NonEmpty a
:| []
in
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ModuleName
moduleName NonEmpty Search
searchDefiningModule forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (IdeDeclaration
-> Map ModuleName Module
-> ModuleName
-> Map ModuleName (NonEmpty Search)
directDependants IdeDeclaration
declaration Map ModuleName Module
modules) (ModuleName
moduleName forall a. a -> [a] -> NonEmpty a
:| (ModuleName, IdeDeclaration)
-> ModuleMap [IdeDeclarationAnn] -> [ModuleName]
findReexportingModules (ModuleName, IdeDeclaration)
query ModuleMap [IdeDeclarationAnn]
decls)
applySearch :: P.Module -> Search -> [P.SourceSpan]
applySearch :: Module -> Search -> [SourceSpan]
applySearch Module
module_ Search
search =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Declaration -> [SourceSpan]
findUsageInDeclaration [Declaration]
decls
where
decls :: [Declaration]
decls = Module -> [Declaration]
P.getModuleDeclarations Module
module_
findUsageInDeclaration :: Declaration -> [SourceSpan]
findUsageInDeclaration =
let
(Set ScopedIdent -> Declaration -> [SourceSpan]
extr, Set ScopedIdent -> Expr -> [SourceSpan]
_, Set ScopedIdent -> Binder -> [SourceSpan]
_, Set ScopedIdent -> CaseAlternative -> [SourceSpan]
_, Set ScopedIdent -> DoNotationElement -> [SourceSpan]
_) = forall r.
Monoid r =>
(Set ScopedIdent -> Declaration -> r)
-> (Set ScopedIdent -> Expr -> r)
-> (Set ScopedIdent -> Binder -> r)
-> (Set ScopedIdent -> CaseAlternative -> r)
-> (Set ScopedIdent -> DoNotationElement -> r)
-> (Set ScopedIdent -> Declaration -> r,
Set ScopedIdent -> Expr -> r, Set ScopedIdent -> Binder -> r,
Set ScopedIdent -> CaseAlternative -> r,
Set ScopedIdent -> DoNotationElement -> r)
P.everythingWithScope forall a. Monoid a => a
mempty Set ScopedIdent -> Expr -> [SourceSpan]
goExpr Set ScopedIdent -> Binder -> [SourceSpan]
goBinder forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
in
Set ScopedIdent -> Declaration -> [SourceSpan]
extr forall a. Monoid a => a
mempty
goExpr :: Set ScopedIdent -> Expr -> [SourceSpan]
goExpr Set ScopedIdent
scope Expr
expr = case Expr
expr of
P.Var SourceSpan
sp Qualified Ident
i
| Just IdeValue
ideValue <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Traversal' IdeDeclaration IdeValue
_IdeDeclValue (forall a. Qualified a -> a
P.disqualify Search
search)
, forall a. Qualified a -> Bool
P.isQualified Search
search
Bool -> Bool -> Bool
|| Bool -> Bool
not (Ident -> ScopedIdent
P.LocalIdent (IdeValue -> Ident
_ideValueIdent IdeValue
ideValue) forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ScopedIdent
scope) ->
[SourceSpan
sp | forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Ident -> Text
P.runIdent Qualified Ident
i forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeDeclaration -> Text
identifierFromIdeDeclaration Search
search]
P.Constructor SourceSpan
sp Qualified (ProperName 'ConstructorName)
name
| Just Qualified IdeDataConstructor
ideDtor <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Traversal' IdeDeclaration IdeDataConstructor
_IdeDeclDataConstructor) Search
search ->
[SourceSpan
sp | Qualified (ProperName 'ConstructorName)
name forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeDataConstructor -> ProperName 'ConstructorName
_ideDtorName Qualified IdeDataConstructor
ideDtor]
P.Op SourceSpan
sp Qualified (OpName 'ValueOpName)
opName
| Just Qualified IdeValueOperator
ideOp <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Traversal' IdeDeclaration IdeValueOperator
_IdeDeclValueOperator) Search
search ->
[SourceSpan
sp | Qualified (OpName 'ValueOpName)
opName forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeValueOperator -> OpName 'ValueOpName
_ideValueOpName Qualified IdeValueOperator
ideOp]
Expr
_ -> []
goBinder :: Set ScopedIdent -> Binder -> [SourceSpan]
goBinder Set ScopedIdent
_ Binder
binder = case Binder
binder of
P.ConstructorBinder SourceSpan
sp Qualified (ProperName 'ConstructorName)
ctorName [Binder]
_
| Just Qualified IdeDataConstructor
ideDtor <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Traversal' IdeDeclaration IdeDataConstructor
_IdeDeclDataConstructor) Search
search ->
[SourceSpan
sp | Qualified (ProperName 'ConstructorName)
ctorName forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeDataConstructor -> ProperName 'ConstructorName
_ideDtorName Qualified IdeDataConstructor
ideDtor]
P.OpBinder SourceSpan
sp Qualified (OpName 'ValueOpName)
opName
| Just Qualified IdeValueOperator
op <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Traversal' IdeDeclaration IdeValueOperator
_IdeDeclValueOperator) Search
search ->
[SourceSpan
sp | Qualified (OpName 'ValueOpName)
opName forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeValueOperator -> OpName 'ValueOpName
_ideValueOpName Qualified IdeValueOperator
op]
Binder
_ -> []