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