git.iko.soy/rowtype-yoga/purescript-native
on 7174a75 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Ide.hs
206 lines 7.8 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.Ide
4-- Description : Interface for the psc-ide-server
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-- Interface for the psc-ide-server
13-----------------------------------------------------------------------------
15{-# LANGUAGE OverloadedStrings #-}
16{-# LANGUAGE PackageImports #-}
17{-# LANGUAGE TemplateHaskell #-}
19module Language.PureScript.Ide
20 ( handleCommand
21 ) where
23import Protolude
25import "monad-logger" Control.Monad.Logger
26import qualified Language.PureScript as P
27import qualified Language.PureScript.Ide.CaseSplit as CS
28import Language.PureScript.Ide.Command
29import Language.PureScript.Ide.Completion
30import Language.PureScript.Ide.Error
31import Language.PureScript.Ide.Externs
32import Language.PureScript.Ide.Filter
33import Language.PureScript.Ide.Imports hiding (Import)
34import Language.PureScript.Ide.Matcher
35import Language.PureScript.Ide.Pursuit
36import Language.PureScript.Ide.Rebuild
37import Language.PureScript.Ide.SourceFile
38import Language.PureScript.Ide.State
39import Language.PureScript.Ide.Types
40import Language.PureScript.Ide.Util
41import System.Directory
42import System.FilePath
43import System.FilePath.Glob
45handleCommand :: (Ide m, MonadLogger m, MonadError PscIdeError m) =>
46 Command -> m Success
47handleCommand 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 rs' -> answerRequest outfp rs'
77 Left question ->
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
88findCompletions :: Ide m =>
89 [Filter] -> Matcher -> Maybe P.ModuleName -> m Success
90findCompletions filters matcher currentModule = do
91 modules <- getAllModules2 currentModule
92 pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules
94findType :: Ide m =>
95 Text -> [Filter] -> Maybe P.ModuleName -> m Success
96findType search filters currentModule = do
97 modules <- getAllModules2 currentModule
98 pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules
100findPursuitCompletions :: MonadIO m =>
101 PursuitQuery -> m Success
102findPursuitCompletions (PursuitQuery q) =
103 PursuitResult <$> liftIO (searchPursuitForDeclarations q)
105findPursuitPackages :: MonadIO m =>
106 PursuitQuery -> m Success
107findPursuitPackages (PursuitQuery q) =
108 PursuitResult <$> liftIO (findPackagesForModuleIdent q)
110printModules :: Ide m => m Success
111printModules = ModuleList . map runModuleNameT <$> getLoadedModulenames
113outputDirectory :: Ide m => m FilePath
114outputDirectory = do
115 outputPath <- confOutputPath . ideConfiguration <$> ask
116 cwd <- liftIO getCurrentDirectory
117 pure (cwd </> outputPath)
119listAvailableModules :: Ide m => m Success
120listAvailableModules = do
121 oDir <- outputDirectory
122 liftIO $ do
123 contents <- getDirectoryContents oDir
124 let cleaned = filter (`notElem` [".", ".."]) contents
125 return (ModuleList (map toS cleaned))
127caseSplit :: (Ide m, MonadError PscIdeError m) =>
128 Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success
129caseSplit l b e csa t = do
130 patterns <- CS.makePattern l b e csa <$> CS.caseSplit t
131 pure (MultilineTextResult patterns)
133addClause
134 :: (MonadError PscIdeError m)
135 => Text
136 -> CS.WildcardAnnotations
137 -> m Success
138addClause t wca = MultilineTextResult <$> CS.addClause t wca
140-- | Finds all the externs.json files inside the output folder and returns the
141-- corresponding Modulenames
142findAvailableExterns :: (Ide m, MonadError PscIdeError m) => m [P.ModuleName]
143findAvailableExterns = do
144 oDir <- outputDirectory
145 unlessM (liftIO (doesDirectoryExist oDir))
146 (throwError (GeneralError "Couldn't locate your output directory."))
147 liftIO $ do
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
161-- | Finds all matches for the globs specified at the commandline
162findAllSourceFiles :: Ide m => m [FilePath]
163findAllSourceFiles = do
164 globs <- confGlobs . ideConfiguration <$> ask
165 liftIO (concatMapM glob globs)
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.
171loadModules
172 :: (Ide m, MonadError PscIdeError m, MonadLogger m)
173 => [P.ModuleName]
174 -> m Success
175loadModules moduleNames = do
176 -- We resolve all the modulenames to externs files and load these into memory.
177 oDir <- outputDirectory
178 let efPaths =
179 map (\mn -> oDir </> P.runModuleName mn </> "externs.json") moduleNames
180 efiles <- traverse readExternFile efPaths
181 traverse_ insertExterns efiles
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
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
196 -- Finally we kick off the worker with @async@ and return the number of
197 -- successfully parsed modules.
198 env <- ask
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."))