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

-- |
-- How we find usages, given an IdeDeclaration and the module it was defined in:
--
-- 1. Find all modules that reexport the given declaration
-- 2. Find all modules that import from those modules, and while traversing the
-- imports build a specification for how the identifier can be found in the
-- module.
-- 3. Apply the collected search specifications and collect the results
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

-- | A declaration can either be imported qualified, or unqualified. All the
-- information we need to find usages through a Traversal is thus captured in
-- the `Search` type.
type Search = P.Qualified IdeDeclaration

findReexportingModules
  :: (P.ModuleName, IdeDeclaration)
  -- ^ The declaration and the module it is defined in for which we are
  -- searching usages
  -> ModuleMap [IdeDeclarationAnn]
  -- ^ Our declaration cache. Needs to have reexports resolved
  -> [P.ModuleName]
  -- ^ All the modules that reexport the declaration. This does NOT include
  -- the defining module
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
_ -> []

-- | Determines whether an IdeDeclaration is referenced by a DeclarationRef.
--
-- TODO(Christoph): We should also extract the spans of matching refs here,
-- since they also count as a usage (at least for rename refactorings)
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
    -- We check if the given data constructor constructs the type imported
    -- here.
    -- This way we match `Just` with an import like `import Data.Maybe (Maybe(..))`
      | 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)

-- | Finds all usages for a given `Search` throughout a module
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
_ -> []