Skip to content

Commit af3bca2

Browse files
kritzcreekkritzcreek
committed
[psc-ide] Parse type annotations from source files
Then use these parsed type annotations to give back the non-expanded types for functions that contain type synonyms in their annotation.
1 parent 2146080 commit af3bca2

File tree

5 files changed

+41
-17
lines changed

5 files changed

+41
-17
lines changed

‎src/Language/PureScript/Ide/Externs.hs‎

Lines changed: 14 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -17,9 +17,9 @@
1717
{-# LANGUAGE FlexibleContexts #-}
1818

1919
module Language.PureScript.Ide.Externs
20-
( readExternFile,
21-
convertExterns,
22-
annotateLocations
20+
( readExternFile
21+
, convertExterns
22+
, annotateModule
2323
) where
2424

2525
import Protolude
@@ -99,14 +99,17 @@ convertTypeOperator P.ExternsTypeFixity{..} =
9999
efTypePrecedence
100100
efTypeAssociativity
101101

102-
annotateLocations :: Map (Either Text Text) P.SourceSpan -> Module -> Module
103-
annotateLocations ast (moduleName, decls) =
102+
annotateModule
103+
:: (DefinitionSites P.SourceSpan, TypeAnnotations)
104+
-> Module
105+
-> Module
106+
annotateModule (defs, types) (moduleName, decls) =
104107
(moduleName, map convertDeclaration decls)
105108
where
106109
convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn
107110
convertDeclaration (IdeDeclarationAnn ann d) = case d of
108111
IdeValue i t ->
109-
annotateValue (runIdentT i) (IdeValue i t)
112+
annotateFunction i (IdeValue i t)
110113
IdeType i k ->
111114
annotateType (runProperNameT i) (IdeType i k)
112115
IdeTypeSynonym i t ->
@@ -120,5 +123,8 @@ annotateLocations ast (moduleName, decls) =
120123
IdeTypeOperator n i p a ->
121124
annotateType i (IdeTypeOperator n i p a)
122125
where
123-
annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) ast})
124-
annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right x) ast})
126+
annotateFunction x = IdeDeclarationAnn (ann { annLocation = Map.lookup (Left (runIdentT x)) defs
127+
, annTypeAnnotation = Map.lookup x types
128+
})
129+
annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) defs})
130+
annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right x) defs})

‎src/Language/PureScript/Ide/SourceFile.hs‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module Language.PureScript.Ide.SourceFile
1818
( parseModule
1919
, getImportsForFile
2020
, extractSpans
21+
, extractTypeAnnotations
2122
) where
2223

2324
import Protolude
@@ -64,6 +65,16 @@ getImportsForFile fp = do
6465
unwrapImportType (P.Hiding decls) = P.Hiding (map unwrapPositionedRef decls)
6566
unwrapImportType P.Implicit = P.Implicit
6667

68+
-- | Extracts type annotations for functions from a given Module
69+
extractTypeAnnotations
70+
:: [P.Declaration]
71+
-> [(P.Ident, P.Type)]
72+
extractTypeAnnotations = mapMaybe extract
73+
where
74+
extract d = case unwrapPositioned d of
75+
P.TypeDeclaration ident ty -> Just (ident, ty)
76+
_ -> Nothing
77+
6778
-- | Given a surrounding Sourcespan and a Declaration from the PS AST, extracts
6879
-- definition sites inside that Declaration.
6980
extractSpans

‎src/Language/PureScript/Ide/State.hs‎

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -132,10 +132,10 @@ getAllModules mmoduleName = do
132132
Just (cachedModulename, ef)
133133
| cachedModulename == moduleName -> do
134134
(AstData asts) <- s2AstData <$> getStage2
135-
let ast = fromMaybe M.empty (M.lookup moduleName asts)
135+
let ast = fromMaybe (M.empty, M.empty) (M.lookup moduleName asts)
136136
pure . M.toList $
137137
M.insert moduleName
138-
(snd . annotateLocations ast . fst . convertExterns $ ef) declarations
138+
(snd . annotateModule ast . fst . convertExterns $ ef) declarations
139139
_ -> pure (M.toList declarations)
140140

141141
-- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the
@@ -180,8 +180,11 @@ populateStage2 = do
180180
populateStage2STM :: TVar IdeState -> STM ()
181181
populateStage2STM ref = do
182182
modules <- s1Modules <$> getStage1STM ref
183-
let spans = map (\(P.Module ss _ _ decls _, _) -> M.fromList (concatMap (extractSpans ss) decls)) modules
184-
setStage2STM ref (Stage2 (AstData spans))
183+
let astData = map (\(P.Module ss _ _ decls _, _) ->
184+
let definitions = M.fromList (concatMap (extractSpans ss) decls)
185+
typeAnnotations = M.fromList (extractTypeAnnotations decls)
186+
in (definitions, typeAnnotations)) modules
187+
setStage2STM ref (Stage2 (AstData astData))
185188

186189
-- | Resolves reexports and populates Stage3 with data to be used in queries.
187190
populateStage3 :: (Ide m, MonadLogger m) => m ()
@@ -206,7 +209,7 @@ populateStage3STM ref = do
206209
nModules :: Map P.ModuleName (Module, [(P.ModuleName, P.DeclarationRef)])
207210
nModules = M.mapWithKey
208211
(\moduleName (m, refs) ->
209-
(fromMaybe m $ annotateLocations <$> M.lookup moduleName asts <*> pure m, refs)) modules
212+
(fromMaybe m $ annotateModule <$> M.lookup moduleName asts <*> pure m, refs)) modules
210213
-- resolves reexports and discards load failures for now
211214
result = resolveReexports (M.map (snd . fst) nModules) <$> M.elems nModules
212215
setStage3STM ref (Stage3 (M.fromList (map reResolved result)) Nothing)

‎src/Language/PureScript/Ide/Types.hs‎

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -47,15 +47,19 @@ data Annotation
4747
= Annotation
4848
{ annLocation :: Maybe P.SourceSpan
4949
, annExportedFrom :: Maybe P.ModuleName
50+
, annTypeAnnotation :: Maybe P.Type
5051
} deriving (Show, Eq, Ord)
5152

5253
emptyAnn :: Annotation
53-
emptyAnn = Annotation Nothing Nothing
54+
emptyAnn = Annotation Nothing Nothing Nothing
5455

5556
type Module = (P.ModuleName, [IdeDeclarationAnn])
5657

57-
newtype AstData a =
58-
AstData (Map P.ModuleName (Map (Either Text Text) a))
58+
type DefinitionSites a = Map (Either Text Text) a
59+
type TypeAnnotations = Map P.Ident P.Type
60+
newtype AstData a = AstData (Map P.ModuleName (DefinitionSites a, TypeAnnotations))
61+
-- ^ SourceSpans for the definition sites of Values and Types aswell as type
62+
-- annotations found in a module
5963
deriving (Show, Eq, Ord, Functor, Foldable)
6064

6165
data Configuration =

‎src/Language/PureScript/Ide/Util.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,7 @@ completionFromMatch' (Match (m', d)) = case d of
7676

7777
infoFromMatch :: Match IdeDeclarationAnn -> Info
7878
infoFromMatch (Match (m, IdeDeclarationAnn ann d)) =
79-
Info (a, b, c, annLocation ann)
79+
Info (a, b, maybe c prettyTypeT (annTypeAnnotation ann), annLocation ann)
8080
where
8181
(a, b, c) = completionFromMatch' (Match (m, d))
8282

0 commit comments

Comments
 (0)