95334c8 · rowtype-yoga/purescript-native

psc-ide-server/Main.hs+1−2

compare with golang

unifiedsplit

@@ -72,7 +72,6 @@ main :: IO ()

72main = do

73 Options dir globs outputPath port noWatch debug <- execParser opts

74 maybe (pure ()) setCurrentDirectory dir

75− serverState <- newTVarIO emptyPscIdeState

76 ideState <- newTVarIO emptyIdeState

75 ideState <- newTVarIO emptyIdeState

77 cwd <- getCurrentDirectory

76 cwd <- getCurrentDirectory

78 let fullOutputPath = cwd </> outputPath

77 let fullOutputPath = cwd </> outputPath

@@ -87,7 +86,7 @@ main = do

87 void (forkFinally (watcher ideState fullOutputPath) print)

86 void (forkFinally (watcher ideState fullOutputPath) print)

88

87

89 let conf = Configuration {confDebug = debug, confOutputPath = outputPath, confGlobs = globs}

88 let conf = Configuration {confDebug = debug, confOutputPath = outputPath, confGlobs = globs}

90− env = IdeEnvironment {envStateVar = serverState, ideStateVar = ideState, ideConfiguration = conf}

89+ env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}

91 startServer port env

90 startServer port env

92 where

91 where

93 parser =

92 parser =

psc-ide-server/PROTOCOL.md+23−2

@@ -30,7 +30,8 @@ to detect all the compiled modules in your project and load them.

30The Load Command returns a string with a summary about the loading process.

31

32### Type

33−The `type` command looks up the type for a given identifier.

33+The `type` command looks up the type for a given identifier. It also returns the

34+definition position, if it can be found in the passed source files.

34

35

35**Params:**

36**Params:**

36 - `search :: String`: The identifier to look for. Only matches on equality.

37 - `search :: String`: The identifier to look for. Only matches on equality.

@@ -50,7 +51,27 @@ The `type` command looks up the type for a given identifier.

50```

51```

51

52

52**Result:**

53**Result:**

53−The possible types are returned in the same format as completions

54+The possible types are returned in the same format as completions + eventual position information

55+```json

56+[

57+ {

58+ "module": "Data.Array",

59+ "identifier": "filter",

60+ "type": "forall a. (a -> Boolean) -> Array a -> Array a"

61+ },

62+ {

63+ "module": "Data.Array",

64+ "identifier": "filter",

65+ "type": "forall a. (a -> Boolean) -> Array a -> Array a",

66+ "definedAt":

67+ {

68+ "name": "/path/to/file",

69+ "start": [1, 3],

70+ "end": [3, 1]

71+ }

72+ }

73+]

74+```

54

75

55### Complete

76### Complete

56The `complete` command looks up possible completions/corrections.

77The `complete` command looks up possible completions/corrections.

purescript.cabal+2

@@ -506,5 +506,7 @@ test-suite tests

506 Language.PureScript.Ide.MatcherSpec

507 Language.PureScript.Ide.RebuildSpec

508 Language.PureScript.Ide.ReexportsSpec

509+ Language.PureScript.Ide.SourceFile.IntegrationSpec

510+ Language.PureScript.Ide.SourceFileSpec

509 buildable: True

511 buildable: True

510 hs-source-dirs: tests

512 hs-source-dirs: tests

src/Language/PureScript/Ide.hs+14−24

@@ -42,6 +42,8 @@ import System.Directory

42import System.FilePath

43import System.FilePath.Glob

44

45+-- | Accepts a Commmand and runs it against psc-ide's State. This is the main

46+-- entry point for the server.

45handleCommand :: (Ide m, MonadLogger m, MonadError PscIdeError m) =>

47handleCommand :: (Ide m, MonadLogger m, MonadError PscIdeError m) =>

46 Command -> m Success

48 Command -> m Success

47handleCommand c = case c of

49handleCommand c = case c of

@@ -66,7 +68,7 @@ handleCommand c = case c of

66 CaseSplit l b e wca t ->

68 CaseSplit l b e wca t ->

67 caseSplit l b e wca t

69 caseSplit l b e wca t

68 AddClause l wca ->

70 AddClause l wca ->

69− addClause l wca

71+ MultilineTextResult <$> CS.addClause l wca

70 Import fp outfp _ (AddImplicitImport mn) -> do

72 Import fp outfp _ (AddImplicitImport mn) -> do

71 rs <- addImplicitImport fp mn

73 rs <- addImplicitImport fp mn

72 answerRequest outfp rs

74 answerRequest outfp rs

@@ -86,16 +88,16 @@ handleCommand c = case c of

86 liftIO exitSuccess

88 liftIO exitSuccess

87

89

88findCompletions :: Ide m =>

90findCompletions :: Ide m =>

89− [Filter] -> Matcher -> Maybe P.ModuleName -> m Success

91+ [Filter] -> Matcher IdeDeclaration -> Maybe P.ModuleName -> m Success

90findCompletions filters matcher currentModule = do

92findCompletions filters matcher currentModule = do

91− modules <- getAllModules2 currentModule

93+ modules <- getAllModules currentModule

92 pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules

94 pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules

93

95

94findType :: Ide m =>

96findType :: Ide m =>

95 Text -> [Filter] -> Maybe P.ModuleName -> m Success

97 Text -> [Filter] -> Maybe P.ModuleName -> m Success

96findType search filters currentModule = do

98findType search filters currentModule = do

97− modules <- getAllModules2 currentModule

99+ modules <- getAllModules currentModule

98− pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules

100+ pure . InfoResult . map infoFromMatch . getExactMatches search filters $ modules

99

101

100findPursuitCompletions :: MonadIO m =>

102findPursuitCompletions :: MonadIO m =>

101 PursuitQuery -> m Success

103 PursuitQuery -> m Success

@@ -130,13 +132,6 @@ caseSplit l b e csa t = do

130 patterns <- CS.makePattern l b e csa <$> CS.caseSplit t

132 patterns <- CS.makePattern l b e csa <$> CS.caseSplit t

131 pure (MultilineTextResult patterns)

133 pure (MultilineTextResult patterns)

132

134

133−addClause

134− :: (MonadError PscIdeError m)

135− => Text

136− -> CS.WildcardAnnotations

137− -> m Success

138−addClause t wca = MultilineTextResult <$> CS.addClause t wca

139−

140-- | Finds all the externs.json files inside the output folder and returns the

135-- | Finds all the externs.json files inside the output folder and returns the

141-- corresponding Modulenames

136-- corresponding Modulenames

142findAvailableExterns :: (Ide m, MonadError PscIdeError m) => m [P.ModuleName]

137findAvailableExterns :: (Ide m, MonadError PscIdeError m) => m [P.ModuleName]

@@ -146,13 +141,13 @@ findAvailableExterns = do

146 (throwError (GeneralError "Couldn't locate your output directory."))

141 (throwError (GeneralError "Couldn't locate your output directory."))

147 liftIO $ do

142 liftIO $ do

148 directories <- getDirectoryContents oDir

143 directories <- getDirectoryContents oDir

149− moduleNames <- filterM (checkExternsPath oDir) directories

144+ moduleNames <- filterM (containsExterns oDir) directories

150 pure (P.moduleNameFromString <$> moduleNames)

145 pure (P.moduleNameFromString <$> moduleNames)

151 where

146 where

152− -- | Takes the output directory and a filepath like "Monad.Control.Eff" and

147+ -- Takes the output directory and a filepath like "Monad.Control.Eff" and

153 -- looks up, whether that folder contains an externs.json

148 -- looks up, whether that folder contains an externs.json

154− checkExternsPath :: FilePath -> FilePath -> IO Bool

149+ containsExterns :: FilePath -> FilePath -> IO Bool

155− checkExternsPath oDir d

150+ containsExterns oDir d

156 | d `elem` [".", ".."] = pure False

151 | d `elem` [".", ".."] = pure False

157 | otherwise = do

152 | otherwise = do

158 let file = oDir </> d </> "externs.json"

153 let file = oDir </> d </> "externs.json"

@@ -188,19 +183,14 @@ loadModules moduleNames = do

188 $(logDebug) ("Failed to parse: " <> show failures)

183 $(logDebug) ("Failed to parse: " <> show failures)

189 traverse_ insertModule allModules

184 traverse_ insertModule allModules

190

185

191− -- Because we still need the "old" module format to resolve reexports in the

192− -- worker thread, we insert it into the state aswell.

193− -- TODO Get rid of this once ModuleOld is gone

194− traverse_ insertModuleOld efiles

195−

196 -- Finally we kick off the worker with @async@ and return the number of

186 -- Finally we kick off the worker with @async@ and return the number of

197 -- successfully parsed modules.

187 -- successfully parsed modules.

198 env <- ask

188 env <- ask

199 let runLogger =

189 let runLogger =

200 runStdoutLoggingT

190 runStdoutLoggingT

201 . filterLogger (\_ _ -> confDebug (ideConfiguration env))

191 . filterLogger (\_ _ -> confDebug (ideConfiguration env))

202− -- populateStage2 returns Unit for now, so it's fine to discard this result.

192+ -- populateStage2 and 3 return Unit for now, so it's fine to discard this

203− -- We might want to block on this in a benchmarking situation.

193+ -- result. We might want to block on this in a benchmarking situation.

204− _ <- liftIO (async (runLogger (runReaderT populateStage2 env)))

194+ _ <- liftIO (async (runLogger (runReaderT (populateStage2 *> populateStage3) env)))

205 pure (TextResult ("Loaded " <> show (length efiles) <> " modules and "

195 pure (TextResult ("Loaded " <> show (length efiles) <> " modules and "

206 <> show (length allModules) <> " source files."))

196 <> show (length allModules) <> " source files."))

src/Language/PureScript/Ide/CaseSplit.hs−1

@@ -30,7 +30,6 @@ import qualified Language.PureScript as P

30

31import Language.PureScript.Externs

32import Language.PureScript.Ide.Error

33−import Language.PureScript.Ide.Externs (unwrapPositioned)

34import Language.PureScript.Ide.State

33import Language.PureScript.Ide.State

35import Language.PureScript.Ide.Types

34import Language.PureScript.Ide.Types

36import Language.PureScript.Ide.Util

35import Language.PureScript.Ide.Util

src/Language/PureScript/Ide/Command.hs+1−1

@@ -35,7 +35,7 @@ data Command

35 }

36 | Complete

37 { completeFilters :: [Filter]

38− , completeMatcher :: Matcher

38+ , completeMatcher :: Matcher IdeDeclaration

39 , completeCurrentModule :: Maybe P.ModuleName

40 }

41 | Pursuit

src/Language/PureScript/Ide/Completion.hs+13−8

@@ -9,19 +9,24 @@ import Protolude

9import Language.PureScript.Ide.Filter

10import Language.PureScript.Ide.Matcher

11import Language.PureScript.Ide.Types

12+import Language.PureScript.Ide.Util

12

13

13-- | Applies the CompletionFilters and the Matcher to the given Modules

14-- | Applies the CompletionFilters and the Matcher to the given Modules

14-- and sorts the found Completions according to the Matching Score

15-- and sorts the found Completions according to the Matching Score

15−getCompletions :: [Filter] -> Matcher -> [Module] -> [Match]

16+getCompletions

17+ :: [Filter]

18+ -> Matcher IdeDeclaration

19+ -> [Module]

20+ -> [Match IdeDeclaration]

16getCompletions filters matcher modules =

21getCompletions filters matcher modules =

17− runMatcher matcher (completionsFromModules (applyFilters filters modules))

22+ runMatcher matcher (completionsFromModules discardAnn (applyFilters filters modules))

18

23

19−getExactMatches :: Text -> [Filter] -> [Module] -> [Match]

24+getExactMatches :: Text -> [Filter] -> [Module] -> [Match IdeDeclarationAnn]

20getExactMatches search filters modules =

25getExactMatches search filters modules =

21− completionsFromModules (applyFilters (equalityFilter search : filters) modules)

26+ completionsFromModules identity (applyFilters (equalityFilter search : filters) modules)

22

27

23−completionsFromModules :: [Module] -> [Match]

