module Language.PureScript.Ide
( handleCommand
) where
import Protolude
import "monad-logger" Control.Monad.Logger
import qualified Language.PureScript as P
import qualified Language.PureScript.Ide.CaseSplit as CS
import Language.PureScript.Ide.Command
import Language.PureScript.Ide.Completion
import Language.PureScript.Ide.Error
import Language.PureScript.Ide.Externs
import Language.PureScript.Ide.Filter
import Language.PureScript.Ide.Imports hiding (Import)
import Language.PureScript.Ide.Matcher
import Language.PureScript.Ide.Pursuit
import Language.PureScript.Ide.Rebuild
import Language.PureScript.Ide.SourceFile
import Language.PureScript.Ide.State
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
import System.Directory (getCurrentDirectory, getDirectoryContents, doesDirectoryExist, doesFileExist)
import System.FilePath ((</>))
import System.FilePath.Glob (glob)
handleCommand :: (Ide m, MonadLogger m, MonadError IdeError m) =>
Command -> m Success
handleCommand c = case c of
Load [] ->
findAvailableExterns >>= loadModulesAsync
Load modules ->
loadModulesAsync modules
LoadSync [] ->
findAvailableExterns >>= loadModulesSync
LoadSync modules ->
loadModulesSync modules
Type search filters currentModule ->
findType search filters currentModule
Complete filters matcher currentModule ->
findCompletions filters matcher currentModule
Pursuit query Package ->
findPursuitPackages query
Pursuit query Identifier ->
findPursuitCompletions query
List LoadedModules ->
printModules
List AvailableModules ->
listAvailableModules
List (Imports fp) ->
ImportList <$> parseImportsFromFile fp
CaseSplit l b e wca t ->
caseSplit l b e wca t
AddClause l wca ->
MultilineTextResult <$> CS.addClause l wca
Import fp outfp _ (AddImplicitImport mn) -> do
rs <- addImplicitImport fp mn
answerRequest outfp rs
Import fp outfp filters (AddImportForIdentifier ident) -> do
rs <- addImportForIdentifier fp ident filters
case rs of
Right rs' -> answerRequest outfp rs'
Left question ->
pure (CompletionResult (map (completionFromMatch . map withEmptyAnn) question))
Rebuild file ->
rebuildFileAsync file
RebuildSync file ->
rebuildFileSync file
Cwd ->
TextResult . toS <$> liftIO getCurrentDirectory
Reset ->
resetIdeState $> TextResult "State has been reset."
Quit ->
liftIO exitSuccess
findCompletions :: Ide m =>
[Filter] -> Matcher IdeDeclarationAnn -> Maybe P.ModuleName -> m Success
findCompletions filters matcher currentModule = do
modules <- getAllModules currentModule
pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules
findType :: Ide m =>
Text -> [Filter] -> Maybe P.ModuleName -> m Success
findType search filters currentModule = do
modules <- getAllModules currentModule
pure . CompletionResult . map completionFromMatch . getExactMatches search filters $ modules
findPursuitCompletions :: MonadIO m =>
PursuitQuery -> m Success
findPursuitCompletions (PursuitQuery q) =
PursuitResult <$> liftIO (searchPursuitForDeclarations q)
findPursuitPackages :: MonadIO m =>
PursuitQuery -> m Success
findPursuitPackages (PursuitQuery q) =
PursuitResult <$> liftIO (findPackagesForModuleIdent q)
printModules :: Ide m => m Success
printModules = ModuleList . map P.runModuleName <$> getLoadedModulenames
outputDirectory :: Ide m => m FilePath
outputDirectory = do
outputPath <- confOutputPath . ideConfiguration <$> ask
cwd <- liftIO getCurrentDirectory
pure (cwd </> outputPath)
listAvailableModules :: Ide m => m Success
listAvailableModules = do
oDir <- outputDirectory
liftIO $ do
contents <- getDirectoryContents oDir
let cleaned = filter (`notElem` [".", ".."]) contents
return (ModuleList (map toS cleaned))
caseSplit :: (Ide m, MonadError IdeError m) =>
Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success
caseSplit l b e csa t = do
patterns <- CS.makePattern l b e csa <$> CS.caseSplit t
pure (MultilineTextResult patterns)
findAvailableExterns :: (Ide m, MonadError IdeError m) => m [P.ModuleName]
findAvailableExterns = do
oDir <- outputDirectory
unlessM (liftIO (doesDirectoryExist oDir))
(throwError (GeneralError "Couldn't locate your output directory."))
liftIO $ do
directories <- getDirectoryContents oDir
moduleNames <- filterM (containsExterns oDir) directories
pure (P.moduleNameFromString . toS <$> moduleNames)
where
containsExterns :: FilePath -> FilePath -> IO Bool
containsExterns oDir d
| d `elem` [".", ".."] = pure False
| otherwise = do
let file = oDir </> d </> "externs.json"
doesFileExist file
findAllSourceFiles :: Ide m => m [FilePath]
findAllSourceFiles = do
globs <- confGlobs . ideConfiguration <$> ask
liftIO (concatMapM glob globs)
loadModulesAsync
:: (Ide m, MonadError IdeError m, MonadLogger m)
=> [P.ModuleName]
-> m Success
loadModulesAsync moduleNames = do
tr <- loadModules moduleNames
env <- ask
let ll = confLogLevel (ideConfiguration env)
_ <- liftIO (async (runLogger ll (runReaderT (populateStage2 *> populateStage3) env)))
pure tr
loadModulesSync
:: (Ide m, MonadError IdeError m, MonadLogger m)
=> [P.ModuleName]
-> m Success
loadModulesSync moduleNames = do
tr <- loadModules moduleNames
populateStage2 *> populateStage3
pure tr
loadModules
:: (Ide m, MonadError IdeError m, MonadLogger m)
=> [P.ModuleName]
-> m Success
loadModules moduleNames = do
oDir <- outputDirectory
let efPaths =
map (\mn -> oDir </> toS (P.runModuleName mn) </> "externs.json") moduleNames
efiles <- traverse readExternFile efPaths
traverse_ insertExterns efiles
(failures, allModules) <-
partitionEithers <$> (traverse parseModule =<< findAllSourceFiles)
unless (null failures) $
$(logWarn) ("Failed to parse: " <> show failures)
traverse_ insertModule allModules
pure (TextResult ("Loaded " <> show (length efiles) <> " modules and "
<> show (length allModules) <> " source files."))