{-# language PackageImports, TemplateHaskell, BlockArguments #-}

module Language.PureScript.Ide.Rebuild
  ( rebuildFileSync
  , rebuildFileAsync
  , rebuildFile
  ) where

import Protolude hiding (moduleName)

import "monad-logger" Control.Monad.Logger (LoggingT, MonadLogger, logDebug)
import Data.List qualified as List
import Data.Map.Lazy qualified as M
import Data.Maybe (fromJust)
import Data.Set qualified as S
import Data.Time qualified as Time
import Data.Text qualified as Text
import Language.PureScript qualified as P
import Language.PureScript.Make (ffiCodegen')
import Language.PureScript.Make.Cache (CacheInfo(..), normaliseForCache)
import Language.PureScript.CST qualified as CST

import Language.PureScript.Ide.Error (IdeError(..))
import Language.PureScript.Ide.Logging (labelTimespec, logPerf, runLogger)
import Language.PureScript.Ide.State (cacheRebuild, getExternFiles, insertExterns, insertModule, populateVolatileState, updateCacheTimestamp)
import Language.PureScript.Ide.Types (Ide, IdeConfiguration(..), IdeEnvironment(..), ModuleMap, Success(..))
import Language.PureScript.Ide.Util (ideReadFile)
import System.Directory (getCurrentDirectory)

-- | Given a filepath performs the following steps:
--
-- * Reads and parses a PureScript module from the filepath.
--
-- * Builds a dependency graph for the parsed module from the already loaded
-- ExternsFiles.
--
-- * Attempts to find an FFI definition file for the module by looking
-- for a file with the same filepath except for a .js extension.
--
-- * Passes all the created artifacts to @rebuildModule@.
--
-- * If the rebuilding succeeds, returns a @RebuildSuccess@ with the generated
-- warnings, and if rebuilding fails, returns a @RebuildError@ with the
-- generated errors.
rebuildFile
  :: (Ide m, MonadLogger m, MonadError IdeError m)
  => FilePath
  -- ^ The file to rebuild
  -> Maybe FilePath
  -- ^ The file to use as the location for parsing and errors
  -> Set P.CodegenTarget
  -- ^ The targets to codegen
  -> (ReaderT IdeEnvironment (LoggingT IO) () -> m ())
  -- ^ A runner for the second build with open exports
  -> m Success
rebuildFile :: forall (m :: * -> *).
(Ide m, MonadLogger m, MonadError IdeError m) =>
FilePath
-> Maybe FilePath
-> Set CodegenTarget
-> (ReaderT IdeEnvironment (LoggingT IO) () -> m ())
-> m Success
rebuildFile FilePath
file Maybe FilePath
actualFile Set CodegenTarget
codegenTargets ReaderT IdeEnvironment (LoggingT IO) () -> m ()
runOpenBuild = do
  (FilePath
fp, Text
input) <-
    case forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix FilePath
"data:" FilePath
file of
      Just FilePath
source -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
"", FilePath -> Text
Text.pack FilePath
source)
      Maybe FilePath
_ -> forall (m :: * -> *).
(MonadIO m, MonadError IdeError m) =>
FilePath -> m (FilePath, Text)
ideReadFile FilePath
file
  let fp' :: FilePath
fp' = forall a. a -> Maybe a -> a
fromMaybe FilePath
fp Maybe FilePath
actualFile
  ([ParserWarning]
pwarnings, Module
m) <- case forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ FilePath
-> Text -> ([ParserWarning], Either (NonEmpty ParserError) Module)
CST.parseFromFile FilePath
fp' Text
input of
    Left NonEmpty ParserError
parseError ->
      forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ [(FilePath, Text)] -> MultipleErrors -> IdeError
RebuildError [(FilePath
fp', Text
input)] forall a b. (a -> b) -> a -> b
$ FilePath -> NonEmpty ParserError -> MultipleErrors
CST.toMultipleErrors FilePath
fp' NonEmpty ParserError
parseError
    Right ([ParserWarning], Module)
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ParserWarning], Module)
m
  let moduleName :: ModuleName
moduleName = Module -> ModuleName
P.getModuleName Module
m
  -- Externs files must be sorted ahead of time, so that they get applied
  -- in the right order (bottom up) to the 'Environment'.
  [ExternsFile]