28+completionsFromModules :: (IdeDeclarationAnn -> a) -> [Module] -> [Match a]

24−completionsFromModules = foldMap completionFromModule

29+completionsFromModules f = foldMap completionFromModule

25 where

30 where

26− completionFromModule :: Module -> [Match]

31+ completionFromModule (moduleName, decls) =

27− completionFromModule (moduleName, decls) = map (Match moduleName) decls

32+ map (\x -> Match (moduleName, f x)) decls

src/Language/PureScript/Ide/Error.hs−1

@@ -15,7 +15,6 @@

15{-# LANGUAGE OverloadedStrings #-}

16module Language.PureScript.Ide.Error

17 ( PscIdeError(..)

18− , textError

19 ) where

18 ) where

20

19

21import Protolude

20import Protolude

src/Language/PureScript/Ide/Externs.hs+55−62

@@ -17,27 +17,23 @@

17{-# LANGUAGE FlexibleContexts #-}

18

19module Language.PureScript.Ide.Externs

20− ( ExternDecl(..),

21− ModuleIdent,

22− readExternFile,

20+ ( readExternFile,

23 convertExterns,

21 convertExterns,

24− convertModule,

22+ annotateLocations

25− unwrapPositioned,

26− unwrapPositionedRef

27 ) where

23 ) where

28

24

29import Protolude

25import Protolude

30

26

31import Data.Aeson (decodeStrict)

27import Data.Aeson (decodeStrict)

32import Data.List (nub)

28import Data.List (nub)

29+import qualified Data.Map as Map

33import qualified Data.ByteString as BS

30import qualified Data.ByteString as BS

34import Language.PureScript.Ide.Error (PscIdeError (..))

31import Language.PureScript.Ide.Error (PscIdeError (..))

35import Language.PureScript.Ide.Types

32import Language.PureScript.Ide.Types

36import Language.PureScript.Ide.Util

33import Language.PureScript.Ide.Util

37

34

38import qualified Language.PureScript as P

35import qualified Language.PureScript as P

39−

40−import System.FilePath

36+import System.FilePath

41

37

42readExternFile :: (MonadIO m, MonadError PscIdeError m) =>

38readExternFile :: (MonadIO m, MonadError PscIdeError m) =>

43 FilePath -> m P.ExternsFile

39 FilePath -> m P.ExternsFile

@@ -47,86 +43,83 @@ readExternFile fp = do

47 Nothing -> throwError . GeneralError $ "Parsing the extern at: " <> toS fp <> " failed"

43 Nothing -> throwError . GeneralError $ "Parsing the extern at: " <> toS fp <> " failed"

48 Just externs -> pure externs

44 Just externs -> pure externs

49

45

50−convertExterns :: P.ExternsFile -> ModuleOld

46+convertExterns :: P.ExternsFile -> (Module, [(P.ModuleName, P.DeclarationRef)])

51−convertExterns ef = (runModuleNameT moduleName, exportDecls ++ importDecls ++ decls ++ operatorDecls ++ tyOperatorDecls)

47+convertExterns ef =

48+ ((P.efModuleName ef, decls), exportDecls)

52 where

49 where

53− moduleName = P.efModuleName ef

50+ decls = map

54− importDecls = convertImport <$> P.efImports ef

51+ (IdeDeclarationAnn emptyAnn)

52+ (cleanDeclarations ++ operatorDecls ++ tyOperatorDecls)

55 exportDecls = mapMaybe (convertExport . unwrapPositionedRef) (P.efExports ef)

53 exportDecls = mapMaybe (convertExport . unwrapPositionedRef) (P.efExports ef)

56 operatorDecls = convertOperator <$> P.efFixities ef

54 operatorDecls = convertOperator <$> P.efFixities ef

57 tyOperatorDecls = convertTypeOperator <$> P.efTypeFixities ef

55 tyOperatorDecls = convertTypeOperator <$> P.efTypeFixities ef

58− otherDecls = mapMaybe convertDecl (P.efDeclarations ef)

56+ declarations = mapMaybe convertDecl (P.efDeclarations ef)

59

57

60− typeClassFilter = foldMap removeTypeDeclarationsForClass (filter isTypeClassDeclaration otherDecls)

58+ typeClassFilter = foldMap removeTypeDeclarationsForClass (filter isTypeClassDeclaration declarations)

61− decls = nub $ appEndo typeClassFilter otherDecls

59+ cleanDeclarations = nub $ appEndo typeClassFilter declarations

62

60

63−removeTypeDeclarationsForClass :: ExternDecl -> Endo [ExternDecl]

61+removeTypeDeclarationsForClass :: IdeDeclaration -> Endo [IdeDeclaration]

64−removeTypeDeclarationsForClass (TypeClassDeclaration n) = Endo (filter notDuplicate)

62+removeTypeDeclarationsForClass (IdeTypeClass n) = Endo (filter notDuplicate)

65− where notDuplicate (TypeDeclaration n' _) = runProperNameT n /= runProperNameT n'

63+ where notDuplicate (IdeType n' _) = runProperNameT n /= runProperNameT n'

66− notDuplicate (TypeSynonymDeclaration n' _) = runProperNameT n /= runProperNameT n'

64+ notDuplicate (IdeTypeSynonym n' _) = runProperNameT n /= runProperNameT n'

67 notDuplicate _ = True

65 notDuplicate _ = True

68removeTypeDeclarationsForClass _ = mempty

66removeTypeDeclarationsForClass _ = mempty

69

67

70−isTypeClassDeclaration :: ExternDecl -> Bool

68+isTypeClassDeclaration :: IdeDeclaration -> Bool

71−isTypeClassDeclaration TypeClassDeclaration{} = True

69+isTypeClassDeclaration IdeTypeClass{} = True

72isTypeClassDeclaration _ = False

70isTypeClassDeclaration _ = False

73

71

74−convertImport :: P.ExternsImport -> ExternDecl

75−convertImport ei = Dependency

76− (runModuleNameT (P.eiModule ei))

77− []

78− (runModuleNameT <$> P.eiImportedAs ei)

79−

80−convertExport :: P.DeclarationRef -> Maybe ExternDecl

72+convertExport :: P.DeclarationRef -> Maybe (P.ModuleName, P.DeclarationRef)

81−convertExport (P.ModuleRef mn) = Just (Export (runModuleNameT mn))

73+convertExport (P.ReExportRef m r) = Just (m, r)

82convertExport _ = Nothing

74convertExport _ = Nothing

83

75

84−convertDecl :: P.ExternsDeclaration -> Maybe ExternDecl

76+convertDecl :: P.ExternsDeclaration -> Maybe IdeDeclaration

85−convertDecl P.EDType{..} = Just $ TypeDeclaration edTypeName edTypeKind

77+convertDecl P.EDType{..} = Just (IdeType edTypeName edTypeKind)

86−convertDecl P.EDTypeSynonym{..} = Just $

78+convertDecl P.EDTypeSynonym{..} =

87− TypeSynonymDeclaration edTypeSynonymName edTypeSynonymType

79+ Just (IdeTypeSynonym edTypeSynonymName edTypeSynonymType)

88convertDecl P.EDDataConstructor{..} = Just $

80convertDecl P.EDDataConstructor{..} = Just $

89− DataConstructor (runProperNameT edDataCtorName) edDataCtorTypeCtor edDataCtorType

81+ IdeDataConstructor edDataCtorName edDataCtorTypeCtor edDataCtorType

90convertDecl P.EDValue{..} = Just $

82convertDecl P.EDValue{..} = Just $

91− ValueDeclaration (runIdentT edValueName) edValueType

83+ IdeValue edValueName edValueType

92−convertDecl P.EDClass{..} = Just $ TypeClassDeclaration edClassName

84+convertDecl P.EDClass{..} = Just (IdeTypeClass edClassName)

93convertDecl P.EDInstance{} = Nothing

85convertDecl P.EDInstance{} = Nothing

94

86

95−convertOperator :: P.ExternsFixity -> ExternDecl

87+convertOperator :: P.ExternsFixity -> IdeDeclaration

96convertOperator P.ExternsFixity{..} =

88convertOperator P.ExternsFixity{..} =

97− ValueOperator

89+ IdeValueOperator

98 efOperator

90 efOperator

99 (toS (P.showQualified (either P.runIdent P.runProperName) efAlias))

91 (toS (P.showQualified (either P.runIdent P.runProperName) efAlias))

100 efPrecedence

92 efPrecedence

101 efAssociativity

93 efAssociativity

102

94

103−convertTypeOperator :: P.ExternsTypeFixity -> ExternDecl

95+convertTypeOperator :: P.ExternsTypeFixity -> IdeDeclaration

104convertTypeOperator P.ExternsTypeFixity{..} =

96convertTypeOperator P.ExternsTypeFixity{..} =

105− TypeOperator

97+ IdeTypeOperator

106 efTypeOperator

98 efTypeOperator

107 (toS (P.showQualified P.runProperName efTypeAlias))

99 (toS (P.showQualified P.runProperName efTypeAlias))

108 efTypePrecedence

100 efTypePrecedence

109 efTypeAssociativity

101 efTypeAssociativity

110

102

111−unwrapPositioned :: P.Declaration -> P.Declaration

103+annotateLocations :: Map (Either Text Text) P.SourceSpan -> Module -> Module

112−unwrapPositioned (P.PositionedDeclaration _ _ x) = x

104+annotateLocations ast (moduleName, decls) =

113−unwrapPositioned x = x

114−

115−unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef

116−unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = x

117−unwrapPositionedRef x = x

118−

119−convertModule :: ModuleOld -> Module

120−convertModule (mn, decls) = (P.moduleNameFromString (toS mn), mapMaybe convertDeclaration decls)

105+ (moduleName, map convertDeclaration decls)

121− where convertDeclaration :: ExternDecl -> Maybe IdeDeclaration

106+ where

107+ convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn

122− convertDeclaration d = case d of

108+ convertDeclaration (IdeDeclarationAnn ann d) = case d of

123− ValueDeclaration i t -> Just (IdeValue i t)

109+ IdeValue i t ->

124− TypeDeclaration i k -> Just (IdeType i k)

110+ annotateValue (runIdentT i) (IdeValue i t)

125− TypeSynonymDeclaration i t -> Just (IdeTypeSynonym i t)

111+ IdeType i k ->

112+ annotateType (runProperNameT i) (IdeType i k)

113+ IdeTypeSynonym i t ->

114+ annotateType (runProperNameT i) (IdeTypeSynonym i t)

115+ IdeDataConstructor i tn t ->

126− DataConstructor i tn t -> Just (IdeDataConstructor i tn t)

116+ annotateValue (runProperNameT i) (IdeDataConstructor i tn t)

127− TypeClassDeclaration i -> Just (IdeTypeClass i)

117+ IdeTypeClass i ->

118+ annotateType (runProperNameT i) (IdeTypeClass i)

119+ IdeValueOperator n i p a ->

128− ValueOperator n i p a -> Just (IdeValueOperator n i p a)

120+ annotateValue i (IdeValueOperator n i p a)

121+ IdeTypeOperator n i p a ->

129− TypeOperator n i p a -> Just (IdeTypeOperator n i p a)

122+ annotateType i (IdeTypeOperator n i p a)

130− Dependency{} -> Nothing

123+ where

131− ModuleDecl _ _ -> Nothing

124+ annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) ast})

132− Export _ -> Nothing

125+ annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right x) ast})

src/Language/PureScript/Ide/Filter.hs+4−4

@@ -20,7 +20,6 @@ module Language.PureScript.Ide.Filter

20 , moduleFilter

21 , prefixFilter

22 , equalityFilter

23− , runFilter

24 , applyFilters

23 , applyFilters

25 ) where

24 ) where

26

25

@@ -65,11 +64,12 @@ identFilter predicate search =

65 filter (not . null . snd) . fmap filterModuleDecls

64 filter (not . null . snd) . fmap filterModuleDecls

66 where

65 where

67 filterModuleDecls :: Module -> Module

66 filterModuleDecls :: Module -> Module

68− filterModuleDecls (moduleIdent,decls) =

67+ filterModuleDecls (moduleIdent, decls) =

