-----------------------------------------------------------------------------
--
-- Module      : Language.PureScript.Ide
-- Description : Interface for the psc-ide-server
-- Copyright   : Christoph Hegemann 2016
-- License     : MIT (http://opensource.org/licenses/MIT)
--
-- Maintainer  : Christoph Hegemann <christoph.hegemann1337@gmail.com>
-- Stability   : experimental
--
-- |
-- Interface for the psc-ide-server
-----------------------------------------------------------------------------

{-# LANGUAGE PackageImports #-}

module Language.PureScript.Ide
       ( handleCommand
       ) where

import           Protolude hiding (moduleName)

import           "monad-logger" Control.Monad.Logger
import qualified Data.Map                           as Map
import qualified Data.Text                          as T
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.Imports.Actions
import           Language.PureScript.Ide.Matcher
import           Language.PureScript.Ide.Prim
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           Language.PureScript.Ide.Usage (findUsages)
import           System.Directory (getCurrentDirectory, getDirectoryContents, doesDirectoryExist, doesFileExist)
import           System.FilePath ((</>), normalise)
import           System.FilePath.Glob (glob)

-- | Accepts a Command and runs it against psc-ide's State. This is the main
-- entry point for the server.
handleCommand
  :: (Ide m, MonadLogger m, MonadError IdeError m)
  => Command
  -> m Success
handleCommand :: forall (m :: * -> *).
(Ide m, MonadLogger m, MonadError IdeError m) =>
Command -> m Success
handleCommand Command
c = case Command
c of
  Load [] ->
    -- Clearing the State before populating it to avoid a space leak
    forall (m :: * -> *). Ide m => m ()
resetIdeState forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *).
(Ide m, MonadError IdeError m) =>
m [ModuleName]
findAvailableExterns forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(Ide m, MonadError IdeError m, MonadLogger m) =>
[ModuleName] -> m Success
loadModulesAsync
  Load [ModuleName]
modules ->
    forall (m :: * -> *).
(Ide m, MonadError IdeError m, MonadLogger m) =>
[ModuleName] -> m Success
loadModulesAsync [ModuleName]
modules
  LoadSync [] ->
    forall (m :: * -> *).
(Ide m, MonadError IdeError m) =>
m [ModuleName]
findAvailableExterns forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(Ide m, MonadError IdeError m, MonadLogger m) =>
[ModuleName] -> m Success
loadModulesSync
  LoadSync [ModuleName]
modules ->
    forall (m :: * -> *).
(Ide m, MonadError IdeError m, MonadLogger m) =>
[ModuleName] -> m Success
loadModulesSync [ModuleName]
modules
  Type Text
search [Filter]
filters Maybe ModuleName
currentModule ->
    forall (m :: * -> *).
Ide m =>
Text -> [Filter] -> Maybe ModuleName -> m Success
findType Text
search [Filter]
filters Maybe ModuleName
currentModule
  Complete [Filter]
filters Matcher IdeDeclarationAnn
matcher Maybe ModuleName
currentModule CompletionOptions
complOptions ->
    forall (m :: * -> *).
Ide m =>
[Filter]
-> Matcher IdeDeclarationAnn
-> Maybe ModuleName
-> CompletionOptions
-> m Success
findCompletions [Filter]
filters Matcher IdeDeclarationAnn
matcher Maybe ModuleName
currentModule CompletionOptions
complOptions
  List ListType
LoadedModules -> do
    forall (m :: * -> *). MonadLogger m => Text -> m ()
logWarnN
      Text
"Listing the loaded modules command is DEPRECATED, use the completion command and filter it to modules instead"
    forall (m :: * -> *). Ide m => m Success
printModules
  List ListType
AvailableModules ->
    forall (m :: * -> *). Ide m => m Success
listAvailableModules
  List (Imports FilePath
fp) ->
    (ModuleName,
 [(ModuleName, ImportDeclarationType, Maybe ModuleName)])
-> Success
ImportList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
FilePath
-> m (ModuleName,
      [(ModuleName, ImportDeclarationType, Maybe ModuleName)])
parseImportsFromFile FilePath
fp
  CaseSplit Text
l Int
b Int
e WildcardAnnotations
wca Text
t ->
    forall (m :: * -> *).
(Ide m, MonadError IdeError m) =>
Text -> Int -> Int -> WildcardAnnotations -> Text -> m Success
caseSplit Text
l Int
b Int
e WildcardAnnotations
wca Text
t
  AddClause Text
l WildcardAnnotations
wca ->
    [Text] -> Success
MultilineTextResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadError IdeError m =>
Text -> WildcardAnnotations -> m [Text]
CS.addClause Text
l WildcardAnnotations
wca
  FindUsages ModuleName
moduleName Text
ident IdeNamespace
namespace -> do
    forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
moduleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Ide m =>
Maybe ModuleName -> m (ModuleMap [IdeDeclarationAnn])
getAllModules forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe [IdeDeclarationAnn]
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> IdeError
GeneralError Text
"Module not found")
      Just [IdeDeclarationAnn]
