git.iko.soy/rowtype-yoga/purescript-native
on a07a714 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Ide.hs
195 lines 7.3 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 #-}
18module Language.PureScript.Ide
19 ( handleCommand
20 -- for tests
21 , printModules
22 ) where
24import Prelude ()
25import Prelude.Compat
27import Control.Concurrent.Async
28import Control.Monad.Error.Class
29import Control.Monad.IO.Class
30import "monad-logger" Control.Monad.Logger
31import Control.Monad.Reader
32import Data.Foldable
33import Data.Maybe (catMaybes)
34import Data.Monoid
35import Data.Text (Text)
36import qualified Data.Text as T
37import qualified Language.PureScript as P
38import qualified Language.PureScript.Ide.CaseSplit as CS
39import Language.PureScript.Ide.Command
40import Language.PureScript.Ide.Completion
41import Language.PureScript.Ide.Error
42import Language.PureScript.Ide.Externs
43import Language.PureScript.Ide.Filter
44import Language.PureScript.Ide.Imports hiding (Import)
45import Language.PureScript.Ide.Matcher
46import Language.PureScript.Ide.Pursuit
47import Language.PureScript.Ide.Rebuild
48import Language.PureScript.Ide.SourceFile
49import Language.PureScript.Ide.State
50import Language.PureScript.Ide.Types
51import Language.PureScript.Ide.Util
52import System.Directory
53import System.Exit
54import System.FilePath
56handleCommand :: (Ide m, MonadLogger m, MonadError PscIdeError m) =>
57 Command -> m Success
58handleCommand (Load []) = loadAllModules
59handleCommand (Load modules) = loadModules modules
60handleCommand (Type search filters currentModule) =
61 findType search filters currentModule
62handleCommand (Complete filters matcher currentModule) =
63 findCompletions filters matcher currentModule
64handleCommand (Pursuit query Package) =
65 findPursuitPackages query
66handleCommand (Pursuit query Identifier) =
67 findPursuitCompletions query
68handleCommand (List LoadedModules) =
69 printModules
70handleCommand (List AvailableModules) =
71 listAvailableModules
72handleCommand (List (Imports fp)) =
73 importsForFile fp
74handleCommand (CaseSplit l b e wca t) =
75 caseSplit l b e wca t
76handleCommand (AddClause l wca) =
77 addClause l wca
78handleCommand (Import fp outfp _ (AddImplicitImport mn)) = do
79 rs <- addImplicitImport fp mn
80 answerRequest outfp rs
81handleCommand (Import fp outfp filters (AddImportForIdentifier ident)) = do
82 rs <- addImportForIdentifier fp ident filters
83 case rs of
84 Right rs' -> answerRequest outfp rs'
85 Left question -> pure $ CompletionResult (map completionFromMatch question)
86handleCommand (Rebuild file) =
87 rebuildFile file
88handleCommand Cwd =
89 TextResult . T.pack <$> liftIO getCurrentDirectory
90handleCommand Reset = resetIdeState *> pure (TextResult "State has been reset.")
91handleCommand Quit = liftIO exitSuccess
93findCompletions :: (Ide m) =>
94 [Filter] -> Matcher -> Maybe P.ModuleName -> m Success
95findCompletions filters matcher currentModule = do
96 modules <- getAllModules2 currentModule
97 pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules
99findType :: (Ide m) =>
100 Text -> [Filter] -> Maybe P.ModuleName -> m Success
101findType search filters currentModule = do
102 modules <- getAllModules2 currentModule
103 pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules
105findPursuitCompletions :: (MonadIO m) =>
106 PursuitQuery -> m Success
107findPursuitCompletions (PursuitQuery q) =
108 PursuitResult <$> liftIO (searchPursuitForDeclarations q)
110findPursuitPackages :: (MonadIO m) =>
111 PursuitQuery -> m Success
112findPursuitPackages (PursuitQuery q) =
113 PursuitResult <$> liftIO (findPackagesForModuleIdent q)
115printModules :: (Ide m) => m Success
116printModules = ModuleList . map runModuleNameT <$> getLoadedModulenames
118outputDirectory :: Ide m => m FilePath
119outputDirectory = do
120 outputPath <- confOutputPath . ideConfiguration <$> ask
121 cwd <- liftIO getCurrentDirectory
122 pure (cwd </> outputPath)
124listAvailableModules :: Ide m => m Success
125listAvailableModules = do
126 oDir <- outputDirectory
127 liftIO $ do
128 contents <- getDirectoryContents oDir
129 let cleaned = filter (`notElem` [".", ".."]) contents
130 return (ModuleList (map T.pack cleaned))
132caseSplit :: (Ide m, MonadError PscIdeError m) =>
133 Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success
134caseSplit l b e csa t = do
135 patterns <- CS.makePattern l b e csa <$> CS.caseSplit t
136 pure (MultilineTextResult patterns)
138addClause
139 :: (MonadError PscIdeError m)
140 => Text
141 -> CS.WildcardAnnotations
142 -> m Success
143addClause t wca = MultilineTextResult <$> CS.addClause t wca
145importsForFile :: (MonadIO m, MonadError PscIdeError m) =>
146 FilePath -> m Success
147importsForFile fp = do
148 imports <- getImportsForFile fp
149 pure (ImportList imports)
151-- | Takes the output directory and a filepath like "Monad.Control.Eff" and
152-- looks up, whether that folder contains an externs.json
153checkExternsPath :: FilePath -> FilePath -> IO (Maybe FilePath)
154checkExternsPath oDir d
155 | d `elem` [".", ".."] = pure Nothing
156 | otherwise = do
157 let file = oDir </> d </> "externs.json"
158 ex <- doesFileExist file
159 if ex
160 then pure (Just file)
161 else pure Nothing
163findAllExterns :: (Ide m, MonadError PscIdeError m) => m [FilePath]
164findAllExterns = do
165 oDir <- outputDirectory
166 unlessM (liftIO (doesDirectoryExist oDir))
167 (throwError (GeneralError "Couldn't locate your output directory."))
168 liftIO $ do
169 dirs <- getDirectoryContents oDir
170 externPaths <- traverse (checkExternsPath oDir) dirs
171 pure (catMaybes externPaths)
173loadModules
174 :: (Ide m, MonadError PscIdeError m, MonadLogger m)
175 => [P.ModuleName]
176 -> m Success
177loadModules mns = do
178 oDir <- outputDirectory
179 let efPaths = map (\mn -> oDir </> P.runModuleName mn </> "externs.json") mns
180 efiles <- traverse readExternFile efPaths
181 traverse_ insertExterns efiles
182 --TODO Get rid of this once ModuleOld is gone
183 traverse_ insertModule efiles
184 populateStage2
185 pure (TextResult ("Loaded " <> foldMap runModuleNameT mns <> "."))
187loadAllModules :: (Ide m, MonadError PscIdeError m) => m Success
188loadAllModules = do
189 exts <- traverse readExternFile =<< findAllExterns
190 traverse_ insertExterns exts
191 --TODO Get rid of this once ModuleOld is gone
192 traverse_ insertModule exts
193 env <- ask
194 _ <- liftIO $ async (runStdoutLoggingT (runReaderT populateStage2 env))
195 pure (TextResult "All modules loaded.")