git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
[psc-ide] Parse type annotations from source files
af3bca2Christoph Hegemann
src/Language/PureScript/Ide/Externs.hs+14−8
compare with golang
unifiedsplit
@@ -17,9 +17,9 @@
17{-# LANGUAGE FlexibleContexts #-}
17{-# LANGUAGE FlexibleContexts #-}
18
18
19module Language.PureScript.Ide.Externs
19module Language.PureScript.Ide.Externs
20− ( readExternFile,
20+ ( readExternFile
21− convertExterns,
21+ , convertExterns
22− annotateLocations
22+ , annotateModule
23 ) where
23 ) where
24
24
25import Protolude
25import Protolude
@@ -99,14 +99,17 @@ convertTypeOperator P.ExternsTypeFixity{..} =
99 efTypePrecedence
99 efTypePrecedence
100 efTypeAssociativity
100 efTypeAssociativity
101
101
102−annotateLocations :: Map (Either Text Text) P.SourceSpan -> Module -> Module
102+annotateModule
103+ :: (DefinitionSites P.SourceSpan, TypeAnnotations)
104+ -> Module
105+ -> Module
103−annotateLocations ast (moduleName, decls) =
106+annotateModule (defs, types) (moduleName, decls) =
104 (moduleName, map convertDeclaration decls)
107 (moduleName, map convertDeclaration decls)
105 where
108 where
106 convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn
109 convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn
107 convertDeclaration (IdeDeclarationAnn ann d) = case d of
110 convertDeclaration (IdeDeclarationAnn ann d) = case d of
108 IdeValue i t ->
111 IdeValue i t ->
109− annotateValue (runIdentT i) (IdeValue i t)
112+ annotateFunction i (IdeValue i t)
110 IdeType i k ->
113 IdeType i k ->
111 annotateType (runProperNameT i) (IdeType i k)
114 annotateType (runProperNameT i) (IdeType i k)
112 IdeTypeSynonym i t ->
115 IdeTypeSynonym i t ->
@@ -120,5 +123,8 @@ annotateLocations ast (moduleName, decls) =
120 IdeTypeOperator n i p a ->
123 IdeTypeOperator n i p a ->
121 annotateType i (IdeTypeOperator n i p a)
124 annotateType i (IdeTypeOperator n i p a)
122 where
125 where
126+ annotateFunction x = IdeDeclarationAnn (ann { annLocation = Map.lookup (Left (runIdentT x)) defs
127+ , annTypeAnnotation = Map.lookup x types
128+ })
123− annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) ast})
129+ annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) defs})
124− annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right x) ast})
130+ annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right x) defs})
src/Language/PureScript/Ide/SourceFile.hs+11
@@ -18,6 +18,7 @@ module Language.PureScript.Ide.SourceFile
18 ( parseModule
18 ( parseModule
19 , getImportsForFile
19 , getImportsForFile
20 , extractSpans
20 , extractSpans
21+ , extractTypeAnnotations
21 ) where
22 ) where
22
23
23import Protolude
24import Protolude
@@ -64,6 +65,16 @@ getImportsForFile fp = do
64 unwrapImportType (P.Hiding decls) = P.Hiding (map unwrapPositionedRef decls)
65 unwrapImportType (P.Hiding decls) = P.Hiding (map unwrapPositionedRef decls)
65 unwrapImportType P.Implicit = P.Implicit
66 unwrapImportType P.Implicit = P.Implicit
66
67
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+
67-- | Given a surrounding Sourcespan and a Declaration from the PS AST, extracts
78-- | Given a surrounding Sourcespan and a Declaration from the PS AST, extracts
68-- definition sites inside that Declaration.
79-- definition sites inside that Declaration.
69extractSpans
80extractSpans
src/Language/PureScript/Ide/State.hs+8−5
@@ -132,10 +132,10 @@ getAllModules mmoduleName = do
132 Just (cachedModulename, ef)
132 Just (cachedModulename, ef)
133 | cachedModulename == moduleName -> do
133 | cachedModulename == moduleName -> do
134 (AstData asts) <- s2AstData <$> getStage2
134 (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)
136 pure . M.toList $
136 pure . M.toList $
137 M.insert moduleName
137 M.insert moduleName
138− (snd . annotateLocations ast . fst . convertExterns $ ef) declarations
138+ (snd . annotateModule ast . fst . convertExterns $ ef) declarations
139 _ -> pure (M.toList declarations)
139 _ -> pure (M.toList declarations)
140
140
141-- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the
141-- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the
@@ -180,8 +180,11 @@ populateStage2 = do
180populateStage2STM :: TVar IdeState -> STM ()
180populateStage2STM :: TVar IdeState -> STM ()
181populateStage2STM ref = do
181populateStage2STM ref = do
182 modules <- s1Modules <$> getStage1STM ref
182 modules <- s1Modules <$> getStage1STM ref
183+ let astData = map (\(P.Module ss _ _ decls _, _) ->
183− let spans = map (\(P.Module ss _ _ decls _, _) -> M.fromList (concatMap (extractSpans ss) decls)) modules
184+ let definitions = M.fromList (concatMap (extractSpans ss) decls)
185+ typeAnnotations = M.fromList (extractTypeAnnotations decls)
186+ in (definitions, typeAnnotations)) modules
184− setStage2STM ref (Stage2 (AstData spans))
187+ setStage2STM ref (Stage2 (AstData astData))
185
188
186-- | Resolves reexports and populates Stage3 with data to be used in queries.
189-- | Resolves reexports and populates Stage3 with data to be used in queries.
187populateStage3 :: (Ide m, MonadLogger m) => m ()
190populateStage3 :: (Ide m, MonadLogger m) => m ()
@@ -206,7 +209,7 @@ populateStage3STM ref = do
206 nModules :: Map P.ModuleName (Module, [(P.ModuleName, P.DeclarationRef)])
209 nModules :: Map P.ModuleName (Module, [(P.ModuleName, P.DeclarationRef)])
207 nModules = M.mapWithKey
210 nModules = M.mapWithKey
208 (\moduleName (m, refs) ->
211 (\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
210 -- resolves reexports and discards load failures for now
213 -- resolves reexports and discards load failures for now
211 result = resolveReexports (M.map (snd . fst) nModules) <$> M.elems nModules
214 result = resolveReexports (M.map (snd . fst) nModules) <$> M.elems nModules
212 setStage3STM ref (Stage3 (M.fromList (map reResolved result)) Nothing)
215 setStage3STM ref (Stage3 (M.fromList (map reResolved result)) Nothing)
src/Language/PureScript/Ide/Types.hs+7−3
@@ -47,15 +47,19 @@ data Annotation
47 = Annotation
47 = Annotation
48 { annLocation :: Maybe P.SourceSpan
48 { annLocation :: Maybe P.SourceSpan
49 , annExportedFrom :: Maybe P.ModuleName
49 , annExportedFrom :: Maybe P.ModuleName
50+ , annTypeAnnotation :: Maybe P.Type
50 } deriving (Show, Eq, Ord)
51 } deriving (Show, Eq, Ord)
51
52
52emptyAnn :: Annotation
53emptyAnn :: Annotation
53−emptyAnn = Annotation Nothing Nothing
54+emptyAnn = Annotation Nothing Nothing Nothing
54
55
55type Module = (P.ModuleName, [IdeDeclarationAnn])
56type Module = (P.ModuleName, [IdeDeclarationAnn])
56
57
57−newtype AstData a =
58+type DefinitionSites a = Map (Either Text Text) a
58− AstData (Map P.ModuleName (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
59 deriving (Show, Eq, Ord, Functor, Foldable)
63 deriving (Show, Eq, Ord, Functor, Foldable)
60
64
61data Configuration =
65data Configuration =
src/Language/PureScript/Ide/Util.hs+1−1
@@ -76,7 +76,7 @@ completionFromMatch' (Match (m', d)) = case d of
76
76
77infoFromMatch :: Match IdeDeclarationAnn -> Info
77infoFromMatch :: Match IdeDeclarationAnn -> Info
78infoFromMatch (Match (m, IdeDeclarationAnn ann d)) =
78infoFromMatch (Match (m, IdeDeclarationAnn ann d)) =
79− Info (a, b, c, annLocation ann)
79+ Info (a, b, maybe c prettyTypeT (annTypeAnnotation ann), annLocation ann)
80 where
80 where
81 (a, b, c) = completionFromMatch' (Match (m, d))
81 (a, b, c) = completionFromMatch' (Match (m, d))
82
82