decls -> do
        case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\IdeDeclarationAnn
d -> IdeDeclaration -> IdeNamespace
namespaceForDeclaration (IdeDeclarationAnn -> IdeDeclaration
discardAnn IdeDeclarationAnn
d) forall a. Eq a => a -> a -> Bool
== IdeNamespace
namespace
                    Bool -> Bool -> Bool
&& IdeDeclaration -> Text
identifierFromIdeDeclaration (IdeDeclarationAnn -> IdeDeclaration
discardAnn IdeDeclarationAnn
d) forall a. Eq a => a -> a -> Bool
== Text
ident) [IdeDeclarationAnn]
decls of
          Maybe IdeDeclarationAnn
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> IdeError
GeneralError Text
"Declaration not found")
          Just IdeDeclarationAnn
declaration -> do
            let sourceModule :: ModuleName
sourceModule = forall a. a -> Maybe a -> a
fromMaybe ModuleName
moduleName (IdeDeclarationAnn
declaration forall a b. a -> (a -> b) -> b
& IdeDeclarationAnn -> Annotation
_idaAnnotation forall a b. a -> (a -> b) -> b
& Annotation -> Maybe ModuleName
_annExportedFrom)
            [SourceSpan] -> Success
UsagesResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Ide m =>
IdeDeclaration
-> ModuleName -> m (Map ModuleName (NonEmpty SourceSpan))
findUsages (IdeDeclarationAnn -> IdeDeclaration
discardAnn IdeDeclarationAnn
declaration) ModuleName
sourceModule
  Import FilePath
fp Maybe FilePath
outfp [Filter]
_ (AddImplicitImport ModuleName
mn) -> do
    [Text]
rs <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
FilePath -> ModuleName -> m [Text]
addImplicitImport FilePath
fp ModuleName
mn
    forall (m :: * -> *).
MonadIO m =>
Maybe FilePath -> [Text] -> m Success
answerRequest Maybe FilePath
outfp [Text]
rs
  Import FilePath
fp Maybe FilePath
outfp [Filter]
_ (AddQualifiedImport ModuleName
mn ModuleName
qual) -> do
    [Text]
rs <- forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
FilePath -> ModuleName -> ModuleName -> m [Text]
addQualifiedImport FilePath
fp ModuleName
mn ModuleName
qual
    forall (m :: * -> *).
MonadIO m =>
Maybe FilePath -> [Text] -> m Success
answerRequest Maybe FilePath
outfp [Text]
rs
  Import FilePath
fp Maybe FilePath
outfp [Filter]
filters (AddImportForIdentifier Text
ident Maybe ModuleName
qual) -> do
    Either [Match IdeDeclaration] [Text]
rs <- forall (m :: * -> *).
(Ide m, MonadError IdeError m) =>
FilePath
-> Text
-> Maybe ModuleName
-> [Filter]
-> m (Either [Match IdeDeclaration] [Text])
addImportForIdentifier FilePath
fp Text
ident Maybe ModuleName
qual [Filter]
filters
    case Either [Match IdeDeclaration] [Text]
