1414
1515{-# LANGUAGE OverloadedStrings #-}
1616{-# LANGUAGE PackageImports #-}
17+ {-# LANGUAGE TemplateHaskell #-}
1718
1819module Language.PureScript.Ide
1920 ( handleCommand
20- -- for tests
21- , printModules
2221 ) where
2322
2423import Protolude
@@ -41,67 +40,74 @@ import Language.PureScript.Ide.Types
4140import Language.PureScript.Ide.Util
4241import System.Directory
4342import System.FilePath
43+ import System.FilePath.Glob
4444
4545handleCommand :: (Ide m , MonadLogger m , MonadError PscIdeError m ) =>
4646 Command -> m Success
47- handleCommand (Load [] ) = loadAllModules
48- handleCommand (Load modules) = loadModules modules
49- handleCommand (Type search filters currentModule) =
50- findType search filters currentModule
51- handleCommand (Complete filters matcher currentModule) =
52- findCompletions filters matcher currentModule
53- handleCommand (Pursuit query Package ) =
54- findPursuitPackages query
55- handleCommand (Pursuit query Identifier ) =
56- findPursuitCompletions query
57- handleCommand (List LoadedModules ) =
58- printModules
59- handleCommand (List AvailableModules ) =
60- listAvailableModules
61- handleCommand (List (Imports fp)) =
62- importsForFile fp
63- handleCommand (CaseSplit l b e wca t) =
64- caseSplit l b e wca t
65- handleCommand (AddClause l wca) =
66- addClause l wca
67- handleCommand (Import fp outfp _ (AddImplicitImport mn)) = do
68- rs <- addImplicitImport fp mn
69- answerRequest outfp rs
70- handleCommand (Import fp outfp filters (AddImportForIdentifier ident)) = do
71- rs <- addImportForIdentifier fp ident filters
72- case rs of
73- Right -> answerRequest outfp rs'
74- Left -> pure $ CompletionResult (map completionFromMatch question)
75- handleCommand (Rebuild file) =
76- rebuildFile file
77- handleCommand Cwd =
78- TextResult . toS <$> liftIO getCurrentDirectory
79- handleCommand Reset = resetIdeState *> pure (TextResult " State has been reset."
80- handleCommand Quit = liftIO exitSuccess
81-
82- findCompletions :: (Ide m ) =>
47+ handleCommand c = case c of
48+ Load [] ->
49+ findAvailableExterns >>= loadModules
50+ Load modules ->
51+ loadModules modules
52+ Type search filters currentModule ->
53+ findType search filters currentModule
54+ Complete filters matcher currentModule ->
55+ findCompletions filters matcher currentModule
56+ Pursuit query Package ->
57+ findPursuitPackages query
58+ Pursuit query Identifier ->
59+ findPursuitCompletions query
60+ List LoadedModules ->
61+ printModules
62+ List AvailableModules ->
63+ listAvailableModules
64+ List (Imports fp) ->
65+ ImportList <$> getImportsForFile fp
66+ CaseSplit l b e wca t ->
67+ caseSplit l b e wca t
68+ AddClause l wca ->
69+ addClause l wca
70+ Import fp outfp _ (AddImplicitImport mn) -> do
71+ rs <- addImplicitImport fp mn
72+ answerRequest outfp rs
73+ Import fp outfp filters (AddImportForIdentifier ident) -> do
74+ rs <- addImportForIdentifier fp ident filters
75+ case rs of
76+ Right -> answerRequest outfp rs'
77+ Left ->
78+ pure (CompletionResult (map completionFromMatch question))
79+ Rebuild file ->
80+ rebuildFile file
81+ Cwd ->
82+ TextResult . toS <$> liftIO getCurrentDirectory
83+ Reset ->
84+ resetIdeState $> TextResult " State has been reset."
85+ Quit ->
86+ liftIO exitSuccess
87+
88+ findCompletions :: Ide m =>
8389 [Filter ] -> Matcher -> Maybe P. ModuleName-> m Success
8490findCompletions filters matcher currentModule = do
8591 modules <- getAllModules2 currentModule
8692 pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules
8793
88- findType :: ( Ide m ) =>
94+ findType :: Ide m =>
8995 Text -> [Filter ] -> Maybe P. ModuleName-> m Success
9096findType search filters currentModule = do
9197 modules <- getAllModules2 currentModule
9298 pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules
9399
94- findPursuitCompletions :: ( MonadIO m ) =>
100+ findPursuitCompletions :: MonadIO m =>
95101 PursuitQuery -> m Success
96102findPursuitCompletions (PursuitQuery q) =
97103 PursuitResult <$> liftIO (searchPursuitForDeclarations q)
98104
99- findPursuitPackages :: ( MonadIO m ) =>
105+ findPursuitPackages :: MonadIO m =>
100106 PursuitQuery -> m Success
101107findPursuitPackages (PursuitQuery q) =
102108 PursuitResult <$> liftIO (findPackagesForModuleIdent q)
103109
104- printModules :: ( Ide m ) => m Success
110+ printModules :: Ide m => m Success
105111printModules = ModuleList . map runModuleNameT <$> getLoadedModulenames
106112
107113outputDirectory :: Ide m => m FilePath
@@ -131,54 +137,70 @@ addClause
131137 -> m Success
132138addClause t wca = MultilineTextResult <$> CS. addClause t wca
133139
134- importsForFile :: (MonadIO m , MonadError PscIdeError m ) =>
135- FilePath -> m Success
136- importsForFile fp = do
137- imports <- getImportsForFile fp
138- pure (ImportList imports)
139-
140- -- | Takes the output directory and a filepath like "Monad.Control.Eff" and
141- -- looks up, whether that folder contains an externs.json
142- checkExternsPath :: FilePath -> FilePath -> IO Maybe FilePath
143- checkExternsPath oDir d
144- | d `elem` [" ." " .." = pure Nothing
145- | otherwise = do
146- let file = oDir </> d </> " externs.json"
147- ex <- doesFileExist file
148- if ex
149- then pure (Just file)
150- else pure Nothing
151-
152- findAllExterns :: (Ide m , MonadError PscIdeError m ) => m [FilePath
153- findAllExterns = do
140+ -- | Finds all the externs.json files inside the output folder and returns the
141+ -- corresponding Modulenames
142+ findAvailableExterns :: (Ide m , MonadError PscIdeError m ) => m [P. ModuleName
143+ findAvailableExterns = do
154144 oDir <- outputDirectory
155145 unlessM (liftIO (doesDirectoryExist oDir))
156146 (throwError (GeneralError " Couldn't locate your output directory."
157147 liftIO $ do
158- dirs <- getDirectoryContents oDir
159- externPaths <- traverse (checkExternsPath oDir) dirs
160- pure (catMaybes externPaths)
161-
148+ directories <- getDirectoryContents oDir
149+ moduleNames <- filterM (checkExternsPath oDir) directories
150+ pure (P. moduleNameFromString <$> moduleNames)
151+ where
152+ -- | Takes the output directory and a filepath like "Monad.Control.Eff" and
153+ -- looks up, whether that folder contains an externs.json
154+ checkExternsPath :: FilePath -> FilePath -> IO Bool
155+ checkExternsPath oDir d
156+ | d `elem` [" ." " .." = pure False
157+ | otherwise = do
158+ let file = oDir </> d </> " externs.json"
159+ doesFileExist file
160+
161+ -- | Finds all matches for the globs specified at the commandline
162+ findAllSourceFiles :: Ide m => m [FilePath
163+ findAllSourceFiles = do
164+ globs <- confGlobs . ideConfiguration <$> ask
165+ liftIO (concatMapM glob globs)
166+
167+ -- | Looks up the ExternsFiles for the given Modulenames and loads them into the
168+ -- server state. Then proceeds to parse all the specified sourcefiles and
169+ -- inserts their ASTs into the state. Finally kicks off an async worker, which
170+ -- populates Stage 2 and 3 of the state.
162171loadModules
163172 :: (Ide m , MonadError PscIdeError m , MonadLogger m )
164173 => [P. ModuleName
165174 -> m Success
166- loadModules mns = do
175+ loadModules moduleNames = do
176+ -- We resolve all the modulenames to externs files and load these into memory.
167177 oDir <- outputDirectory
168- let efPaths = map (\ mn -> oDir </> P. runModuleName mn </> " externs.json"
178+ let efPaths =
179+ map (\ mn -> oDir </> P. runModuleName mn </> " externs.json"
169180 efiles <- traverse readExternFile efPaths
170181 traverse_ insertExterns efiles
171- -- TODO Get rid of this once ModuleOld is gone
172- traverse_ insertModule efiles
173- populateStage2
174- pure (TextResult (" Loaded " <> foldMap runModuleNameT mns <> " ."
175-
176- loadAllModules :: (Ide m , MonadError PscIdeError m ) => m Success
177- loadAllModules = do
178- exts <- traverse readExternFile =<< findAllExterns
179- traverse_ insertExterns exts
180- -- TODO Get rid of this once ModuleOld is gone
181- traverse_ insertModule exts
182+
183+ -- We parse all source files, log eventual parse failures if the debug flag
184+ -- was set and insert the succesful parses into the state.
185+ (failures, allModules) <-
186+ partitionEithers <$> (traverse parseModule =<< findAllSourceFiles)
187+ unless (null failures) $
188+ $ (logDebug) (" Failed to parse: " <> show failures)
189+ traverse_ insertModule allModules
190+
191+ -- Because we still need the "old" module format to resolve reexports in the
192+ -- worker thread, we insert it into the state aswell.
193+ -- TODO Get rid of this once ModuleOld is gone
194+ traverse_ insertModuleOld efiles
195+
196+ -- Finally we kick off the worker with @async@ and return the number of
197+ -- successfully parsed modules.
182198 env <- ask
183- _ <- liftIO $ async (runStdoutLoggingT (runReaderT populateStage2 env))
184- pure (TextResult " All modules loaded."
199+ let runLogger =
200+ runStdoutLoggingT
201+ . filterLogger (\ _ _ -> confDebug (ideConfiguration env))
202+ -- populateStage2 returns Unit for now, so it's fine to discard this result.
203+ -- We might want to block on this in a benchmarking situation.
204+ _ <- liftIO (async (runLogger (runReaderT populateStage2 env)))
205+ pure (TextResult (" Loaded " <> show (length efiles) <> " modules and "
206+ <> show (length allModules) <> " source files."
0 commit comments