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