rs of
      Right [Text]
rs' -> forall (m :: * -> *).
MonadIO m =>
Maybe FilePath -> [Text] -> m Success
answerRequest Maybe FilePath
outfp [Text]
rs'
      Left [Match IdeDeclaration]
question ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Completion] -> Success
CompletionResult (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Match IdeDeclarationAnn, [ModuleName]) -> Completion
completionFromMatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Match a -> (Match a, [ModuleName])
simpleExport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeDeclaration -> IdeDeclarationAnn
withEmptyAnn) [Match IdeDeclaration]
question))
  Rebuild FilePath
file Maybe FilePath
actualFile Set CodegenTarget
targets ->
    forall (m :: * -> *).
(Ide m, MonadLogger m, MonadError IdeError m) =>
FilePath -> Maybe FilePath -> Set CodegenTarget -> m Success
rebuildFileAsync FilePath
file Maybe FilePath
actualFile Set CodegenTarget
targets
  RebuildSync FilePath
file Maybe FilePath
actualFile Set CodegenTarget
targets ->
    forall (m :: * -> *).
(Ide m, MonadLogger m, MonadError IdeError m) =>
FilePath -> Maybe FilePath -> Set CodegenTarget -> m Success
rebuildFileSync FilePath
file Maybe FilePath
actualFile Set CodegenTarget
targets
  Command
Cwd ->
    Text -> Success
TextResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getCurrentDirectory
  Command
Reset ->
    forall (m :: * -> *). Ide m => m ()
resetIdeState forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text -> Success
TextResult Text
"State has been reset."
  Command
Quit ->
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO a
exitSuccess

findCompletions
  :: Ide m
  => [Filter]
  -> Matcher IdeDeclarationAnn
  -> Maybe P.ModuleName
  -> CompletionOptions
  -> m Success
findCompletions :: forall (m :: * -> *).
Ide m =>
[Filter]
-> Matcher IdeDeclarationAnn
-> Maybe ModuleName
-> CompletionOptions
-> m Success
findCompletions [Filter]
filters Matcher IdeDeclarationAnn
matcher Maybe ModuleName
currentModule CompletionOptions
complOptions = do
  ModuleMap [IdeDeclarationAnn]
modules <- forall (m :: * -> *).
Ide m =>
Maybe ModuleName -> m (ModuleMap [IdeDeclarationAnn])
getAllModules Maybe ModuleName
currentModule
  let insertPrim :: ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
insertPrim = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ModuleMap [IdeDeclarationAnn]
idePrimDeclarations
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Completion] -> Success
CompletionResult ([Filter]
-> Matcher IdeDeclarationAnn
-> CompletionOptions
-> ModuleMap [IdeDeclarationAnn]
-> [Completion]
getCompletions [Filter]
filters Matcher IdeDeclarationAnn
matcher CompletionOptions
complOptions (ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
insertPrim ModuleMap [IdeDeclarationAnn]
modules)))

findType
  :: Ide m
  => Text
  -> [Filter]
  -> Maybe P.ModuleName
  -> m Success
findType :: forall (m :: * -> *).
Ide m =>
Text -> [Filter] -> Maybe ModuleName -> m Success
findType Text
search [Filter]
filters Maybe ModuleName
currentModule = do
  ModuleMap [IdeDeclarationAnn]
modules <- forall (m :: * -> *).
Ide m =>
Maybe ModuleName -> m (ModuleMap [IdeDeclarationAnn])
getAllModules Maybe ModuleName
currentModule
  let insertPrim :: ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
insertPrim = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ModuleMap [IdeDeclarationAnn]
idePrimDeclarations
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Completion] -> Success
CompletionResult (Text -> [Filter] -> ModuleMap [IdeDeclarationAnn] -> [Completion]
getExactCompletions Text
search [Filter]
filters (ModuleMap [IdeDeclarationAnn] -> ModuleMap [IdeDeclarationAnn]
insertPrim ModuleMap [IdeDeclarationAnn]
modules)))

