git.iko.soy/rowtype-yoga/purescript-native
on ca98825 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Ide.hs
242 lines 9.7 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 -- for tests
22 , printModules
23 ) where
25import Prelude ()
26import Prelude.Compat
28import Control.Monad (unless)
29import Control.Monad.Error.Class
30import Control.Monad.IO.Class
31import "monad-logger" Control.Monad.Logger
32import Control.Monad.Reader.Class
33import Data.Foldable
34import qualified Data.Map.Lazy as M
35import Data.Maybe (catMaybes, mapMaybe)
36import Data.Monoid
37import Data.Text (Text)
38import qualified Data.Text as T
39import qualified Language.PureScript.Ide.CaseSplit as CS
40import Language.PureScript.Ide.Command
41import Language.PureScript.Ide.Completion
42import Language.PureScript.Ide.Error
43import Language.PureScript.Ide.Externs
44import Language.PureScript.Ide.Filter
45import Language.PureScript.Ide.Imports hiding (Import)
46import Language.PureScript.Ide.Matcher
47import Language.PureScript.Ide.Pursuit
48import Language.PureScript.Ide.Rebuild
49import Language.PureScript.Ide.Reexports
50import Language.PureScript.Ide.SourceFile
51import Language.PureScript.Ide.State
52import Language.PureScript.Ide.Types
53import Language.PureScript.Ide.Util
54import System.Directory
55import System.Exit
56import System.FilePath
58handleCommand :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
59 Command -> m Success
60handleCommand (Load [] []) = loadAllModules
61handleCommand (Load modules deps) =
62 loadModulesAndDeps modules deps
63handleCommand (Type search filters) =
64 findType search filters
65handleCommand (Complete filters matcher) =
66 findCompletions filters matcher
67handleCommand (Pursuit query Package) =
68 findPursuitPackages query
69handleCommand (Pursuit query Identifier) =
70 findPursuitCompletions query
71handleCommand (List LoadedModules) =
72 printModules
73handleCommand (List AvailableModules) =
74 listAvailableModules
75handleCommand (List (Imports fp)) =
76 importsForFile fp
77handleCommand (CaseSplit l b e wca t) =
78 caseSplit l b e wca t
79handleCommand (AddClause l wca) =
80 pure $ addClause l wca
81handleCommand (Import fp outfp _ (AddImplicitImport mn)) = do
82 rs <- addImplicitImport fp mn
83 answerRequest outfp rs
84handleCommand (Import fp outfp filters (AddImportForIdentifier ident)) = do
85 rs <- addImportForIdentifier fp ident filters
86 case rs of
87 Right rs' -> answerRequest outfp rs'
88 Left question -> pure $ CompletionResult (mapMaybe completionFromMatch question)
89handleCommand (Rebuild file) =
90 rebuildFile file
91handleCommand Cwd =
92 TextResult . T.pack <$> liftIO getCurrentDirectory
93handleCommand Reset = resetPscIdeState *> pure (TextResult "State has been reset.")
94handleCommand Quit = liftIO exitSuccess
96findCompletions :: (PscIde m, MonadLogger m) =>
97 [Filter] -> Matcher -> m Success
98findCompletions filters matcher =
99 CompletionResult . mapMaybe completionFromMatch . getCompletions filters matcher <$> getAllModulesWithReexports
101findType :: (PscIde m, MonadLogger m) =>
102 DeclIdent -> [Filter] -> m Success
103findType search filters =
104 CompletionResult . mapMaybe completionFromMatch . getExactMatches search filters <$> getAllModulesWithReexports
106findPursuitCompletions :: (MonadIO m, MonadLogger m) =>
107 PursuitQuery -> m Success
108findPursuitCompletions (PursuitQuery q) =
109 PursuitResult <$> liftIO (searchPursuitForDeclarations q)
111findPursuitPackages :: (MonadIO m, MonadLogger m) =>
112 PursuitQuery -> m Success
113findPursuitPackages (PursuitQuery q) =
114 PursuitResult <$> liftIO (findPackagesForModuleIdent q)
116loadExtern ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>
117 FilePath -> m ()
118loadExtern fp = do
119 m <- readExternFile fp
120 insertModule m
122printModules :: (PscIde m) => m Success
123printModules = printModules' <$> getPscIdeState
125printModules' :: M.Map ModuleIdent [ExternDecl] -> Success
126printModules' = ModuleList . M.keys
128listAvailableModules :: PscIde m => m Success
129listAvailableModules = do
130 outputPath <- confOutputPath . envConfiguration <$> ask
131 liftIO $ do
132 cwd <- getCurrentDirectory
133 dirs <- getDirectoryContents (cwd </> outputPath)
134 return (ModuleList (listAvailableModules' dirs))
136listAvailableModules' :: [FilePath] -> [Text]
137listAvailableModules' dirs =
138 let cleanedModules = filter (`notElem` [".", ".."]) dirs
139 in map T.pack cleanedModules
141caseSplit :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
142 Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success
143caseSplit l b e csa t = do
144 patterns <- CS.makePattern l b e csa <$> CS.caseSplit t
145 pure (MultilineTextResult patterns)
147addClause :: Text -> CS.WildcardAnnotations -> Success
148addClause t wca = MultilineTextResult (CS.addClause t wca)
150importsForFile :: (MonadIO m, MonadLogger m, MonadError PscIdeError m) =>
151 FilePath -> m Success
152importsForFile fp = do
153 imports <- getImportsForFile fp
154 pure (ImportList imports)
156-- | The first argument is a set of modules to load. The second argument
157-- denotes modules for which to load dependencies
158loadModulesAndDeps :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
159 [ModuleIdent] -> [ModuleIdent] -> m Success
160loadModulesAndDeps mods deps = do
161 r1 <- mapM loadModule (mods ++ deps)
162 r2 <- mapM loadModuleDependencies deps
163 let moduleResults = T.concat r1
164 let dependencyResults = T.concat r2
165 pure (TextResult (moduleResults <> ", " <> dependencyResults))
167loadModuleDependencies ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>
168 ModuleIdent -> m Text
169loadModuleDependencies moduleName = do
170 m <- getModule moduleName
171 case getDependenciesForModule <$> m of
172 Just deps -> do
173 mapM_ loadModule deps
174 -- We need to load the modules, that get reexported from the dependencies
175 depModules <- catMaybes <$> mapM getModule deps
176 -- What to do with errors here? This basically means a reexported dependency
177 -- doesn't exist in the output/ folder
178 traverse_ loadReexports depModules
179 pure ("Dependencies for " <> moduleName <> " loaded.")
180 Nothing -> throwError (ModuleNotFound moduleName)
182loadReexports :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
183 Module -> m [ModuleIdent]
184loadReexports m = case getReexports m of
185 [] -> pure []
186 exportDeps -> do
187 -- I'm fine with this crashing on a failed pattern match.
188 -- If this ever fails I'll need to look at GADTs
189 let reexports = map (\(Export mn) -> mn) exportDeps
190 $(logDebug) ("Loading reexports for module: " <> fst m <>
191 " reexports: " <> T.intercalate ", " reexports)
192 traverse_ loadModule reexports
193 exportDepsModules <- catMaybes <$> traverse getModule reexports
194 exportDepDeps <- traverse loadReexports exportDepsModules
195 return $ concat exportDepDeps
197getDependenciesForModule :: Module -> [ModuleIdent]
198getDependenciesForModule (_, decls) = mapMaybe getDependencyName decls
199 where getDependencyName (Dependency dependencyName _ _) = Just dependencyName
200 getDependencyName _ = Nothing
202loadModule :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
203 ModuleIdent -> m Text
204loadModule "Prim" = pure "Prim won't be loaded"
205loadModule mn = do
206 path <- filePathFromModule mn
207 loadExtern path
208 $(logDebug) ("Loaded extern file at: " <> T.pack path)
209 pure ("Loaded extern file at: " <> T.pack path)
211loadAllModules :: (PscIde m, MonadLogger m, MonadError PscIdeError m) => m Success
212loadAllModules = do
213 outputPath <- confOutputPath . envConfiguration <$> ask
214 cwd <- liftIO getCurrentDirectory
215 let outputDirectory = cwd </> outputPath
216 liftIO (doesDirectoryExist outputDirectory)
217 >>= flip unless (throwError (GeneralError "Couldn't locate your output directory"))
218 liftIO (getDirectoryContents outputDirectory)
219 >>= liftIO . traverse (getExternsPath outputDirectory)
220 >>= traverse_ loadExtern . catMaybes
221 pure (TextResult "All modules loaded.")
222 where
223 getExternsPath :: FilePath -> FilePath -> IO (Maybe FilePath)
224 getExternsPath outputDirectory d
225 | d `elem` [".", ".."] = pure Nothing
226 | otherwise = do
227 let file = outputDirectory </> d </> "externs.json"
228 ex <- doesFileExist file
229 if ex
230 then pure (Just file)
231 else pure Nothing
233filePathFromModule :: (PscIde m, MonadError PscIdeError m) =>
234 ModuleIdent -> m FilePath
235filePathFromModule moduleName = do
236 outputPath <- confOutputPath . envConfiguration <$> ask
237 cwd <- liftIO getCurrentDirectory
238 let path = cwd </> outputPath </> T.unpack moduleName </> "externs.json"
239 ex <- liftIO $ doesFileExist path
240 if ex
241 then pure path
242 else throwError (ModuleFileNotFound moduleName)