@@ -14,7 +14,6 @@
1414
1515{-# LANGUAGE OverloadedStrings #-}
1616{-# LANGUAGE PackageImports #-}
17−{-# LANGUAGE TemplateHaskell #-}
1817
1918module Language.PureScript.Ide
2019 ( handleCommand
@@ -25,14 +24,13 @@ module Language.PureScript.Ide
2524import Prelude ()
2625import Prelude.Compat
2726
28−import Control.Monad (unless)
27+import Control.Concurrent.Async
2928import Control.Monad.Error.Class
3029import Control.Monad.IO.Class
3130import "monad-logger" Control.Monad.Logger
32−import Control.Monad.Reader.Class
31+import Control.Monad.Reader
3332import Data.Foldable
34−import qualified Data.Map.Lazy as M
35−import Data.Maybe (catMaybes, mapMaybe)
33+import Data.Maybe (catMaybes)
3634import Data.Monoid
3735import Data.Text (Text)
3836import qualified Data.Text as T
@@ -47,7 +45,6 @@ import Language.PureScript.Ide.Imports hiding (Import)
4745import Language.PureScript.Ide.Matcher
4846import Language.PureScript.Ide.Pursuit
4947import Language.PureScript.Ide.Rebuild
50−import Language.PureScript.Ide.Reexports
5148import Language.PureScript.Ide.SourceFile
5249import Language.PureScript.Ide.State
5350import Language.PureScript.Ide.Types
@@ -56,11 +53,10 @@ import System.Directory
5653import System.Exit
5754import System.FilePath
5855
59−handleCommand :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
56+handleCommand :: (Ide m, MonadLogger m, MonadError PscIdeError m) =>
6057 Command -> m Success
61−handleCommand (Load [] []) = loadAllModules
62−handleCommand (Load modules deps) =
63− loadModulesAndDeps modules deps
58+handleCommand (Load []) = loadAllModules
59+handleCommand (Load modules) = loadModules modules
6460handleCommand (Type search filters currentModule) =
6561 findType search filters currentModule
6662handleCommand (Complete filters matcher currentModule) =
@@ -78,7 +74,7 @@ handleCommand (List (Imports fp)) =
7874handleCommand (CaseSplit l b e wca t) =
7975 caseSplit l b e wca t
8076handleCommand (AddClause l wca) =
81− pure $ addClause l wca
77+ addClause l wca
8278handleCommand (Import fp outfp _ (AddImplicitImport mn)) = do
8379 rs <- addImplicitImport fp mn
8480 answerRequest outfp rs
@@ -86,25 +82,25 @@ handleCommand (Import fp outfp filters (AddImportForIdentifier ident)) = do
8682 rs <- addImportForIdentifier fp ident filters
8783 case rs of
8884 Right rs' -> answerRequest outfp rs'
89− Left question -> pure $ CompletionResult (mapMaybe completionFromMatch question)
85+ Left question -> pure $ CompletionResult (map completionFromMatch question)
9086handleCommand (Rebuild file) =
9187 rebuildFile file
9288handleCommand Cwd =
9389 TextResult . T.pack <$> liftIO getCurrentDirectory
94−handleCommand Reset = resetPscIdeState *> pure (TextResult "State has been reset.")
90+handleCommand Reset = resetIdeState *> pure (TextResult "State has been reset.")
9591handleCommand Quit = liftIO exitSuccess
9692
97−findCompletions :: (PscIde m) =>
93+findCompletions :: (Ide m) =>
9894 [Filter] -> Matcher -> Maybe P.ModuleName -> m Success
9995findCompletions filters matcher currentModule = do
100− modules <- getAllModulesWithReexportsAndCache currentModule
101− pure . CompletionResult . mapMaybe completionFromMatch . getCompletions filters matcher $ modules
96+ modules <- getAllModules2 currentModule
97+ pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules
10298
103−findType :: (PscIde m) =>
104− DeclIdent -> [Filter] -> Maybe P.ModuleName -> m Success
99+findType :: (Ide m) =>
100+ Text -> [Filter] -> Maybe P.ModuleName -> m Success
105101findType search filters currentModule = do
106− modules <- getAllModulesWithReexportsAndCache currentModule
107− pure . CompletionResult . mapMaybe completionFromMatch . getExactMatches search filters $ modules
102+ modules <- getAllModules2 currentModule
103+ pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules
108104
109105findPursuitCompletions :: (MonadIO m) =>
110106 PursuitQuery -> m Success
@@ -116,39 +112,35 @@ findPursuitPackages :: (MonadIO m) =>
116112findPursuitPackages (PursuitQuery q) =
117113 PursuitResult <$> liftIO (findPackagesForModuleIdent q)
118114
119−loadExtern :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
120− FilePath -> m ()
121−loadExtern fp = do
122− m <- readExternFile fp
123− insertModule m
115+printModules :: (Ide m) => m Success
116+printModules = ModuleList . map runModuleNameT <$> getLoadedModulenames
124117
125−printModules :: (PscIde m) => m Success
126−printModules = printModules' . pscIdeStateModules <$> getPscIdeState
127−
128−printModules' :: M.Map ModuleIdent [ExternDecl] -> Success
129−printModules' = ModuleList . M.keys
118+outputDirectory :: Ide m => m FilePath
119+outputDirectory = do
120+ outputPath <- confOutputPath . ideConfiguration <$> ask
121+ cwd <- liftIO getCurrentDirectory
122+ pure (cwd </> outputPath)
130123
131−listAvailableModules :: PscIde m => m Success
124+listAvailableModules :: Ide m => m Success
132125listAvailableModules = do
133− outputPath <- confOutputPath . envConfiguration <$> ask
126+ oDir <- outputDirectory
134127 liftIO $ do
135− cwd <- getCurrentDirectory
136− dirs <- getDirectoryContents (cwd </> outputPath)
137− return (ModuleList (listAvailableModules' dirs))
138−
139−listAvailableModules' :: [FilePath] -> [Text]
140−listAvailableModules' dirs =
141− let cleanedModules = filter (`notElem` [".", ".."]) dirs
142− in map T.pack cleanedModules
128+ contents <- getDirectoryContents oDir
129+ let cleaned = filter (`notElem` [".", ".."]) contents
130+ return (ModuleList (map T.pack cleaned))
143131
144−caseSplit :: (PscIde m, MonadError PscIdeError m) =>
132+caseSplit :: (Ide m, MonadError PscIdeError m) =>
145133 Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success
146134caseSplit l b e csa t = do
147135 patterns <- CS.makePattern l b e csa <$> CS.caseSplit t
148136 pure (MultilineTextResult patterns)
149137
150−addClause :: Text -> CS.WildcardAnnotations -> Success
151−addClause t wca = MultilineTextResult (CS.addClause t wca)
138+addClause
139+ :: (MonadError PscIdeError m)
140+ => Text
141+ -> CS.WildcardAnnotations
142+ -> m Success
143+addClause t wca = MultilineTextResult <$> CS.addClause t wca
152144
153145importsForFile :: (MonadIO m, MonadError PscIdeError m) =>
154146 FilePath -> m Success
@@ -156,90 +148,48 @@ importsForFile fp = do
156148 imports <- getImportsForFile fp
157149 pure (ImportList imports)
158150
159−-- | The first argument is a set of modules to load. The second argument
160−-- denotes modules for which to load dependencies
161−loadModulesAndDeps :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
162− [ModuleIdent] -> [ModuleIdent] -> m Success
163−loadModulesAndDeps 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))
169−
170−loadModuleDependencies ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>
171− ModuleIdent -> m Text
172−loadModuleDependencies 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)
184−
185−loadReexports :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
186− Module -> m [ModuleIdent]
187−loadReexports 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
199−
200−getDependenciesForModule :: Module -> [ModuleIdent]
201−getDependenciesForModule (_, decls) = mapMaybe getDependencyName decls
202− where getDependencyName (Dependency dependencyName _ _) = Just dependencyName
203− getDependencyName _ = Nothing
204−
205−loadModule :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
206− ModuleIdent -> m Text
207−loadModule "Prim" = pure "Prim won't be loaded"
208−loadModule 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)
213−
214−loadAllModules :: (PscIde m, MonadLogger m, MonadError PscIdeError m) => m Success
151+-- | Takes the output directory and a filepath like "Monad.Control.Eff" and
152+-- looks up, whether that folder contains an externs.json
153+checkExternsPath :: FilePath -> FilePath -> IO (Maybe FilePath)
154+checkExternsPath oDir d
155+ | d `elem` [".", ".."] = pure Nothing
156+ | otherwise = do
157+ let file = oDir </> d </> "externs.json"
158+ ex <- doesFileExist file
159+ if ex
160+ then pure (Just file)
161+ else pure Nothing
162+
163+findAllExterns :: (Ide m, MonadError PscIdeError m) => m [FilePath]
164+findAllExterns = do
165+ oDir <- outputDirectory
166+ unlessM (liftIO (doesDirectoryExist oDir))
167+ (throwError (GeneralError "Couldn't locate your output directory."))
168+ liftIO $ do
169+ dirs <- getDirectoryContents oDir
170+ externPaths <- traverse (checkExternsPath oDir) dirs
171+ pure (catMaybes externPaths)
172+
173+loadModules
174+ :: (Ide m, MonadError PscIdeError m, MonadLogger m)
175+ => [P.ModuleName]
176+ -> m Success
177+loadModules mns = do
178+ oDir <- outputDirectory
179+ let efPaths = map (\mn -> oDir </> P.runModuleName mn </> "externs.json") mns
180+ efiles <- traverse readExternFile efPaths
181+ traverse_ insertExterns efiles
182+ --TODO Get rid of this once ModuleOld is gone
183+ traverse_ insertModule efiles
184+ populateStage2
185+ pure (TextResult ("Loaded " <> foldMap runModuleNameT mns <> "."))
186+
187+loadAllModules :: (Ide m, MonadError PscIdeError m) => m Success
215188loadAllModules = 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
189+ exts <- traverse readExternFile =<< findAllExterns
190+ traverse_ insertExterns exts
191+ --TODO Get rid of this once ModuleOld is gone
192+ traverse_ insertModule exts
193+ env <- ask
194+ _ <- liftIO $ async (runStdoutLoggingT (runReaderT populateStage2 env))
224195 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
235−
236−filePathFromModule :: (PscIde m, MonadError PscIdeError m) =>
237− ModuleIdent -> m FilePath
238−filePathFromModule 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)