printModules :: Ide m => m Success
printModules :: forall (m :: * -> *). Ide m => m Success
printModules = [Text] -> Success
ModuleList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ModuleName -> Text
P.runModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Ide m => m [ModuleName]
getLoadedModulenames

outputDirectory :: Ide m => m FilePath
outputDirectory :: forall (m :: * -> *). Ide m => m FilePath
outputDirectory = do
  FilePath
outputPath <- IdeConfiguration -> FilePath
confOutputPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeEnvironment -> IdeConfiguration
ideConfiguration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
  FilePath
cwd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getCurrentDirectory
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
cwd FilePath -> FilePath -> FilePath
</> FilePath
outputPath)

listAvailableModules :: Ide m => m Success
listAvailableModules :: forall (m :: * -> *). Ide m => m Success
listAvailableModules = do
  FilePath
oDir <- forall (m :: * -> *). Ide m => m FilePath
outputDirectory
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    [FilePath]
contents <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
oDir
    let cleaned :: [FilePath]
cleaned = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".", FilePath
".."]) [FilePath]
contents
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Success
ModuleList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall a b. ConvertText a b => a -> b
toS [FilePath]
cleaned))

caseSplit :: (Ide m, MonadError IdeError m) =>
  Text -> Int -> Int -> CS.WildcardAnnotations -> Text -> m Success
caseSplit :: forall (m :: * -> *).
(Ide m, MonadError IdeError m) =>
Text -> Int -> Int -> WildcardAnnotations -> Text -> m Success
caseSplit Text
l Int
b Int
e WildcardAnnotations
csa Text
t = do
  [Text]
patterns <- Text
-> Int -> Int -> WildcardAnnotations -> [Constructor] -> [Text]
CS.makePattern Text
l Int
b Int
e WildcardAnnotations
csa forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(Ide m, MonadError IdeError m) =>
Text -> m [Constructor]
CS.caseSplit Text
t
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Success
MultilineTextResult [Text]
patterns)

-- | Finds all the externs inside the output folder and returns the
-- corresponding module names
findAvailableExterns :: (Ide m, MonadError IdeError m) => m [P.ModuleName]
findAvailableExterns :: forall (m :: * -> *).
(Ide m, MonadError IdeError m) =>
m [ModuleName]
findAvailableExterns = do
  FilePath
oDir <- forall (m :: * -> *). Ide m => m FilePath
outputDirectory
  forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesDirectoryExist FilePath
oDir))
    (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> IdeError
GeneralError forall a b. (a -> b) -> a -> b
$ Text
"Couldn't locate your output directory at: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath -> FilePath
normalise FilePath
oDir)))
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    [FilePath]
directories <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
oDir
    [FilePath]
moduleNames <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> FilePath -> IO Bool
containsExterns FilePath
oDir) [FilePath]
directories
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ModuleName
P.moduleNameFromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
moduleNames)
  where
    -- Takes the output directory and a filepath like "Data.Array" and
    -- looks up, whether that folder contains an externs file
    containsExterns :: FilePath -> FilePath -> IO Bool
    containsExterns :: FilePath -> FilePath -> IO Bool
containsExterns FilePath
oDir FilePath
d
      | FilePath
d forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
".", FilePath
".."] = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      | Bool
otherwise = do
          let file :: FilePath
file = FilePath
oDir FilePath -> FilePath -> FilePath
</> FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
P.externsFileName
          FilePath -> IO Bool
doesFileExist FilePath
file

-- | Finds all matches for the globs specified at the commandline
findAllSourceFiles :: Ide m => m [FilePath]
findAllSourceFiles :: forall (m :: * -> *). Ide m => m [FilePath]
findAllSourceFiles = do
  [FilePath]