69− (moduleIdent, filter (`predicate` search) decls)

68+ (moduleIdent, filter (flip predicate search . getDeclaration) decls)

69+ getDeclaration (IdeDeclarationAnn _ d) = d

70

71runFilter :: Filter -> [Module] -> [Module]

72−runFilter (Filter f)= appEndo f

72+runFilter (Filter f) = appEndo f

73

74applyFilters :: [Filter] -> [Module] -> [Module]

75applyFilters = runFilter . fold

src/Language/PureScript/Ide/Imports.hs+7−12

@@ -36,8 +36,6 @@ import qualified Data.Text.IO as TIO

36import qualified Language.PureScript as P

37import Language.PureScript.Ide.Completion

38import Language.PureScript.Ide.Error

39−import Language.PureScript.Ide.Externs (unwrapPositioned,

40− unwrapPositionedRef)

41import Language.PureScript.Ide.Filter

39import Language.PureScript.Ide.Filter

42import Language.PureScript.Ide.State

40import Language.PureScript.Ide.State

43import Language.PureScript.Ide.Types

41import Language.PureScript.Ide.Types

@@ -203,7 +201,7 @@ addExplicitImport' decl moduleName imports =

203 refFromDeclaration (IdeTypeClass n) =

201 refFromDeclaration (IdeTypeClass n) =

204 P.TypeClassRef n

202 P.TypeClassRef n

205 refFromDeclaration (IdeDataConstructor n tn _) =

203 refFromDeclaration (IdeDataConstructor n tn _) =

206− P.TypeRef tn (Just [P.ProperName (T.unpack n)])

204+ P.TypeRef tn (Just [n])

207 refFromDeclaration (IdeType n _) =

205 refFromDeclaration (IdeType n _) =

208 P.TypeRef n (Just [])

206 P.TypeRef n (Just [])

209 refFromDeclaration (IdeValueOperator op _ _ _) =

207 refFromDeclaration (IdeValueOperator op _ _ _) =

@@ -222,10 +220,7 @@ addExplicitImport' decl moduleName imports =

222

220

223 insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]

221 insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]

224 insertDeclIntoRefs (IdeDataConstructor dtor tn _) refs =

222 insertDeclIntoRefs (IdeDataConstructor dtor tn _) refs =

225− let

226− dtor' = P.ProperName (T.unpack dtor)

227− in

228− updateAtFirstOrPrepend (matchType tn) (insertDtor dtor') (P.TypeRef tn (Just [dtor'])) refs

223+ updateAtFirstOrPrepend (matchType tn) (insertDtor dtor) (P.TypeRef tn (Just [dtor])) refs

229 insertDeclIntoRefs dr refs = nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs)

224 insertDeclIntoRefs dr refs = nubBy ((==) `on` P.prettyPrintRef) (refFromDeclaration dr : refs)

230

225