externs <- forall (m :: * -> *) t.
(MonadIO m, MonadLogger m) =>
(TimeSpec -> Text) -> m t -> m t
logPerf (Text -> TimeSpec -> Text
labelTimespec Text
"Sorting externs") (forall (m :: * -> *).
(Ide m, MonadError IdeError m) =>
Module -> ModuleMap ExternsFile -> m [ExternsFile]
sortExterns Module
m forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). Ide m => m (ModuleMap ExternsFile)
getExternFiles)
  FilePath
outputDirectory <- 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
  -- For rebuilding, we want to 'RebuildAlways', but for inferring foreign
  -- modules using their file paths, we need to specify the path in the 'Map'.
  let filePathMap :: Map ModuleName (Either RebuildPolicy FilePath)
filePathMap = forall k a. k -> a -> Map k a
M.singleton ModuleName
moduleName (forall a b. a -> Either a b
Left RebuildPolicy
P.RebuildAlways)
  let pureRebuild :: Bool
pureRebuild = FilePath
fp forall a. Eq a => a -> a -> Bool
== FilePath
""
  let modulePath :: FilePath
modulePath = if Bool
pureRebuild then FilePath
fp' else FilePath
file
  Map ModuleName FilePath
foreigns <- forall (m :: * -> *).
MonadIO m =>
Map ModuleName (Either RebuildPolicy FilePath)
-> m (Map ModuleName FilePath)
P.inferForeignModules (forall k a. k -> a -> Map k a
M.singleton ModuleName
moduleName (forall a b. b -> Either a b
Right FilePath
modulePath))
  let makeEnv :: MakeActions Make
makeEnv = FilePath
-> Map ModuleName (Either RebuildPolicy FilePath)
-> Map ModuleName FilePath
-> Bool
-> MakeActions Make
P.buildMakeActions FilePath
outputDirectory Map ModuleName (Either RebuildPolicy FilePath)
filePathMap Map ModuleName FilePath
foreigns Bool
False
        forall a b. a -> (a -> b) -> b
& (if Bool
pureRebuild then Map ModuleName FilePath
-> Set CodegenTarget -> MakeActions Make -> MakeActions Make
enableForeignCheck Map ModuleName FilePath
foreigns Set CodegenTarget
codegenTargets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Monad m => MakeActions m -> MakeActions m
shushCodegen else forall a. a -> a
identity)
        forall a b. a -> (a -> b) -> b
& forall (m :: * -> *). Monad m => MakeActions m -> MakeActions m
shushProgress
  -- Rebuild the single module using the cached externs
  (Either MultipleErrors ExternsFile
result, MultipleErrors
warnings) <- forall (m :: * -> *) t.
(MonadIO m, MonadLogger m) =>
(TimeSpec -> Text) -> m t -> m t
logPerf (Text -> TimeSpec -> Text
labelTimespec Text
"Rebuilding Module") forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
Options -> Make a -> IO (Either MultipleErrors a, MultipleErrors)
P.runMake (Options
P.defaultOptions { optionsCodegenTargets :: Set CodegenTarget
P.optionsCodegenTargets = Set CodegenTarget
codegenTargets }) do
      ExternsFile
newExterns <- forall (m :: * -> *).
(MonadBaseControl IO m, MonadError MultipleErrors m,
 MonadWriter MultipleErrors m) =>
MakeActions m -> [ExternsFile] -> Module -> m ExternsFile
P.rebuildModule MakeActions Make
makeEnv [ExternsFile]
externs Module
m
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pureRebuild
        forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, MonadError MultipleErrors m) =>
Set CodegenTarget
-> FilePath -> FilePath -> Maybe FilePath -> ModuleName -> m ()
updateCacheDb Set CodegenTarget
codegenTargets FilePath
outputDirectory FilePath
file Maybe FilePath
actualFile ModuleName
moduleName
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ExternsFile
newExterns
  case Either MultipleErrors ExternsFile
result of
    Left MultipleErrors
errors ->
      forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([(FilePath, Text)] -> MultipleErrors -> IdeError
RebuildError [(FilePath
fp', Text
input)] MultipleErrors
errors)
    Right ExternsFile