globs <- IdeConfiguration -> [FilePath]
confGlobs forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeEnvironment -> IdeConfiguration
ideConfiguration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM FilePath -> IO [FilePath]
glob [FilePath]
globs)

-- | Looks up the ExternsFiles for the given Modulenames and loads them into the
-- server state. Then proceeds to parse all the specified sourcefiles and
-- inserts their ASTs into the state. Finally kicks off an async worker, which
-- populates the VolatileState.
loadModulesAsync
  :: (Ide m, MonadError IdeError m, MonadLogger m)
  => [P.ModuleName]
  -> m Success
loadModulesAsync :: forall (m :: * -> *).
(Ide m, MonadError IdeError m, MonadLogger m) =>
[ModuleName] -> m Success
loadModulesAsync [ModuleName]
moduleNames = do
  Success
tr <- forall (m :: * -> *).
(Ide m, MonadError IdeError m, MonadLogger m) =>
[ModuleName] -> m Success
loadModules [ModuleName]
moduleNames
  Async ()
_ <- forall (m :: * -> *). Ide m => m (Async ())
populateVolatileState
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Success
tr

loadModulesSync
  :: (Ide m, MonadError IdeError m, MonadLogger m)
  => [P.ModuleName]
  -> m Success
loadModulesSync :: forall (m :: * -> *).
(Ide m, MonadError IdeError m, MonadLogger m) =>
[ModuleName] -> m Success
loadModulesSync [ModuleName]
moduleNames = do
  Success
tr <- forall (m :: * -> *).
(Ide m, MonadError IdeError m, MonadLogger m) =>
[ModuleName] -> m Success
loadModules [ModuleName]
moduleNames
  forall (m :: * -> *). (Ide m, MonadLogger m) => m ()
populateVolatileStateSync
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Success
tr

loadModules
  :: (Ide m, MonadError IdeError m, MonadLogger m)
  => [P.ModuleName]
  -> m Success
loadModules :: forall (m :: * -> *).
(Ide m, MonadError IdeError m, MonadLogger m) =>
[ModuleName] -> m Success
loadModules [ModuleName]
moduleNames = do
  -- We resolve all the modulenames to externs files and load these into memory.
  FilePath
oDir <- forall (m :: * -> *). Ide m => m FilePath
outputDirectory
  let efPaths :: [FilePath]
efPaths =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\ModuleName
mn -> FilePath
oDir FilePath -> FilePath -> FilePath
</> forall a b. ConvertText a b => a -> b
toS (ModuleName -> Text
P.runModuleName ModuleName
mn) FilePath -> FilePath -> FilePath
</> FilePath
P.externsFileName) [ModuleName]
moduleNames
  [ExternsFile]
efiles <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *).
(MonadIO m, MonadError IdeError m, MonadLogger m) =>
FilePath -> m ExternsFile
readExternFile [FilePath]
efPaths
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (m :: * -> *). Ide m => ExternsFile -> m ()
insertExterns [ExternsFile]
efiles

  -- We parse all source files, log eventual parse failures and insert the
  -- successful parses into the state.
  ([FilePath]
failures, [(FilePath, Module)]
allModules) <-
    forall a b. [Either a b] -> ([a], [b])
partitionEithers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
[FilePath] -> m [Either FilePath (FilePath, Module)]
parseModulesFromFiles forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). Ide m => m [FilePath]
findAllSourceFiles)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
failures) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *). MonadLogger m => Text -> m ()
logWarnN (Text
"Failed to parse: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv FilePath b) => a -> b
show [FilePath]
failures)
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (m :: * -> *). Ide m => (FilePath, Module) -> m ()
insertModule [(FilePath, Module)]
allModules

  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Success
TextResult (Text
"Loaded " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv FilePath b) => a -> b
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExternsFile]
efiles) forall a. Semigroup a => a -> a -> a
<> Text
" modules and "
                    forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv FilePath b) => a -> b
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, Module)]
allModules) forall a. Semigroup a => a -> a -> a
<> Text
" source files."))