a07a714 · rowtype-yoga/purescript-native

psc-ide-server/Main.hs+11−11

compare with golang

unifiedsplit

@@ -81,21 +81,21 @@ main = do

81 Options dir outputPath port noWatch debug <- execParser opts

82 maybe (pure ()) setCurrentDirectory dir

83 serverState <- newTVarIO emptyPscIdeState

84+ ideState <- newTVarIO emptyIdeState

84 cwd <- getCurrentDirectory

85 cwd <- getCurrentDirectory

85 let fullOutputPath = cwd </> outputPath

86 let fullOutputPath = cwd </> outputPath

86

87

87− doesDirectoryExist fullOutputPath

88+ unlessM (doesDirectoryExist fullOutputPath) $ do

88− >>= flip unless

89− (do putStrLn ("Your output directory didn't exist. I'll create it at: " <> fullOutputPath)

89+ putStrLn ("Your output directory didn't exist. I'll create it at: " <> fullOutputPath)

90− createDirectory fullOutputPath

90+ createDirectory fullOutputPath

91− putStrLn "This usually means you didn't compile your project yet."

91+ putStrLn "This usually means you didn't compile your project yet."

92− putStrLn "psc-ide needs you to compile your project (for example by running pulp build)")

92+ putStrLn "psc-ide needs you to compile your project (for example by running pulp build)"

93

94 unless noWatch $

95− void (forkFinally (watcher serverState fullOutputPath) print)

95+ void (forkFinally (watcher ideState fullOutputPath) print)

96

97 let conf = Configuration {confDebug = debug, confOutputPath = outputPath}

98− env = PscIdeEnvironment {envStateVar = serverState, envConfiguration = conf}

98+ env = IdeEnvironment {envStateVar = serverState, ideStateVar = ideState, ideConfiguration = conf}

99 startServer port env

100 where

101 parser =

@@ -111,14 +111,14 @@ main = do

111 (InfoMsg (showVersion Paths.version))

112 (long "version" <> help "Show the version number")

113

114−startServer :: PortID -> PscIdeEnvironment -> IO ()

114+startServer :: PortID -> IdeEnvironment -> IO ()

115startServer port env = withSocketsDo $ do

116 sock <- listenOnLocalhost port

117 runLogger (runReaderT (forever (loop sock)) env)

118 where

119− runLogger = runStdoutLoggingT . filterLogger (\_ _ -> confDebug (envConfiguration env))

119+ runLogger = runStdoutLoggingT . filterLogger (\_ _ -> confDebug (ideConfiguration env))

120

121− loop :: (PscIde m, MonadLogger m) => Socket -> m ()

121+ loop :: (Ide m, MonadLogger m) => Socket -> m ()

122 loop sock = do

123 accepted <- runExceptT $ acceptCommand sock

124 case accepted of

psc-ide-server/PROTOCOL.md+3−7

@@ -14,24 +14,20 @@ to detect all the compiled modules in your project and load them.

14

15**Params:**

16 - `modules :: (optional) [ModuleName]`: A list of modules to load.

17− psc-ide-server will try to parse all the declarations in these modules

17+ psc-ide-server will try to parse all the declarations in these modules

18− - `dependencies :: (optional) [ModuleName]`: A list of modules to load

19− including their dependencies. In contrast to the `module` field, all the

20− imports in these Modules will also be loaded.

21

18

22```json

19```json

23{

20{

24 "command": "load",

21 "command": "load",

25 "params": (optional) {

22 "params": (optional) {

26− "modules": (optional)["Module.Name1", "Module.Name2"],

23+ "modules": (optional)["Module.Name1", "Module.Name2"]

27− "dependencies": (optional)["Module.Name3"]

28 }

24 }

29}

25}

30```

26```

31

27

32**Result:**

28**Result:**

33

29

34−The Load Command returns a string.

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

35

31

36### Type

32### Type

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

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

purescript.cabal+12−11

@@ -101,6 +101,7 @@ library

101 aeson >= 0.8 && < 0.12,

102 aeson-better-errors >= 0.8,

103 ansi-terminal >= 0.6.2 && < 0.7,

104+ async,

104 base-compat >=0.6.0,

105 base-compat >=0.6.0,

105 bower-json >= 0.8,

106 bower-json >= 0.8,

106 boxes >= 0.1.4 && < 0.2.0,

107 boxes >= 0.1.4 && < 0.2.0,

@@ -251,22 +252,23 @@ library

251 Language.PureScript.Publish.BoxesHelpers

252 Language.PureScript.Publish.BoxesHelpers

252

253

253 Language.PureScript.Ide

254 Language.PureScript.Ide

255+ Language.PureScript.Ide.CaseSplit

254 Language.PureScript.Ide.Command

256 Language.PureScript.Ide.Command

257+ Language.PureScript.Ide.Completion

258+ Language.PureScript.Ide.Conversions

255 Language.PureScript.Ide.Externs

259 Language.PureScript.Ide.Externs

256 Language.PureScript.Ide.Error

260 Language.PureScript.Ide.Error

257− Language.PureScript.Ide.Pursuit

261+ Language.PureScript.Ide.Imports

258− Language.PureScript.Ide.Completion

259− Language.PureScript.Ide.Matcher

260 Language.PureScript.Ide.Filter

262 Language.PureScript.Ide.Filter

261− Language.PureScript.Ide.Types

263+ Language.PureScript.Ide.Matcher

262− Language.PureScript.Ide.State

264+ Language.PureScript.Ide.Pursuit

263− Language.PureScript.Ide.CaseSplit

265+ Language.PureScript.Ide.Rebuild

264− Language.PureScript.Ide.SourceFile

265− Language.PureScript.Ide.Watcher

266 Language.PureScript.Ide.Reexports

267− Language.PureScript.Ide.Imports

267+ Language.PureScript.Ide.SourceFile

268+ Language.PureScript.Ide.State

269+ Language.PureScript.Ide.Types

268 Language.PureScript.Ide.Util

270 Language.PureScript.Ide.Util

269− Language.PureScript.Ide.Rebuild

271+ Language.PureScript.Ide.Watcher

270

272

271 Language.PureScript.Interactive

273 Language.PureScript.Interactive

272 Language.PureScript.Interactive.Types

274 Language.PureScript.Interactive.Types

@@ -498,6 +500,5 @@ test-suite tests

498 Language.PureScript.Ide.MatcherSpec

500 Language.PureScript.Ide.MatcherSpec

499 Language.PureScript.Ide.RebuildSpec

501 Language.PureScript.Ide.RebuildSpec

500 Language.PureScript.Ide.ReexportsSpec

502 Language.PureScript.Ide.ReexportsSpec

501− Language.PureScript.IdeSpec

502 buildable: True

503 buildable: True

503 hs-source-dirs: tests

504 hs-source-dirs: tests

src/Language/PureScript/Ide.hs+78−128

@@ -14,7 +14,6 @@

14

