git.iko.soy/rowtype-yoga/purescript-native
on 4af7f4a help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Ide.hs
193 lines 7.6 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 PscIdeError m) =>
47 Command -> m Success
48handleCommand c = case c of
49 Load [] ->
50 findAvailableExterns >>= loadModules
51 Load modules ->
52 loadModules modules
53 Type search filters currentModule ->
54 findType search filters currentModule
55 Complete filters matcher currentModule ->
56 findCompletions filters matcher currentModule
57 Pursuit query Package ->
58 findPursuitPackages query
59 Pursuit query Identifier ->
60 findPursuitCompletions query
61 List LoadedModules ->
62 printModules
63 List AvailableModules ->
64 listAvailableModules
65 List (Imports fp) ->
66 ImportList <$> getImportsForFile fp
67 CaseSplit l b e wca t ->
68 caseSplit l b e wca t
69 AddClause l wca ->
70 MultilineTextResult <$> CS.addClause l wca
71 Import fp outfp _ (AddImplicitImport mn) -> do
72 rs <- addImplicitImport fp mn
73 answerRequest outfp rs
74 Import fp outfp filters (AddImportForIdentifier ident) -> do
75 rs <- addImportForIdentifier fp ident filters
76 case rs of
77 Right rs' -> answerRequest outfp rs'
78 Left question ->
79 pure (CompletionResult (map (completionFromMatch . map withEmptyAnn) question))
80 Rebuild file ->
81 rebuildFile file
82 Cwd ->
83 TextResult . toS <$> liftIO getCurrentDirectory
84 Reset ->
85 resetIdeState $> TextResult "State has been reset."
86 Quit ->
87 liftIO exitSuccess
89findCompletions :: Ide m =>
90 [Filter] -> Matcher IdeDeclarationAnn -> Maybe P.ModuleName -> m Success
91findCompletions filters matcher currentModule = do
92 modules <- getAllModules currentModule
93 pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules
95findType :: Ide m =>
96 Text -> [Filter] -> Maybe P.ModuleName -> m Success
97findType search filters currentModule = do
98 modules <- getAllModules currentModule
99 pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules
101findPursuitCompletions :: MonadIO m =>
102 PursuitQuery -> m Success
103findPursuitCompletions (PursuitQuery q) =
104 PursuitResult <$> liftIO (searchPursuitForDeclarations q)
106findPursuitPackages :: MonadIO m =>
107 PursuitQuery -> m Success
108findPursuitPackages (PursuitQuery q) =
109 PursuitResult <$> liftIO (findPackagesForModuleIdent q)
111printModules :: Ide m => m Success
112printModules = ModuleList . map P.runModuleName <$> getLoadedModulenames
114outputDirectory :: Ide m => m FilePath
115outputDirectory = do
116 outputPath <- confOutputPath . ideConfiguration <$> ask
117 cwd <- liftIO getCurrentDirectory
118 pure (cwd </> outputPath)
120listAvailableModules :: Ide m => m Success
121listAvailableModules = do
122 oDir <- outputDirectory
123 liftIO $ do
124 contents <- getDirectoryContents oDir
125 let cleaned = filter (`notElem` [".", ".."]) contents
126 return (ModuleList (map toS cleaned))
128caseSplit :: (Ide m, MonadError PscIdeError m) =>
129 Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success
130caseSplit l b e csa t = do
131 patterns <- CS.makePattern l b e csa <$> CS.caseSplit t
132 pure (MultilineTextResult patterns)
134-- | Finds all the externs.json files inside the output folder and returns the
135-- corresponding Modulenames
136findAvailableExterns :: (Ide m, MonadError PscIdeError m) => m [P.ModuleName]
137findAvailableExterns = do
138 oDir <- outputDirectory
139 unlessM (liftIO (doesDirectoryExist oDir))
140 (throwError (GeneralError "Couldn't locate your output directory."))
141 liftIO $ do
142 directories <- getDirectoryContents oDir
143 moduleNames <- filterM (containsExterns oDir) directories
144 pure (P.moduleNameFromString . toS <$> moduleNames)
145 where
146 -- Takes the output directory and a filepath like "Monad.Control.Eff" and
147 -- looks up, whether that folder contains an externs.json
148 containsExterns :: FilePath -> FilePath -> IO Bool
149 containsExterns oDir d
150 | d `elem` [".", ".."] = pure False
151 | otherwise = do
152 let file = oDir </> d </> "externs.json"
153 doesFileExist file
155-- | Finds all matches for the globs specified at the commandline
156findAllSourceFiles :: Ide m => m [FilePath]
157findAllSourceFiles = do
158 globs <- confGlobs . ideConfiguration <$> ask
159 liftIO (concatMapM glob globs)
161-- | Looks up the ExternsFiles for the given Modulenames and loads them into the
162-- server state. Then proceeds to parse all the specified sourcefiles and
163-- inserts their ASTs into the state. Finally kicks off an async worker, which
164-- populates Stage 2 and 3 of the state.
165loadModules
166 :: (Ide m, MonadError PscIdeError m, MonadLogger m)
167 => [P.ModuleName]
168 -> m Success
169loadModules moduleNames = do
170 -- We resolve all the modulenames to externs files and load these into memory.
171 oDir <- outputDirectory
172 let efPaths =
173 map (\mn -> oDir </> toS (P.runModuleName mn) </> "externs.json") moduleNames
174 efiles <- traverse readExternFile efPaths
175 traverse_ insertExterns efiles
177 -- We parse all source files, log eventual parse failures and insert the
178 -- successful parses into the state.
179 (failures, allModules) <-
180 partitionEithers <$> (traverse parseModule =<< findAllSourceFiles)
181 unless (null failures) $
182 $(logWarn) ("Failed to parse: " <> show failures)
183 traverse_ insertModule allModules
185 -- Finally we kick off the worker with @async@ and return the number of
186 -- successfully parsed modules.
187 env <- ask
188 let ll = confLogLevel (ideConfiguration env)
189 -- populateStage2 and 3 return Unit for now, so it's fine to discard this
190 -- result. We might want to block on this in a benchmarking situation.
191 _ <- liftIO (async (runLogger ll (runReaderT (populateStage2 *> populateStage3) env)))
192 pure (TextResult ("Loaded " <> show (length efiles) <> " modules and "
193 <> show (length allModules) <> " source files."))