newExterns -> do
      forall (m :: * -> *). Ide m => (FilePath, Module) -> m ()
insertModule (forall a. a -> Maybe a -> a
fromMaybe FilePath
file Maybe FilePath
actualFile, Module
m)
      forall (m :: * -> *). Ide m => ExternsFile -> m ()
insertExterns ExternsFile
newExterns
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *). Ide m => m (Async ())
populateVolatileState
      Maybe (Maybe UTCTime, Maybe UTCTime)
_ <- forall (m :: * -> *).
Ide m =>
m (Maybe (Maybe UTCTime, Maybe UTCTime))
updateCacheTimestamp
      ReaderT IdeEnvironment (LoggingT IO) () -> m ()
runOpenBuild (forall (m :: * -> *).
(Ide m, MonadLogger m) =>
MakeActions Make -> [ExternsFile] -> Module -> m ()
rebuildModuleOpen MakeActions Make
makeEnv [ExternsFile]
externs Module
m)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultipleErrors -> Success
RebuildSuccess (FilePath -> [ParserWarning] -> MultipleErrors
CST.toMultipleWarnings FilePath
fp [ParserWarning]
pwarnings forall a. Semigroup a => a -> a -> a
<> MultipleErrors
warnings))

-- | When adjusting the cache db file after a rebuild we always pick a
-- non-sensical timestamp ("1858-11-17T00:00:00Z"), and rely on the
-- content hash to tell whether the module needs rebuilding. This is
-- because IDE rebuilds may be triggered on temporary files to not
-- force editors to save the actual source file to get at diagnostics
dayZero :: Time.UTCTime
dayZero :: UTCTime
dayZero = Day -> DiffTime -> UTCTime
Time.UTCTime (Integer -> Day
Time.ModifiedJulianDay Integer
0) DiffTime
0

updateCacheDb
  :: MonadIO m
  => MonadError P.MultipleErrors m
  => Set P.CodegenTarget
  -> FilePath
  -- ^ The output directory
  -> FilePath
  -- ^ The file to read the content hash from
  -> Maybe FilePath
  -- ^ The file name to update in the cache
  -> P.ModuleName
  -- ^ The module name to update in the cache
  -> m ()
updateCacheDb :: forall (m :: * -> *).
(MonadIO m, MonadError MultipleErrors m) =>
Set CodegenTarget
-> FilePath -> FilePath -> Maybe FilePath -> ModuleName -> m ()
updateCacheDb Set CodegenTarget
codegenTargets FilePath
outputDirectory FilePath
file Maybe FilePath
actualFile ModuleName
moduleName = do
  FilePath
cwd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getCurrentDirectory
  ContentHash
contentHash <- forall (m :: * -> *).
(MonadIO m, MonadError MultipleErrors m) =>
FilePath -> m ContentHash
P.hashFile FilePath
file
  let moduleCacheInfo :: (FilePath, (UTCTime, ContentHash))
moduleCacheInfo = (FilePath -> FilePath -> FilePath
normaliseForCache FilePath
cwd (forall a. a -> Maybe a -> a
fromMaybe FilePath
file Maybe FilePath
actualFile), (UTCTime
dayZero, ContentHash
contentHash))

  Maybe (FilePath, (UTCTime, ContentHash))
foreignCacheInfo <-
    if forall a. Ord a => a -> Set a -> Bool
S.member CodegenTarget
P.JS Set CodegenTarget
codegenTargets then do
      Map ModuleName FilePath
foreigns' <- forall (m :: * -> *).
MonadIO m =>
Map ModuleName (Either RebuildPolicy FilePath)
-> m (Map ModuleName FilePath)
P.inferForeignModules (forall k a. k -> a -> Map k a
M.singleton ModuleName
moduleName (forall a b. b -> Either a b
Right (forall a. a -> Maybe a -> a
fromMaybe FilePath
file Maybe FilePath
actualFile)))
      forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ModuleName
moduleName Map ModuleName FilePath
foreigns') \FilePath
foreignPath -> do
        ContentHash
foreignHash <- forall (m :: * -> *).
(MonadIO m, MonadError MultipleErrors m) =>
FilePath -> m ContentHash
P.hashFile FilePath
foreignPath
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> FilePath -> FilePath
normaliseForCache FilePath
cwd FilePath
foreignPath, (UTCTime
dayZero, ContentHash
foreignHash))
    else
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

  let cacheInfo :: Map FilePath (UTCTime, ContentHash)
