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