@@ -0,0 +1,199 @@
1+{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
4+{-# LANGUAGE OverloadedStrings #-}
5+{-# LANGUAGE PackageImports #-}
6+{-# LANGUAGE TemplateHaskell #-}
7+{-# LANGUAGE TupleSections #-}
9+module Language.PureScript.Ide where
14+import Control.Monad.Error.Class
15+import Control.Monad.IO.Class
16+import "monad-logger" Control.Monad.Logger
17+import Control.Monad.Reader.Class
19+import qualified Data.Map.Lazy as M
20+import Data.Maybe (catMaybes, mapMaybe)
22+import Data.Text (Text)
23+import qualified Data.Text as T
24+import qualified Language.PureScript.Ide.CaseSplit as CS
25+import Language.PureScript.Ide.Command
26+import Language.PureScript.Ide.Completion
27+import Language.PureScript.Ide.Error
28+import Language.PureScript.Ide.Externs
29+import Language.PureScript.Ide.Filter
30+import Language.PureScript.Ide.Matcher
31+import Language.PureScript.Ide.Pursuit
32+import Language.PureScript.Ide.Reexports
33+import Language.PureScript.Ide.SourceFile
34+import Language.PureScript.Ide.State
35+import Language.PureScript.Ide.Types
36+import System.Directory
37+import System.FilePath
41+handleCommand :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
43+handleCommand (Load modules deps) =
44+ loadModulesAndDeps modules deps
45+handleCommand (Type search filters) =
46+ findType search filters
47+handleCommand (Complete filters matcher) =
48+ findCompletions filters matcher
49+handleCommand (Pursuit query Package) =
50+ findPursuitPackages query
51+handleCommand (Pursuit query Identifier) =
52+ findPursuitCompletions query
53+handleCommand (List LoadedModules) =
55+handleCommand (List AvailableModules) =
57+handleCommand (List (Imports fp)) =
59+handleCommand (CaseSplit l b e wca t) =
60+ caseSplit l b e wca t
61+handleCommand (AddClause l wca) =
62+ pure $ addClause l wca
64+ TextResult . T.pack <$> liftIO getCurrentDirectory
65+handleCommand Quit = liftIO exitSuccess
67+findCompletions :: (PscIde m, MonadLogger m) =>
68+ [Filter] -> Matcher -> m Success
69+findCompletions filters matcher =
70+ CompletionResult . getCompletions filters matcher <$> getAllModulesWithReexports
72+findType :: (PscIde m, MonadLogger m) =>
73+ DeclIdent -> [Filter] -> m Success
74+findType search filters =
75+ CompletionResult . getExactMatches search filters <$> getAllModulesWithReexports
77+findPursuitCompletions :: (Applicative m, MonadIO m, MonadLogger m) =>
78+ PursuitQuery -> m Success
79+findPursuitCompletions (PursuitQuery q) =
80+ PursuitResult <$> liftIO (searchPursuitForDeclarations q)
82+findPursuitPackages :: (Applicative m, MonadIO m, MonadLogger m) =>
83+ PursuitQuery -> m Success
84+findPursuitPackages (PursuitQuery q) =
85+ PursuitResult <$> liftIO (findPackagesForModuleIdent q)
87+loadExtern ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>
90+ m <- readExternFile fp
93+printModules :: (PscIde m) => m Success
94+printModules = printModules' <$> getPscIdeState
96+printModules' :: M.Map ModuleIdent [ExternDecl] -> Success
97+printModules' = ModuleList . M.keys
99+listAvailableModules :: PscIde m => m Success
100+listAvailableModules = do
101+ outputPath <- confOutputPath . envConfiguration <$> ask
103+ cwd <- getCurrentDirectory
104+ dirs <- getDirectoryContents (cwd </> outputPath)
105+ return (ModuleList (listAvailableModules' dirs))
107+listAvailableModules' :: [FilePath] -> [Text]
108+listAvailableModules' dirs =
109+ let cleanedModules = filter (`notElem` [".", ".."]) dirs
110+ in map T.pack cleanedModules
112+caseSplit :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
113+ Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success
114+caseSplit l b e csa t = do
115+ patterns <- CS.makePattern l b e csa <$> CS.caseSplit t
116+ pure (MultilineTextResult patterns)
118+addClause :: Text -> CS.WildcardAnnotations -> Success
119+addClause t wca = MultilineTextResult (CS.addClause t wca)
121+importsForFile :: (Applicative m, MonadIO m, MonadLogger m, MonadError PscIdeError m) =>
122+ FilePath -> m Success
123+importsForFile fp = do
124+ imports <- getImportsForFile fp
125+ pure (ImportList imports)
127+-- | The first argument is a set of modules to load. The second argument
128+-- denotes modules for which to load dependencies
129+loadModulesAndDeps :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
130+ [ModuleIdent] -> [ModuleIdent] -> m Success
131+loadModulesAndDeps mods deps = do
132+ r1 <- mapM loadModule (mods ++ deps)
133+ r2 <- mapM loadModuleDependencies deps
134+ let moduleResults = T.concat r1
135+ let dependencyResults = T.concat r2
136+ pure (TextResult (moduleResults <> ", " <> dependencyResults))
138+loadModuleDependencies ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>
139+ ModuleIdent -> m Text
140+loadModuleDependencies moduleName = do
141+ m <- getModule moduleName
142+ case getDependenciesForModule <$> m of
144+ mapM_ loadModule deps
145+ -- We need to load the modules, that get reexported from the dependencies
146+ depModules <- catMaybes <$> mapM getModule deps
147+ -- What to do with errors here? This basically means a reexported dependency
148+ -- doesn't exist in the output/ folder
149+ traverse_ loadReexports depModules
150+ pure ("Dependencies for " <> moduleName <> " loaded.")
151+ Nothing -> throwError (ModuleNotFound moduleName)
153+loadReexports :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
154+ Module -> m [ModuleIdent]
155+loadReexports m = case getReexports m of
158+ -- I'm fine with this crashing on a failed pattern match.
159+ -- If this ever fails I'll need to look at GADTs
160+ let reexports = map (\(Export mn) -> mn) exportDeps
161+ $(logDebug) ("Loading reexports for module: " <> fst m <>
162+ " reexports: " <> T.intercalate ", " reexports)
163+ traverse_ loadModule reexports
164+ exportDepsModules <- catMaybes <$> traverse getModule reexports
165+ exportDepDeps <- traverse loadReexports exportDepsModules
166+ return $ concat exportDepDeps
168+getDependenciesForModule :: Module -> [ModuleIdent]
169+getDependenciesForModule (_, decls) = mapMaybe getDependencyName decls
170+ where getDependencyName (Dependency dependencyName _ _) = Just dependencyName
171+ getDependencyName _ = Nothing
173+loadModule :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
174+ ModuleIdent -> m Text
175+loadModule "Prim" = pure "Prim won't be loaded"
177+ path <- filePathFromModule mn
179+ $(logDebug) ("Loaded extern file at: " <> T.pack path)
180+ pure ("Loaded extern file at: " <> T.pack path)
182+filePathFromModule :: (PscIde m, MonadError PscIdeError m) =>
183+ ModuleIdent -> m FilePath
184+filePathFromModule moduleName = do
185+ outputPath <- confOutputPath . envConfiguration <$> ask
186+ cwd <- liftIO getCurrentDirectory
187+ let path = cwd </> outputPath </> T.unpack moduleName </> "externs.json"
188+ ex <- liftIO $ doesFileExist path
191+ else throwError (ModuleFileNotFound moduleName)
193+-- | Taken from Data.Either.Utils
194+maybeToEither :: MonadError e m =>
195+ e -- ^ (Left e) will be returned if the Maybe value is Nothing
196+ -> Maybe a -- ^ (Right a) will be returned if this is (Just a)
198+maybeToEither errorval Nothing = throwError errorval
199+maybeToEither _ (Just normalval) = return normalval