15{-# LANGUAGE OverloadedStrings #-}

16{-# LANGUAGE PackageImports #-}

17−{-# LANGUAGE TemplateHaskell #-}

18

17

19module Language.PureScript.Ide

18module Language.PureScript.Ide

20 ( handleCommand

19 ( handleCommand

@@ -25,14 +24,13 @@ module Language.PureScript.Ide

25import Prelude ()

24import Prelude ()

26import Prelude.Compat

25import Prelude.Compat

27

26

28−import Control.Monad (unless)

27+import Control.Concurrent.Async

29import Control.Monad.Error.Class

28import Control.Monad.Error.Class

30import Control.Monad.IO.Class

29import Control.Monad.IO.Class

31import "monad-logger" Control.Monad.Logger

30import "monad-logger" Control.Monad.Logger

32−import Control.Monad.Reader.Class

31+import Control.Monad.Reader

33import Data.Foldable

32import Data.Foldable

34−import qualified Data.Map.Lazy as M

35−import Data.Maybe (catMaybes, mapMaybe)

33+import Data.Maybe (catMaybes)

36import Data.Monoid

34import Data.Monoid

37import Data.Text (Text)

35import Data.Text (Text)

38import qualified Data.Text as T

36import qualified Data.Text as T

@@ -47,7 +45,6 @@ import Language.PureScript.Ide.Imports hiding (Import)

47import Language.PureScript.Ide.Matcher

45import Language.PureScript.Ide.Matcher

48import Language.PureScript.Ide.Pursuit

46import Language.PureScript.Ide.Pursuit

49import Language.PureScript.Ide.Rebuild

47import Language.PureScript.Ide.Rebuild

50−import Language.PureScript.Ide.Reexports

51import Language.PureScript.Ide.SourceFile

48import Language.PureScript.Ide.SourceFile

52import Language.PureScript.Ide.State

49import Language.PureScript.Ide.State

53import Language.PureScript.Ide.Types

50import Language.PureScript.Ide.Types

@@ -56,11 +53,10 @@ import System.Directory

56import System.Exit

53import System.Exit

57import System.FilePath

54import System.FilePath

58

55

59−handleCommand :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

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

60 Command -> m Success

57 Command -> m Success

61−handleCommand (Load [] []) = loadAllModules

58+handleCommand (Load []) = loadAllModules

62−handleCommand (Load modules deps) =

59+handleCommand (Load modules) = loadModules modules

63− loadModulesAndDeps modules deps

64handleCommand (Type search filters currentModule) =

60handleCommand (Type search filters currentModule) =

65 findType search filters currentModule

61 findType search filters currentModule

66handleCommand (Complete filters matcher currentModule) =

62handleCommand (Complete filters matcher currentModule) =

@@ -78,7 +74,7 @@ handleCommand (List (Imports fp)) =

78handleCommand (CaseSplit l b e wca t) =

74handleCommand (CaseSplit l b e wca t) =

79 caseSplit l b e wca t

75 caseSplit l b e wca t

80handleCommand (AddClause l wca) =

76handleCommand (AddClause l wca) =

81− pure $ addClause l wca

77+ addClause l wca

82handleCommand (Import fp outfp _ (AddImplicitImport mn)) = do

78handleCommand (Import fp outfp _ (AddImplicitImport mn)) = do

83 rs <- addImplicitImport fp mn

79 rs <- addImplicitImport fp mn

84 answerRequest outfp rs

80 answerRequest outfp rs

@@ -86,25 +82,25 @@ handleCommand (Import fp outfp filters (AddImportForIdentifier ident)) = do

86 rs <- addImportForIdentifier fp ident filters

82 rs <- addImportForIdentifier fp ident filters

87 case rs of

83 case rs of

88 Right rs' -> answerRequest outfp rs'

84 Right rs' -> answerRequest outfp rs'

89− Left question -> pure $ CompletionResult (mapMaybe completionFromMatch question)

85+ Left question -> pure $ CompletionResult (map completionFromMatch question)

90handleCommand (Rebuild file) =

86handleCommand (Rebuild file) =

91 rebuildFile file

87 rebuildFile file

92handleCommand Cwd =

88handleCommand Cwd =

93 TextResult . T.pack <$> liftIO getCurrentDirectory

89 TextResult . T.pack <$> liftIO getCurrentDirectory

94−handleCommand Reset = resetPscIdeState *> pure (TextResult "State has been reset.")

90+handleCommand Reset = resetIdeState *> pure (TextResult "State has been reset.")

95handleCommand Quit = liftIO exitSuccess

91handleCommand Quit = liftIO exitSuccess

96

92

97−findCompletions :: (PscIde m) =>

93+findCompletions :: (Ide m) =>

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

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

99findCompletions filters matcher currentModule = do

95findCompletions filters matcher currentModule = do

100− modules <- getAllModulesWithReexportsAndCache currentModule

96+ modules <- getAllModules2 currentModule

101− pure . CompletionResult . mapMaybe completionFromMatch . getCompletions filters matcher $ modules

97+ pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules

102

98

103−findType :: (PscIde m) =>

99+findType :: (Ide m) =>

104− DeclIdent -> [Filter] -> Maybe P.ModuleName -> m Success

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

105findType search filters currentModule = do

101findType search filters currentModule = do

106− modules <- getAllModulesWithReexportsAndCache currentModule

102+ modules <- getAllModules2 currentModule

107− pure . CompletionResult . mapMaybe completionFromMatch . getExactMatches search filters $ modules

103+ pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules

108

104

109findPursuitCompletions :: (MonadIO m) =>

105findPursuitCompletions :: (MonadIO m) =>

110 PursuitQuery -> m Success

106 PursuitQuery -> m Success

@@ -116,39 +112,35 @@ findPursuitPackages :: (MonadIO m) =>

116findPursuitPackages (PursuitQuery q) =

112findPursuitPackages (PursuitQuery q) =

117 PursuitResult <$> liftIO (findPackagesForModuleIdent q)

113 PursuitResult <$> liftIO (findPackagesForModuleIdent q)

118

114

119−loadExtern :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

115+printModules :: (Ide m) => m Success

120− FilePath -> m ()

116+printModules = ModuleList . map runModuleNameT <$> getLoadedModulenames

121−loadExtern fp = do

122− m <- readExternFile fp

123− insertModule m

124

117

125−printModules :: (PscIde m) => m Success

118+outputDirectory :: Ide m => m FilePath

126−printModules = printModules' . pscIdeStateModules <$> getPscIdeState

119+outputDirectory = do

127−

120+ outputPath <- confOutputPath . ideConfiguration <$> ask

128−printModules' :: M.Map ModuleIdent [ExternDecl] -> Success

121+ cwd <- liftIO getCurrentDirectory

129−printModules' = ModuleList . M.keys

122+ pure (cwd </> outputPath)

130

123

131−listAvailableModules :: PscIde m => m Success

124+listAvailableModules :: Ide m => m Success

132listAvailableModules = do

125listAvailableModules = do

133− outputPath <- confOutputPath . envConfiguration <$> ask

126+ oDir <- outputDirectory

134 liftIO $ do

127 liftIO $ do

135− cwd <- getCurrentDirectory

136− dirs <- getDirectoryContents (cwd </> outputPath)

128+ contents <- getDirectoryContents oDir

137− return (ModuleList (listAvailableModules' dirs))

138−

139−listAvailableModules' :: [FilePath] -> [Text]

140−listAvailableModules' dirs =

141− let cleanedModules = filter (`notElem` [".", ".."]) dirs

129+ let cleaned = filter (`notElem` [".", ".."]) contents

142− in map T.pack cleanedModules

130+ return (ModuleList (map T.pack cleaned))

143

131

144−caseSplit :: (PscIde m, MonadError PscIdeError m) =>

132+caseSplit :: (Ide m, MonadError PscIdeError m) =>

145 Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success

133 Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success

146caseSplit l b e csa t = do

134caseSplit l b e csa t = do

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

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

148 pure (MultilineTextResult patterns)

136 pure (MultilineTextResult patterns)

149

137

138+addClause

139+ :: (MonadError PscIdeError m)

140+ => Text

150−addClause :: Text -> CS.WildcardAnnotations -> Success

141+ -> CS.WildcardAnnotations

142+ -> m Success

151−addClause t wca = MultilineTextResult (CS.addClause t wca)

143+addClause t wca = MultilineTextResult <$> CS.addClause t wca

152

144

153importsForFile :: (MonadIO m, MonadError PscIdeError m) =>

145importsForFile :: (MonadIO m, MonadError PscIdeError m) =>

154 FilePath -> m Success

146 FilePath -> m Success

@@ -156,90 +148,48 @@ importsForFile fp = do

156 imports <- getImportsForFile fp

148 imports <- getImportsForFile fp

157 pure (ImportList imports)

149 pure (ImportList imports)

158

150

159−-- | The first argument is a set of modules to load. The second argument

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

160−-- denotes modules for which to load dependencies

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

161−loadModulesAndDeps :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

153+checkExternsPath :: FilePath -> FilePath -> IO (Maybe FilePath)

162− [ModuleIdent] -> [ModuleIdent] -> m Success

154+checkExternsPath oDir d

163−loadModulesAndDeps mods deps = do

155+ | d `elem` [".", ".."] = pure Nothing

164− r1 <- mapM loadModule (mods ++ deps)

156+ | otherwise = do

165− r2 <- mapM loadModuleDependencies deps

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

166− let moduleResults = T.concat r1

158+ ex <- doesFileExist file

167− let dependencyResults = T.concat r2

159+ if ex

168− pure (TextResult (moduleResults <> ", " <> dependencyResults))

160+ then pure (Just file)

169−

161+ else pure Nothing

170−loadModuleDependencies ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>

162+

171− ModuleIdent -> m Text

163+findAllExterns :: (Ide m, MonadError PscIdeError m) => m [FilePath]

172−loadModuleDependencies moduleName = do

164+findAllExterns = do

173− m <- getModule moduleName

165+ oDir <- outputDirectory

174− case getDependenciesForModule <$> m of

166+ unlessM (liftIO (doesDirectoryExist oDir))

175− Just deps -> do

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

176− mapM_ loadModule deps

168+ liftIO $ do

177− -- We need to load the modules, that get reexported from the dependencies

169+ dirs <- getDirectoryContents oDir

178− depModules <- catMaybes <$> mapM getModule deps

170+ externPaths <- traverse (checkExternsPath oDir) dirs

179− -- What to do with errors here? This basically means a reexported dependency

171+ pure (catMaybes externPaths)

180− -- doesn't exist in the output/ folder

172+

181− traverse_ loadReexports depModules

173+loadModules

182− pure ("Dependencies for " <> moduleName <> " loaded.")

174+ :: (Ide m, MonadError PscIdeError m, MonadLogger m)

183− Nothing -> throwError (ModuleNotFound moduleName)

175+ => [P.ModuleName]

184−

176+ -> m Success

185−loadReexports :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

177+loadModules mns = do

186− Module -> m [ModuleIdent]

178+ oDir <- outputDirectory

187−loadReexports m = case getReexports m of

179+ let efPaths = map (\mn -> oDir </> P.runModuleName mn </> "externs.json") mns

188− [] -> pure []

180+ efiles <- traverse readExternFile efPaths

189− exportDeps -> do

181+ traverse_ insertExterns efiles

190− -- I'm fine with this crashing on a failed pattern match.

182+ --TODO Get rid of this once ModuleOld is gone

191− -- If this ever fails I'll need to look at GADTs

183+ traverse_ insertModule efiles

192− let reexports = map (\(Export mn) -> mn) exportDeps

184+ populateStage2

193− $(logDebug) ("Loading reexports for module: " <> fst m <>

185+ pure (TextResult ("Loaded " <> foldMap runModuleNameT mns <> "."))

194− " reexports: " <> T.intercalate ", " reexports)

186+

195− traverse_ loadModule reexports

196− exportDepsModules <- catMaybes <$> traverse getModule reexports

197− exportDepDeps <- traverse loadReexports exportDepsModules

198− return $ concat exportDepDeps

199−

200−getDependenciesForModule :: Module -> [ModuleIdent]

201−getDependenciesForModule (_, decls) = mapMaybe getDependencyName decls

202− where getDependencyName (Dependency dependencyName _ _) = Just dependencyName

203− getDependencyName _ = Nothing

204−

205−loadModule :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>

206− ModuleIdent -> m Text

207−loadModule "Prim" = pure "Prim won't be loaded"

208−loadModule mn = do

209− path <- filePathFromModule mn

210− loadExtern path

211− $(logDebug) ("Loaded extern file at: " <> T.pack path)

212− pure ("Loaded extern file at: " <> T.pack path)

213−

214−loadAllModules :: (PscIde m, MonadLogger m, MonadError PscIdeError m) => m Success

187+loadAllModules :: (Ide m, MonadError PscIdeError m) => m Success

215loadAllModules = do

188loadAllModules = do

216− outputPath <- confOutputPath . envConfiguration <$> ask

189+ exts <- traverse readExternFile =<< findAllExterns

217− cwd <- liftIO getCurrentDirectory

190+ traverse_ insertExterns exts

218− let outputDirectory = cwd </> outputPath

191+ --TODO Get rid of this once ModuleOld is gone

219− liftIO (doesDirectoryExist outputDirectory)

192+ traverse_ insertModule exts

220− >>= flip unless (throwError (GeneralError "Couldn't locate your output directory"))

193+ env <- ask

221− liftIO (getDirectoryContents outputDirectory)

194+ _ <- liftIO $ async (runStdoutLoggingT (runReaderT populateStage2 env))

222− >>= liftIO . traverse (getExternsPath outputDirectory)

223− >>= traverse_ loadExtern . catMaybes

224 pure (TextResult "All modules loaded.")

195 pure (TextResult "All modules loaded.")

225− where

226− getExternsPath :: FilePath -> FilePath -> IO (Maybe FilePath)

227− getExternsPath outputDirectory d

228− | d `elem` [".", ".."] = pure Nothing

229− | otherwise = do

230− let file = outputDirectory </> d </> "externs.json"

231− ex <- doesFileExist file

232− if ex

233− then pure (Just file)

234− else pure Nothing

235−

236−filePathFromModule :: (PscIde m, MonadError PscIdeError m) =>

237− ModuleIdent -> m FilePath

238−filePathFromModule moduleName = do

239− outputPath <- confOutputPath . envConfiguration <$> ask

240− cwd <- liftIO getCurrentDirectory

241− let path = cwd </> outputPath </> T.unpack moduleName </> "externs.json"

242− ex <- liftIO $ doesFileExist path

243− if ex

244− then pure path

245− else throwError (ModuleFileNotFound moduleName)

src/Language/PureScript/Ide/CaseSplit.hs+13−10

@@ -53,7 +53,7 @@ explicitAnnotations = WildcardAnnotations True

53noAnnotations :: WildcardAnnotations

54noAnnotations = WildcardAnnotations False

55

56−caseSplit :: (PscIde m, MonadError PscIdeError m) =>

56+caseSplit :: (Ide m, MonadError PscIdeError m) =>

57 Text -> m [Constructor]

58caseSplit q = do

59 type' <- parseType' (T.unpack q)

@@ -63,7 +63,7 @@ caseSplit q = do

63 let appliedCtors = map (second (map applyTypeVars)) ctors

64 pure appliedCtors

65

66−findTypeDeclaration :: (PscIde m, MonadError PscIdeError m) =>

66+findTypeDeclaration :: (Ide m, MonadError PscIdeError m) =>

67 P.ProperName 'P.TypeName -> m ExternsDeclaration

68findTypeDeclaration q = do

69 efs <- getExternFiles

@@ -113,14 +113,14 @@ makePattern t x y wsa = makePattern' (T.take x t) (T.drop y t)

113 where

114 makePattern' lhs rhs = map (\ctor -> lhs <> prettyCtor wsa ctor <> rhs)

115

116−addClause :: Text -> WildcardAnnotations -> [Text]

116+addClause :: (MonadError PscIdeError m) => Text -> WildcardAnnotations -> m [Text]

117−addClause s wca =

117+addClause s wca = do

118− let (fName, fType) = parseTypeDeclaration' (T.unpack s)

118+ (fName, fType) <- parseTypeDeclaration' (T.unpack s)

119− (args, _) = splitFunctionType fType

119+ let (args, _) = splitFunctionType fType

120 template = runIdentT fName <> " " <>

121 T.unwords (map (prettyPrintWildcard wca) args) <>

122 " = ?" <> (T.strip . runIdentT $ fName)

123− in [s, template]

123+ pure [s, template]

124

125parseType' :: (MonadError PscIdeError m) =>

126 String -> m P.Type

@@ -131,15 +131,18 @@ parseType' s =

131 throwError (GeneralError ("Parsing the splittype failed with:"

132 ++ show err))

133

134−parseTypeDeclaration' :: String -> (P.Ident, P.Type)

134+parseTypeDeclaration' :: (MonadError PscIdeError m) => String -> m (P.Ident, P.Type)

135parseTypeDeclaration' s =

136 let x = do

137 ts <- P.lex "" s

138 P.runTokenParser "" (P.parseDeclaration <* Parsec.eof) ts

139 in

140 case unwrapPositioned <$> x of

141− Right (P.TypeDeclaration i t) -> (i, t)

141+ Right (P.TypeDeclaration i t) -> pure (i, t)

142+ Right _ -> throwError (GeneralError "Found a non-type-declaration")

143+ Left err ->

144+ throwError (GeneralError ("Parsing the typesignature failed with: "

142− y -> error (show y)

145+ ++ show err))

143

146

144splitFunctionType :: P.Type -> ([P.Type], P.Type)

147splitFunctionType :: P.Type -> ([P.Type], P.Type)

145splitFunctionType t = (arguments, returns)

148splitFunctionType t = (arguments, returns)

src/Language/PureScript/Ide/Command.hs+5−10

@@ -29,12 +29,9 @@ import Language.PureScript.Ide.Matcher

29import Language.PureScript.Ide.Types

30

31data Command

32− = Load

32+ = Load [P.ModuleName]

33− { loadModules :: [ModuleIdent]

34− , loadDependencies :: [ModuleIdent]

35− }

36 | Type

33 | Type

37− { typeSearch :: DeclIdent

34+ { typeSearch :: Text

38 , typeFilters :: [Filter]

35 , typeFilters :: [Filter]

39 , typeCurrentModule :: Maybe P.ModuleName

36 , typeCurrentModule :: Maybe P.ModuleName

40 }

37 }

@@ -68,7 +65,7 @@ data Command

68

65

69data ImportCommand

66data ImportCommand

70 = AddImplicitImport P.ModuleName

67 = AddImplicitImport P.ModuleName

71− | AddImportForIdentifier DeclIdent

68+ | AddImportForIdentifier Text

72 deriving (Show, Eq)

69 deriving (Show, Eq)

73

70

74instance FromJSON ImportCommand where

71instance FromJSON ImportCommand where

@@ -103,11 +100,9 @@ instance FromJSON Command where

103 "load" -> do

100 "load" -> do

104 params' <- o .:? "params"

101 params' <- o .:? "params"

105 case params' of

102 case params' of

106− Nothing -> pure (Load [] [])

103+ Nothing -> pure (Load [])

107 Just params ->

104 Just params ->

108− Load

109− <$> params .:? "modules" .!= []

105+ Load <$> (map P.moduleNameFromString <$> params .:? "modules" .!= [])

110− <*> params .:? "dependencies" .!= []

111 "type" -> do

106 "type" -> do

112 params <- o .: "params"

107 params <- o .: "params"

113 Type

108 Type

src/Language/PureScript/Ide/Completion.hs+3−6

@@ -6,7 +6,7 @@ module Language.PureScript.Ide.Completion

6import Prelude ()

7import Prelude.Compat

8

9−import Data.Maybe (mapMaybe)

9+import Data.Text (Text)

10import Language.PureScript.Ide.Filter

11import Language.PureScript.Ide.Matcher

12import Language.PureScript.Ide.Types

@@ -17,7 +17,7 @@ getCompletions :: [Filter] -> Matcher -> [Module] -> [Match]

17getCompletions filters matcher modules =

18 runMatcher matcher $ completionsFromModules (applyFilters filters modules)

19

20−getExactMatches :: DeclIdent -> [Filter] -> [Module] -> [Match]

20+getExactMatches :: Text -> [Filter] -> [Module] -> [Match]

21getExactMatches search filters modules =

22 completionsFromModules $

23 applyFilters (equalityFilter search : filters) modules

@@ -26,7 +26,4 @@ completionsFromModules :: [Module] -> [Match]

26completionsFromModules = foldMap completionFromModule

27 where

28 completionFromModule :: Module -> [Match]

29− completionFromModule (moduleIdent, decls) = mapMaybe (matchFromDecl moduleIdent) decls

29+ completionFromModule (moduleName, decls) = map (Match moduleName) decls

30−

31−matchFromDecl :: ModuleIdent -> ExternDecl -> Maybe Match

32−matchFromDecl mi = Just . Match mi

src/Language/PureScript/Ide/Conversions.hsnew file+36

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

1+-----------------------------------------------------------------------------

2+--

3+-- Module : Language.PureScript.Ide.Conversions

4+-- Description : Conversions to Text for PureScript types

5+-- Copyright : Christoph Hegemann 2016

6+-- License : MIT (http://opensource.org/licenses/MIT)

7+--

8+-- Maintainer : Christoph Hegemann <christoph.hegemann1337@gmail.com>

9+-- Stability : experimental

10+--

11+-- |

12+-- Conversions to Text for PureScript types

13+-----------------------------------------------------------------------------

14+

15+module Language.PureScript.Ide.Conversions where

16+

17+import Prelude.Compat

18+import Data.Text (Text)

19+import qualified Data.Text as T

20+import qualified Language.PureScript as P

21+

22+runProperNameT :: P.ProperName a -> Text

23+runProperNameT = T.pack . P.runProperName

24+

25+runIdentT :: P.Ident -> Text

26+runIdentT = T.pack . P.runIdent

27+

28+runOpNameT :: P.OpName a -> Text

29+runOpNameT = T.pack . P.runOpName

30+

31+runModuleNameT :: P.ModuleName -> Text

32+runModuleNameT = T.pack . P.runModuleName

33+

34+prettyTypeT :: P.Type -> Text

35+prettyTypeT = T.unwords . fmap T.strip . T.lines . T.pack . P.prettyPrintType

36+

src/Language/PureScript/Ide/Externs.hs+25−11

@@ -12,14 +12,16 @@

12-- Handles externs files for psc-ide

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

14

15−{-# LANGUAGE OverloadedStrings #-}

15+{-# LANGUAGE OverloadedStrings #-}

16+{-# LANGUAGE RecordWildCards #-}

17+{-# LANGUAGE FlexibleContexts #-}

16

18

17module Language.PureScript.Ide.Externs

19module Language.PureScript.Ide.Externs

18 ( ExternDecl(..),

20 ( ExternDecl(..),

19 ModuleIdent,

21 ModuleIdent,

20− DeclIdent,

21 readExternFile,

22 readExternFile,

22 convertExterns,

23 convertExterns,

24+ convertModule,

23 unwrapPositioned,

25 unwrapPositioned,

24 unwrapPositionedRef

26 unwrapPositionedRef

25 ) where

27 ) where

@@ -50,16 +52,13 @@ readExternFile fp = do

50 Nothing -> throwError . GeneralError $ "Parsing the extern at: " ++ fp ++ " failed"

52 Nothing -> throwError . GeneralError $ "Parsing the extern at: " ++ fp ++ " failed"

51 Just externs -> pure externs

53 Just externs -> pure externs

52

54

53−moduleNameToText :: P.ModuleName -> Text

54−moduleNameToText = T.pack . P.runModuleName

55−

56identToText :: P.Ident -> Text

55identToText :: P.Ident -> Text

57identToText = T.pack . P.runIdent

56identToText = T.pack . P.runIdent

58

57

59−convertExterns :: P.ExternsFile -> Module

58+convertExterns :: P.ExternsFile -> ModuleOld

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

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

61 where

60 where

62− moduleName = moduleNameToText (P.efModuleName ef)

61+ moduleName = P.efModuleName ef

63 importDecls = convertImport <$> P.efImports ef

62 importDecls = convertImport <$> P.efImports ef

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

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

65 operatorDecls = convertOperator <$> P.efFixities ef

64 operatorDecls = convertOperator <$> P.efFixities ef

@@ -82,12 +81,12 @@ isTypeClassDeclaration _ = False

82

81

83convertImport :: P.ExternsImport -> ExternDecl

82convertImport :: P.ExternsImport -> ExternDecl

84convertImport ei = Dependency

83convertImport ei = Dependency

85− (moduleNameToText (P.eiModule ei))

84+ (runModuleNameT (P.eiModule ei))

86 []

85 []

87− (moduleNameToText <$> P.eiImportedAs ei)

86+ (runModuleNameT <$> P.eiImportedAs ei)

88

87

89convertExport :: P.DeclarationRef -> Maybe ExternDecl

88convertExport :: P.DeclarationRef -> Maybe ExternDecl

90−convertExport (P.ModuleRef mn) = Just (Export (moduleNameToText mn))

89+convertExport (P.ModuleRef mn) = Just (Export (runModuleNameT mn))

91convertExport _ = Nothing

90convertExport _ = Nothing

92

91

93convertDecl :: P.ExternsDeclaration -> Maybe ExternDecl

92convertDecl :: P.ExternsDeclaration -> Maybe ExternDecl

@@ -124,3 +123,18 @@ unwrapPositioned x = x

124unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef

123unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef

125unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = x

124unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = x

126unwrapPositionedRef x = x

125unwrapPositionedRef x = x

126+

127+convertModule :: ModuleOld -> Module

128+convertModule (mn, decls) = (P.moduleNameFromString (T.unpack mn), mapMaybe convertDeclaration decls)

129+ where convertDeclaration :: ExternDecl -> Maybe IdeDeclaration

130+ convertDeclaration d = case d of

131+ ValueDeclaration i t -> Just (IdeValue i t)

132+ TypeDeclaration i k -> Just (IdeType i k)

133+ TypeSynonymDeclaration i t -> Just (IdeTypeSynonym i t)

134+ DataConstructor i tn t -> Just (IdeDataConstructor i tn t)

135+ TypeClassDeclaration i -> Just (IdeTypeClass i)

136+ ValueOperator n i p a -> Just (IdeValueOperator n i p a)

137+ TypeOperator n i p a -> Just (IdeTypeOperator n i p a)

138+ Dependency{} -> Nothing

139+ ModuleDecl _ _ -> Nothing

140+ Export _ -> Nothing

src/Language/PureScript/Ide/Filter.hs+9−38

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

20 , moduleFilter

21 , prefixFilter

22 , equalityFilter

23− , dependencyFilter

24 , runFilter

23 , runFilter

25 , applyFilters

24 , applyFilters

26 ) where

25 ) where

@@ -31,11 +30,11 @@ import Prelude.Compat

31import Control.Monad

30import Control.Monad

32import Data.Aeson

31import Data.Aeson

33import Data.Foldable

32import Data.Foldable

34−import Data.Maybe (listToMaybe, mapMaybe)

35import Data.Monoid

33import Data.Monoid

36import Data.Text (Text, isPrefixOf)

34import Data.Text (Text, isPrefixOf)

37import Language.PureScript.Ide.Types

35import Language.PureScript.Ide.Types

38import Language.PureScript.Ide.Util

36import Language.PureScript.Ide.Util

37+import qualified Language.PureScript as P

39

38

40newtype Filter = Filter (Endo [Module]) deriving(Monoid)

39newtype Filter = Filter (Endo [Module]) deriving(Monoid)

41

40

@@ -43,53 +42,29 @@ mkFilter :: ([Module] -> [Module]) -> Filter

43mkFilter = Filter . Endo

42mkFilter = Filter . Endo

44

43

45-- | Only keeps the given Modules

44-- | Only keeps the given Modules

46−moduleFilter :: [ModuleIdent] -> Filter

45+moduleFilter :: [P.ModuleName] -> Filter

47moduleFilter =

46moduleFilter =

48 mkFilter . moduleFilter'

47 mkFilter . moduleFilter'

49

48

50−moduleFilter' :: [ModuleIdent] -> [Module] -> [Module]

49+moduleFilter' :: [P.ModuleName] -> [Module] -> [Module]

51moduleFilter' moduleIdents = filter (flip elem moduleIdents . fst)

50moduleFilter' moduleIdents = filter (flip elem moduleIdents . fst)

52

51

53−-- | Only keeps the given Modules and all of their dependencies

54−dependencyFilter :: [ModuleIdent] -> Filter

55−dependencyFilter = mkFilter . dependencyFilter'

56−

57−dependencyFilter' :: [ModuleIdent] -> [Module] -> [Module]

58−dependencyFilter' moduleIdents mods =

59− moduleFilter' (concatMap (getDepForModule mods) moduleIdents) mods

60− where

61− getDepForModule :: [Module] -> ModuleIdent -> [ModuleIdent]

62− getDepForModule ms moduleIdent =

63− moduleIdent : maybe [] extractDeps (findModule moduleIdent ms)

64−

65− findModule :: ModuleIdent -> [Module] -> Maybe Module

66− findModule i ms = listToMaybe $ filter go ms

67− where go (mn, _) = i == mn

68−

69− extractDeps :: Module -> [ModuleIdent]

70− extractDeps = mapMaybe extractDep . snd

71− where extractDep (Dependency n _ _) = Just n

72− extractDep _ = Nothing

73−

74-- | Only keeps Identifiers that start with the given prefix

52-- | Only keeps Identifiers that start with the given prefix

75prefixFilter :: Text -> Filter

53prefixFilter :: Text -> Filter

76prefixFilter "" = mkFilter id

54prefixFilter "" = mkFilter id

77prefixFilter t = mkFilter $ identFilter prefix t

55prefixFilter t = mkFilter $ identFilter prefix t

78 where

56 where

79− prefix :: ExternDecl -> Text -> Bool

57+ prefix :: IdeDeclaration -> Text -> Bool

80− prefix Export{} _ = False

81− prefix Dependency{} _ = False

82− prefix ed search = search `isPrefixOf` identifierFromExternDecl ed

58+ prefix ed search = search `isPrefixOf` identifierFromIdeDeclaration ed

83−

84

59

85-- | Only keeps Identifiers that are equal to the search string

60-- | Only keeps Identifiers that are equal to the search string

86equalityFilter :: Text -> Filter

61equalityFilter :: Text -> Filter

87equalityFilter = mkFilter . identFilter equality

62equalityFilter = mkFilter . identFilter equality

88 where

63 where

89− equality :: ExternDecl -> Text -> Bool

64+ equality :: IdeDeclaration -> Text -> Bool

90− equality ed search = identifierFromExternDecl ed == search

65+ equality ed search = identifierFromIdeDeclaration ed == search

91

66

92−identFilter :: (ExternDecl -> Text -> Bool ) -> Text -> [Module] -> [Module]

67+identFilter :: (IdeDeclaration -> Text -> Bool) -> Text -> [Module] -> [Module]

93identFilter predicate search =

68identFilter predicate search =

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

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

95 where

70 where

@@ -117,10 +92,6 @@ instance FromJSON Filter where

117 return $ prefixFilter search

92 return $ prefixFilter search

118 "modules" -> do

93 "modules" -> do

119 params <- o .: "params"

94 params <- o .: "params"

120− modules <- params .: "modules"

95+ modules <- map P.moduleNameFromString <$> params .: "modules"

121 return $ moduleFilter modules

96 return $ moduleFilter modules

122− "dependencies" -> do

123− params <- o .: "params"

124− deps <- params .: "modules"

125− return $ dependencyFilter deps

126 _ -> mzero

97 _ -> mzero

src/Language/PureScript/Ide/Imports.hs+17−17

@@ -181,7 +181,7 @@ addImplicitImport' imports mn =

181-- @import Prelude (bind)@ in the file File.purs returns @["import Prelude

182-- (bind, unit)"]@

183addExplicitImport :: (MonadIO m, MonadError PscIdeError m) =>

184− FilePath -> ExternDecl -> P.ModuleName -> m [Text]

184+ FilePath -> IdeDeclaration -> P.ModuleName -> m [Text]

185addExplicitImport fp decl moduleName = do

186 (mn, pre, imports, post) <- parseImportsFromFile fp

187 let newImportSection =

@@ -192,7 +192,7 @@ addExplicitImport fp decl moduleName = do

192 else addExplicitImport' decl moduleName imports

193 pure (pre ++ prettyPrintImportSection newImportSection ++ post)

194

195−addExplicitImport' :: ExternDecl -> P.ModuleName -> [Import] -> [Import]

195+addExplicitImport' :: IdeDeclaration -> P.ModuleName -> [Import] -> [Import]

196addExplicitImport' decl moduleName imports =

197 let

198 isImplicitlyImported =

@@ -207,28 +207,28 @@ addExplicitImport' decl moduleName imports =

207 then imports

208 else updateAtFirstOrPrepend matches (insertDeclIntoImport decl) freshImport imports

209 where

210− refFromDeclaration (TypeClassDeclaration n) =

210+ refFromDeclaration (IdeTypeClass n) =

211 P.TypeClassRef n

212− refFromDeclaration (DataConstructor n tn _) =

212+ refFromDeclaration (IdeDataConstructor n tn _) =

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

214− refFromDeclaration (TypeDeclaration n _) =

214+ refFromDeclaration (IdeType n _) =

215 P.TypeRef n (Just [])

216− refFromDeclaration (ValueOperator op _ _ _) =

216+ refFromDeclaration (IdeValueOperator op _ _ _) =

217 P.ValueOpRef op

218− refFromDeclaration (TypeOperator op _ _ _) =

218+ refFromDeclaration (IdeTypeOperator op _ _ _) =

219 P.TypeOpRef op

220 refFromDeclaration d =

221− P.ValueRef $ P.Ident $ T.unpack (identifierFromExternDecl d)

221+ P.ValueRef $ P.Ident $ T.unpack (identifierFromIdeDeclaration d)

222

223 -- | Adds a declaration to an import:

224 -- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)

225− insertDeclIntoImport :: ExternDecl -> Import -> Import

225+ insertDeclIntoImport :: IdeDeclaration -> Import -> Import

226 insertDeclIntoImport decl' (Import mn (P.Explicit refs) Nothing) =

227 Import mn (P.Explicit (insertDeclIntoRefs decl' refs)) Nothing

228 insertDeclIntoImport _ is = is

229

230− insertDeclIntoRefs :: ExternDecl -> [P.DeclarationRef] -> [P.DeclarationRef]

230+ insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]

231− insertDeclIntoRefs (DataConstructor dtor tn _) refs =

231+ insertDeclIntoRefs (IdeDataConstructor dtor tn _) refs =

232 let

233 dtor' = P.ProperName (T.unpack dtor)

234 in

@@ -263,14 +263,14 @@ updateAtFirstOrPrepend p t d l =

263--

264-- * If more than one possible imports are found, reports the possibilities as a

265-- list of completions.

266−addImportForIdentifier :: (PscIde m, MonadError PscIdeError m)

266+addImportForIdentifier :: (Ide m, MonadError PscIdeError m)

267 => FilePath -- ^ The Sourcefile to read from

268 -> Text -- ^ The identifier to import

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

270 -- the identifier

271 -> m (Either [Match] [Text])

272addImportForIdentifier fp ident filters = do

273− modules <- getAllModulesWithReexports

273+ modules <- getAllModules2 Nothing

274 case getExactMatches ident filters modules of

275 [] ->

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

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

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

280 -- right away

281 [Match m decl] ->

282− Right <$> addExplicitImport fp decl (P.moduleNameFromString (T.unpack m))

282+ Right <$> addExplicitImport fp decl m

283

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

285 -- types don't share a namespace we can get multiple matches from the same

@@ -296,7 +296,7 @@ addImportForIdentifier fp ident filters = do

296 -- dataconstructor as that will give us an unnecessary import warning at

297 -- worst

298 Just decl ->

299− Right <$> addExplicitImport fp decl (P.moduleNameFromString (T.unpack m1))

299+ Right <$> addExplicitImport fp decl m1

300 -- Here we need the user to specify whether he wanted a dataconstructor

301 -- or a type

302 Nothing ->

@@ -307,9 +307,9 @@ addImportForIdentifier fp ident filters = do

307 xs ->

308 pure $ Left xs

309 where

310− decideRedundantCase dtor@(DataConstructor _ t _) (TypeDeclaration t' _) =

310+ decideRedundantCase dtor@(IdeDataConstructor _ t _) (IdeType t' _) =

311 if t == t' then Just dtor else Nothing

312− decideRedundantCase TypeDeclaration{} ts@TypeSynonymDeclaration{} =

312+ decideRedundantCase IdeType{} ts@IdeTypeSynonym{} =

313 Just ts

314 decideRedundantCase _ _ = Nothing

315

src/Language/PureScript/Ide/Matcher.hs+2−2

@@ -41,7 +41,7 @@ import Text.Regex.TDFA ((=~))

41

42type ScoredMatch = (Match, Double)

43

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

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

45

46instance FromJSON Matcher where

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

@@ -105,7 +105,7 @@ flexRate p c = do

105-- By string =~ pattern we'll get the start of the match and the length of

106-- the matchas a (start, length) tuple if there's a match.

107-- If match fails then it would be (-1,0)

108−flexScore :: Text -> DeclIdent -> Maybe Double

108+flexScore :: Text -> Text -> Maybe Double

109flexScore pat str =

110 case T.uncons pat of

111 Nothing -> Nothing

src/Language/PureScript/Ide/Rebuild.hs+5−5

@@ -42,7 +42,7 @@ import System.IO.UTF8 (readUTF8File)

42-- warnings, and if rebuilding fails, returns a @RebuildError@ with the

43-- generated errors.

44rebuildFile

45− :: (PscIde m, MonadLogger m, MonadError PscIdeError m)

45+ :: (Ide m, MonadLogger m, MonadError PscIdeError m)

46 => FilePath

47 -> m Success

48rebuildFile path = do

@@ -60,7 +60,7 @@ rebuildFile path = do

60 -- correctly to the 'Environment'.

61 externs <- sortExterns m =<< getExternFiles

62

63− outputDirectory <- confOutputPath . envConfiguration <$> ask

63+ outputDirectory <- confOutputPath . ideConfiguration <$> ask

64

65 -- For rebuilding, we want to 'RebuildAlways', but for inferring foreign

66 -- modules using their file paths, we need to specify the path in the 'Map'.

@@ -82,7 +82,7 @@ rebuildFile path = do

82-- | Rebuilds a module but opens up its export list first and stores the result

83-- inside the rebuild cache

84rebuildModuleOpen

85− :: (PscIde m, MonadLogger m, MonadError PscIdeError m)

85+ :: (Ide m, MonadLogger m, MonadError PscIdeError m)

86 => MakeActionsEnv

87 -> [P.ExternsFile]

88 -> P.Module

@@ -100,7 +100,7 @@ rebuildModuleOpen makeEnv externs m = do

100 Right result -> do

101 $(logDebug)

102 ("Setting Rebuild cache: " <> runModuleNameT (P.efModuleName result))

103− setCachedRebuild result

103+ cacheRebuild result

104

105-- | Parameters we can access while building our @MakeActions@

106data MakeActionsEnv =

@@ -135,7 +135,7 @@ shushCodegen ma MakeActionsEnv{..} =

135-- module. Throws an error if there is a cyclic dependency within the

136-- ExternsFiles

137sortExterns

138− :: (PscIde m, MonadError PscIdeError m)

138+ :: (Ide m, MonadError PscIdeError m)

139 => P.Module

140 -> M.Map P.ModuleName P.ExternsFile

141 -> m [P.ExternsFile]

src/Language/PureScript/Ide/Reexports.hs+20−9

@@ -15,7 +15,13 @@

15

16{-# LANGUAGE OverloadedStrings #-}

17

18−module Language.PureScript.Ide.Reexports where

18+module Language.PureScript.Ide.Reexports

19+ ( resolveReexports2

20+ -- for tests

21+ , getReexports

22+ , replaceReexport

23+ , replaceReexports

24+ ) where

19

25

20

26

21import Prelude ()

27import Prelude ()

@@ -25,9 +31,11 @@ import Data.List (union)

25import Data.Map (Map)

31import Data.Map (Map)

26import qualified Data.Map as Map

32import qualified Data.Map as Map

27import Data.Maybe

33import Data.Maybe

34+import qualified Data.Text as T

28import Language.PureScript.Ide.Types

35import Language.PureScript.Ide.Types

36+import Language.PureScript.Ide.Externs

29

37

30−getReexports :: Module -> [ExternDecl]

38+getReexports :: ModuleOld -> [ExternDecl]

31getReexports (mn, decls)= concatMap getExport decls

39getReexports (mn, decls)= concatMap getExport decls

32 where getExport d

40 where getExport d

33 | (Export mn') <- d

41 | (Export mn') <- d

@@ -48,32 +56,32 @@ replaceExportWithAliases decls ident =

48 , alias == ident = True

56 , alias == ident = True

49 | otherwise = False

57 | otherwise = False

50

58

51−replaceReexport :: ExternDecl -> Module -> Module -> Module

59+replaceReexport :: ExternDecl -> ModuleOld -> ModuleOld -> ModuleOld

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

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

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

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

54replaceReexport _ _ _ = error "Should only get Exports here."

62replaceReexport _ _ _ = error "Should only get Exports here."

55

63

56−emptyModule :: Module

64+emptyModule :: ModuleOld

57emptyModule = ("Empty", [])

65emptyModule = ("Empty", [])

58

66

59isExport :: ExternDecl -> Bool

67isExport :: ExternDecl -> Bool

60isExport (Export _) = True

68isExport (Export _) = True

61isExport _ = False

69isExport _ = False

62

70

63−removeExportDecls :: Module -> Module

71+removeExportDecls :: ModuleOld -> ModuleOld

64removeExportDecls = fmap (filter (not . isExport))

72removeExportDecls = fmap (filter (not . isExport))

65

73

66−replaceReexports :: Module -> Map ModuleIdent [ExternDecl] -> Module

74+replaceReexports :: ModuleOld -> Map ModuleIdent [ExternDecl] -> ModuleOld

67replaceReexports m db = result

75replaceReexports m db = result

68 where

76 where

69 reexports = getReexports m

77 reexports = getReexports m

70 result = foldl go (removeExportDecls m) reexports

78 result = foldl go (removeExportDecls m) reexports

71

79

72− go :: Module -> ExternDecl -> Module

80+ go :: ModuleOld -> ExternDecl -> ModuleOld

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

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

74 go _ _ = error "partiality! woohoo"

82 go _ _ = error "partiality! woohoo"

75

83

76− getModule :: ModuleIdent -> Module

84+ getModule :: ModuleIdent -> ModuleOld

77 getModule name = clean res

85 getModule name = clean res

78 where

86 where

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

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

@@ -81,9 +89,12 @@ replaceReexports m db = result

81 -- infinite loops

89 -- infinite loops

82 clean (mn, decls) = (mn,) (filter (/= Export mn) decls)

90 clean (mn, decls) = (mn,) (filter (/= Export mn) decls)

83

91

84−resolveReexports :: Map ModuleIdent [ExternDecl] -> Module -> Module

92+resolveReexports :: Map ModuleIdent [ExternDecl] -> ModuleOld -> ModuleOld

85resolveReexports modules m =

93resolveReexports modules m =

86 let replaced = replaceReexports m modules

94 let replaced = replaceReexports m modules

87 in if null (getReexports replaced)

95 in if null (getReexports replaced)

88 then replaced

96 then replaced

89 else resolveReexports modules replaced

97 else resolveReexports modules replaced

98+

99+resolveReexports2 :: Map T.Text [ExternDecl] -> ModuleOld -> Module

100+resolveReexports2 decls = convertModule . resolveReexports decls

src/Language/PureScript/Ide/State.hs+131−78

@@ -17,17 +17,20 @@

17{-# LANGUAGE TemplateHaskell #-}

18

19module Language.PureScript.Ide.State

20− ( getPscIdeState

20+ ( getLoadedModulenames

21 , getExternFiles

22− , getModule

23− , getModuleWithReexports

24− , getAllModulesWithReexports

25− , getAllModulesWithReexportsAndCache

26 , insertModule

22 , insertModule

27− , insertModuleSTM

23+ , resetIdeState

28− , getCachedRebuild

24+ , cacheRebuild

29− , resetPscIdeState

25+ , insertExterns

30− , setCachedRebuild

26+ , insertExternsSTM

27+ , getAllModules2

28+ , getStage1

29+ , setStage1

30+ , getStage2

31+ , setStage2

32+ , populateStage2

33+ , populateStage2STM

31 ) where

34 ) where

32

35

33import Prelude ()

36import Prelude ()

@@ -38,8 +41,9 @@ import Control.Monad.IO.Class

38import "monad-logger" Control.Monad.Logger

41import "monad-logger" Control.Monad.Logger

39import Control.Monad.Reader.Class

42import Control.Monad.Reader.Class

40import qualified Data.Map.Lazy as M

43import qualified Data.Map.Lazy as M

41−import Data.Maybe (mapMaybe)

42import Data.Monoid

44import Data.Monoid

45+import qualified Data.Text as T

46+import Data.Time (getCurrentTime, diffUTCTime)

43import Language.PureScript.Externs

47import Language.PureScript.Externs

44import Language.PureScript.Ide.Externs

48import Language.PureScript.Ide.Externs

45import Language.PureScript.Ide.Reexports

49import Language.PureScript.Ide.Reexports

@@ -47,74 +51,30 @@ import Language.PureScript.Ide.Types

47import Language.PureScript.Ide.Util

51import Language.PureScript.Ide.Util

48import qualified Language.PureScript as P

52import qualified Language.PureScript as P

49

53

50−-- | Resets the PscIdeState to emptyPscIdeState

54+-- | Resets all State inside psc-ide

51−resetPscIdeState :: PscIde m => m ()

55+resetIdeState :: Ide m => m ()

52−resetPscIdeState = do

56+resetIdeState = do

53 stateVar <- envStateVar <$> ask

57 stateVar <- envStateVar <$> ask

58+ ideVar <- ideStateVar <$> ask

59+ liftIO . atomically $ do

54− liftIO $ atomically (writeTVar stateVar emptyPscIdeState)

60+ writeTVar stateVar emptyPscIdeState

61+ writeTVar ideVar emptyIdeState

62+ setStage2STM ideVar emptyStage2

55

63

56−-- | Gets the entire PscIdeState

64+-- | Gets the loaded Modulenames

57−getPscIdeState :: PscIde m => m PscIdeState

65+getLoadedModulenames :: Ide m => m [P.ModuleName]

58−getPscIdeState = do

66+getLoadedModulenames = M.keys <$> getExternFiles

59− stateVar <- envStateVar <$> ask

60− liftIO (readTVarIO stateVar)

61

67

62-- | Gets all loaded ExternFiles

68-- | Gets all loaded ExternFiles

63−getExternFiles :: (PscIde m) => m (M.Map P.ModuleName ExternsFile)

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

64−getExternFiles = do

70+getExternFiles = s1Externs <$> getStage1

65− stateVar <- envStateVar <$> ask

66− liftIO (pscIdeStateExternsFiles <$> readTVarIO stateVar)

67−

68−-- | Gets all loaded Modules and resolves Reexports

69−getAllModulesWithReexports :: (PscIde m) => m [Module]

70−getAllModulesWithReexports = getAllModulesWithReexports' <$> getPscIdeState

71−

72−-- | Pure version of @getAllModulesWithReexports@

73−getAllModulesWithReexports' :: PscIdeState -> [Module]

74−getAllModulesWithReexports' state =

75− mapMaybe (getModuleWithReexports' state) (M.keys (pscIdeStateModules state))

76−

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

78−-- does, runs @getAllModulesWithReexports@ with the cached module replacing the

79−-- loaded module

80−getAllModulesWithReexportsAndCache

81− :: (PscIde m)

82− => Maybe P.ModuleName

83− -> m [Module]

84−getAllModulesWithReexportsAndCache Nothing = getAllModulesWithReexports

85−getAllModulesWithReexportsAndCache (Just mn) = do

86− state <- getPscIdeState

87− cachedRebuild <- getCachedRebuild

88− case cachedRebuild of

89− Just (cachedIdent, ef) | cachedIdent == mn ->

90− pure (getAllModulesWithReexports' (insertModule' ef state))

91− _ -> getAllModulesWithReexports

92−

93−-- | Looks up a single Module inside the loaded Modules

94−getModule :: (PscIde m) => ModuleIdent -> m (Maybe Module)

95−getModule m = getModule' <$> getPscIdeState <*> pure m

96−

97−-- | Pure version of @getModule@

98−getModule' :: PscIdeState -> ModuleIdent -> Maybe Module

99−getModule' ps mi = (mi,) <$> M.lookup mi (pscIdeStateModules ps)

100−

101−-- | Looks up a single Module and resolves its Reexports

102−getModuleWithReexports :: PscIde m => ModuleIdent -> m (Maybe Module)

103−getModuleWithReexports i = getModuleWithReexports' <$> getPscIdeState <*> pure i

104−

105−-- | Pure version of @getModuleWithReexports@

106−getModuleWithReexports' :: PscIdeState -> ModuleIdent -> Maybe Module

107−getModuleWithReexports' ps mi =

108− resolveReexports (pscIdeStateModules ps) <$> getModule' ps mi

109

71

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

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

111-- ExternsFile into psc-ide's internal Declaration format

73-- ExternsFile into psc-ide's internal Declaration format

112−insertModule :: (PscIde m, MonadLogger m) =>

74+-- TODO: should be removed when the "old" Declaration format gets removed

113− ExternsFile -> m ()

75+insertModule :: Ide m => ExternsFile -> m ()

114insertModule externsFile = do

76insertModule externsFile = do

115 stateVar <- envStateVar <$> ask

77 stateVar <- envStateVar <$> ask

116− let moduleName = efModuleName externsFile

117− $(logDebug) $ "Inserting Module: " <> runModuleNameT moduleName

118 liftIO . atomically $ insertModuleSTM stateVar externsFile

78 liftIO . atomically $ insertModuleSTM stateVar externsFile

119

79

120-- | STM version of insertModule

80-- | STM version of insertModule

@@ -125,19 +85,112 @@ insertModuleSTM st ef = modifyTVar st (insertModule' ef)

125insertModule' :: ExternsFile -> PscIdeState -> PscIdeState

85insertModule' :: ExternsFile -> PscIdeState -> PscIdeState

126insertModule' ef state =

86insertModule' ef state =

127 state

87 state

128− { pscIdeStateExternsFiles =

129− M.insert (efModuleName ef) ef (pscIdeStateExternsFiles state)

130− , pscIdeStateModules = let (mn, decls) = convertExterns ef

88+ { pscIdeStateModules = let (mn, decls) = convertExterns ef

131 in M.insert mn decls (pscIdeStateModules state)

89 in M.insert mn decls (pscIdeStateModules state)

132 }

90 }

133

91

92+-- | Retrieves Stage1 from the State.

93+-- This includes loaded Externfiles

94+-- (TODO: as soon as we actually parse the modules) aswell as the parsed modules

95+getStage1 :: Ide m => m Stage1

96+getStage1 = do

97+ st <- ideStateVar <$> ask

98+ fmap ideStage1 . liftIO . readTVarIO $ st

99+

100+-- | STM version of getStage1

101+getStage1STM :: TVar IdeState -> STM Stage1

102+getStage1STM ref = ideStage1 <$> readTVar ref

103+

104+-- | Sets Stage1 inside the compiler

105+setStage1 :: Ide m => Stage1 -> m ()

106+setStage1 s1 = do

107+ st <- ideStateVar <$> ask

108+ liftIO . atomically . modifyTVar st $ \x ->

109+ x {ideStage1 = s1}

110+ pure ()

111+

112+-- TODO: Soon to be Stage3

113+-- | Retrieves Stage2 from the State.

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

115+getStage2 :: Ide m => m Stage2

116+getStage2 = do

117+ st <- ideStateVar <$> ask

118+ fmap ideStage2 . liftIO . readTVarIO $ st

119+

120+-- | Sets Stage2 inside the compiler

121+setStage2 :: Ide m => Stage2 -> m ()

122+setStage2 s2 = do

123+ st <- ideStateVar <$> ask

124+ liftIO . atomically $ setStage2STM st s2

125+

126+-- | STM version of setStage2

127+setStage2STM :: TVar IdeState -> Stage2 -> STM ()

128+setStage2STM ref s2 = do

129+ modifyTVar ref $ \x ->

130+ x {ideStage2 = s2}

131+ pure ()

132+

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

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

135+-- cache

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

137+getAllModules2 mmoduleName = do

138+ modules <- s2Modules <$> getStage2

139+ rebuild <- cachedRebuild

140+ case mmoduleName of

141+ Nothing -> pure (M.toList modules)

142+ Just moduleName ->

143+ case rebuild of

144+ Just (cachedModulename, ef)

145+ | cachedModulename == moduleName ->

146+ pure . M.toList $

147+ M.insert moduleName (snd . convertModule . convertExterns $ ef) modules

148+ _ -> pure (M.toList modules)

149+

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

151+-- following Stages, which needs to be done after all the necessary Exterms have

152+-- been loaded.

153+insertExterns :: Ide m => ExternsFile -> m ()

154+insertExterns ef = do

155+ st <- ideStateVar <$> ask

156+ liftIO (atomically (insertExternsSTM st ef))

157+

158+-- | STM version of insertExterns

159+insertExternsSTM :: TVar IdeState -> ExternsFile -> STM ()

160+insertExternsSTM ref ef =

161+ modifyTVar ref $ \x ->

162+ x { ideStage1 = (ideStage1 x) {

163+ s1Externs = M.insert (efModuleName ef) ef (s1Externs (ideStage1 x))}}

164+

134-- | Sets rebuild cache to the given ExternsFile

165-- | Sets rebuild cache to the given ExternsFile

135−setCachedRebuild :: PscIde m => ExternsFile -> m ()

166+cacheRebuild :: Ide m => ExternsFile -> m ()

136−setCachedRebuild ef = do

167+cacheRebuild ef = do

137− st <- envStateVar <$> ask

168+ st <- ideStateVar <$> ask

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

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

170+ x { ideStage2 = (ideStage2 x) {

139− x { pscIdeStateCachedRebuild = Just (efModuleName ef, ef) }

171+ s2CachedRebuild = Just (efModuleName ef, ef)}}

140

172

141-- | Retrieves the rebuild cache

173-- | Retrieves the rebuild cache

142−getCachedRebuild :: PscIde m => m (Maybe (P.ModuleName, ExternsFile))

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

143−getCachedRebuild = pscIdeStateCachedRebuild <$> getPscIdeState

175+cachedRebuild = s2CachedRebuild <$> getStage2

176+

177+-- | Resolves reexports and populates Stage2 with data to be used in queries.

178+populateStage2 :: (Ide m, MonadLogger m) => m ()

179+populateStage2 = do

180+ st <- ideStateVar <$> ask

181+ duration <- liftIO $ do

182+ start <- getCurrentTime

183+ atomically (populateStage2STM st)

184+ end <- getCurrentTime

185+ pure (diffUTCTime end start)

186+ $(logDebug) $ "Finished populating Stage2 in " <> T.pack (show duration)

187+

188+-- | STM version of populateStage2

189+populateStage2STM :: TVar IdeState -> STM ()

190+populateStage2STM ref = do

191+ externs <- s1Externs <$> getStage1STM ref

192+ -- Build the "old" ExternDecl format

193+ let modules = M.mapKeys runModuleNameT (M.map (snd . convertExterns) externs)

194+ -- Convert ExternDecl into IdeDeclaration

195+ declarations = resolveReexports2 modules <$> M.toList modules

196+ setStage2STM ref (Stage2 (M.fromList declarations) Nothing)

src/Language/PureScript/Ide/Types.hs+57−27

@@ -26,18 +26,15 @@ import Control.Monad.Trans

26import Data.Aeson

27import Data.Map.Lazy as M

28import Data.Maybe (maybeToList)

29−import Data.Text (Text (), pack, unpack)

29+import Data.Text (Text, pack, unpack)

30−import qualified Language.PureScript.AST.Declarations as D

31−import Language.PureScript.Externs

32import qualified Language.PureScript.Errors.JSON as P

30import qualified Language.PureScript.Errors.JSON as P

33−import qualified Language.PureScript.Names as N

34import qualified Language.PureScript as P

31import qualified Language.PureScript as P

32+import Language.PureScript.Ide.Conversions

35

33

36import Text.Parsec

34import Text.Parsec

37import Text.Parsec.Text

35import Text.Parsec.Text

38

36

39type Ident = Text

37type Ident = Text

40−type DeclIdent = Text

41type ModuleIdent = Text

38type ModuleIdent = Text

42

39

43data ExternDecl

40data ExternDecl

@@ -53,10 +50,10 @@ data ExternDecl

53 -- | A module declaration

50 -- | A module declaration

54 | ModuleDecl

51 | ModuleDecl

55 ModuleIdent -- The modules name

52 ModuleIdent -- The modules name

56− [DeclIdent] -- The exported identifiers

53+ [Ident] -- The exported identifiers

57 -- | A data/newtype declaration

54 -- | A data/newtype declaration

58 | DataConstructor

55 | DataConstructor

59− DeclIdent -- The type name

56+ Ident -- The type name

60 (P.ProperName 'P.TypeName)

57 (P.ProperName 'P.TypeName)

61 P.Type -- The "type"

58 P.Type -- The "type"

62 -- | An exported module

59 -- | An exported module

@@ -66,7 +63,18 @@ data ExternDecl

66 | Export ModuleIdent -- The exported Modules name

63 | Export ModuleIdent -- The exported Modules name

67 deriving (Show,Eq,Ord)

64 deriving (Show,Eq,Ord)

68

65

69−type Module = (ModuleIdent, [ExternDecl])

66+data IdeDeclaration

67+ = IdeValue Ident P.Type

68+ | IdeType (P.ProperName 'P.TypeName) P.Kind

69+ | IdeTypeSynonym (P.ProperName 'P.TypeName) P.Type

70+ | IdeDataConstructor Ident (P.ProperName 'P.TypeName) P.Type

71+ | IdeTypeClass (P.ProperName 'P.ClassName)

72+ | IdeValueOperator (P.OpName 'P.ValueOpName) Ident P.Precedence P.Associativity

73+ | IdeTypeOperator (P.OpName 'P.TypeOpName) Ident P.Precedence P.Associativity

74+ deriving (Show, Eq, Ord)

75+

76+type Module = (P.ModuleName, [IdeDeclaration])

77+type ModuleOld = (Text, [ExternDecl])

70

78

71data Configuration =

79data Configuration =

72 Configuration

80 Configuration

@@ -74,29 +82,51 @@ data Configuration =

74 , confDebug :: Bool

82 , confDebug :: Bool

75 }

83 }

76

84

77−data PscIdeEnvironment =

85+data IdeEnvironment =

78− PscIdeEnvironment

86+ IdeEnvironment

79 { envStateVar :: TVar PscIdeState

87 { envStateVar :: TVar PscIdeState

88+ , ideStateVar :: TVar IdeState

80− , envConfiguration :: Configuration

89+ , ideConfiguration :: Configuration

81 }

90 }

82

91

83−type PscIde m = (MonadIO m, MonadReader PscIdeEnvironment m)

92+type Ide m = (MonadIO m, MonadReader IdeEnvironment m)

84

93

85data PscIdeState =

94data PscIdeState =

86 PscIdeState

95 PscIdeState

87 { pscIdeStateModules :: M.Map Text [ExternDecl]

96 { pscIdeStateModules :: M.Map Text [ExternDecl]

88− , pscIdeStateExternsFiles :: M.Map P.ModuleName ExternsFile

89− , pscIdeStateCachedRebuild :: Maybe (P.ModuleName, ExternsFile)

90 } deriving Show

97 } deriving Show

91

98

92emptyPscIdeState :: PscIdeState

99emptyPscIdeState :: PscIdeState

93−emptyPscIdeState = PscIdeState M.empty M.empty Nothing

100+emptyPscIdeState = PscIdeState M.empty

101+

102+data IdeState = IdeState

103+ { ideStage1 :: Stage1

104+ , ideStage2 :: Stage2

105+ }

106+

107+emptyIdeState :: IdeState

108+emptyIdeState = IdeState emptyStage1 emptyStage2

109+

110+emptyStage1 :: Stage1

111+emptyStage1 = Stage1 M.empty

112+

113+emptyStage2 :: Stage2

114+emptyStage2 = Stage2 M.empty Nothing

115+

116+data Stage1 = Stage1

117+ { s1Externs :: M.Map P.ModuleName P.ExternsFile

118+ }

119+

120+data Stage2 = Stage2

121+ { s2Modules :: M.Map P.ModuleName [IdeDeclaration]

122+ , s2CachedRebuild :: Maybe (P.ModuleName, P.ExternsFile)

123+ }

94

124

95−data Match = Match ModuleIdent ExternDecl

125+data Match = Match P.ModuleName IdeDeclaration

96− deriving (Show, Eq)

126+ deriving (Show, Eq)

97

127

98newtype Completion =

128newtype Completion =

99− Completion (ModuleIdent, DeclIdent, Text)

129+ Completion (ModuleIdent, Ident, Text)

100 deriving (Show,Eq)

130 deriving (Show,Eq)

101

131

102instance ToJSON Completion where

132instance ToJSON Completion where

@@ -106,7 +136,7 @@ instance ToJSON Completion where

106data ModuleImport =

136data ModuleImport =

107 ModuleImport

137 ModuleImport

108 { importModuleName :: ModuleIdent

138 { importModuleName :: ModuleIdent

109− , importType :: D.ImportDeclarationType

139+ , importType :: P.ImportDeclarationType

110 , importQualifier :: Maybe Text

140 , importQualifier :: Maybe Text

111 } deriving(Show)

141 } deriving(Show)

112

142

@@ -116,25 +146,25 @@ instance Eq ModuleImport where

116 && importQualifier mi1 == importQualifier mi2

146 && importQualifier mi1 == importQualifier mi2

117

147

118instance ToJSON ModuleImport where

148instance ToJSON ModuleImport where

119− toJSON (ModuleImport mn D.Implicit qualifier) =

149+ toJSON (ModuleImport mn P.Implicit qualifier) =

120 object $ [ "module" .= mn

150 object $ [ "module" .= mn

121 , "importType" .= ("implicit" :: Text)

151 , "importType" .= ("implicit" :: Text)

122 ] ++ fmap (\x -> "qualifier" .= x) (maybeToList qualifier)

152 ] ++ fmap (\x -> "qualifier" .= x) (maybeToList qualifier)

123− toJSON (ModuleImport mn (D.Explicit refs) _) =

153+ toJSON (ModuleImport mn (P.Explicit refs) _) =

124 object [ "module" .= mn

154 object [ "module" .= mn

125 , "importType" .= ("explicit" :: Text)

155 , "importType" .= ("explicit" :: Text)

126 , "identifiers" .= (identifierFromDeclarationRef <$> refs)

156 , "identifiers" .= (identifierFromDeclarationRef <$> refs)

127 ]

157 ]

128− toJSON (ModuleImport mn (D.Hiding refs) _) =

158+ toJSON (ModuleImport mn (P.Hiding refs) _) =

129 object [ "module" .= mn

159 object [ "module" .= mn

130 , "importType" .= ("hiding" :: Text)

160 , "importType" .= ("hiding" :: Text)

131 , "identifiers" .= (identifierFromDeclarationRef <$> refs)

161 , "identifiers" .= (identifierFromDeclarationRef <$> refs)

132 ]

162 ]

133

163

134−identifierFromDeclarationRef :: D.DeclarationRef -> String

164+identifierFromDeclarationRef :: P.DeclarationRef -> Text

135−identifierFromDeclarationRef (D.TypeRef name _) = N.runProperName name

165+identifierFromDeclarationRef (P.TypeRef name _) = runProperNameT name

136−identifierFromDeclarationRef (D.ValueRef ident) = N.runIdent ident

166+identifierFromDeclarationRef (P.ValueRef ident) = runIdentT ident

137−identifierFromDeclarationRef (D.TypeClassRef name) = N.runProperName name

167+identifierFromDeclarationRef (P.TypeClassRef name) = runProperNameT name

138identifierFromDeclarationRef _ = ""

168identifierFromDeclarationRef _ = ""

139

169

140data Success =

170data Success =

@@ -182,7 +212,7 @@ data PursuitResponse =

182 ModuleResponse ModuleIdent Text

212 ModuleResponse ModuleIdent Text

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

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

184 -- module, name and package

214 -- module, name and package

185− | DeclarationResponse Text ModuleIdent DeclIdent Text

215+ | DeclarationResponse Text ModuleIdent Ident Text

186 deriving (Show,Eq)

216 deriving (Show,Eq)

187

217

188instance FromJSON PursuitResponse where

218instance FromJSON PursuitResponse where

src/Language/PureScript/Ide/Util.hs+35−42

@@ -9,14 +9,23 @@

9-- Stability : experimental

10--

11-- |

12−-- Generally useful functions and conversions

12+-- Generally useful functions

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

14

15{-# LANGUAGE OverloadedStrings #-}

16

17−module Language.PureScript.Ide.Util where

17+module Language.PureScript.Ide.Util

18+ ( identifierFromIdeDeclaration

19+ , identifierFromMatch

20+ , completionFromMatch

21+ , encodeT

22+ , decodeT

23+ , unlessM

24+ , module Language.PureScript.Ide.Conversions

25+ ) where

18

26

19import Prelude.Compat

27import Prelude.Compat

28+import Control.Monad (unless)

20import Data.Aeson

29import Data.Aeson

21import Data.Text (Text)

30import Data.Text (Text)

22import qualified Data.Text as T

31import qualified Data.Text as T

@@ -24,50 +33,32 @@ import Data.Text.Lazy (fromStrict, toStrict)

24import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)

33import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)

25import qualified Language.PureScript as P

34import qualified Language.PureScript as P

26import Language.PureScript.Ide.Types

35import Language.PureScript.Ide.Types

36+import Language.PureScript.Ide.Conversions

27

37

28−runProperNameT :: P.ProperName a -> Text

38+identifierFromIdeDeclaration :: IdeDeclaration -> Text

29−runProperNameT = T.pack . P.runProperName

39+identifierFromIdeDeclaration d = case d of

30−

40+ IdeValue name _ -> name

31−runIdentT :: P.Ident -> Text

32−runIdentT = T.pack . P.runIdent

33−

34−runOpNameT :: P.OpName a -> Text

35−runOpNameT = T.pack . P.runOpName

36−

37−runModuleNameT :: P.ModuleName -> Text

38−runModuleNameT = T.pack . P.runModuleName

39−

40−prettyTypeT :: P.Type -> Text

41−prettyTypeT = T.unwords . fmap T.strip . T.lines . T.pack . P.prettyPrintType

42−

43−identifierFromExternDecl :: ExternDecl -> Text

44−identifierFromExternDecl (ValueDeclaration name _) = name

45−identifierFromExternDecl (TypeDeclaration name _) = runProperNameT name

41+ IdeType name _ -> runProperNameT name

46−identifierFromExternDecl (TypeSynonymDeclaration name _) = runProperNameT name

42+ IdeTypeSynonym name _ -> runProperNameT name

47−identifierFromExternDecl (DataConstructor name _ _) = name

43+ IdeDataConstructor name _ _ -> name

48−identifierFromExternDecl (TypeClassDeclaration name) = runProperNameT name

44+ IdeTypeClass name -> runProperNameT name

49−identifierFromExternDecl (ModuleDecl name _) = name

45+ IdeValueOperator op _ _ _ -> runOpNameT op

50−identifierFromExternDecl (ValueOperator op _ _ _) = runOpNameT op

51−identifierFromExternDecl (TypeOperator op _ _ _) = runOpNameT op

46+ IdeTypeOperator op _ _ _ -> runOpNameT op

52−identifierFromExternDecl Dependency{} = "~Dependency~"

53−identifierFromExternDecl Export{} = "~Export~"

54

47

55identifierFromMatch :: Match -> Text

48identifierFromMatch :: Match -> Text

56−identifierFromMatch (Match _ ed) = identifierFromExternDecl ed

49+identifierFromMatch (Match _ ed) = identifierFromIdeDeclaration ed

57

50

58−completionFromMatch :: Match -> Maybe Completion

51+completionFromMatch :: Match -> Completion

59−completionFromMatch (Match m d) = case d of

52+completionFromMatch (Match m' d) = case d of

60− ValueDeclaration name type' -> Just $ Completion (m, name, prettyTypeT type')

53+ IdeValue name type' -> Completion (m, name, prettyTypeT type')

61− TypeDeclaration name kind -> Just $ Completion (m, runProperNameT name, T.pack $ P.prettyPrintKind kind)

54+ IdeType name kind -> Completion (m, runProperNameT name, T.pack $ P.prettyPrintKind kind)

62− TypeSynonymDeclaration name kind -> Just $ Completion (m, runProperNameT name, prettyTypeT kind)

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

63− DataConstructor name _ type' -> Just $ Completion (m, name, prettyTypeT type')

56+ IdeDataConstructor name _ type' -> Completion (m, name, prettyTypeT type')

64− TypeClassDeclaration name -> Just $ Completion (m, runProperNameT name, "class")

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

65− ModuleDecl name _ -> Just $ Completion ("module", name, "module")

66− ValueOperator op ref precedence associativity -> Just $ Completion (m, runOpNameT op, showFixity precedence associativity ref op)

58+ IdeValueOperator op ref precedence associativity -> Completion (m, runOpNameT op, showFixity precedence associativity ref op)

67− TypeOperator op ref precedence associativity -> Just $ Completion (m, runOpNameT op, showFixity precedence associativity ref op)

59+ IdeTypeOperator op ref precedence associativity -> Completion (m, runOpNameT op, showFixity precedence associativity ref op)

68− Dependency{} -> Nothing

69− Export{} -> Nothing

70 where

60 where

61+ m = runModuleNameT m'

71 showFixity p a r o =

62 showFixity p a r o =

72 let asso = case a of

63 let asso = case a of

73 P.Infix -> "infix"

64 P.Infix -> "infix"

@@ -75,9 +66,11 @@ completionFromMatch (Match m d) = case d of

75 P.Infixr -> "infixr"

66 P.Infixr -> "infixr"

76 in T.unwords [asso, T.pack (show p), r, "as", runOpNameT o]

67 in T.unwords [asso, T.pack (show p), r, "as", runOpNameT o]

77

68

78−

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

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

80encodeT = toStrict . decodeUtf8 . encode

70encodeT = toStrict . decodeUtf8 . encode

81

71

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

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

83decodeT = decode . encodeUtf8 . fromStrict

73decodeT = decode . encodeUtf8 . fromStrict

74+

75+unlessM :: Monad m => m Bool -> m () -> m ()

76+unlessM cond act = cond >>= flip unless act

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

@@ -27,20 +27,20 @@ import System.FSNotify

27

28-- | Reloads an ExternsFile from Disc. If the Event indicates the ExternsFile

29-- was deleted we don't do anything.

30−reloadFile :: TVar PscIdeState -> Event -> IO ()

30+reloadFile :: TVar IdeState -> Event -> IO ()

31reloadFile _ Removed{} = pure ()

32−reloadFile stateVar ev = do

32+reloadFile ref ev = do

33 let fp = eventPath ev

34 ef' <- runExceptT (readExternFile fp)

35 case ef' of

36 Left _ -> pure ()

37 Right ef -> do

38− atomically (insertModuleSTM stateVar ef)

38+ atomically (insertExternsSTM ref ef *> populateStage2STM ref)

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

40

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

42-- they change on disc

43−watcher :: TVar PscIdeState -> FilePath -> IO ()

43+watcher :: TVar IdeState -> FilePath -> IO ()

44watcher stateVar fp =

45 withManagerConf (defaultConfig { confDebounce = NoDebounce }) $ \mgr -> do

46 _ <- watchTree mgr fp

src/Language/PureScript/Publish.hs+1

@@ -21,6 +21,7 @@ module Language.PureScript.Publish

21 , getResolvedDependencies

22 ) where

23

24+import Prelude ()

24import Prelude.Compat hiding (userError)

25import Prelude.Compat hiding (userError)

25

26

26import Control.Arrow ((***))

27import Control.Arrow ((***))

tests/Language/PureScript/Ide/FilterSpec.hs+9−22

@@ -7,26 +7,23 @@ import Language.PureScript.Ide.Types

7import qualified Language.PureScript as P

8import Test.Hspec

9

10−value :: Text -> ExternDecl

10+value :: Text -> IdeDeclaration

11−value s = ValueDeclaration s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

11+value s = IdeValue s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

12

13modules :: [Module]

14modules =

15− [

16− ("Module.A", [value "function1"]),

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

17− ("Module.B", [value "data1"]),

16+ , (P.moduleNameFromString "Module.B", [value "data1"])

18− ("Module.C", [ModuleDecl "Module.C" []]),

19− ("Module.D", [Dependency "Module.C" [] Nothing, value "asd"])

20 ]

17 ]

21

18

22runEq :: Text -> [Module]

19runEq :: Text -> [Module]

23runEq s = runFilter (equalityFilter s) modules

20runEq s = runFilter (equalityFilter s) modules

21+

24runPrefix :: Text -> [Module]

22runPrefix :: Text -> [Module]

25runPrefix s = runFilter (prefixFilter s) modules

23runPrefix s = runFilter (prefixFilter s) modules

24+

26−runModule :: [ModuleIdent] -> [Module]

25+runModule :: [P.ModuleName] -> [Module]

27runModule ms = runFilter (moduleFilter ms) modules

26runModule ms = runFilter (moduleFilter ms) modules

28−runDependency :: [ModuleIdent] -> [Module]

29−runDependency ms = runFilter (dependencyFilter ms) modules

30

27

31spec :: Spec

28spec :: Spec

32spec = do

29spec = do

@@ -35,7 +32,6 @@ spec = do

35 runEq "test" `shouldBe` []

32 runEq "test" `shouldBe` []

36 it "keeps function declarations that are equal" $

33 it "keeps function declarations that are equal" $

37 runEq "function1" `shouldBe` [head modules]

34 runEq "function1" `shouldBe` [head modules]

38− -- TODO: It would be more sensible to match Constructors

39 it "keeps data declarations that are equal" $

35 it "keeps data declarations that are equal" $

40 runEq "data1" `shouldBe` [modules !! 1]

36 runEq "data1" `shouldBe` [modules !! 1]

41 describe "prefixFilter" $ do

37 describe "prefixFilter" $ do

@@ -45,19 +41,10 @@ spec = do

45 runPrefix "fun" `shouldBe` [head modules]

41 runPrefix "fun" `shouldBe` [head modules]

46 it "keeps data decls prefix matches" $

42 it "keeps data decls prefix matches" $

47 runPrefix "dat" `shouldBe` [modules !! 1]

43 runPrefix "dat" `shouldBe` [modules !! 1]

48− it "keeps module decl prefix matches" $

49− runPrefix "Mod" `shouldBe` [modules !! 2]

50 describe "moduleFilter" $ do

44 describe "moduleFilter" $ do

51 it "removes everything on empty input" $

45 it "removes everything on empty input" $

52 runModule [] `shouldBe` []

46 runModule [] `shouldBe` []

53 it "only keeps the specified modules" $

47 it "only keeps the specified modules" $

54− runModule ["Module.A", "Module.C"] `shouldBe` [head modules, modules !! 2]

48+ runModule [P.moduleNameFromString "Module.A"] `shouldBe` [head modules]

55 it "ignores modules that are not in scope" $

49 it "ignores modules that are not in scope" $

56− runModule ["Module.A", "Module.C", "Unknown"] `shouldBe` [head modules, modules !! 2]

50+ runModule (P.moduleNameFromString <$> ["Module.A", "Unknown"]) `shouldBe` [head modules]

57− describe "dependencyFilter" $ do

58− it "removes everything on empty input" $

59− runDependency [] `shouldBe` []

60− it "only keeps the specified modules if they have no imports" $

61− runDependency ["Module.A", "Module.B"] `shouldBe` [head modules, modules !! 1]

62− it "keeps the specified modules and their imports" $

63− runDependency ["Module.A", "Module.D"] `shouldBe` [head modules, modules !! 2, modules !! 3]

tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs+10−23

@@ -12,9 +12,7 @@ import System.Directory

12import System.FilePath

13

14setup :: IO ()

15−setup = do

16− Integration.reset

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

17− mapM_ Integration.loadModuleWithDeps ["ImportsSpec", "ImportsSpec1"]

18

16

19withSupportFiles :: (FilePath -> FilePath -> IO a) -> IO ()

17withSupportFiles :: (FilePath -> FilePath -> IO a) -> IO ()

20withSupportFiles test = do

18withSupportFiles test = do

@@ -35,52 +33,41 @@ spec = beforeAll_ setup . describe "Adding imports" $ do

35 let

33 let

36 sourceFileSkeleton :: [Text] -> [Text]

34 sourceFileSkeleton :: [Text] -> [Text]

37 sourceFileSkeleton importSection =

35 sourceFileSkeleton importSection =

38− [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId = id"]

36+ [ "module ImportsSpec where" , ""] ++ importSection ++ [ "" , "myId x = x"]

39 it "adds an implicit import" $ do

37 it "adds an implicit import" $ do

40 withSupportFiles (Integration.addImplicitImport "ImportsSpec1")

38 withSupportFiles (Integration.addImplicitImport "ImportsSpec1")

41 outputFileShouldBe (sourceFileSkeleton

39 outputFileShouldBe (sourceFileSkeleton

42 [ "import ImportsSpec1"

40 [ "import ImportsSpec1"

43− , "import Main (id)"

44 ])

41 ])

45 it "adds an explicit unqualified import" $ do

42 it "adds an explicit unqualified import" $ do

46 withSupportFiles (Integration.addImport "exportedFunction")

43 withSupportFiles (Integration.addImport "exportedFunction")

47 outputFileShouldBe (sourceFileSkeleton

44 outputFileShouldBe (sourceFileSkeleton

48 [ "import ImportsSpec1 (exportedFunction)"

45 [ "import ImportsSpec1 (exportedFunction)"

49− , "import Main (id)"

50 ])

46 ])

51 it "adds an explicit unqualified import (type)" $ do

47 it "adds an explicit unqualified import (type)" $ do

52 withSupportFiles (Integration.addImport "MyType")

48 withSupportFiles (Integration.addImport "MyType")

53− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyType)"

49+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyType)"])

54− , "import Main (id)"

55− ])

56 it "adds an explicit unqualified import (parameterized type)" $ do

50 it "adds an explicit unqualified import (parameterized type)" $ do

57 withSupportFiles (Integration.addImport "MyParamType")

51 withSupportFiles (Integration.addImport "MyParamType")

58− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyParamType)"

52+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyParamType)"])

59− , "import Main (id)"

60− ])

61 it "adds an explicit unqualified import (typeclass)" $ do

53 it "adds an explicit unqualified import (typeclass)" $ do

62 withSupportFiles (Integration.addImport "ATypeClass")

54 withSupportFiles (Integration.addImport "ATypeClass")

63− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (class ATypeClass)"

55+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (class ATypeClass)"])

64− , "import Main (id)"])

65 it "adds an explicit unqualified import (dataconstructor)" $ do

56 it "adds an explicit unqualified import (dataconstructor)" $ do

66 withSupportFiles (Integration.addImport "MyJust")

57 withSupportFiles (Integration.addImport "MyJust")

67− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyMaybe(MyJust))"

58+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyMaybe(MyJust))"])

68− , "import Main (id)"])

69 it "adds an explicit unqualified import (newtype)" $ do

59 it "adds an explicit unqualified import (newtype)" $ do

70 withSupportFiles (Integration.addImport "MyNewtype")

60 withSupportFiles (Integration.addImport "MyNewtype")

71− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (MyNewtype(MyNewtype))"

61+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (MyNewtype(MyNewtype))"])

72− , "import Main (id)"])

73 it "adds an explicit unqualified import (typeclass member function)" $ do

62 it "adds an explicit unqualified import (typeclass member function)" $ do

74 withSupportFiles (Integration.addImport "typeClassFun")

63 withSupportFiles (Integration.addImport "typeClassFun")

75− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (typeClassFun)"

64+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (typeClassFun)"])

76− , "import Main (id)"])

77 it "doesn't add a newtypes constructor if only the type is exported" $ do

65 it "doesn't add a newtypes constructor if only the type is exported" $ do

78 withSupportFiles (Integration.addImport "OnlyTypeExported")

66 withSupportFiles (Integration.addImport "OnlyTypeExported")

79− outputFileShouldBe (sourceFileSkeleton [ "import ImportsSpec1 (OnlyTypeExported)"

67+ outputFileShouldBe (sourceFileSkeleton ["import ImportsSpec1 (OnlyTypeExported)"])

80− , "import Main (id)"])

81 it "doesn't add an import if the identifier is defined in the module itself" $ do

68 it "doesn't add an import if the identifier is defined in the module itself" $ do

82 withSupportFiles (Integration.addImport "myId")

69 withSupportFiles (Integration.addImport "myId")

83− outputFileShouldBe (sourceFileSkeleton [ "import Main (id)"])

70+ outputFileShouldBe (sourceFileSkeleton [])

84 it "responds with an error if it's undecidable whether we want a type or constructor" $

71 it "responds with an error if it's undecidable whether we want a type or constructor" $

85 withSupportFiles (\sourceFp outFp -> do

72 withSupportFiles (\sourceFp outFp -> do

86 r <- Integration.addImport "SpecialCase" sourceFp outFp

73 r <- Integration.addImport "SpecialCase" sourceFp outFp

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

@@ -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' (ValueDeclaration i wildcard) mn is)

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

72 addOpImport op mn is =

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

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

74 addDtorImport i t mn is =

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

75+ prettyPrintImportSection (addExplicitImport' (IdeDataConstructor 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+11−7

@@ -29,8 +29,9 @@ module Language.PureScript.Ide.Integration

29 -- sending commands

30 , addImport

31 , addImplicitImport

32+ , loadAll

32 , loadModule

33 , loadModule

33− , loadModuleWithDeps

34+ , loadModules

34 , getCwd

35 , getCwd

35 , getFlexCompletions

36 , getFlexCompletions

36 , getFlexCompletionsInModule

37 , getFlexCompletionsInModule

@@ -161,11 +162,14 @@ getCwd = do

161 let cwdCommand = object ["command" .= ("cwd" :: String)]

162 let cwdCommand = object ["command" .= ("cwd" :: String)]

162 sendCommand cwdCommand

163 sendCommand cwdCommand

163

164

164−loadModuleWithDeps :: String -> IO String

165−loadModuleWithDeps m = sendCommand $ load [] [m]

166−

167loadModule :: String -> IO String

165loadModule :: String -> IO String

166+loadModule m = loadModules [m]

167+

168+loadModules :: [String] -> IO String

168−loadModule m = sendCommand $ load [m] []

169+loadModules = sendCommand . load

170+

171+loadAll :: IO String

172+loadAll = sendCommand (load [])

169

173

170getFlexCompletions :: String -> IO [(String, String, String)]

174getFlexCompletions :: String -> IO [(String, String, String)]

171getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) Nothing)

175getFlexCompletions q = parseCompletions <$> sendCommand (completion [] (Just (flexMatcher q)) Nothing)

@@ -190,8 +194,8 @@ rebuildModule m = sendCommand (rebuildC m Nothing)

190commandWrapper :: String -> Value -> Value

194commandWrapper :: String -> Value -> Value

191commandWrapper c p = object ["command" .= c, "params" .= p]

195commandWrapper c p = object ["command" .= c, "params" .= p]

192

196

193−load :: [String] -> [String] -> Value

197+load :: [String] -> Value

194−load ms ds = commandWrapper "load" (object ["modules" .= ms, "dependencies" .= ds])

198+load ms = commandWrapper "load" (object ["modules" .= ms])

195

199

196typeC :: String -> [Value] -> Value

200typeC :: String -> [Value] -> Value

197typeC q filters = commandWrapper "type" (object ["search" .= q, "filters" .= filters])

201typeC q filters = commandWrapper "type" (object ["search" .= q, "filters" .= filters])

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

@@ -10,14 +10,14 @@ import Language.PureScript.Ide.Matcher

10import Language.PureScript.Ide.Types

11import Test.Hspec

12

13−value :: Text -> ExternDecl

13+value :: Text -> IdeDeclaration

14−value s = ValueDeclaration s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

14+value s = IdeValue s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)

15

16completions :: [Match]

17completions =

18− [ Match "" (value "firstResult")

18+ [ Match (P.moduleNameFromString "Match") (value "firstResult")

19− , Match "" (value "secondResult")

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

20− , Match "" (value "fiult")

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

21 ]

22

23mkResult :: [Int] -> [Match]

@@ -27,7 +27,7 @@ runFlex :: Text -> [Match]

27runFlex s = runMatcher (flexMatcher s) completions

28

29setup :: IO ()

30−setup = reset *> void (loadModuleWithDeps "Main")

30+setup = reset *> void loadAll

31

32spec :: Spec

33spec = do

@@ -45,4 +45,4 @@ spec = do

45 cs `shouldBe` []

46 it "matches on equality" $ do

47 cs <- getFlexCompletions "const"

48− cs `shouldBe` [("Main", "const", "forall a b. a -> b -> a")]

48+ cs `shouldBe` [("MatcherSpec", "const", "forall a b. a -> b -> a")]

tests/Language/PureScript/Ide/RebuildSpec.hs+4−4

@@ -13,7 +13,7 @@ shouldBeFailure = shouldBe False . Integration.resultIsSuccess

13spec :: Spec

14spec = before_ Integration.reset . describe "Rebuilding single modules" $ do

15 it "rebuilds a correct module without dependencies successfully" $ do

16− _ <- Integration.loadModuleWithDeps "RebuildSpecSingleModule"

16+ _ <- Integration.loadModule "RebuildSpecSingleModule"

17 pdir <- Integration.projectDirectory

18 let file = pdir </> "src" </> "RebuildSpecSingleModule.purs"

19 Integration.rebuildModule file >>= shouldBeSuccess

@@ -22,12 +22,12 @@ spec = before_ Integration.reset . describe "Rebuilding single modules" $ do

22 let file = pdir </> "src" </> "RebuildSpecSingleModule.fail"

23 Integration.rebuildModule file >>= shouldBeFailure

24 it "rebuilds a correct module with its dependencies successfully" $ do

25− _ <- Integration.loadModuleWithDeps "RebuildSpecWithDeps"

25+ _ <- Integration.loadModules ["RebuildSpecWithDeps", "RebuildSpecDep"]

26 pdir <- Integration.projectDirectory

27 let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"

28 Integration.rebuildModule file >>= shouldBeSuccess

29 it "rebuilds a correct module that has reverse dependencies" $ do

30− _ <- Integration.loadModuleWithDeps "RebuildSpecWithDeps"

30+ _ <- Integration.loadModule "RebuildSpecWithDeps"

31 pdir <- Integration.projectDirectory

32 let file = pdir </> "src" </> "RebuildSpecDep.purs"

33 Integration.rebuildModule file >>= shouldBeSuccess

@@ -37,7 +37,7 @@ spec = before_ Integration.reset . describe "Rebuilding single modules" $ do

37 let file = pdir </> "src" </> "RebuildSpecWithDeps.purs"

38 Integration.rebuildModule file >>= shouldBeFailure

39 it "rebuilds a correct module with a foreign file" $ do

40− _ <- Integration.loadModuleWithDeps "RebuildSpecWithForeign"

40+ _ <- Integration.loadModule "RebuildSpecWithForeign"

41 pdir <- Integration.projectDirectory

42 let file = pdir </> "src" </> "RebuildSpecWithForeign.purs"

43 Integration.rebuildModule file >>= shouldBeSuccess

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

@@ -23,28 +23,28 @@ dep1 = Dependency "Test.Foo" [] (Just "T")

23dep2 :: ExternDecl

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

25

26−circularModule :: Module

26+circularModule :: ModuleOld

27circularModule = ("Circular", [Export "Circular"])

28

29−module1 :: Module

29+module1 :: ModuleOld

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

31

32−module2 :: Module

32+module2 :: ModuleOld

33module2 = ("Module2", [decl2])

34

35−module3 :: Module

35+module3 :: ModuleOld

36module3 = ("Module3", [decl3])

37

38−module4 :: Module

38+module4 :: ModuleOld

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

40

41−result :: Module

41+result :: ModuleOld

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

43

44db :: Map.Map ModuleIdent [ExternDecl]

45db = Map.fromList [module1, module2, module3]

46

47−shouldBeEqualSorted :: Module -> Module -> Expectation

47+shouldBeEqualSorted :: ModuleOld -> ModuleOld -> Expectation

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

49

50spec :: Spec

tests/Language/PureScript/IdeSpec.hsdeleted−35

@@ -1,35 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−module Language.PureScript.IdeSpec where

4−

5−import Control.Concurrent.STM

6−import Control.Monad.Reader

7−import Data.List

8−import qualified Data.Map as Map

9−import Language.PureScript.Ide

10−import Language.PureScript.Ide.Types

11−import Test.Hspec

12−

13−testState :: PscIdeState

14−testState = PscIdeState (Map.fromList [("Data.Array", []), ("Control.Monad.Eff", [])]) Map.empty Nothing

15−

16−defaultConfig :: Configuration

17−defaultConfig =

18− Configuration

19− {

20− confOutputPath = "output/"

21− , confDebug = False

22− }

23−

24−spec :: SpecWith ()

25−spec =

26− describe "list" $

27− describe "loadedModules" $ do

28− it "returns an empty list when no modules are loaded" $ do

29− st <- newTVarIO emptyPscIdeState

30− result <- runReaderT printModules (PscIdeEnvironment st defaultConfig)

31− result `shouldBe` ModuleList []

32− it "returns the list of loaded modules" $ do

33− st <- newTVarIO testState

34− ModuleList result <- runReaderT printModules (PscIdeEnvironment st defaultConfig)

35− sort result `shouldBe` sort ["Data.Array", "Control.Monad.Eff"]

tests/support/pscide/src/ImportsSpec.purs+1−3

@@ -1,5 +1,3 @@

1module ImportsSpec where

2

3−import Main (id)

4−

5−myId = id

3+myId x = x

tests/support/pscide/src/Main.purs → tests/support/pscide/src/MatcherSpec.pursrenamed+1−1

@@ -1,4 +1,4 @@

1−module Main where

1+module MatcherSpec where

2

3id :: forall a. a -> a

4id x = x

tests/support/pscide/src/RebuildSpecSingleModule.purs+1−1

@@ -1,4 +1,4 @@

1module RebuildSpecSingleModule where

2

3id x = x

4−const x y = x

4+lulz x y = x