git.iko.soy/rowtype-yoga/purescript-native
on ff4866a help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Ide.hs
217 lines 8.2 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 PackageImports #-}
16{-# LANGUAGE TemplateHaskell #-}
18module Language.PureScript.Ide
19 ( handleCommand
20 ) where
22import Protolude
24import "monad-logger" Control.Monad.Logger
25import qualified Language.PureScript as P
26import qualified Language.PureScript.Ide.CaseSplit as CS
27import Language.PureScript.Ide.Command
28import Language.PureScript.Ide.Completion
29import Language.PureScript.Ide.Error
30import Language.PureScript.Ide.Externs
31import Language.PureScript.Ide.Filter
32import Language.PureScript.Ide.Imports hiding (Import)
33import Language.PureScript.Ide.Matcher
34import Language.PureScript.Ide.Pursuit
35import Language.PureScript.Ide.Rebuild
36import Language.PureScript.Ide.SourceFile
37import Language.PureScript.Ide.State
38import Language.PureScript.Ide.Types
39import Language.PureScript.Ide.Util
40import System.Directory (getCurrentDirectory, getDirectoryContents, doesDirectoryExist, doesFileExist)
41import System.FilePath ((</>))
42import System.FilePath.Glob (glob)
44-- | Accepts a Commmand and runs it against psc-ide's State. This is the main
45-- entry point for the server.
46handleCommand :: (Ide m, MonadLogger m, MonadError IdeError m) =>
47 Command -> m Success
48handleCommand c = case c of
49 Load [] ->
50 findAvailableExterns >>= loadModulesAsync
51 Load modules ->
52 loadModulesAsync modules
53 LoadSync [] ->
54 findAvailableExterns >>= loadModulesSync
55 LoadSync modules ->
56 loadModulesSync modules
57 Type search filters currentModule ->
58 findType search filters currentModule
59 Complete filters matcher currentModule ->
60 findCompletions filters matcher currentModule
61 Pursuit query Package ->
62 findPursuitPackages query
63 Pursuit query Identifier ->
64 findPursuitCompletions query
65 List LoadedModules ->
66 printModules
67 List AvailableModules ->
68 listAvailableModules
69 List (Imports fp) ->
70 ImportList <$> getImportsForFile fp
71 CaseSplit l b e wca t ->
72 caseSplit l b e wca t
73 AddClause l wca ->
74 MultilineTextResult <$> CS.addClause l wca
75 Import fp outfp _ (AddImplicitImport mn) -> do
76 rs <- addImplicitImport fp mn
77 answerRequest outfp rs
78 Import fp outfp filters (AddImportForIdentifier ident) -> do
79 rs <- addImportForIdentifier fp ident filters
80 case rs of
81 Right rs' -> answerRequest outfp rs'
82 Left question ->
83 pure (CompletionResult (map (completionFromMatch . map withEmptyAnn) question))
84 Rebuild file ->
85 rebuildFileAsync file
86 RebuildSync file ->
87 rebuildFileSync file
88 Cwd ->
89 TextResult . toS <$> liftIO getCurrentDirectory
90 Reset ->
91 resetIdeState $> TextResult "State has been reset."
92 Quit ->
93 liftIO exitSuccess
95findCompletions :: Ide m =>
96 [Filter] -> Matcher IdeDeclarationAnn -> Maybe P.ModuleName -> m Success
97findCompletions filters matcher currentModule = do
98 modules <- getAllModules currentModule
99 pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules
101findType :: Ide m =>
102 Text -> [Filter] -> Maybe P.ModuleName -> m Success
103findType search filters currentModule = do
104 modules <- getAllModules currentModule
105 pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules
107findPursuitCompletions :: MonadIO m =>
108 PursuitQuery -> m Success
109findPursuitCompletions (PursuitQuery q) =
110 PursuitResult <$> liftIO (searchPursuitForDeclarations q)
112findPursuitPackages :: MonadIO m =>
113 PursuitQuery -> m Success
114findPursuitPackages (PursuitQuery q) =
115 PursuitResult <$> liftIO (findPackagesForModuleIdent q)
117printModules :: Ide m => m Success
118printModules = ModuleList . map P.runModuleName <$> getLoadedModulenames
120outputDirectory :: Ide m => m FilePath
121outputDirectory = do
122 outputPath <- confOutputPath . ideConfiguration <$> ask
123 cwd <- liftIO getCurrentDirectory
124 pure (cwd </> outputPath)
126listAvailableModules :: Ide m => m Success
127listAvailableModules = do
128 oDir <- outputDirectory
129 liftIO $ do
130 contents <- getDirectoryContents oDir
131 let cleaned = filter (`notElem` [".", ".."]) contents
132 return (ModuleList (map toS cleaned))
134caseSplit :: (Ide m, MonadError IdeError m) =>
135 Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success
136caseSplit l b e csa t = do
137 patterns <- CS.makePattern l b e csa <$> CS.caseSplit t
138 pure (MultilineTextResult patterns)
140-- | Finds all the externs.json files inside the output folder and returns the
141-- corresponding Modulenames
142findAvailableExterns :: (Ide m, MonadError IdeError 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 (containsExterns oDir) directories
150 pure (P.moduleNameFromString . toS <$> 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 containsExterns :: FilePath -> FilePath -> IO Bool
155 containsExterns 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.
171loadModulesAsync
172 :: (Ide m, MonadError IdeError m, MonadLogger m)
173 => [P.ModuleName]
174 -> m Success
175loadModulesAsync moduleNames = do
176 tr <- loadModules moduleNames
178 -- Finally we kick off the worker with @async@ and return the number of
179 -- successfully parsed modules.
180 env <- ask
181 let ll = confLogLevel (ideConfiguration env)
182 -- populateStage2 and 3 return Unit for now, so it's fine to discard this
183 -- result. We might want to block on this in a benchmarking situation.
184 _ <- liftIO (async (runLogger ll (runReaderT (populateStage2 *> populateStage3) env)))
185 pure tr
187loadModulesSync
188 :: (Ide m, MonadError IdeError m, MonadLogger m)
189 => [P.ModuleName]
190 -> m Success
191loadModulesSync moduleNames = do
192 tr <- loadModules moduleNames
193 populateStage2 *> populateStage3
194 pure tr
196loadModules
197 :: (Ide m, MonadError IdeError m, MonadLogger m)
198 => [P.ModuleName]
199 -> m Success
200loadModules moduleNames = do
201 -- We resolve all the modulenames to externs files and load these into memory.
202 oDir <- outputDirectory
203 let efPaths =
204 map (\mn -> oDir </> toS (P.runModuleName mn) </> "externs.json") moduleNames
205 efiles <- traverse readExternFile efPaths
206 traverse_ insertExterns efiles
208 -- We parse all source files, log eventual parse failures and insert the
209 -- successful parses into the state.
210 (failures, allModules) <-
211 partitionEithers <$> (traverse parseModule =<< findAllSourceFiles)
212 unless (null failures) $
213 $(logWarn) ("Failed to parse: " <> show failures)
214 traverse_ insertModule allModules
216 pure (TextResult ("Loaded " <> show (length efiles) <> " modules and "
217 <> show (length allModules) <> " source files."))