cacheInfo = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((FilePath, (UTCTime, ContentHash))
moduleCacheInfo forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList Maybe (FilePath, (UTCTime, ContentHash))
foreignCacheInfo)
  CacheDb
cacheDb <- forall (m :: * -> *).
(MonadIO m, MonadError MultipleErrors m) =>
FilePath -> m CacheDb
P.readCacheDb' FilePath
outputDirectory
  forall (m :: * -> *).
(MonadIO m, MonadError MultipleErrors m) =>
FilePath -> CacheDb -> m ()
P.writeCacheDb' FilePath
outputDirectory (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ModuleName
moduleName (Map FilePath (UTCTime, ContentHash) -> CacheInfo
CacheInfo Map FilePath (UTCTime, ContentHash)
cacheInfo) CacheDb
cacheDb)

rebuildFileAsync
  :: forall m. (Ide m, MonadLogger m, MonadError IdeError m)
  => FilePath -> Maybe FilePath -> Set P.CodegenTarget -> m Success
rebuildFileAsync :: forall (m :: * -> *).
(Ide m, MonadLogger m, MonadError IdeError m) =>
FilePath -> Maybe FilePath -> Set CodegenTarget -> m Success
rebuildFileAsync FilePath
fp Maybe FilePath
fp' Set CodegenTarget
ts = forall (m :: * -> *).
(Ide m, MonadLogger m, MonadError IdeError m) =>
FilePath
-> Maybe FilePath
-> Set CodegenTarget
-> (ReaderT IdeEnvironment (LoggingT IO) () -> m ())
-> m Success
rebuildFile FilePath
fp Maybe FilePath
fp' Set CodegenTarget
ts ReaderT IdeEnvironment (LoggingT IO) () -> m ()
asyncRun
  where
    asyncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()
    asyncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()
asyncRun ReaderT IdeEnvironment (LoggingT IO) ()
action = do
        IdeEnvironment
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
        let ll :: IdeLogLevel
ll = IdeConfiguration -> IdeLogLevel
confLogLevel (IdeEnvironment -> IdeConfiguration
ideConfiguration IdeEnvironment
env)
        forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IO a -> IO (Async a)
async (forall (m :: * -> *) a.
MonadIO m =>
IdeLogLevel -> LoggingT m a -> m a
runLogger IdeLogLevel
ll (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT IdeEnvironment (LoggingT IO) ()
action IdeEnvironment
env))))

rebuildFileSync
  :: forall m. (Ide m, MonadLogger m, MonadError IdeError m)
  => FilePath -> Maybe FilePath -> Set P.CodegenTarget -> m Success
rebuildFileSync :: forall (m :: * -> *).
(Ide m, MonadLogger m, MonadError IdeError m) =>
FilePath -> Maybe FilePath -> Set CodegenTarget -> m Success
rebuildFileSync FilePath
fp Maybe FilePath
fp' Set CodegenTarget
ts = forall (m :: * -> *).
(Ide m, MonadLogger m, MonadError IdeError m) =>
FilePath
-> Maybe FilePath
-> Set CodegenTarget
-> (ReaderT IdeEnvironment (LoggingT IO) () -> m ())
-> m Success
rebuildFile FilePath
fp Maybe FilePath
fp' Set CodegenTarget
ts ReaderT IdeEnvironment (LoggingT IO) () -> m ()
syncRun
  where
    syncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()
    syncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()
syncRun ReaderT IdeEnvironment (LoggingT IO) ()
action = do
        IdeEnvironment
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
        let ll :: IdeLogLevel
ll = IdeConfiguration -> IdeLogLevel
confLogLevel (IdeEnvironment -> IdeConfiguration
ideConfiguration IdeEnvironment
env)
        forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a.
MonadIO m =>
IdeLogLevel -> LoggingT m a -> m a
runLogger IdeLogLevel
ll (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT IdeEnvironment (LoggingT IO) ()
action IdeEnvironment
env)))

-- | Rebuilds a module but opens up its export list first and stores the result
-- inside the rebuild cache
rebuildModuleOpen
  :: (Ide m, MonadLogger m)
  => P.MakeActions P.Make
  -> [P.ExternsFile]
  -> P.Module
  -> m ()
