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