231 insertDtor dtor (P.TypeRef tn' dtors) =

226 insertDtor dtor (P.TypeRef tn' dtors) =

@@ -261,17 +256,17 @@ addImportForIdentifier :: (Ide m, MonadError PscIdeError m)

261 -> Text -- ^ The identifier to import

256 -> Text -- ^ The identifier to import

262 -> [Filter] -- ^ Filters to apply before searching for

257 -> [Filter] -- ^ Filters to apply before searching for

263 -- the identifier

258 -- the identifier

264− -> m (Either [Match] [Text])

259+ -> m (Either [Match IdeDeclaration] [Text])

265addImportForIdentifier fp ident filters = do

260addImportForIdentifier fp ident filters = do

266− modules <- getAllModules2 Nothing

261+ modules <- getAllModules Nothing

267− case getExactMatches ident filters modules of

262+ case map (fmap discardAnn) (getExactMatches ident filters modules) of

268 [] ->

263 [] ->

269 throwError (NotFound "Couldn't find the given identifier. \

264 throwError (NotFound "Couldn't find the given identifier. \

270 \Have you loaded the corresponding module?")

265 \Have you loaded the corresponding module?")

271

266

272 -- Only one match was found for the given identifier, so we can insert it

267 -- Only one match was found for the given identifier, so we can insert it

273 -- right away

268 -- right away

274− [Match m decl] ->

269+ [Match (m, decl)] ->

275 Right <$> addExplicitImport fp decl m

270 Right <$> addExplicitImport fp decl m

276

271

277 -- This case comes up for newtypes and dataconstructors. Because values and

272 -- This case comes up for newtypes and dataconstructors. Because values and

@@ -279,7 +274,7 @@ addImportForIdentifier fp ident filters = do

279 -- module. This also happens for parameterized types, as these generate both

274 -- module. This also happens for parameterized types, as these generate both

280 -- a type aswell as a type synonym.

275 -- a type aswell as a type synonym.

281

276

282− ms@[Match m1 d1, Match m2 d2] ->

277+ ms@[Match (m1, d1), Match (m2, d2)] ->

283 if m1 /= m2

278 if m1 /= m2

284 -- If the modules don't line up we just ask the user to specify the

279 -- If the modules don't line up we just ask the user to specify the

285 -- module

280 -- module

src/Language/PureScript/Ide/Matcher.hs+20−19

@@ -14,11 +14,13 @@

14

15{-# LANGUAGE GeneralizedNewtypeDeriving #-}

16{-# LANGUAGE OverloadedStrings #-}

17+{-# LANGUAGE FlexibleInstances #-}

17

18

18module Language.PureScript.Ide.Matcher

19module Language.PureScript.Ide.Matcher

19 ( Matcher

20 ( Matcher

20− , flexMatcher

21 , runMatcher

22+ -- for tests

23+ , flexMatcher

22 ) where

24 ) where

23

25

24import Protolude

26import Protolude

@@ -32,23 +34,22 @@ import Text.EditDistance

32import Text.Regex.TDFA ((=~))

34import Text.Regex.TDFA ((=~))

33

35

34

36

35−type ScoredMatch = (Match, Double)

37+type ScoredMatch a = (Match a, Double)

36

38

37−newtype Matcher = Matcher (Endo [Match]) deriving (Monoid)

39+newtype Matcher a = Matcher (Endo [Match a]) deriving (Monoid)

38

40

39−instance FromJSON Matcher where

41+instance FromJSON (Matcher IdeDeclaration) where

40 parseJSON = withObject "matcher" $ \o -> do

42 parseJSON = withObject "matcher" $ \o -> do

41 (matcher :: Maybe Text) <- o .:? "matcher"

43 (matcher :: Maybe Text) <- o .:? "matcher"

42 case matcher of

44 case matcher of

43 Just "flex" -> do

45 Just "flex" -> do

44 params <- o .: "params"

46 params <- o .: "params"

45− search <- params .: "search"

47+ flexMatcher <$> params .: "search"

46− pure $ flexMatcher search

47 Just "distance" -> do

48 Just "distance" -> do

48 params <- o .: "params"

49 params <- o .: "params"

50+ distanceMatcher

49− search <- params .: "search"

51+ <$> params .: "search"

50− maxDist <- params .: "maximumDistance"

52+ <*> params .: "maximumDistance"

51− pure $ distanceMatcher search maxDist

52 Just _ -> mzero

53 Just _ -> mzero

53 Nothing -> return mempty

54 Nothing -> return mempty

54

55

@@ -59,37 +60,37 @@ instance FromJSON Matcher where

59-- Examples:

60-- Examples:

60-- flMa matches flexMatcher. Score: 14.28

61-- flMa matches flexMatcher. Score: 14.28

61-- sons matches sortCompletions. Score: 6.25

62-- sons matches sortCompletions. Score: 6.25

62−flexMatcher :: Text -> Matcher

63+flexMatcher :: Text -> Matcher IdeDeclaration

63flexMatcher p = mkMatcher (flexMatch p)

64flexMatcher p = mkMatcher (flexMatch p)

64

65

65−distanceMatcher :: Text -> Int -> Matcher

66+distanceMatcher :: Text -> Int -> Matcher IdeDeclaration

66distanceMatcher q maxDist = mkMatcher (distanceMatcher' q maxDist)

67distanceMatcher q maxDist = mkMatcher (distanceMatcher' q maxDist)

67

68

68−distanceMatcher' :: Text -> Int -> [Match] -> [ScoredMatch]

69+distanceMatcher' :: Text -> Int -> [Match IdeDeclaration] -> [ScoredMatch IdeDeclaration]

69distanceMatcher' q maxDist = mapMaybe go

70distanceMatcher' q maxDist = mapMaybe go

70 where

71 where

71 go m = let d = dist (T.unpack y)

72 go m = let d = dist (T.unpack y)

72− y = identifierFromMatch m

73+ y = identifierFromIdeDeclaration (unwrapMatch m)

73 in if d <= maxDist

74 in if d <= maxDist

74 then Just (m, 1 / fromIntegral d)

75 then Just (m, 1 / fromIntegral d)

75 else Nothing

76 else Nothing

76 dist = levenshteinDistance defaultEditCosts (T.unpack q)

77 dist = levenshteinDistance defaultEditCosts (T.unpack q)

77

78

78−mkMatcher :: ([Match] -> [ScoredMatch]) -> Matcher

79+mkMatcher :: ([Match a] -> [ScoredMatch a]) -> Matcher a

79mkMatcher matcher = Matcher . Endo $ fmap fst . sortCompletions . matcher

80mkMatcher matcher = Matcher . Endo $ fmap fst . sortCompletions . matcher

80

81

81−runMatcher :: Matcher -> [Match] -> [Match]

82+runMatcher :: Matcher a -> [Match a] -> [Match a]

82runMatcher (Matcher m)= appEndo m

83runMatcher (Matcher m)= appEndo m

83

84

84−sortCompletions :: [ScoredMatch] -> [ScoredMatch]

85+sortCompletions :: [ScoredMatch a] -> [ScoredMatch a]

85sortCompletions = sortBy (flip compare `on` snd)

86sortCompletions = sortBy (flip compare `on` snd)

86

87

87−flexMatch :: Text -> [Match] -> [ScoredMatch]

88+flexMatch :: Text -> [Match IdeDeclaration] -> [ScoredMatch IdeDeclaration]

88flexMatch = mapMaybe . flexRate

89flexMatch = mapMaybe . flexRate

89

90

90−flexRate :: Text -> Match -> Maybe ScoredMatch

91+flexRate :: Text -> Match IdeDeclaration -> Maybe (ScoredMatch IdeDeclaration)

91flexRate p c = do

92flexRate p c = do

92− score <- flexScore p (identifierFromMatch c)

93+ score <- flexScore p (identifierFromIdeDeclaration (unwrapMatch c))

93 return (c, score)

94 return (c, score)

94

95

95-- FlexMatching ala Sublime.

96-- FlexMatching ala Sublime.

src/Language/PureScript/Ide/Pursuit.hs+4−1

@@ -14,7 +14,10 @@

14

15{-# LANGUAGE OverloadedStrings #-}

16

17−module Language.PureScript.Ide.Pursuit where

17+module Language.PureScript.Ide.Pursuit

18+ ( searchPursuitForDeclarations

19+ , findPackagesForModuleIdent

20+ ) where

18

21

19import Protolude

22import Protolude

20

23

src/Language/PureScript/Ide/Reexports.hs+88−67

@@ -14,84 +14,105 @@

14-----------------------------------------------------------------------------

15

16{-# LANGUAGE OverloadedStrings #-}

17+{-# LANGUAGE PackageImports #-}

18+{-# LANGUAGE TemplateHaskell #-}

19+{-# LANGUAGE RecordWildCards #-}

17

20

18module Language.PureScript.Ide.Reexports

21module Language.PureScript.Ide.Reexports

19− ( resolveReexports2

22+ ( resolveReexports

20− -- for tests

23+ , prettyPrintReexportResult

21− , getReexports

24+ , reexportHasFailures

22− , replaceReexport

25+ , ReexportResult(..)

23− , replaceReexports

24 ) where

26 ) where

25

27

26−

27import Protolude

28import Protolude

28

29

29−import Data.List (union)

30import qualified Data.Map as Map

31import Language.PureScript.Ide.Types

32−import Language.PureScript.Ide.Externs

32+import Language.PureScript.Ide.Util

33import qualified Language.PureScript as P

34

35−getReexports :: ModuleOld -> [ExternDecl]

35+-- | Contains the module with resolved reexports, and eventual failures

36−getReexports (mn, decls)= concatMap getExport decls

36+data ReexportResult a

37− where getExport d

37+ = ReexportResult

38− | (Export mn') <- d

38+ { reResolved :: a

39− , mn /= mn' = replaceExportWithAliases decls mn'

39+ , reFailed :: [(P.ModuleName, P.DeclarationRef)]

40− | otherwise = []

40+ } deriving (Show, Eq, Functor)

41−

41+

42−dependencyToExport :: ExternDecl -> ExternDecl

42+-- | Uses the passed formatter to format the resolved module, and adds eventual

43−dependencyToExport (Dependency m _ _) = Export m

43+-- failures

44−dependencyToExport decl = decl

44+prettyPrintReexportResult

45−

45+ :: (a -> Text)

46−replaceExportWithAliases :: [ExternDecl] -> ModuleIdent -> [ExternDecl]

46+ -- ^ Formatter for the resolved result

47−replaceExportWithAliases decls ident =

47+ -> ReexportResult a

48− case filter isMatch decls of

48+ -- ^ The Result to be pretty printed

49− [] -> [Export ident]

49+ -> Text

50− aliases -> map dependencyToExport aliases

50+prettyPrintReexportResult f ReexportResult{..}

51− where isMatch d

51+ | null reFailed =

52− | Dependency _ _ (Just alias) <- d

52+ "Successfully resolved reexports for " <> f reResolved

53− , alias == ident = True

54− | otherwise = False

53+ | otherwise =

55−

54+ "Failed to resolve reexports for "

56−replaceReexport :: ExternDecl -> ModuleOld -> ModuleOld -> ModuleOld

55+ <> f reResolved

57−replaceReexport e@(Export _) (m, decls) (_, newDecls) =

56+ <> foldMap (\(mn, ref) -> runModuleNameT mn <> show ref) reFailed

58− (m, filter (/= e) decls `union` newDecls)

57+

59−replaceReexport _ _ _ = P.internalError "Should only get Exports here"

58+-- | Whether any Refs couldn't be resolved

60−

59+reexportHasFailures :: ReexportResult a -> Bool

61−emptyModule :: ModuleOld

60+reexportHasFailures = not . null . reFailed

62−emptyModule = ("Empty", [])

61+

63−

62+-- | Resolves Reexports for a given Module, by looking up the reexported values

64−isExport :: ExternDecl -> Bool

63+-- from the passed in Map

65−isExport (Export _) = True

64+resolveReexports

66−isExport _ = False

65+ :: Map P.ModuleName [IdeDeclarationAnn]

67−

66+ -- ^ Modules to search for the reexported declarations

68−removeExportDecls :: ModuleOld -> ModuleOld

67+ -> (Module, [(P.ModuleName, P.DeclarationRef)])

69−removeExportDecls = fmap (filter (not . isExport))

68+ -- ^ The module to resolve reexports for, aswell as the references to resolve

70−

69+ -> ReexportResult Module

71−replaceReexports :: ModuleOld -> Map ModuleIdent [ExternDecl] -> ModuleOld

70+resolveReexports modules ((moduleName, decls), refs) =

72−replaceReexports m db = result

71+ ReexportResult (moduleName, decls <> concat resolvedRefs) failedRefs

72+ where

73+ (failedRefs, resolvedRefs) = partitionEithers (resolveRef' <$> refs)

74+ resolveRef' x@(mn, r) = case Map.lookup mn modules of

75+ Nothing -> Left x

76+ Just decls' -> first (mn,) (resolveRef decls' r)

77+

78+resolveRef

79+ :: [IdeDeclarationAnn]

80+ -> P.DeclarationRef

81+ -> Either P.DeclarationRef [IdeDeclarationAnn]

82+resolveRef decls ref = case ref of

83+ P.TypeRef tn mdtors ->

84+ case findRef (\case IdeType name _ -> name == tn; _ -> False) of

85+ Nothing -> Left ref

86+ Just d -> Right $ d : case mdtors of

87+ Nothing ->

88+ -- If the dataconstructor field inside the TypeRef is Nothing, that

89+ -- means that all data constructors are exported, so we need to look

90+ -- those up ourselfes

91+ findDtors tn

92+ Just dtors -> mapMaybe lookupDtor dtors

93+ P.ValueRef i ->

94+ findWrapped (\case IdeValue i' _ -> i' == i; _ -> False)

95+ P.TypeOpRef name ->

96+ findWrapped (\case IdeTypeOperator n _ _ _ -> n == name; _ -> False)

97+ P.ValueOpRef name ->

98+ findWrapped (\case IdeValueOperator n _ _ _ -> n == name; _ -> False)

99+ P.TypeClassRef name ->

100+ findWrapped (\case IdeTypeClass n -> n == name; _ -> False)

101+ _ ->

102+ Left ref

73 where

103 where

74− reexports = getReexports m

104+ findWrapped = wrapSingle . findRef

75− result = foldl go (removeExportDecls m) reexports

105+ wrapSingle = maybe (Left ref) (Right . pure)

106+ findRef f = find (f . discardAnn) decls

76

107

77− go :: ModuleOld -> ExternDecl -> ModuleOld

108+ lookupDtor name =

78− go m' re@(Export name) = replaceReexport re m' (getModule name)

109+ findRef (\case IdeDataConstructor name' _ _ -> name == name'

79− go _ _ = P.internalError "Should only get Exports here"

110+ _ -> False)

80

111

81− getModule :: ModuleIdent -> ModuleOld

112+ findDtors tn = filter (f . discardAnn) decls

82− getModule name = clean res

83 where

113 where

84− res = fromMaybe emptyModule $ (name , ) <$> Map.lookup name db

114+ f :: IdeDeclaration -> Bool

85− -- we have to do this because keeping self exports in will result in

115+ f decl

86− -- infinite loops

116+ | (IdeDataConstructor _ tn' _) <- decl

87− clean (mn, decls) = (mn,) (filter (/= Export mn) decls)

117+ , tn == tn' = True

88−

118+ | otherwise = False

89−resolveReexports :: Map ModuleIdent [ExternDecl] -> ModuleOld -> ModuleOld

90−resolveReexports modules m =

91− let replaced = replaceReexports m modules

92− in if null (getReexports replaced)

93− then replaced

94− else resolveReexports modules replaced

95−

96−resolveReexports2 :: Map Text [ExternDecl] -> ModuleOld -> Module

97−resolveReexports2 decls = convertModule . resolveReexports decls

src/Language/PureScript/Ide/SourceFile.hs+38−31

@@ -17,8 +17,7 @@

17module Language.PureScript.Ide.SourceFile

18 ( parseModule

19 , getImportsForFile

20− -- SOON...

20+ , extractSpans

21− , getDeclPosition

22 ) where

21 ) where

23

22

24import Protolude

23import Protolude

@@ -26,8 +25,6 @@ import Protolude

26import qualified Language.PureScript as P

25import qualified Language.PureScript as P

27import Language.PureScript.Ide.Error

26import Language.PureScript.Ide.Error

28import Language.PureScript.Ide.Util

27import Language.PureScript.Ide.Util

29−import Language.PureScript.Ide.Externs (unwrapPositioned,

30− unwrapPositionedRef)

31import Language.PureScript.Ide.Types

28import Language.PureScript.Ide.Types

32import System.FilePath

29import System.FilePath

33import System.IO.UTF8 (readUTF8File)

30import System.IO.UTF8 (readUTF8File)

@@ -68,31 +65,41 @@ getImportsForFile fp = do

68 unwrapImportType (P.Hiding decls) = P.Hiding (map unwrapPositionedRef decls)

65 unwrapImportType (P.Hiding decls) = P.Hiding (map unwrapPositionedRef decls)

69 unwrapImportType P.Implicit = P.Implicit

66 unwrapImportType P.Implicit = P.Implicit

70

67

71−getDeclPosition :: P.Module -> Text -> Maybe P.SourceSpan

68+-- | Given a surrounding Sourcespan and a Declaration from the PS AST, extracts

72−getDeclPosition m ident = getFirst (foldMap (match ident) decls)

69+-- definition sites inside that Declaration.

70+extractSpans

71+ :: P.SourceSpan

72+ -- ^ The surrounding span

73+ -> P.Declaration

74+ -- ^ The declaration to extract spans from

75+ -> [(Either Text Text, P.SourceSpan)]

76+ -- ^ A @Right@ corresponds to a type level declaration, and a @Left@ to a

77+ -- value level one

78+extractSpans ss d = case d of

79+ P.PositionedDeclaration ss' _ d' ->

80+ extractSpans ss' d'

81+ P.ValueDeclaration i _ _ _ ->

82+ [(Left (runIdentT i), ss)]

83+ P.TypeSynonymDeclaration name _ _ ->

84+ [(Right (runProperNameT name), ss)]

85+ P.TypeClassDeclaration name _ _ members ->

86+ (Right (runProperNameT name), ss) : concatMap (extractSpans' ss) members

87+ P.DataDeclaration _ name _ ctors ->

88+ (Right (runProperNameT name), ss)

89+ : map (\(cname, _) -> (Left (runProperNameT cname), ss)) ctors

90+ P.ExternDeclaration ident _ ->

91+ [(Left (runIdentT ident), ss)]

92+ P.ExternDataDeclaration name _ ->

93+ [(Right (runProperNameT name), ss)]

94+ _ -> []

73 where

95 where

74− decls = getDeclarations m

96+ -- We need this special case to be able to also get the position info for

97+ -- typeclass member functions. Typedeclaratations would clash with value

98+ -- declarations for non-typeclass members, which is why we can't handle them

99+ -- in extractSpans.

100+ extractSpans' ssP dP = case dP of

75− match q (P.PositionedDeclaration ss _ decl) = First (if go q decl

101+ P.PositionedDeclaration ssP' _ dP' ->

76− then Just ss

102+ extractSpans' ssP' dP'

77− else Nothing)

78− match _ _ = First Nothing

79−

80− go q (P.DataDeclaration _ name _ constructors) =

81− properEqual name q || any (\(x,_) -> properEqual x q) constructors

82− go q (P.DataBindingGroupDeclaration decls') = any (go q) decls'

83− go q (P.TypeSynonymDeclaration name _ _) = properEqual name q

84− go q (P.TypeDeclaration ident' _) = identEqual ident' q

103+ P.TypeDeclaration ident _ ->

85− go q (P.ValueDeclaration ident' _ _ _) = identEqual ident' q

86− go q (P.ExternDeclaration ident' _) = identEqual ident' q

87− go q (P.ExternDataDeclaration name _) = properEqual name q

88− go q (P.TypeClassDeclaration name _ _ members) =

89− properEqual name q || any (go q . unwrapPositioned) members

90− go q (P.TypeInstanceDeclaration ident' _ _ _ _) =

91− identEqual ident' q

92− go _ _ = False

93−

94− properEqual x q = runProperNameT x == q

95− identEqual x q = runIdentT x == q

104+ [(Left (runIdentT ident), ssP)]

96−

105+ _ -> []

97− getDeclarations :: P.Module -> [P.Declaration]

98− getDeclarations (P.Module _ _ _ declarations _) = declarations

src/Language/PureScript/Ide/State.hs+66−63

@@ -19,20 +19,15 @@

19module Language.PureScript.Ide.State

20 ( getLoadedModulenames

21 , getExternFiles

22− , insertModuleOld

23 , resetIdeState

22 , resetIdeState

24 , cacheRebuild

23 , cacheRebuild

25 , insertExterns

24 , insertExterns

26 , insertModule

25 , insertModule

27− , insertModuleSTM

28 , insertExternsSTM

26 , insertExternsSTM

29− , getAllModules2

27+ , getAllModules

30− , getStage1

31− , setStage1

32− , getStage2

33− , setStage2

34 , populateStage2

28 , populateStage2

35− , populateStage2STM

29+ , populateStage3

30+ , populateStage3STM

36 ) where

31 ) where

37

32

38import Protolude

33import Protolude

@@ -44,6 +39,7 @@ import qualified Data.Map.Lazy as M

44import Language.PureScript.Externs

39import Language.PureScript.Externs

45import Language.PureScript.Ide.Externs

40import Language.PureScript.Ide.Externs

46import Language.PureScript.Ide.Reexports

41import Language.PureScript.Ide.Reexports

42+import Language.PureScript.Ide.SourceFile

47import Language.PureScript.Ide.Types

43import Language.PureScript.Ide.Types

48import Language.PureScript.Ide.Util

44import Language.PureScript.Ide.Util

49import qualified Language.PureScript as P

45import qualified Language.PureScript as P

@@ -53,12 +49,10 @@ import System.FilePath

53-- | Resets all State inside psc-ide

49-- | Resets all State inside psc-ide

54resetIdeState :: Ide m => m ()

50resetIdeState :: Ide m => m ()

55resetIdeState = do

51resetIdeState = do

56− stateVar <- envStateVar <$> ask

57 ideVar <- ideStateVar <$> ask

52 ideVar <- ideStateVar <$> ask

58 liftIO . atomically $ do

53 liftIO . atomically $ do

59− writeTVar stateVar emptyPscIdeState

60 writeTVar ideVar emptyIdeState

54 writeTVar ideVar emptyIdeState

61− setStage2STM ideVar emptyStage2

55+ setStage3STM ideVar emptyStage3

62

56

63-- | Gets the loaded Modulenames

57-- | Gets the loaded Modulenames

64getLoadedModulenames :: Ide m => m [P.ModuleName]

58getLoadedModulenames :: Ide m => m [P.ModuleName]

@@ -68,26 +62,6 @@ getLoadedModulenames = M.keys <$> getExternFiles

68getExternFiles :: Ide m => m (M.Map P.ModuleName ExternsFile)

62getExternFiles :: Ide m => m (M.Map P.ModuleName ExternsFile)

69getExternFiles = s1Externs <$> getStage1

63getExternFiles = s1Externs <$> getStage1

70

64

71−-- | Inserts an @ExternsFile@ into the PscIdeState. Also converts the

72−-- ExternsFile into psc-ide's internal Declaration format

73−-- TODO: should be removed when the "old" Declaration format gets removed

74−insertModuleOld :: Ide m => ExternsFile -> m ()

75−insertModuleOld externsFile = do

76− stateVar <- envStateVar <$> ask

77− liftIO . atomically $ insertModuleOldSTM stateVar externsFile

78−

79−-- | STM version of insertModuleOld

80−insertModuleOldSTM :: TVar PscIdeState -> ExternsFile -> STM ()

81−insertModuleOldSTM st ef = modifyTVar st (insertModule' ef)

82−

83−-- | Pure version of insertModuleOld

84−insertModule' :: ExternsFile -> PscIdeState -> PscIdeState

85−insertModule' ef state =

86− state

87− { pscIdeStateModules = let (mn, decls) = convertExterns ef

88− in M.insert mn decls (pscIdeStateModules state)

89− }

90−

91-- | Insert a Module into Stage1 of the State

65-- | Insert a Module into Stage1 of the State

92insertModule :: Ide m => (FilePath, P.Module) -> m ()

66insertModule :: Ide m => (FilePath, P.Module) -> m ()

93insertModule module' = do

67insertModule module' = do

@@ -106,7 +80,6 @@ insertModuleSTM ref (fp, module') =

106

80

107-- | Retrieves Stage1 from the State.

81-- | Retrieves Stage1 from the State.

108-- This includes loaded Externfiles

82-- This includes loaded Externfiles

109−-- (TODO: as soon as we actually parse the modules) aswell as the parsed modules

110getStage1 :: Ide m => m Stage1

83getStage1 :: Ide m => m Stage1

111getStage1 = do

84getStage1 = do

112 st <- ideStateVar <$> ask

85 st <- ideStateVar <$> ask

@@ -116,27 +89,14 @@ getStage1 = do

116getStage1STM :: TVar IdeState -> STM Stage1

89getStage1STM :: TVar IdeState -> STM Stage1

117getStage1STM ref = ideStage1 <$> readTVar ref

90getStage1STM ref = ideStage1 <$> readTVar ref

118

91

119−-- | Sets Stage1 inside the compiler

120−setStage1 :: Ide m => Stage1 -> m ()

121−setStage1 s1 = do

122− st <- ideStateVar <$> ask

123− liftIO . atomically . modifyTVar st $ \x ->

124− x {ideStage1 = s1}

125− pure ()

126−

127−-- TODO: Soon to be Stage3

128-- | Retrieves Stage2 from the State.

92-- | Retrieves Stage2 from the State.

129−-- This includes the denormalized Declarations and cached rebuilds

130getStage2 :: Ide m => m Stage2

93getStage2 :: Ide m => m Stage2

131getStage2 = do

94getStage2 = do

132 st <- ideStateVar <$> ask

95 st <- ideStateVar <$> ask

133− fmap ideStage2 . liftIO . readTVarIO $ st

96+ liftIO (atomically (getStage2STM st))

134

97

135−-- | Sets Stage2 inside the compiler

98+getStage2STM :: TVar IdeState -> STM Stage2

136−setStage2 :: Ide m => Stage2 -> m ()

99+getStage2STM ref = ideStage2 <$> readTVar ref

137−setStage2 s2 = do

138− st <- ideStateVar <$> ask

139− liftIO . atomically $ setStage2STM st s2

140

100

141-- | STM version of setStage2

101-- | STM version of setStage2

142setStage2STM :: TVar IdeState -> Stage2 -> STM ()

102setStage2STM :: TVar IdeState -> Stage2 -> STM ()

@@ -145,21 +105,38 @@ setStage2STM ref s2 = do

145 x {ideStage2 = s2}

105 x {ideStage2 = s2}

146 pure ()

106 pure ()

147

107

108+-- | Retrieves Stage3 from the State.

109+-- This includes the denormalized Declarations and cached rebuilds

110+getStage3 :: Ide m => m Stage3

111+getStage3 = do

112+ st <- ideStateVar <$> ask

113+ fmap ideStage3 . liftIO . readTVarIO $ st

114+

115+-- | Sets Stage3 inside the compiler

116+setStage3STM :: TVar IdeState -> Stage3 -> STM ()

117+setStage3STM ref s3 = do

118+ modifyTVar ref $ \x ->

119+ x {ideStage3 = s3}

120+ pure ()

121+

148-- | Checks if the given ModuleName matches the last rebuild cache and if it

122-- | Checks if the given ModuleName matches the last rebuild cache and if it

149-- does returns all loaded definitions + the definitions inside the rebuild

123-- does returns all loaded definitions + the definitions inside the rebuild

150-- cache

124-- cache

151−getAllModules2 :: Ide m => Maybe P.ModuleName -> m [(P.ModuleName, [IdeDeclaration])]

125+getAllModules :: Ide m => Maybe P.ModuleName -> m [Module]

152−getAllModules2 mmoduleName = do

126+getAllModules mmoduleName = do

153− declarations <- s2Declarations <$> getStage2

127+ declarations <- s3Declarations <$> getStage3

154 rebuild <- cachedRebuild

128 rebuild <- cachedRebuild

155 case mmoduleName of

129 case mmoduleName of

156 Nothing -> pure (M.toList declarations)

130 Nothing -> pure (M.toList declarations)

157 Just moduleName ->

131 Just moduleName ->

158 case rebuild of

132 case rebuild of

159 Just (cachedModulename, ef)

133 Just (cachedModulename, ef)

160− | cachedModulename == moduleName ->

134+ | cachedModulename == moduleName -> do

135+ (AstData asts) <- s2AstData <$> getStage2

136+ let ast = fromMaybe M.empty (M.lookup moduleName asts)

161− pure . M.toList $

137+ pure . M.toList $

138+ M.insert moduleName

162− M.insert moduleName (snd . convertModule . convertExterns $ ef) declarations

139+ (snd . annotateLocations ast . fst . convertExterns $ ef) declarations

163 _ -> pure (M.toList declarations)

140 _ -> pure (M.toList declarations)

164

141

165-- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the

142-- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the

@@ -182,14 +159,14 @@ cacheRebuild :: Ide m => ExternsFile -> m ()

182cacheRebuild ef = do

159cacheRebuild ef = do

183 st <- ideStateVar <$> ask

160 st <- ideStateVar <$> ask

184 liftIO . atomically . modifyTVar st $ \x ->

161 liftIO . atomically . modifyTVar st $ \x ->

185− x { ideStage2 = (ideStage2 x) {

162+ x { ideStage3 = (ideStage3 x) {

186− s2CachedRebuild = Just (efModuleName ef, ef)}}

163+ s3CachedRebuild = Just (efModuleName ef, ef)}}

187

164

188-- | Retrieves the rebuild cache

165-- | Retrieves the rebuild cache

189cachedRebuild :: Ide m => m (Maybe (P.ModuleName, ExternsFile))

166cachedRebuild :: Ide m => m (Maybe (P.ModuleName, ExternsFile))

190−cachedRebuild = s2CachedRebuild <$> getStage2

167+cachedRebuild = s3CachedRebuild <$> getStage3

191

168

192−-- | Resolves reexports and populates Stage2 with data to be used in queries.

169+-- | Extracts source spans from the parsed ASTs

193populateStage2 :: (Ide m, MonadLogger m) => m ()

170populateStage2 :: (Ide m, MonadLogger m) => m ()

194populateStage2 = do

171populateStage2 = do

195 st <- ideStateVar <$> ask

172 st <- ideStateVar <$> ask

@@ -203,9 +180,35 @@ populateStage2 = do

203-- | STM version of populateStage2

180-- | STM version of populateStage2

204populateStage2STM :: TVar IdeState -> STM ()

181populateStage2STM :: TVar IdeState -> STM ()

205populateStage2STM ref = do

182populateStage2STM ref = do

183+ modules <- s1Modules <$> getStage1STM ref

184+ let spans = map (\((P.Module ss _ _ decls _), _) -> M.fromList (concatMap (extractSpans ss) decls)) modules

185+ setStage2STM ref (Stage2 (AstData spans))

186+

187+-- | Resolves reexports and populates Stage3 with data to be used in queries.

188+populateStage3 :: (Ide m, MonadLogger m) => m ()

189+populateStage3 = do

190+ st <- ideStateVar <$> ask

191+ (duration, results) <- liftIO $ do

192+ start <- getTime Monotonic

193+ results <- atomically (populateStage3STM st)

194+ end <- getTime Monotonic

195+ pure (Prelude.show (diffTimeSpec start end), results)

196+ traverse_

197+ (logWarnN . prettyPrintReexportResult (runModuleNameT . fst))

198+ (filter reexportHasFailures results)

199+ $(logDebug) $ "Finished populating Stage3 in " <> toS duration

200+

201+-- | STM version of populateStage3

202+populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]

203+populateStage3STM ref = do

206 externs <- s1Externs <$> getStage1STM ref

204 externs <- s1Externs <$> getStage1STM ref

207− -- Build the "old" ExternDecl format

205+ (AstData asts) <- s2AstData <$> getStage2STM ref

208− let modules = M.mapKeys runModuleNameT (M.map (snd . convertExterns) externs)

206+ let modules = M.map convertExterns externs

209− -- Convert ExternDecl into IdeDeclaration

207+ nModules :: Map P.ModuleName (Module, [(P.ModuleName, P.DeclarationRef)])

210− declarations = resolveReexports2 modules <$> M.toList modules

208+ nModules = M.mapWithKey

211− setStage2STM ref (Stage2 (M.fromList declarations) Nothing)

209+ (\moduleName (m, refs) ->

210+ (fromMaybe m $ annotateLocations <$> M.lookup moduleName asts <*> pure m, refs)) modules

211+ -- resolves reexports and discards load failures for now

212+ result = resolveReexports (M.map (snd . fst) nModules) <$> M.elems nModules

213+ setStage3STM ref (Stage3 (M.fromList (map reResolved result)) Nothing)

214+ pure result

src/Language/PureScript/Ide/Types.hs+50−52

@@ -13,6 +13,7 @@

13-----------------------------------------------------------------------------

14

15{-# LANGUAGE OverloadedStrings #-}

16+{-# LANGUAGE DeriveFoldable #-}

16

17

17module Language.PureScript.Ide.Types where

18module Language.PureScript.Ide.Types where

18

19

@@ -28,47 +29,35 @@ import System.FilePath

28import Text.Parsec as Parsec

29import Text.Parsec as Parsec

29import Text.Parsec.Text

30import Text.Parsec.Text

30

31

31−type Ident = Text

32type ModuleIdent = Text

33

34−data ExternDecl

35− -- | A function/value declaration

36− = ValueDeclaration Ident P.Type

37− | TypeDeclaration (P.ProperName 'P.TypeName) P.Kind

38− | TypeSynonymDeclaration (P.ProperName 'P.TypeName) P.Type

39− -- | A Dependency onto another Module

40− | Dependency

41− ModuleIdent -- name of the dependency

42− [Text] -- explicit imports

43− (Maybe Text) -- An eventual qualifier

44− -- | A module declaration

45− | ModuleDecl

46− ModuleIdent -- The modules name

47− [Ident] -- The exported identifiers

48− -- | A data/newtype declaration

49− | DataConstructor

50− Ident -- The type name

51− (P.ProperName 'P.TypeName)

52− P.Type -- The "type"

53− -- | An exported module

54− | TypeClassDeclaration (P.ProperName 'P.ClassName)

55− | ValueOperator (P.OpName 'P.ValueOpName) Ident P.Precedence P.Associativity

56− | TypeOperator (P.OpName 'P.TypeOpName) Ident P.Precedence P.Associativity

57− | Export ModuleIdent -- The exported Modules name

58− deriving (Show,Eq,Ord)

59−

60data IdeDeclaration

34data IdeDeclaration

61− = IdeValue Ident P.Type

35+ = IdeValue P.Ident P.Type

62 | IdeType (P.ProperName 'P.TypeName) P.Kind

36 | IdeType (P.ProperName 'P.TypeName) P.Kind

63 | IdeTypeSynonym (P.ProperName 'P.TypeName) P.Type

37 | IdeTypeSynonym (P.ProperName 'P.TypeName) P.Type

64− | IdeDataConstructor Ident (P.ProperName 'P.TypeName) P.Type

38+ | IdeDataConstructor (P.ProperName 'P.ConstructorName) (P.ProperName 'P.TypeName) P.Type

65 | IdeTypeClass (P.ProperName 'P.ClassName)

39 | IdeTypeClass (P.ProperName 'P.ClassName)

66− | IdeValueOperator (P.OpName 'P.ValueOpName) Ident P.Precedence P.Associativity

40+ | IdeValueOperator (P.OpName 'P.ValueOpName) Text P.Precedence P.Associativity

67− | IdeTypeOperator (P.OpName 'P.TypeOpName) Ident P.Precedence P.Associativity

41+ | IdeTypeOperator (P.OpName 'P.TypeOpName) Text P.Precedence P.Associativity

42+ deriving (Show, Eq, Ord)

43+

44+data IdeDeclarationAnn = IdeDeclarationAnn Annotation IdeDeclaration

68 deriving (Show, Eq, Ord)

45 deriving (Show, Eq, Ord)

69

46

47+data Annotation

48+ = Annotation

49+ { annLocation :: Maybe P.SourceSpan

50+ , annExportedFrom :: Maybe P.ModuleName

51+ } deriving (Show, Eq, Ord)

52+

53+emptyAnn :: Annotation

54+emptyAnn = Annotation Nothing Nothing

55+

70−type Module = (P.ModuleName, [IdeDeclaration])

56+type Module = (P.ModuleName, [IdeDeclarationAnn])

71−type ModuleOld = (Text, [ExternDecl])

57+

58+newtype AstData a =

59+ AstData (Map P.ModuleName (Map (Either Text Text) a))

60+ deriving (Show, Eq, Ord, Functor, Foldable)

72

61

73data Configuration =

62data Configuration =

74 Configuration

63 Configuration

@@ -79,34 +68,29 @@ data Configuration =

79

68

80data IdeEnvironment =

69data IdeEnvironment =

81 IdeEnvironment

70 IdeEnvironment

82− { envStateVar :: TVar PscIdeState

83− , ideStateVar :: TVar IdeState

71+ { ideStateVar :: TVar IdeState

84 , ideConfiguration :: Configuration

72 , ideConfiguration :: Configuration

85 }

73 }

86

74

87type Ide m = (MonadIO m, MonadReader IdeEnvironment m)

75type Ide m = (MonadIO m, MonadReader IdeEnvironment m)

88

76

89−data PscIdeState =

90− PscIdeState

91− { pscIdeStateModules :: M.Map Text [ExternDecl]

92− } deriving Show

93−

94−emptyPscIdeState :: PscIdeState

95−emptyPscIdeState = PscIdeState M.empty

96−

97data IdeState = IdeState

77data IdeState = IdeState

98 { ideStage1 :: Stage1

78 { ideStage1 :: Stage1

99 , ideStage2 :: Stage2

79 , ideStage2 :: Stage2

80+ , ideStage3 :: Stage3

100 }

81 }

101

82

102emptyIdeState :: IdeState

83emptyIdeState :: IdeState

103−emptyIdeState = IdeState emptyStage1 emptyStage2

84+emptyIdeState = IdeState emptyStage1 emptyStage2 emptyStage3

104

85

105emptyStage1 :: Stage1

86emptyStage1 :: Stage1

106emptyStage1 = Stage1 M.empty M.empty

87emptyStage1 = Stage1 M.empty M.empty

107

88

108emptyStage2 :: Stage2

89emptyStage2 :: Stage2

109−emptyStage2 = Stage2 M.empty Nothing

90+emptyStage2 = Stage2 (AstData M.empty)

91+

92+emptyStage3 :: Stage3

93+emptyStage3 = Stage3 M.empty Nothing

110

94

111data Stage1 = Stage1

95data Stage1 = Stage1

112 { s1Externs :: M.Map P.ModuleName P.ExternsFile

96 { s1Externs :: M.Map P.ModuleName P.ExternsFile

@@ -114,19 +98,31 @@ data Stage1 = Stage1

114 }

98 }

115

99

116data Stage2 = Stage2

100data Stage2 = Stage2

117− { s2Declarations :: M.Map P.ModuleName [IdeDeclaration]

101+ { s2AstData :: AstData P.SourceSpan

102+ }

103+

104+data Stage3 = Stage3

105+ { s3Declarations :: M.Map P.ModuleName [IdeDeclarationAnn]

118− , s2CachedRebuild :: Maybe (P.ModuleName, P.ExternsFile)

106+ , s3CachedRebuild :: Maybe (P.ModuleName, P.ExternsFile)

119 }

107 }

120

108

121−data Match = Match P.ModuleName IdeDeclaration

109+newtype Match a = Match (P.ModuleName, a)

122− deriving (Show, Eq)

110+ deriving (Show, Eq, Functor)

123

111

124newtype Completion =

112newtype Completion =

125− Completion (ModuleIdent, Ident, Text)

113+ Completion (Text, Text, Text)

126 deriving (Show,Eq)

114 deriving (Show,Eq)

127

115

116+newtype Info =

117+ Info (Text, Text, Text, Maybe P.SourceSpan)

118+ deriving (Show,Eq)

119+

120+instance ToJSON Info where

121+ toJSON (Info (m, d, t, sourceSpan)) =

122+ object ["module" .= m, "identifier" .= d, "type" .= t, "definedAt" .= sourceSpan]

123+

128instance ToJSON Completion where

124instance ToJSON Completion where

129− toJSON (Completion (m,d,t)) =

125+ toJSON (Completion (m, d, t)) =

130 object ["module" .= m, "identifier" .= d, "type" .= t]

126 object ["module" .= m, "identifier" .= d, "type" .= t]

131

127

132data ModuleImport =

128data ModuleImport =

@@ -165,6 +161,7 @@ identifierFromDeclarationRef _ = ""

165

161

166data Success =

162data Success =

167 CompletionResult [Completion]

163 CompletionResult [Completion]

164+ | InfoResult [Info]

168 | TextResult Text

165 | TextResult Text

169 | MultilineTextResult [Text]

166 | MultilineTextResult [Text]

170 | PursuitResult [PursuitResponse]

167 | PursuitResult [PursuitResponse]

@@ -179,6 +176,7 @@ encodeSuccess res =

179

176

180instance ToJSON Success where

177instance ToJSON Success where

181 toJSON (CompletionResult cs) = encodeSuccess cs

178 toJSON (CompletionResult cs) = encodeSuccess cs

179+ toJSON (InfoResult i) = encodeSuccess i

182 toJSON (TextResult t) = encodeSuccess t

180 toJSON (TextResult t) = encodeSuccess t

183 toJSON (MultilineTextResult ts) = encodeSuccess ts

181 toJSON (MultilineTextResult ts) = encodeSuccess ts

184 toJSON (PursuitResult resp) = encodeSuccess resp

182 toJSON (PursuitResult resp) = encodeSuccess resp

@@ -208,7 +206,7 @@ data PursuitResponse =

208 ModuleResponse ModuleIdent Text

206 ModuleResponse ModuleIdent Text

209 -- | A Pursuit Response for a declaration. Consist of the declarations type,

207 -- | A Pursuit Response for a declaration. Consist of the declarations type,

210 -- module, name and package

208 -- module, name and package

211− | DeclarationResponse Text ModuleIdent Ident Text

209+ | DeclarationResponse Text ModuleIdent Text Text

212 deriving (Show,Eq)

210 deriving (Show,Eq)

213

211

214instance FromJSON PursuitResponse where

212instance FromJSON PursuitResponse where

src/Language/PureScript/Ide/Util.hs+40−14

@@ -16,10 +16,14 @@

16

17module Language.PureScript.Ide.Util

18 ( identifierFromIdeDeclaration

19− , identifierFromMatch

19+ , unwrapMatch

20+ , unwrapPositioned

21+ , unwrapPositionedRef

20 , completionFromMatch

22 , completionFromMatch

23+ , infoFromMatch

21 , encodeT

24 , encodeT

22 , decodeT

25 , decodeT

26+ , discardAnn

23 , module Language.PureScript.Ide.Conversions

27 , module Language.PureScript.Ide.Conversions

24 ) where

28 ) where

25

29

@@ -33,26 +37,34 @@ import Language.PureScript.Ide.Conversions

33

37

34identifierFromIdeDeclaration :: IdeDeclaration -> Text

38identifierFromIdeDeclaration :: IdeDeclaration -> Text

35identifierFromIdeDeclaration d = case d of

39identifierFromIdeDeclaration d = case d of

36− IdeValue name _ -> name

40+ IdeValue name _ -> runIdentT name

37 IdeType name _ -> runProperNameT name

41 IdeType name _ -> runProperNameT name

38 IdeTypeSynonym name _ -> runProperNameT name

42 IdeTypeSynonym name _ -> runProperNameT name

39− IdeDataConstructor name _ _ -> name

43+ IdeDataConstructor name _ _ -> runProperNameT name

40 IdeTypeClass name -> runProperNameT name

44 IdeTypeClass name -> runProperNameT name

41 IdeValueOperator op _ _ _ -> runOpNameT op

45 IdeValueOperator op _ _ _ -> runOpNameT op

42 IdeTypeOperator op _ _ _ -> runOpNameT op

46 IdeTypeOperator op _ _ _ -> runOpNameT op

43

47

44−identifierFromMatch :: Match -> Text

48+discardAnn :: IdeDeclarationAnn -> IdeDeclaration

45−identifierFromMatch (Match _ ed) = identifierFromIdeDeclaration ed

49+discardAnn (IdeDeclarationAnn _ d) = d

46

50

51+unwrapMatch :: Match a -> a

52+unwrapMatch (Match (_, ed)) = ed

53+

47−completionFromMatch :: Match -> Completion

54+completionFromMatch :: Match IdeDeclaration -> Completion

48−completionFromMatch (Match m' d) = case d of

55+completionFromMatch = Completion . completionFromMatch'

56+

57+completionFromMatch' :: Match IdeDeclaration -> (Text, Text, Text)

58+completionFromMatch' (Match (m', d)) = case d of

49− IdeValue name type' -> Completion (m, name, prettyTypeT type')

59+ IdeValue name type' -> (m, runIdentT name, prettyTypeT type')

50− IdeType name kind -> Completion (m, runProperNameT name, toS (P.prettyPrintKind kind))

60+ IdeType name kind -> (m, runProperNameT name, toS (P.prettyPrintKind kind))

51− IdeTypeSynonym name kind -> Completion (m, runProperNameT name, prettyTypeT kind)

61+ IdeTypeSynonym name kind -> (m, runProperNameT name, prettyTypeT kind)

52− IdeDataConstructor name _ type' -> Completion (m, name, prettyTypeT type')

62+ IdeDataConstructor name _ type' -> (m, runProperNameT name, prettyTypeT type')

53− IdeTypeClass name -> Completion (m, runProperNameT name, "class")

63+ IdeTypeClass name -> (m, runProperNameT name, "class")

64+ IdeValueOperator op ref precedence associativity ->

54− IdeValueOperator op ref precedence associativity -> Completion (m, runOpNameT op, showFixity precedence associativity ref op)

65+ (m, runOpNameT op, showFixity precedence associativity ref op)

66+ IdeTypeOperator op ref precedence associativity ->

55− IdeTypeOperator op ref precedence associativity -> Completion (m, runOpNameT op, showFixity precedence associativity ref op)

67+ (m, runOpNameT op, showFixity precedence associativity ref op)

56 where

68 where

57 m = runModuleNameT m'

69 m = runModuleNameT m'

58 showFixity p a r o =

70 showFixity p a r o =

@@ -62,8 +74,22 @@ completionFromMatch (Match m' d) = case d of

62 P.Infixr -> "infixr"

74 P.Infixr -> "infixr"

63 in T.unwords [asso, show p, r, "as", runOpNameT o]

75 in T.unwords [asso, show p, r, "as", runOpNameT o]

64

76

77+infoFromMatch :: Match IdeDeclarationAnn -> Info

78+infoFromMatch (Match (m, (IdeDeclarationAnn ann d))) =

79+ Info (a, b, c, annLocation ann)

80+ where

81+ (a, b, c) = completionFromMatch' (Match (m, d))

82+

65encodeT :: (ToJSON a) => a -> Text

83encodeT :: (ToJSON a) => a -> Text

66encodeT = toS . decodeUtf8 . encode

84encodeT = toS . decodeUtf8 . encode

67

85

68decodeT :: (FromJSON a) => Text -> Maybe a

86decodeT :: (FromJSON a) => Text -> Maybe a

69decodeT = decode . encodeUtf8 . toS

87decodeT = decode . encodeUtf8 . toS

88+

89+unwrapPositioned :: P.Declaration -> P.Declaration

90+unwrapPositioned (P.PositionedDeclaration _ _ x) = x

91+unwrapPositioned x = x

92+

93+unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef

94+unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = x

95+unwrapPositionedRef x = x

src/Language/PureScript/Ide/Watcher.hs+4−2

@@ -12,7 +12,9 @@

12-- File watcher for externs files

13-----------------------------------------------------------------------------

14

15−module Language.PureScript.Ide.Watcher where

15+module Language.PureScript.Ide.Watcher

16+ ( watcher

17+ ) where

16

18

17import Protolude

19import Protolude

18

20

@@ -33,7 +35,7 @@ reloadFile ref ev = do

33 case ef' of

35 case ef' of

34 Left _ -> pure ()

36 Left _ -> pure ()

35 Right ef -> do

37 Right ef -> do

36− atomically (insertExternsSTM ref ef *> populateStage2STM ref)

38+ void $ atomically (insertExternsSTM ref ef *> populateStage3STM ref)

37 putStrLn ("Reloaded File at: " ++ fp)

39 putStrLn ("Reloaded File at: " ++ fp)

38

40

39-- | Installs filewatchers for the given directory and reloads ExternsFiles when

41-- | Installs filewatchers for the given directory and reloads ExternsFiles when

tests/Language/PureScript/Ide/FilterSpec.hs+5−5

@@ -8,8 +8,8 @@ import Language.PureScript.Ide.Types

8import qualified Language.PureScript as P

9import Test.Hspec

10

11−value :: Text -> IdeDeclaration

11+value :: Text -> IdeDeclarationAnn

12−value s = IdeValue s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

12+value s = IdeDeclarationAnn emptyAnn (IdeValue (P.Ident (toS s)) P.REmpty)

13

14moduleA, moduleB :: Module

15moduleA = (P.moduleNameFromString "Module.A", [value "function1"])

@@ -19,13 +19,13 @@ modules :: [Module]

19modules = [moduleA, moduleB]

20

21runEq :: Text -> [Module]

22−runEq s = runFilter (equalityFilter s) modules

22+runEq s = applyFilters [equalityFilter s] modules

23

24runPrefix :: Text -> [Module]

25−runPrefix s = runFilter (prefixFilter s) modules

25+runPrefix s = applyFilters [prefixFilter s] modules

26

27runModule :: [P.ModuleName] -> [Module]

28−runModule ms = runFilter (moduleFilter ms) modules

28+runModule ms = applyFilters [moduleFilter ms] modules

29

30spec :: Spec

31spec = do

tests/Language/PureScript/Ide/ImportsSpec.hs+2−2

@@ -68,11 +68,11 @@ spec = do

68 describe "import commands" $ do

69 let simpleFileImports = let (_, _, i, _) = splitSimpleFile in i

70 addValueImport i mn is =

71− prettyPrintImportSection (addExplicitImport' (IdeValue i wildcard) mn is)

71+ prettyPrintImportSection (addExplicitImport' (IdeValue (P.Ident i) wildcard) mn is)

72 addOpImport op mn is =

73 prettyPrintImportSection (addExplicitImport' (IdeValueOperator op "" 2 P.Infix) mn is)

74 addDtorImport i t mn is =

75− prettyPrintImportSection (addExplicitImport' (IdeDataConstructor i t wildcard) mn is)

75+ prettyPrintImportSection (addExplicitImport' (IdeDataConstructor (P.ProperName i) t wildcard) mn is)

76 it "adds an implicit unqualified import" $

77 shouldBe

78 (addImplicitImport' simpleFileImports (P.moduleNameFromString "Data.Map"))

tests/Language/PureScript/Ide/Integration.hs+17−6

@@ -37,11 +37,13 @@ module Language.PureScript.Ide.Integration

37 , getFlexCompletions

38 , getFlexCompletionsInModule

39 , getType

40+ , getInfo

40 , rebuildModule

41 , rebuildModule

41 , reset

42 , reset

42 -- checking results

43 -- checking results

43 , resultIsSuccess

44 , resultIsSuccess

44 , parseCompletions

45 , parseCompletions

46+ , parseInfo

45 , parseTextResult

47 , parseTextResult

46 ) where

48 ) where

47

49

@@ -53,6 +55,7 @@ import Data.Aeson.Types

53import qualified Data.Text as T

55import qualified Data.Text as T

54import qualified Data.Vector as V

56import qualified Data.Vector as V

55import Language.PureScript.Ide.Util

57import Language.PureScript.Ide.Util

58+import qualified Language.PureScript as P

56import System.Directory

59import System.Directory

57import System.FilePath

60import System.FilePath

58import System.IO.Error (mkIOError, userErrorType)

61import System.IO.Error (mkIOError, userErrorType)

@@ -68,8 +71,8 @@ startServer = do

68 pdir <- projectDirectory

71 pdir <- projectDirectory

69 -- Turn off filewatching since it creates race condition in a testing environment

72 -- Turn off filewatching since it creates race condition in a testing environment

70 (_, _, _, procHandle) <- createProcess $

73 (_, _, _, procHandle) <- createProcess $

71− (shell "psc-ide-server --no-watch") {cwd = Just pdir}

74+ (shell "psc-ide-server --no-watch src/*.purs") {cwd = Just pdir}

72− threadDelay 500000 -- give the server 500ms to start up

75+ threadDelay 2000000 -- give the server 2s to start up

73 return procHandle

76 return procHandle

74

77

75stopServer :: ProcessHandle -> IO ()

78stopServer :: ProcessHandle -> IO ()

@@ -91,10 +94,7 @@ compileTestProject :: IO Bool

91compileTestProject = do

94compileTestProject = do

92 pdir <- projectDirectory

95 pdir <- projectDirectory

93 (_, _, _, procHandle) <- createProcess $

96 (_, _, _, procHandle) <- createProcess $

94− (shell . toS $ "psc " <> fileGlob) { cwd = Just pdir

97+ (shell . toS $ "psc " <> fileGlob) { cwd = Just pdir }

95− , std_out = CreatePipe

96− , std_err = CreatePipe

97− }

98 r <- tryNTimes 5 (getProcessExitCode procHandle)

99 pure (fromMaybe False (isSuccess <$> r))

100

@@ -167,6 +167,9 @@ getFlexCompletionsInModule q m = parseCompletions <$> sendCommand (completion []

167getType :: Text -> IO [(Text, Text, Text)]

168getType q = parseCompletions <$> sendCommand (typeC q [])

169

170+getInfo :: Text -> IO [P.SourceSpan]

171+getInfo q = parseInfo <$> sendCommand (typeC q [])

172+

170addImport :: Text -> FilePath -> FilePath -> IO Text

173addImport :: Text -> FilePath -> FilePath -> IO Text

171addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp)

174addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp)

172

175

@@ -259,6 +262,10 @@ completionParser = withArray "res" $ \cs ->

259 ty <- o .: "type"

262 ty <- o .: "type"

260 pure (module', ident, ty)) (V.toList cs)

263 pure (module', ident, ty)) (V.toList cs)

261

264

265+infoParser :: Value -> Parser [P.SourceSpan]

266+infoParser = withArray "res" $ \cs ->

267+ mapM (withObject "info" $ \o -> o .: "definedAt") (V.toList cs)

268+

262valueFromText :: Text -> Value

269valueFromText :: Text -> Value

263valueFromText = fromJust . decode . toS

270valueFromText = fromJust . decode . toS

264

271

@@ -269,6 +276,10 @@ parseCompletions :: Text -> [(Text, Text, Text)]

269parseCompletions s =

276parseCompletions s =

270 fromJust $ join (rightToMaybe <$> parseMaybe (withResult completionParser) (valueFromText s))

277 fromJust $ join (rightToMaybe <$> parseMaybe (withResult completionParser) (valueFromText s))

271

278

279+parseInfo :: Text -> [P.SourceSpan]

280+parseInfo s =

281+ fromJust $ join (rightToMaybe <$> parseMaybe (withResult infoParser) (valueFromText s))

282+

272parseTextResult :: Text -> Text

283parseTextResult :: Text -> Text

273parseTextResult s =

284parseTextResult s =

274 fromJust $ join (rightToMaybe <$> parseMaybe (withResult (withText "tr" pure)) (valueFromText s))

285 fromJust $ join (rightToMaybe <$> parseMaybe (withResult (withText "tr" pure)) (valueFromText s))

tests/Language/PureScript/Ide/MatcherSpec.hs+7−7

@@ -12,17 +12,17 @@ import Language.PureScript.Ide.Types

12import Test.Hspec

13

14value :: Text -> IdeDeclaration

15−value s = IdeValue s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

15+value s = IdeValue (P.Ident (toS s)) P.REmpty

16

17−firstResult, secondResult, fiult :: Match

17+firstResult, secondResult, fiult :: Match IdeDeclaration

18−firstResult = Match (P.moduleNameFromString "Match") (value "firstResult")

18+firstResult = Match (P.moduleNameFromString "Match", value "firstResult")

19−secondResult = Match (P.moduleNameFromString "Match") (value "secondResult")

19+secondResult = Match (P.moduleNameFromString "Match", value "secondResult")

20−fiult = Match (P.moduleNameFromString "Match") (value "fiult")

20+fiult = Match (P.moduleNameFromString "Match", value "fiult")

21

22−completions :: [Match]

22+completions :: [Match IdeDeclaration]

23completions = [firstResult, secondResult, fiult]

24

25−runFlex :: Text -> [Match]

25+runFlex :: Text -> [Match IdeDeclaration]

26runFlex s = runMatcher (flexMatcher s) completions

27

28setup :: IO ()

tests/Language/PureScript/Ide/ReexportsSpec.hs+51−66

@@ -2,78 +2,63 @@

2{-# LANGUAGE NoImplicitPrelude #-}

3module Language.PureScript.Ide.ReexportsSpec where

4

5+import qualified Prelude as Prelude

5import Protolude

6import Protolude

6

7

7−import qualified Data.Map as Map

8+import qualified Data.Map as Map

8import Language.PureScript.Ide.Reexports

9import Language.PureScript.Ide.Reexports

9import Language.PureScript.Ide.Types

10import Language.PureScript.Ide.Types

10import qualified Language.PureScript as P

11import qualified Language.PureScript as P

11import Test.Hspec

12import Test.Hspec

12

13

13−wildcard :: P.Type

14+m :: Prelude.String -> P.ModuleName

14−wildcard = P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

15+m = P.moduleNameFromString

15−

16+

16−decl1 :: ExternDecl

17+d :: IdeDeclaration -> IdeDeclarationAnn

17−decl1 = ValueDeclaration "filter" wildcard

18+d = IdeDeclarationAnn emptyAnn

18−decl2 :: ExternDecl

19+

19−decl2 = ValueDeclaration "map" wildcard

20+valueA, typeA, classA, dtorA1, dtorA2 :: IdeDeclarationAnn

20−decl3 :: ExternDecl

21+valueA = d (IdeValue (P.Ident "valueA") P.REmpty)

21−decl3 = ValueDeclaration "catMaybe" wildcard

22+typeA = d (IdeType (P.ProperName "TypeA") P.Star)

22−dep1 :: ExternDecl

23+classA = d (IdeTypeClass (P.ProperName "ClassA"))

23−dep1 = Dependency "Test.Foo" [] (Just "T")

24+dtorA1 = d (IdeDataConstructor (P.ProperName "DtorA1") (P.ProperName "TypeA") P.REmpty)

24−dep2 :: ExternDecl

25+dtorA2 = d (IdeDataConstructor (P.ProperName "DtorA2") (P.ProperName "TypeA") P.REmpty)

25−dep2 = Dependency "Test.Bar" [] (Just "T")

26+

26−

27+env :: Map P.ModuleName [IdeDeclarationAnn]

27−circularModule :: ModuleOld

28−circularModule = ("Circular", [Export "Circular"])

29−

30−module1 :: ModuleOld

31−module1 = ("Module1", [Export "Module2", Export "Module3", decl1])

32−

33−module2 :: ModuleOld

34−module2 = ("Module2", [decl2])

35−

36−module3 :: ModuleOld

37−module3 = ("Module3", [decl3])

38−

39−module4 :: ModuleOld

40−module4 = ("Module4", [Export "T", decl1, dep1, dep2])

41−

42−result :: ModuleOld

43−result = ("Module1", [decl1, decl2, Export "Module3"])

44−

45−db :: Map ModuleIdent [ExternDecl]

46−db = Map.fromList [module1, module2, module3]

28+env = Map.fromList

47−

29+ [ (m "A", [valueA, typeA, classA, dtorA1, dtorA2])

48−shouldBeEqualSorted :: ModuleOld -> ModuleOld -> Expectation

30+ ]

49−shouldBeEqualSorted (n1, d1) (n2, d2) = (n1, sort d1) `shouldBe` (n2, sort d2)

31+

32+type Refs = [(P.ModuleName, P.DeclarationRef)]

33+

34+succTestCases :: [(Text, Module, Refs, Module)]

35+succTestCases =

36+ [ ("resolves a value reexport", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueA"))], (m "C", [valueA]))

37+ , ("resolves a type reexport with explicit data constructors"

38+ , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeA") (Just [P.ProperName "DtorA1"]))], (m "C", [typeA, dtorA1]))

39+ , ("resolves a type reexport with implicit data constructors"

40+ , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeA") Nothing)], (m "C", [typeA, dtorA1, dtorA2]))

41+ , ("resolves a class reexport", (m "C", []), [(m "A", P.TypeClassRef (P.ProperName "ClassA"))], (m "C", [classA]))

42+ ]

43+

44+failTestCases :: [(Text, Module, Refs)]

45+failTestCases =

46+ [ ("fails to resolve a non existing value", (m "C", []), [(m "A", P.ValueRef (P.Ident "valueB"))])

47+ , ("fails to resolve a non existing type reexport" , (m "C", []), [(m "A", P.TypeRef (P.ProperName "TypeB") Nothing)])

48+ , ("fails to resolve a non existing class reexport", (m "C", []), [(m "A", P.TypeClassRef (P.ProperName "ClassB"))])

49+ ]

50

51spec :: Spec

52−spec =

52+spec = do

53− describe "Reexports" $ do

53+ describe "Successful Reexports" $

54− it "finds all reexports" $

54+ for_ succTestCases $ \(desc, initial, refs, result) ->

55− getReexports module1 `shouldBe` [Export "Module2", Export "Module3"]

55+ it (toS desc) $ do

56−

56+ let reResult = resolveReexports env (initial, refs)

57− it "replaces a reexport with another module" $

57+ reResolved reResult `shouldBe` result

58− replaceReexport (Export "Module2") module1 module2 `shouldBeEqualSorted` result

58+ reResult `shouldSatisfy` not . reexportHasFailures

59−

59+ describe "Failed Reexports" $

60− it "adds another module even if there is no export statement" $

60+ for_ failTestCases $ \(desc, initial, refs) ->

61− replaceReexport (Export "Module2") ("Module1", [decl1, Export "Module3"]) module2

61+ it (toS desc) $ do

62− `shouldBeEqualSorted` result

62+ let reResult = resolveReexports env (initial, refs)

63−

63+ reFailed reResult `shouldBe` refs

64− it "only adds a declaration once" $

64+ reResult `shouldSatisfy` reexportHasFailures

65− let replaced = replaceReexport (Export "Module2") module1 module2

66− in replaceReexport (Export "Module2") replaced module2 `shouldBeEqualSorted` result

67−

68− it "replaces all Exports with their corresponding declarations" $

69− replaceReexports module1 db `shouldBe` ("Module1", [decl1, decl2, decl3])

70−

71− it "does not list itself as a reexport" $

72− getReexports circularModule `shouldBe` []

73−

74− it "does not include circular references when replacing reexports" $

75− replaceReexports circularModule (uncurry Map.singleton circularModule )

76− `shouldBe` ("Circular", [])

77−

78− it "replaces exported aliases with imported module" $

79− getReexports module4 `shouldBe` [Export "Test.Foo", Export "Test.Bar"]

tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hsnew file+36

@@ -0,0 +1,36 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE NoImplicitPrelude #-}

3+module Language.PureScript.Ide.SourceFile.IntegrationSpec where

4+

5+

6+import Protolude

7+

8+import qualified Data.Text as T

9+import qualified Language.PureScript.Ide.Integration as Integration

10+import qualified Language.PureScript as P

11+import Test.Hspec

12+

13+setup :: IO ()

14+setup = void (Integration.reset *> Integration.loadAll)

15+

16+spec :: Spec

17+spec = beforeAll_ setup $ do

18+ describe "Sourcefile Integration" $ do

19+ it "finds a value declaration" $ do

20+ testCase "sfValue" (3, 1)

21+ it "finds a type declaration" $ do

22+ testCase "SFType" (5, 1)

23+ it "finds a data declaration" $ do

24+ testCase "SFData" (7, 1)

25+ it "finds a data constructor" $ do

26+ testCase "SFOne" (7, 1)

27+ it "finds a typeclass" $ do

28+ testCase "SFClass" (9, 1)

29+ it "finds a typeclass member" $ do

30+ testCase "sfShow" (10, 3)

31+

32+testCase :: Text -> (Int, Int) -> IO ()

33+testCase s (x, y) = do

34+ (P.SourceSpan f (P.SourcePos l c) _):_ <- Integration.getInfo s

35+ toS f `shouldSatisfy` T.isSuffixOf "SourceFileSpec.purs"

36+ (l, c) `shouldBe` (x, y)

tests/Language/PureScript/Ide/SourceFileSpec.hsnew file+46

@@ -0,0 +1,46 @@

1+{-# LANGUAGE NoImplicitPrelude #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+module Language.PureScript.Ide.SourceFileSpec where

4+

5+import Protolude

6+

7+import qualified Language.PureScript as P

8+import Language.PureScript.Ide.SourceFile

9+import Test.Hspec

10+

11+span0, span1, span2 :: P.SourceSpan

12+span0 = P.SourceSpan "ModuleLevel" (P.SourcePos 0 0) (P.SourcePos 1 1)

13+span1 = P.SourceSpan "" (P.SourcePos 1 1) (P.SourcePos 2 2)

14+span2 = P.SourceSpan "" (P.SourcePos 2 2) (P.SourcePos 3 3)

15+

16+value1, synonym1, class1, class2, data1, data2, foreign1, foreign2, member1 :: P.Declaration

17+value1 = P.ValueDeclaration (P.Ident "value1") P.Public [] (Left [])

18+synonym1 = P.TypeSynonymDeclaration (P.ProperName "Synonym1") [] P.REmpty

19+class1 = P.TypeClassDeclaration (P.ProperName "Class1") [] [] []

20+class2 = P.TypeClassDeclaration (P.ProperName "Class2") [] []

21+ [P.PositionedDeclaration span2 [] member1]

22+data1 = P.DataDeclaration P.Newtype (P.ProperName "Data1") [] []

23+data2 = P.DataDeclaration P.Data (P.ProperName "Data2") [] [(P.ProperName "Cons1", [])]

24+foreign1 = P.ExternDeclaration (P.Ident "foreign1") P.REmpty

25+foreign2 = P.ExternDataDeclaration (P.ProperName "Foreign2") P.Star

26+member1 = P.TypeDeclaration (P.Ident "member1") P.REmpty

27+

28+spec :: Spec

29+spec = do

30+ describe "Extracting Spans" $ do

31+ it "extracts a span for a value declaration" $

32+ extractSpans span0 (P.PositionedDeclaration span1 [] value1) `shouldBe` [(Left "value1", span1)]

33+ it "extracts a span for a type synonym declaration" $

34+ extractSpans span0 (P.PositionedDeclaration span1 [] synonym1) `shouldBe` [(Right "Synonym1", span1)]

35+ it "extracts a span for a typeclass declaration" $

36+ extractSpans span0 (P.PositionedDeclaration span1 [] class1) `shouldBe` [(Right "Class1", span1)]

37+ it "extracts spans for a typeclass declaration and its members" $

38+ extractSpans span0 (P.PositionedDeclaration span1 [] class2) `shouldBe` [(Right "Class2", span1), (Left "member1", span2)]

39+ it "extracts a span for a data declaration" $

40+ extractSpans span0 (P.PositionedDeclaration span1 [] data1) `shouldBe` [(Right "Data1", span1)]

41+ it "extracts spans for a data declaration and its constructors" $

42+ extractSpans span0 (P.PositionedDeclaration span1 [] data2) `shouldBe` [(Right "Data2", span1), (Left "Cons1", span1)]

43+ it "extracts a span for a foreign declaration" $

44+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(Left "foreign1", span1)]

45+ it "extracts a span for a data foreign declaration" $

46+ extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(Right "Foreign2", span1)]

tests/support/pscide/src/RebuildSpecWithForeign.js−2

@@ -1,3 +1 @@

1−// module RebuildSpecWithForeign

2−

3exports.f = 5;

1exports.f = 5;

tests/support/pscide/src/SourceFileSpec.pursnew file+10

@@ -0,0 +1,10 @@

1+module SourceFileSpec where

2+

3+sfValue = "sfValue"

4+

5+type SFType = String

6+

7+data SFData = SFOne | SFTwo | SFThree

8+

9+class SFClass a where

10+ sfShow :: a -> String