rebuildModuleOpen :: forall (m :: * -> *).
(Ide m, MonadLogger m) =>
MakeActions Make -> [ExternsFile] -> Module -> m ()
rebuildModuleOpen MakeActions Make
makeEnv [ExternsFile]
externs Module
m = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  (Either MultipleErrors ExternsFile
openResult, MultipleErrors
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
Options -> Make a -> IO (Either MultipleErrors a, MultipleErrors)
P.runMake Options
P.defaultOptions forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *).
(MonadBaseControl IO m, MonadError MultipleErrors m,
 MonadWriter MultipleErrors m) =>
MakeActions m -> [ExternsFile] -> Module -> m ExternsFile
P.rebuildModule (forall (m :: * -> *). Monad m => MakeActions m -> MakeActions m
shushProgress (forall (m :: * -> *). Monad m => MakeActions m -> MakeActions m
shushCodegen MakeActions Make
makeEnv)) [ExternsFile]
externs (Module -> Module
openModuleExports Module
m)
  case Either MultipleErrors ExternsFile
openResult of
    Left MultipleErrors
_ ->
      forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> IdeError
GeneralError Text
"Failed when rebuilding with open exports")
    Right ExternsFile
result -> do
      $(logDebug)
        (Text
"Setting Rebuild cache: " forall a. Semigroup a => a -> a -> a
<> ModuleName -> Text
P.runModuleName (ExternsFile -> ModuleName
P.efModuleName ExternsFile
result))
      forall (m :: * -> *). Ide m => ExternsFile -> m ()
cacheRebuild ExternsFile
result

-- | Shuts the compiler up about progress messages
shushProgress :: Monad m => P.MakeActions m -> P.MakeActions m
shushProgress :: forall (m :: * -> *). Monad m => MakeActions m -> MakeActions m
shushProgress MakeActions m
ma =
  MakeActions m
ma { progress :: ProgressMessage -> m ()
P.progress = \ProgressMessage
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure () }

-- | Stops any kind of codegen
shushCodegen :: Monad m => P.MakeActions m -> P.MakeActions m
shushCodegen :: forall (m :: * -> *). Monad m => MakeActions m -> MakeActions m
shushCodegen MakeActions m
ma =
  MakeActions m
ma { codegen :: Module Ann -> Module -> ExternsFile -> SupplyT m ()
P.codegen = \Module Ann
_ Module
_ ExternsFile
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
     , ffiCodegen :: Module Ann -> m ()
P.ffiCodegen = \Module Ann
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
     }

-- | Enables foreign module check without actual codegen.
enableForeignCheck
  :: M.Map P.ModuleName FilePath
  -> S.Set P.CodegenTarget
  -> P.MakeActions P.Make
  -> P.MakeActions P.Make
enableForeignCheck :: Map ModuleName FilePath
-> Set CodegenTarget -> MakeActions Make -> MakeActions Make
enableForeignCheck Map ModuleName FilePath
foreigns Set CodegenTarget
codegenTargets MakeActions Make
ma =
  MakeActions Make
ma { ffiCodegen :: Module Ann -> Make ()
P.ffiCodegen = Map ModuleName FilePath
-> Set CodegenTarget
-> Maybe (ModuleName -> FilePath -> FilePath)
-> Module Ann
-> Make ()
ffiCodegen' Map ModuleName FilePath
foreigns Set CodegenTarget
codegenTargets forall a. Maybe a
Nothing
     }

-- | Returns a topologically sorted list of dependent ExternsFiles for the given
-- module. Throws an error if there is a cyclic dependency within the
-- ExternsFiles
sortExterns
  :: (Ide m, MonadError IdeError m)
  => P.Module
  -> ModuleMap P.ExternsFile
  -> m [P.ExternsFile]
sortExterns :: forall (m :: * -> *).
(Ide m, MonadError IdeError m) =>
Module -> ModuleMap ExternsFile -> m [ExternsFile]
sortExterns Module
m ModuleMap ExternsFile
ex = do
  Either MultipleErrors ([Module], ModuleGraph)
