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