git.iko.soy/rowtype-yoga/purescript-native
on 447c7a0 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Ide.hs
241 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 Quit = liftIO exitSuccess
95findCompletions :: (PscIde m, MonadLogger m) =>
96 [Filter] -> Matcher -> m Success
97findCompletions filters matcher =
98 CompletionResult . mapMaybe completionFromMatch . getCompletions filters matcher <$> getAllModulesWithReexports
100findType :: (PscIde m, MonadLogger m) =>
101 DeclIdent -> [Filter] -> m Success
102findType search filters =
103 CompletionResult . mapMaybe completionFromMatch . getExactMatches search filters <$> getAllModulesWithReexports
105findPursuitCompletions :: (MonadIO m, MonadLogger m) =>
106 PursuitQuery -> m Success
107findPursuitCompletions (PursuitQuery q) =
108 PursuitResult <$> liftIO (searchPursuitForDeclarations q)
110findPursuitPackages :: (MonadIO m, MonadLogger m) =>
111 PursuitQuery -> m Success
112findPursuitPackages (PursuitQuery q) =
113 PursuitResult <$> liftIO (findPackagesForModuleIdent q)
115loadExtern ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>
116 FilePath -> m ()
117loadExtern fp = do
118 m <- readExternFile fp
119 insertModule m
121printModules :: (PscIde m) => m Success
122printModules = printModules' <$> getPscIdeState
124printModules' :: M.Map ModuleIdent [ExternDecl] -> Success
125printModules' = ModuleList . M.keys
127listAvailableModules :: PscIde m => m Success
128listAvailableModules = do
129 outputPath <- confOutputPath . envConfiguration <$> ask
130 liftIO $ do
131 cwd <- getCurrentDirectory
132 dirs <- getDirectoryContents (cwd </> outputPath)
133 return (ModuleList (listAvailableModules' dirs))
135listAvailableModules' :: [FilePath] -> [Text]
136listAvailableModules' dirs =
137 let cleanedModules = filter (`notElem` [".", ".."]) dirs
138 in map T.pack cleanedModules
140caseSplit :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
141 Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success
142caseSplit l b e csa t = do
143 patterns <- CS.makePattern l b e csa <$> CS.caseSplit t
144 pure (MultilineTextResult patterns)
146addClause :: Text -> CS.WildcardAnnotations -> Success
147addClause t wca = MultilineTextResult (CS.addClause t wca)
149importsForFile :: (MonadIO m, MonadLogger m, MonadError PscIdeError m) =>
150 FilePath -> m Success
151importsForFile fp = do
152 imports <- getImportsForFile fp
153 pure (ImportList imports)
155-- | The first argument is a set of modules to load. The second argument
156-- denotes modules for which to load dependencies
157loadModulesAndDeps :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
158 [ModuleIdent] -> [ModuleIdent] -> m Success
159loadModulesAndDeps mods deps = do
160 r1 <- mapM loadModule (mods ++ deps)
161 r2 <- mapM loadModuleDependencies deps
162 let moduleResults = T.concat r1
163 let dependencyResults = T.concat r2
164 pure (TextResult (moduleResults <> ", " <> dependencyResults))
166loadModuleDependencies ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>
167 ModuleIdent -> m Text
168loadModuleDependencies moduleName = do
169 m <- getModule moduleName
170 case getDependenciesForModule <$> m of
171 Just deps -> do
172 mapM_ loadModule deps
173 -- We need to load the modules, that get reexported from the dependencies
174 depModules <- catMaybes <$> mapM getModule deps
175 -- What to do with errors here? This basically means a reexported dependency
176 -- doesn't exist in the output/ folder
177 traverse_ loadReexports depModules
178 pure ("Dependencies for " <> moduleName <> " loaded.")
179 Nothing -> throwError (ModuleNotFound moduleName)
181loadReexports :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
182 Module -> m [ModuleIdent]
183loadReexports m = case getReexports m of
184 [] -> pure []
185 exportDeps -> do
186 -- I'm fine with this crashing on a failed pattern match.
187 -- If this ever fails I'll need to look at GADTs
188 let reexports = map (\(Export mn) -> mn) exportDeps
189 $(logDebug) ("Loading reexports for module: " <> fst m <>
190 " reexports: " <> T.intercalate ", " reexports)
191 traverse_ loadModule reexports
192 exportDepsModules <- catMaybes <$> traverse getModule reexports
193 exportDepDeps <- traverse loadReexports exportDepsModules
194 return $ concat exportDepDeps
196getDependenciesForModule :: Module -> [ModuleIdent]
197getDependenciesForModule (_, decls) = mapMaybe getDependencyName decls
198 where getDependencyName (Dependency dependencyName _ _) = Just dependencyName
199 getDependencyName _ = Nothing
201loadModule :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
202 ModuleIdent -> m Text
203loadModule "Prim" = pure "Prim won't be loaded"
204loadModule mn = do
205 path <- filePathFromModule mn
206 loadExtern path
207 $(logDebug) ("Loaded extern file at: " <> T.pack path)
208 pure ("Loaded extern file at: " <> T.pack path)
210loadAllModules :: (PscIde m, MonadLogger m, MonadError PscIdeError m) => m Success
211loadAllModules = do
212 outputPath <- confOutputPath . envConfiguration <$> ask
213 cwd <- liftIO getCurrentDirectory
214 let outputDirectory = cwd </> outputPath
215 liftIO (doesDirectoryExist outputDirectory)
216 >>= flip unless (throwError (GeneralError "Couldn't locate your output directory"))
217 liftIO (getDirectoryContents outputDirectory)
218 >>= liftIO . traverse (getExternsPath outputDirectory)
219 >>= traverse_ loadExtern . catMaybes
220 pure (TextResult "All modules loaded.")
221 where
222 getExternsPath :: FilePath -> FilePath -> IO (Maybe FilePath)
223 getExternsPath outputDirectory d
224 | d `elem` [".", ".."] = pure Nothing
225 | otherwise = do
226 let file = outputDirectory </> d </> "externs.json"
227 ex <- doesFileExist file
228 if ex
229 then pure (Just file)
230 else pure Nothing
232filePathFromModule :: (PscIde m, MonadError PscIdeError m) =>
233 ModuleIdent -> m FilePath
234filePathFromModule moduleName = do
235 outputPath <- confOutputPath . envConfiguration <$> ask
236 cwd <- liftIO getCurrentDirectory
237 let path = cwd </> outputPath </> T.unpack moduleName </> "externs.json"
238 ex <- liftIO $ doesFileExist path
239 if ex
240 then pure path
241 else throwError (ModuleFileNotFound moduleName)