1module Language.PureScript.Ide.Usage
2  ( findReexportingModules
3  , directDependants
4  , eligibleModules
5  , applySearch
6  , findUsages
7  ) where
8
9import           Protolude hiding (moduleName)
10
11import qualified Data.Map as Map
12import qualified Data.Set as Set
13import qualified Language.PureScript as P
14import           Language.PureScript.Ide.State (getAllModules, getFileState)
15import           Language.PureScript.Ide.Types
16import           Language.PureScript.Ide.Util
17import           Lens.Micro.Platform (preview)
18
19-- |
20-- How we find usages, given an IdeDeclaration and the module it was defined in:
21--
22-- 1. Find all modules that reexport the given declaration
23-- 2. Find all modules that import from those modules, and while traversing the
24-- imports build a specification for how the identifier can be found in the
25-- module.
26-- 3. Apply the collected search specifications and collect the results
27findUsages
28  :: (MonadIO m, Ide m)
29  => IdeDeclaration
30  -> P.ModuleName
31  -> m (ModuleMap (NonEmpty P.SourceSpan))
32findUsages declaration moduleName = do
33  ms <- getAllModules Nothing
34  asts <- Map.map fst . fsModules <$> getFileState
35  let elig = eligibleModules (moduleName, declaration) ms asts
36  pure
37    $ Map.mapMaybe nonEmpty
38    $ Map.mapWithKey (\mn searches ->
39        foldMap (\m -> foldMap (applySearch m) searches) (Map.lookup mn asts)) elig
40
41-- | A declaration can either be imported qualified, or unqualified. All the
42-- information we need to find usages through a Traversal is thus captured in
43-- the `Search` type.
44type Search = P.Qualified IdeDeclaration
45
46findReexportingModules
47  :: (P.ModuleName, IdeDeclaration)
48  -- ^ The declaration and the module it is defined in for which we are
49  -- searching usages
50  -> ModuleMap [IdeDeclarationAnn]
51  -- ^ Our declaration cache. Needs to have reexports resolved
52  -> [P.ModuleName]
53  -- ^ All the modules that reexport the declaration. This does NOT include
54  -- the defining module
55findReexportingModules (moduleName, declaration) decls =
56  Map.keys (Map.filter (any hasReexport) decls)
57  where
58    hasReexport d =
59      (d & _idaDeclaration & identifierFromIdeDeclaration) == identifierFromIdeDeclaration declaration
60      && (d & _idaAnnotation & _annExportedFrom) == Just moduleName
61      && (d & _idaDeclaration & namespaceForDeclaration) == namespaceForDeclaration declaration
62
63directDependants :: IdeDeclaration -> ModuleMap P.Module -> P.ModuleName -> ModuleMap (NonEmpty Search)
64directDependants declaration modules mn = Map.mapMaybe (nonEmpty . go) modules
65  where
66    go :: P.Module -> [Search]
67    go = foldMap isImporting . P.getModuleDeclarations
68
69    isImporting d = case d of
70      P.ImportDeclaration _ mn' it qual | mn == mn' -> P.Qualified qual <$> case it of
71        P.Implicit -> pure declaration
72        P.Explicit refs
73          | any (declaration `matchesRef`) refs -> pure declaration
74        P.Explicit _ -> []
75        P.Hiding refs
76          | not (any (declaration `matchesRef`) refs) -> pure declaration
77        P.Hiding _ -> []
78      _ -> []
79
80-- | Determines whether an IdeDeclaration is referenced by a DeclarationRef.
81--
82-- TODO(Christoph): We should also extract the spans of matching refs here,
83-- since they also count as a usage (at least for rename refactorings)
84matchesRef :: IdeDeclaration -> P.DeclarationRef -> Bool
85matchesRef declaration ref = case declaration of
86  IdeDeclValue valueDecl -> case ref of
87    P.ValueRef _ i -> i == _ideValueIdent valueDecl
88    _ -> False
89  IdeDeclType typeDecl -> case ref of
90    P.TypeRef _ tn _ -> tn == _ideTypeName typeDecl
91    _ -> False
92  IdeDeclTypeSynonym synonym -> case ref of
93    P.TypeRef _ tn _ -> tn == _ideSynonymName synonym
94    _ -> False
95  IdeDeclDataConstructor dtor -> case ref of
96    P.TypeRef _ tn dtors
97    -- We check if the given data constructor constructs the type imported
98    -- here.
99    -- This way we match `Just` with an import like `import Data.Maybe (Maybe(..))`
100      | _ideDtorTypeName dtor == tn ->
101          maybe True (elem (_ideDtorName dtor)) dtors
102    _ -> False
103  IdeDeclTypeClass typeClass -> case ref of
104    P.TypeClassRef _ name -> name == _ideTCName typeClass
105    _ -> False
106  IdeDeclValueOperator valueOperator -> case ref of
107    P.ValueOpRef _ opName -> opName == _ideValueOpName valueOperator
108    _ -> False
109  IdeDeclTypeOperator typeOperator -> case ref of
110    P.TypeOpRef _ opName -> opName == _ideTypeOpName typeOperator
111    _ -> False
112  IdeDeclModule m -> case ref of
113    P.ModuleRef _ mn -> m == mn
114    _ -> False
115
116eligibleModules
117  :: (P.ModuleName, IdeDeclaration)
118  -> ModuleMap [IdeDeclarationAnn]
119  -> ModuleMap P.Module
120  -> ModuleMap (NonEmpty Search)
121eligibleModules query@(moduleName, declaration) decls modules =
122  let
123    searchDefiningModule = P.Qualified Nothing declaration :| []
124  in
125    Map.insert moduleName searchDefiningModule $
126      foldMap (directDependants declaration modules) (moduleName :| findReexportingModules query decls)
127
128-- | Finds all usages for a given `Search` throughout a module
129applySearch :: P.Module -> Search -> [P.SourceSpan]
130applySearch module_ search =
131  foldMap findUsageInDeclaration decls
132  where
133    decls = P.getModuleDeclarations module_
134    findUsageInDeclaration =
135      let
136        (extr, _, _, _, _) = P.everythingWithScope mempty goExpr goBinder mempty mempty
137      in
138        extr mempty
139
140    goExpr scope expr = case expr of
141      P.Var sp i
142        | Just ideValue <- preview _IdeDeclValue (P.disqualify search)
143        , P.isQualified search
144          || not (P.LocalIdent (_ideValueIdent ideValue) `Set.member` scope) ->
145          [sp | map P.runIdent i == map identifierFromIdeDeclaration search]
146      P.Constructor sp name
147        | Just ideDtor <- traverse (preview _IdeDeclDataConstructor) search ->
148          [sp | name == map _ideDtorName ideDtor]
149      P.Op sp opName
150        | Just ideOp <- traverse (preview _IdeDeclValueOperator) search ->
151          [sp | opName == map _ideValueOpName ideOp]
152      _ -> []
153
154    goBinder _ binder = case binder of
155      P.ConstructorBinder sp ctorName _
156        | Just ideDtor <- traverse (preview _IdeDeclDataConstructor) search ->
157          [sp | ctorName == map _ideDtorName ideDtor]
158      P.OpBinder sp opName
159        | Just op <- traverse (preview _IdeDeclValueOperator) search ->
160          [sp | opName == map _ideValueOpName op]
161      _ -> []
162