sorted' <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadError MultipleErrors m =>
DependencyDepth
-> (a -> ModuleSignature) -> [a] -> m ([a], ModuleGraph)
P.sortModules DependencyDepth
P.Transitive Module -> ModuleSignature
P.moduleSignature
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Module
m
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ExternsFile -> Module
mkShallowModule
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
M.elems
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Module -> ModuleName
P.getModuleName Module
m) forall a b. (a -> b) -> a -> b
$ ModuleMap ExternsFile
ex
  case Either MultipleErrors ([Module], ModuleGraph)
sorted' of
    Left MultipleErrors
err ->
      forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([(FilePath, Text)] -> MultipleErrors -> IdeError
RebuildError [] MultipleErrors
err)
    Right ([Module]
sorted, ModuleGraph
graph) -> do
      let deps :: [ModuleName]
deps = forall a. HasCallStack => Maybe a -> a
fromJust (forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup (Module -> ModuleName
P.getModuleName Module
m) ModuleGraph
graph)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ModuleName -> Maybe ExternsFile
getExtern ([ModuleName]
deps forall a. Ord a => [a] -> [a] -> [a]
`inOrderOf` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Module -> ModuleName
P.getModuleName [Module]
sorted)
  where
    mkShallowModule :: ExternsFile -> Module
mkShallowModule P.ExternsFile{[DeclarationRef]
[ExternsDeclaration]
[ExternsTypeFixity]
[ExternsFixity]
[ExternsImport]
Text
SourceSpan
ModuleName
efSourceSpan :: ExternsFile -> SourceSpan
efDeclarations :: ExternsFile -> [ExternsDeclaration]
efTypeFixities :: ExternsFile -> [ExternsTypeFixity]
efFixities :: ExternsFile -> [ExternsFixity]
efImports :: ExternsFile -> [ExternsImport]
efExports :: ExternsFile -> [DeclarationRef]
efVersion :: ExternsFile -> Text
efSourceSpan :: SourceSpan
efDeclarations :: [ExternsDeclaration]
efTypeFixities :: [ExternsTypeFixity]
efFixities :: [ExternsFixity]
efImports :: [ExternsImport]
efExports :: [DeclarationRef]
efModuleName :: ModuleName
efVersion :: Text
efModuleName :: ExternsFile -> ModuleName
..} =
      SourceSpan
-> [Comment]
-> ModuleName
-> [Declaration]
-> Maybe [DeclarationRef]
-> Module
P.Module (FilePath -> SourceSpan
P.internalModuleSourceSpan FilePath
"<rebuild>") [] ModuleName
efModuleName (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ExternsImport -> Declaration
mkImport [ExternsImport]
efImports) forall a. Maybe a
Nothing
    mkImport :: ExternsImport -> Declaration
mkImport (P.ExternsImport ModuleName
mn ImportDeclarationType
it Maybe ModuleName
iq) =
      SourceAnn
-> ModuleName
-> ImportDeclarationType
-> Maybe ModuleName
-> Declaration
P.ImportDeclaration (FilePath -> SourceSpan
P.internalModuleSourceSpan FilePath
"<rebuild>", []) ModuleName
mn ImportDeclarationType
it Maybe ModuleName
iq
    getExtern :: ModuleName -> Maybe ExternsFile
getExtern ModuleName
mn = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ModuleName
mn ModuleMap ExternsFile
ex
    -- Sort a list so its elements appear in the same order as in another list.
    inOrderOf :: (Ord a) => [a] -> [a] -> [a]
    inOrderOf :: forall a. Ord a => [a] -> [a] -> [a]
inOrderOf [a]
xs [a]
ys = let s :: Set a
s = forall a. Ord a => [a] -> Set a
S.fromList [a]
xs in forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
s) [a]
ys

-- | Removes a modules export list.
openModuleExports :: P.Module -> P.Module
openModuleExports :: Module -> Module
openModuleExports (P.Module SourceSpan
ss [Comment]
cs ModuleName
mn [Declaration]
decls Maybe [DeclarationRef]
_) = SourceSpan
-> [Comment]
-> ModuleName
-> [Declaration]
-> Maybe [DeclarationRef]
-> Module
P.Module SourceSpan
ss [Comment]
cs ModuleName
mn [Declaration]
decls forall a. Maybe a
Nothing