-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-}

module Development.IDE.Import.DependencyInformation
  ( DependencyInformation(..)
  , ModuleImports(..)
  , RawDependencyInformation(..)
  , NodeError(..)
  , ModuleParseError(..)
  , TransitiveDependencies(..)
  , FilePathId(..)
  , NamedModuleDep(..)
  , ShowableModule(..)
  , ShowableModuleEnv(..)
  , PathIdMap (..)
  , emptyPathIdMap
  , getPathId
  , lookupPathToId
  , insertImport
  , pathToId
  , idToPath
  , reachableModules
  , processDependencyInformation
  , transitiveDeps
  , transitiveReverseDependencies
  , immediateReverseDependencies
  , lookupModuleFile
  , BootIdMap
  , insertBootId
  ) where

import           Control.DeepSeq
import           Data.Bifunctor
import           Data.Coerce
import           Data.Either
import           Data.Graph                         hiding (edges, path)
import           Data.HashMap.Strict                (HashMap)
import qualified Data.HashMap.Strict                as HMS
import           Data.IntMap                        (IntMap)
import qualified Data.IntMap.Lazy                   as IntMapLazy
import qualified Data.IntMap.Strict                 as IntMap
import           Data.IntSet                        (IntSet)
import qualified Data.IntSet                        as IntSet
import           Data.List
import           Data.List.NonEmpty                 (NonEmpty (..), nonEmpty)
import qualified Data.List.NonEmpty                 as NonEmpty
import           Data.Maybe
import           Data.Tuple.Extra                   hiding (first, second)
import           Development.IDE.GHC.Orphans        ()
import           GHC.Generics                       (Generic)
import           Prelude                            hiding (mod)

import           Development.IDE.Import.FindImports (ArtifactsLocation (..))
import           Development.IDE.Types.Diagnostics
import           Development.IDE.Types.Location

import           Development.IDE.GHC.Compat

-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]

#if !MIN_VERSION_ghc(9,3,0)
import           GHC
#endif

-- | The imports for a given module.
newtype ModuleImports = ModuleImports
    { ModuleImports -> [(Located ModuleName, Maybe FilePathId)]
moduleImports :: [(Located ModuleName, Maybe FilePathId)]
    -- ^ Imports of a module in the current package and the file path of
    -- that module on disk (if we found it)
    } deriving Key -> ModuleImports -> ShowS
[ModuleImports] -> ShowS
ModuleImports -> String
(Key -> ModuleImports -> ShowS)
-> (ModuleImports -> String)
-> ([ModuleImports] -> ShowS)
-> Show ModuleImports
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> ModuleImports -> ShowS
showsPrec :: Key -> ModuleImports -> ShowS
$cshow :: ModuleImports -> String
show :: ModuleImports -> String
$cshowList :: [ModuleImports] -> ShowS
showList :: [ModuleImports] -> ShowS
Show

-- | For processing dependency information, we need lots of maps and sets of
-- filepaths. Comparing Strings is really slow, so we work with IntMap/IntSet
-- instead and only convert at the edges.
newtype FilePathId = FilePathId { FilePathId -> Key
getFilePathId :: Int }
  deriving (Key -> FilePathId -> ShowS
[FilePathId] -> ShowS
FilePathId -> String
(Key -> FilePathId -> ShowS)
-> (FilePathId -> String)
-> ([FilePathId] -> ShowS)
-> Show FilePathId
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> FilePathId -> ShowS
showsPrec :: Key -> FilePathId -> ShowS
$cshow :: FilePathId -> String
show :: FilePathId -> String
$cshowList :: [FilePathId] -> ShowS
showList :: [FilePathId] -> ShowS
Show, FilePathId -> ()
(FilePathId -> ()) -> NFData FilePathId
forall a. (a -> ()) -> NFData a
$crnf :: FilePathId -> ()
rnf :: FilePathId -> ()
NFData, FilePathId -> FilePathId -> Bool
(FilePathId -> FilePathId -> Bool)
-> (FilePathId -> FilePathId -> Bool) -> Eq FilePathId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FilePathId -> FilePathId -> Bool
== :: FilePathId -> FilePathId -> Bool
$c/= :: FilePathId -> FilePathId -> Bool
/= :: FilePathId -> FilePathId -> Bool
Eq, Eq FilePathId
Eq FilePathId =>
(FilePathId -> FilePathId -> Ordering)
-> (FilePathId -> FilePathId -> Bool)
-> (FilePathId -> FilePathId -> Bool)
-> (FilePathId -> FilePathId -> Bool)
-> (FilePathId -> FilePathId -> Bool)
-> (FilePathId -> FilePathId -> FilePathId)
-> (FilePathId -> FilePathId -> FilePathId)
-> Ord FilePathId
FilePathId -> FilePathId -> Bool
FilePathId -> FilePathId -> Ordering
FilePathId -> FilePathId -> FilePathId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FilePathId -> FilePathId -> Ordering
compare :: FilePathId -> FilePathId -> Ordering
$c< :: FilePathId -> FilePathId -> Bool
< :: FilePathId -> FilePathId -> Bool
$c<= :: FilePathId -> FilePathId -> Bool
<= :: FilePathId -> FilePathId -> Bool
$c> :: FilePathId -> FilePathId -> Bool
> :: FilePathId -> FilePathId -> Bool
$c>= :: FilePathId -> FilePathId -> Bool
>= :: FilePathId -> FilePathId -> Bool
$cmax :: FilePathId -> FilePathId -> FilePathId
max :: FilePathId -> FilePathId -> FilePathId
$cmin :: FilePathId -> FilePathId -> FilePathId
min :: FilePathId -> FilePathId -> FilePathId
Ord)

-- | Map from 'FilePathId'
type FilePathIdMap = IntMap

-- | Set of 'FilePathId's
type FilePathIdSet = IntSet

data PathIdMap = PathIdMap
  { PathIdMap -> FilePathIdMap ArtifactsLocation
idToPathMap :: !(FilePathIdMap ArtifactsLocation)
  , PathIdMap -> HashMap NormalizedFilePath FilePathId
pathToIdMap :: !(HashMap NormalizedFilePath FilePathId)
  , PathIdMap -> Key
nextFreshId :: !Int
  }
  deriving (Key -> PathIdMap -> ShowS
[PathIdMap] -> ShowS
PathIdMap -> String
(Key -> PathIdMap -> ShowS)
-> (PathIdMap -> String)
-> ([PathIdMap] -> ShowS)
-> Show PathIdMap
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> PathIdMap -> ShowS
showsPrec :: Key -> PathIdMap -> ShowS
$cshow :: PathIdMap -> String
show :: PathIdMap -> String
$cshowList :: [PathIdMap] -> ShowS
showList :: [PathIdMap] -> ShowS
Show, (forall x. PathIdMap -> Rep PathIdMap x)
-> (forall x. Rep PathIdMap x -> PathIdMap) -> Generic PathIdMap
forall x. Rep PathIdMap x -> PathIdMap
forall x. PathIdMap -> Rep PathIdMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PathIdMap -> Rep PathIdMap x
from :: forall x. PathIdMap -> Rep PathIdMap x
$cto :: forall x. Rep PathIdMap x -> PathIdMap
to :: forall x. Rep PathIdMap x -> PathIdMap
Generic)

instance NFData PathIdMap

emptyPathIdMap :: PathIdMap
emptyPathIdMap :: PathIdMap
emptyPathIdMap = FilePathIdMap ArtifactsLocation
-> HashMap NormalizedFilePath FilePathId -> Key -> PathIdMap
PathIdMap FilePathIdMap ArtifactsLocation
forall a. IntMap a
IntMap.empty HashMap NormalizedFilePath FilePathId
forall k v. HashMap k v
HMS.empty Key
0

getPathId :: ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)
getPathId :: ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)
getPathId ArtifactsLocation
path m :: PathIdMap
m@PathIdMap{Key
HashMap NormalizedFilePath FilePathId
FilePathIdMap ArtifactsLocation
idToPathMap :: PathIdMap -> FilePathIdMap ArtifactsLocation
pathToIdMap :: PathIdMap -> HashMap NormalizedFilePath FilePathId
nextFreshId :: PathIdMap -> Key
idToPathMap :: FilePathIdMap ArtifactsLocation
pathToIdMap :: HashMap NormalizedFilePath FilePathId
nextFreshId :: Key
..} =
    case NormalizedFilePath
-> HashMap NormalizedFilePath FilePathId -> Maybe FilePathId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup (ArtifactsLocation -> NormalizedFilePath
artifactFilePath ArtifactsLocation
path) HashMap NormalizedFilePath FilePathId
pathToIdMap of
        Maybe FilePathId
Nothing ->
            let !newId :: FilePathId
newId = Key -> FilePathId
FilePathId Key
nextFreshId
            in (FilePathId
newId, FilePathId -> PathIdMap
insertPathId FilePathId
newId )
        Just FilePathId
fileId -> (FilePathId
fileId, PathIdMap
m)
  where
    insertPathId :: FilePathId ->  PathIdMap
    insertPathId :: FilePathId -> PathIdMap
insertPathId FilePathId
fileId =
        FilePathIdMap ArtifactsLocation
-> HashMap NormalizedFilePath FilePathId -> Key -> PathIdMap
PathIdMap
            (Key
-> ArtifactsLocation
-> FilePathIdMap ArtifactsLocation
-> FilePathIdMap ArtifactsLocation
forall a. Key -> a -> IntMap a -> IntMap a
IntMap.insert (FilePathId -> Key
getFilePathId FilePathId
fileId) ArtifactsLocation
path FilePathIdMap ArtifactsLocation
idToPathMap)
            (NormalizedFilePath
-> FilePathId
-> HashMap NormalizedFilePath FilePathId
-> HashMap NormalizedFilePath FilePathId
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HMS.insert (ArtifactsLocation -> NormalizedFilePath
artifactFilePath ArtifactsLocation
path) FilePathId
fileId HashMap NormalizedFilePath FilePathId
pathToIdMap)
            (Key -> Key
forall a. Enum a => a -> a
succ Key
nextFreshId)

insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation
insertImport :: FilePathId
-> Either ModuleParseError ModuleImports
-> RawDependencyInformation
-> RawDependencyInformation
insertImport (FilePathId Key
k) Either ModuleParseError ModuleImports
v RawDependencyInformation
rawDepInfo = RawDependencyInformation
rawDepInfo { rawImports = IntMap.insert k v (rawImports rawDepInfo) }

pathToId :: PathIdMap -> NormalizedFilePath -> Maybe FilePathId
pathToId :: PathIdMap -> NormalizedFilePath -> Maybe FilePathId
pathToId PathIdMap{HashMap NormalizedFilePath FilePathId
pathToIdMap :: PathIdMap -> HashMap NormalizedFilePath FilePathId
pathToIdMap :: HashMap NormalizedFilePath FilePathId
pathToIdMap} NormalizedFilePath
path = HashMap NormalizedFilePath FilePathId
pathToIdMap HashMap NormalizedFilePath FilePathId
-> NormalizedFilePath -> Maybe FilePathId
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
HMS.!? NormalizedFilePath
path

lookupPathToId :: PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId :: PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId PathIdMap{HashMap NormalizedFilePath FilePathId
pathToIdMap :: PathIdMap -> HashMap NormalizedFilePath FilePathId
pathToIdMap :: HashMap NormalizedFilePath FilePathId
pathToIdMap} NormalizedFilePath
path = NormalizedFilePath
-> HashMap NormalizedFilePath FilePathId -> Maybe FilePathId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup NormalizedFilePath
path HashMap NormalizedFilePath FilePathId
pathToIdMap

idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath
idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
pathIdMap FilePathId
filePathId = ArtifactsLocation -> NormalizedFilePath
artifactFilePath (ArtifactsLocation -> NormalizedFilePath)
-> ArtifactsLocation -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ PathIdMap -> FilePathId -> ArtifactsLocation
idToModLocation PathIdMap
pathIdMap FilePathId
filePathId

idToModLocation :: PathIdMap -> FilePathId -> ArtifactsLocation
idToModLocation :: PathIdMap -> FilePathId -> ArtifactsLocation
idToModLocation PathIdMap{FilePathIdMap ArtifactsLocation
idToPathMap :: PathIdMap -> FilePathIdMap ArtifactsLocation
idToPathMap :: FilePathIdMap ArtifactsLocation
idToPathMap} (FilePathId Key
i) = FilePathIdMap ArtifactsLocation
idToPathMap FilePathIdMap ArtifactsLocation -> Key -> ArtifactsLocation
forall a. IntMap a -> Key -> a
IntMap.! Key
i

type BootIdMap = FilePathIdMap FilePathId

insertBootId :: FilePathId -> FilePathId -> BootIdMap -> BootIdMap
insertBootId :: FilePathId -> FilePathId -> BootIdMap -> BootIdMap
insertBootId FilePathId
k = Key -> FilePathId -> BootIdMap -> BootIdMap
forall a. Key -> a -> IntMap a -> IntMap a
IntMap.insert (FilePathId -> Key
getFilePathId FilePathId
k)

-- | Unprocessed results that we find by following imports recursively.
data RawDependencyInformation = RawDependencyInformation
    { RawDependencyInformation
-> IntMap (Either ModuleParseError ModuleImports)
rawImports   :: !(FilePathIdMap (Either ModuleParseError ModuleImports))
    , RawDependencyInformation -> PathIdMap
rawPathIdMap :: !PathIdMap
    -- The rawBootMap maps the FilePathId of a hs-boot file to its
    -- corresponding hs file. It is used when topologically sorting as we
    -- need to add edges between .hs-boot and .hs so that the .hs files
    -- appear later in the sort.
    , RawDependencyInformation -> FilePathIdMap ShowableModule
rawModuleMap :: !(FilePathIdMap ShowableModule)
    } deriving Key -> RawDependencyInformation -> ShowS
[RawDependencyInformation] -> ShowS
RawDependencyInformation -> String
(Key -> RawDependencyInformation -> ShowS)
-> (RawDependencyInformation -> String)
-> ([RawDependencyInformation] -> ShowS)
-> Show RawDependencyInformation
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> RawDependencyInformation -> ShowS
showsPrec :: Key -> RawDependencyInformation -> ShowS
$cshow :: RawDependencyInformation -> String
show :: RawDependencyInformation -> String
$cshowList :: [RawDependencyInformation] -> ShowS
showList :: [RawDependencyInformation] -> ShowS
Show

data DependencyInformation =
  DependencyInformation
    { DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
depErrorNodes        :: !(FilePathIdMap (NonEmpty NodeError))
    -- ^ Nodes that cannot be processed correctly.
    , DependencyInformation -> FilePathIdMap ShowableModule
depModules           :: !(FilePathIdMap ShowableModule)
    , DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleDeps        :: !(FilePathIdMap FilePathIdSet)
    -- ^ For a non-error node, this contains the set of module immediate dependencies
    -- in the same package.
    , DependencyInformation -> FilePathIdMap FilePathIdSet
depReverseModuleDeps :: !(IntMap IntSet)
    -- ^ Contains a reverse mapping from a module to all those that immediately depend on it.
    , DependencyInformation -> PathIdMap
depPathIdMap         :: !PathIdMap
    -- ^ Map from FilePath to FilePathId
    , DependencyInformation -> BootIdMap
depBootMap           :: !BootIdMap
    -- ^ Map from hs-boot file to the corresponding hs file
    , DependencyInformation -> ShowableModuleEnv FilePathId
depModuleFiles       :: !(ShowableModuleEnv FilePathId)
    -- ^ Map from Module to the corresponding non-boot hs file
    , DependencyInformation -> ModuleGraph
depModuleGraph       :: !ModuleGraph
    } deriving (Key -> DependencyInformation -> ShowS
[DependencyInformation] -> ShowS
DependencyInformation -> String
(Key -> DependencyInformation -> ShowS)
-> (DependencyInformation -> String)
-> ([DependencyInformation] -> ShowS)
-> Show DependencyInformation
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> DependencyInformation -> ShowS
showsPrec :: Key -> DependencyInformation -> ShowS
$cshow :: DependencyInformation -> String
show :: DependencyInformation -> String
$cshowList :: [DependencyInformation] -> ShowS
showList :: [DependencyInformation] -> ShowS
Show, (forall x. DependencyInformation -> Rep DependencyInformation x)
-> (forall x. Rep DependencyInformation x -> DependencyInformation)
-> Generic DependencyInformation
forall x. Rep DependencyInformation x -> DependencyInformation
forall x. DependencyInformation -> Rep DependencyInformation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DependencyInformation -> Rep DependencyInformation x
from :: forall x. DependencyInformation -> Rep DependencyInformation x
$cto :: forall x. Rep DependencyInformation x -> DependencyInformation
to :: forall x. Rep DependencyInformation x -> DependencyInformation
Generic)

newtype ShowableModule =
  ShowableModule {ShowableModule -> Module
showableModule :: Module}
  deriving ShowableModule -> ()
(ShowableModule -> ()) -> NFData ShowableModule
forall a. (a -> ()) -> NFData a
$crnf :: ShowableModule -> ()
rnf :: ShowableModule -> ()
NFData

newtype ShowableModuleEnv a =
  ShowableModuleEnv {forall a. ShowableModuleEnv a -> ModuleEnv a
showableModuleEnv :: ModuleEnv a}

instance Show a => Show (ShowableModuleEnv a) where
  show :: ShowableModuleEnv a -> String
show (ShowableModuleEnv ModuleEnv a
x) = [(Module, a)] -> String
forall a. Show a => a -> String
show (ModuleEnv a -> [(Module, a)]
forall a. ModuleEnv a -> [(Module, a)]
moduleEnvToList ModuleEnv a
x)
instance NFData a => NFData (ShowableModuleEnv a) where
  rnf :: ShowableModuleEnv a -> ()
rnf = ShowableModuleEnv a -> ()
forall a. a -> ()
rwhnf

instance Show ShowableModule where show :: ShowableModule -> String
show = ModuleName -> String
moduleNameString (ModuleName -> String)
-> (ShowableModule -> ModuleName) -> ShowableModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName)
-> (ShowableModule -> Module) -> ShowableModule -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowableModule -> Module
showableModule

reachableModules :: DependencyInformation -> [NormalizedFilePath]
reachableModules :: DependencyInformation -> [NormalizedFilePath]
reachableModules DependencyInformation{FilePathIdMap (NonEmpty NodeError)
FilePathIdMap FilePathIdSet
FilePathIdMap ShowableModule
BootIdMap
ModuleGraph
ShowableModuleEnv FilePathId
PathIdMap
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
depModules :: DependencyInformation -> FilePathIdMap ShowableModule
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depPathIdMap :: DependencyInformation -> PathIdMap
depBootMap :: DependencyInformation -> BootIdMap
depModuleFiles :: DependencyInformation -> ShowableModuleEnv FilePathId
depModuleGraph :: DependencyInformation -> ModuleGraph
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depModules :: FilePathIdMap ShowableModule
depModuleDeps :: FilePathIdMap FilePathIdSet
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depPathIdMap :: PathIdMap
depBootMap :: BootIdMap
depModuleFiles :: ShowableModuleEnv FilePathId
depModuleGraph :: ModuleGraph
..} =
    (Key -> NormalizedFilePath) -> [Key] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap (FilePathId -> NormalizedFilePath)
-> (Key -> FilePathId) -> Key -> NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> FilePathId
FilePathId) ([Key] -> [NormalizedFilePath]) -> [Key] -> [NormalizedFilePath]
forall a b. (a -> b) -> a -> b
$ FilePathIdMap (NonEmpty NodeError) -> [Key]
forall a. IntMap a -> [Key]
IntMap.keys FilePathIdMap (NonEmpty NodeError)
depErrorNodes [Key] -> [Key] -> [Key]
forall a. Semigroup a => a -> a -> a
<> FilePathIdMap FilePathIdSet -> [Key]
forall a. IntMap a -> [Key]
IntMap.keys FilePathIdMap FilePathIdSet
depModuleDeps

instance NFData DependencyInformation

-- | This does not contain the actual parse error as that is already reported by GetParsedModule.
data ModuleParseError = ModuleParseError
  deriving (Key -> ModuleParseError -> ShowS
[ModuleParseError] -> ShowS
ModuleParseError -> String
(Key -> ModuleParseError -> ShowS)
-> (ModuleParseError -> String)
-> ([ModuleParseError] -> ShowS)
-> Show ModuleParseError
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> ModuleParseError -> ShowS
showsPrec :: Key -> ModuleParseError -> ShowS
$cshow :: ModuleParseError -> String
show :: ModuleParseError -> String
$cshowList :: [ModuleParseError] -> ShowS
showList :: [ModuleParseError] -> ShowS
Show, (forall x. ModuleParseError -> Rep ModuleParseError x)
-> (forall x. Rep ModuleParseError x -> ModuleParseError)
-> Generic ModuleParseError
forall x. Rep ModuleParseError x -> ModuleParseError
forall x. ModuleParseError -> Rep ModuleParseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModuleParseError -> Rep ModuleParseError x
from :: forall x. ModuleParseError -> Rep ModuleParseError x
$cto :: forall x. Rep ModuleParseError x -> ModuleParseError
to :: forall x. Rep ModuleParseError x -> ModuleParseError
Generic)

instance NFData ModuleParseError

-- | Error when trying to locate a module.
newtype LocateError = LocateError [Diagnostic]
  deriving (LocateError -> LocateError -> Bool
(LocateError -> LocateError -> Bool)
-> (LocateError -> LocateError -> Bool) -> Eq LocateError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LocateError -> LocateError -> Bool
== :: LocateError -> LocateError -> Bool
$c/= :: LocateError -> LocateError -> Bool
/= :: LocateError -> LocateError -> Bool
Eq, Key -> LocateError -> ShowS
[LocateError] -> ShowS
LocateError -> String
(Key -> LocateError -> ShowS)
-> (LocateError -> String)
-> ([LocateError] -> ShowS)
-> Show LocateError
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> LocateError -> ShowS
showsPrec :: Key -> LocateError -> ShowS
$cshow :: LocateError -> String
show :: LocateError -> String
$cshowList :: [LocateError] -> ShowS
showList :: [LocateError] -> ShowS
Show, (forall x. LocateError -> Rep LocateError x)
-> (forall x. Rep LocateError x -> LocateError)
-> Generic LocateError
forall x. Rep LocateError x -> LocateError
forall x. LocateError -> Rep LocateError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LocateError -> Rep LocateError x
from :: forall x. LocateError -> Rep LocateError x
$cto :: forall x. Rep LocateError x -> LocateError
to :: forall x. Rep LocateError x -> LocateError
Generic)

instance NFData LocateError

-- | An error attached to a node in the dependency graph.
data NodeError
  = PartOfCycle (Located ModuleName) [FilePathId]
  -- ^ This module is part of an import cycle. The module name corresponds
  -- to the import that enters the cycle starting from this module.
  -- The list of filepaths represents the elements
  -- in the cycle in unspecified order.
  | FailedToLocateImport (Located ModuleName)
  -- ^ This module has an import that couldn’t be located.
  | ParseError ModuleParseError
  | ParentOfErrorNode (Located ModuleName)
  -- ^ This module is the parent of a module that cannot be
  -- processed (either it cannot be parsed, is part of a cycle
  -- or the parent of another error node).
  deriving (Key -> NodeError -> ShowS
[NodeError] -> ShowS
NodeError -> String
(Key -> NodeError -> ShowS)
-> (NodeError -> String)
-> ([NodeError] -> ShowS)
-> Show NodeError
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> NodeError -> ShowS
showsPrec :: Key -> NodeError -> ShowS
$cshow :: NodeError -> String
show :: NodeError -> String
$cshowList :: [NodeError] -> ShowS
showList :: [NodeError] -> ShowS
Show, (forall x. NodeError -> Rep NodeError x)
-> (forall x. Rep NodeError x -> NodeError) -> Generic NodeError
forall x. Rep NodeError x -> NodeError
forall x. NodeError -> Rep NodeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeError -> Rep NodeError x
from :: forall x. NodeError -> Rep NodeError x
$cto :: forall x. Rep NodeError x -> NodeError
to :: forall x. Rep NodeError x -> NodeError
Generic)

instance NFData NodeError where
  rnf :: NodeError -> ()
rnf (PartOfCycle Located ModuleName
m [FilePathId]
fs)       = Located ModuleName
m Located ModuleName -> () -> ()
forall a b. a -> b -> b
`seq` [FilePathId] -> ()
forall a. NFData a => a -> ()
rnf [FilePathId]
fs
  rnf (FailedToLocateImport Located ModuleName
m) = Located ModuleName
m Located ModuleName -> () -> ()
forall a b. a -> b -> b
`seq` ()
  rnf (ParseError ModuleParseError
e)           = ModuleParseError -> ()
forall a. NFData a => a -> ()
rnf ModuleParseError
e
  rnf (ParentOfErrorNode Located ModuleName
m)    = Located ModuleName
m Located ModuleName -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | A processed node in the dependency graph. If there was any error
-- during processing the node or any of its dependencies, this is an
-- `ErrorNode`. Otherwise it is a `SuccessNode`.
data NodeResult
  = ErrorNode (NonEmpty NodeError)
  | SuccessNode [(Located ModuleName, FilePathId)]
  deriving Key -> NodeResult -> ShowS
[NodeResult] -> ShowS
NodeResult -> String
(Key -> NodeResult -> ShowS)
-> (NodeResult -> String)
-> ([NodeResult] -> ShowS)
-> Show NodeResult
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> NodeResult -> ShowS
showsPrec :: Key -> NodeResult -> ShowS
$cshow :: NodeResult -> String
show :: NodeResult -> String
$cshowList :: [NodeResult] -> ShowS
showList :: [NodeResult] -> ShowS
Show

partitionNodeResults
    :: [(a, NodeResult)]
    -> ([(a, NonEmpty NodeError)], [(a, [(Located ModuleName, FilePathId)])])
partitionNodeResults :: forall a.
[(a, NodeResult)]
-> ([(a, NonEmpty NodeError)],
    [(a, [(Located ModuleName, FilePathId)])])
partitionNodeResults = [Either
   (a, NonEmpty NodeError) (a, [(Located ModuleName, FilePathId)])]
-> ([(a, NonEmpty NodeError)],
    [(a, [(Located ModuleName, FilePathId)])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either
    (a, NonEmpty NodeError) (a, [(Located ModuleName, FilePathId)])]
 -> ([(a, NonEmpty NodeError)],
     [(a, [(Located ModuleName, FilePathId)])]))
-> ([(a, NodeResult)]
    -> [Either
          (a, NonEmpty NodeError) (a, [(Located ModuleName, FilePathId)])])
-> [(a, NodeResult)]
-> ([(a, NonEmpty NodeError)],
    [(a, [(Located ModuleName, FilePathId)])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, NodeResult)
 -> Either
      (a, NonEmpty NodeError) (a, [(Located ModuleName, FilePathId)]))
-> [(a, NodeResult)]
-> [Either
      (a, NonEmpty NodeError) (a, [(Located ModuleName, FilePathId)])]
forall a b. (a -> b) -> [a] -> [b]
map (a, NodeResult)
-> Either
     (a, NonEmpty NodeError) (a, [(Located ModuleName, FilePathId)])
forall {a}.
(a, NodeResult)
-> Either
     (a, NonEmpty NodeError) (a, [(Located ModuleName, FilePathId)])
f
  where f :: (a, NodeResult)
-> Either
     (a, NonEmpty NodeError) (a, [(Located ModuleName, FilePathId)])
f (a
a, ErrorNode NonEmpty NodeError
errs)   = (a, NonEmpty NodeError)
-> Either
     (a, NonEmpty NodeError) (a, [(Located ModuleName, FilePathId)])
forall a b. a -> Either a b
Left (a
a, NonEmpty NodeError
errs)
        f (a
a, SuccessNode [(Located ModuleName, FilePathId)]
imps) = (a, [(Located ModuleName, FilePathId)])
-> Either
     (a, NonEmpty NodeError) (a, [(Located ModuleName, FilePathId)])
forall a b. b -> Either a b
Right (a
a, [(Located ModuleName, FilePathId)]
imps)

instance Semigroup NodeResult where
   ErrorNode NonEmpty NodeError
errs <> :: NodeResult -> NodeResult -> NodeResult
<> ErrorNode NonEmpty NodeError
errs' = NonEmpty NodeError -> NodeResult
ErrorNode (NonEmpty NodeError
errs NonEmpty NodeError -> NonEmpty NodeError -> NonEmpty NodeError
forall a. Semigroup a => a -> a -> a
<> NonEmpty NodeError
errs')
   ErrorNode NonEmpty NodeError
errs <> SuccessNode [(Located ModuleName, FilePathId)]
_   = NonEmpty NodeError -> NodeResult
ErrorNode NonEmpty NodeError
errs
   SuccessNode [(Located ModuleName, FilePathId)]
_ <> ErrorNode NonEmpty NodeError
errs   = NonEmpty NodeError -> NodeResult
ErrorNode NonEmpty NodeError
errs
   SuccessNode [(Located ModuleName, FilePathId)]
a <> SuccessNode [(Located ModuleName, FilePathId)]
_    = [(Located ModuleName, FilePathId)] -> NodeResult
SuccessNode [(Located ModuleName, FilePathId)]
a

processDependencyInformation :: RawDependencyInformation -> BootIdMap -> ModuleGraph -> DependencyInformation
processDependencyInformation :: RawDependencyInformation
-> BootIdMap -> ModuleGraph -> DependencyInformation
processDependencyInformation RawDependencyInformation{IntMap (Either ModuleParseError ModuleImports)
FilePathIdMap ShowableModule
PathIdMap
rawImports :: RawDependencyInformation
-> IntMap (Either ModuleParseError ModuleImports)
rawPathIdMap :: RawDependencyInformation -> PathIdMap
rawModuleMap :: RawDependencyInformation -> FilePathIdMap ShowableModule
rawImports :: IntMap (Either ModuleParseError ModuleImports)
rawPathIdMap :: PathIdMap
rawModuleMap :: FilePathIdMap ShowableModule
..} BootIdMap
rawBootMap ModuleGraph
mg =
  DependencyInformation
    { depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depErrorNodes = [(Key, NonEmpty NodeError)] -> FilePathIdMap (NonEmpty NodeError)
forall a. [(Key, a)] -> IntMap a
IntMap.fromList [(Key, NonEmpty NodeError)]
errorNodes
    , depModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps = FilePathIdMap FilePathIdSet
moduleDeps
    , depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depReverseModuleDeps = FilePathIdMap FilePathIdSet
reverseModuleDeps
    , depModules :: FilePathIdMap ShowableModule
depModules = FilePathIdMap ShowableModule
rawModuleMap
    , depPathIdMap :: PathIdMap
depPathIdMap = PathIdMap
rawPathIdMap
    , depBootMap :: BootIdMap
depBootMap = BootIdMap
rawBootMap
    , depModuleFiles :: ShowableModuleEnv FilePathId
depModuleFiles = ModuleEnv FilePathId -> ShowableModuleEnv FilePathId
forall a. ModuleEnv a -> ShowableModuleEnv a
ShowableModuleEnv ModuleEnv FilePathId
reverseModuleMap
    , depModuleGraph :: ModuleGraph
depModuleGraph = ModuleGraph
mg
    }
  where resultGraph :: FilePathIdMap NodeResult
resultGraph = IntMap (Either ModuleParseError ModuleImports)
-> FilePathIdMap NodeResult
buildResultGraph IntMap (Either ModuleParseError ModuleImports)
rawImports
        ([(Key, NonEmpty NodeError)]
errorNodes, [(Key, [(Located ModuleName, FilePathId)])]
successNodes) = [(Key, NodeResult)]
-> ([(Key, NonEmpty NodeError)],
    [(Key, [(Located ModuleName, FilePathId)])])
forall a.
[(a, NodeResult)]
-> ([(a, NonEmpty NodeError)],
    [(a, [(Located ModuleName, FilePathId)])])
partitionNodeResults ([(Key, NodeResult)]
 -> ([(Key, NonEmpty NodeError)],
     [(Key, [(Located ModuleName, FilePathId)])]))
-> [(Key, NodeResult)]
-> ([(Key, NonEmpty NodeError)],
    [(Key, [(Located ModuleName, FilePathId)])])
forall a b. (a -> b) -> a -> b
$ FilePathIdMap NodeResult -> [(Key, NodeResult)]
forall a. IntMap a -> [(Key, a)]
IntMap.toList FilePathIdMap NodeResult
resultGraph
        successEdges :: [(FilePathId, [FilePathId])]
        successEdges :: [(FilePathId, [FilePathId])]
successEdges =
            ((Key, [(Located ModuleName, FilePathId)])
 -> (FilePathId, [FilePathId]))
-> [(Key, [(Located ModuleName, FilePathId)])]
-> [(FilePathId, [FilePathId])]
forall a b. (a -> b) -> [a] -> [b]
map
              ((Key -> FilePathId)
-> ([(Located ModuleName, FilePathId)] -> [FilePathId])
-> (Key, [(Located ModuleName, FilePathId)])
-> (FilePathId, [FilePathId])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Key -> FilePathId
FilePathId (((Located ModuleName, FilePathId) -> FilePathId)
-> [(Located ModuleName, FilePathId)] -> [FilePathId]
forall a b. (a -> b) -> [a] -> [b]
map (Located ModuleName, FilePathId) -> FilePathId
forall a b. (a, b) -> b
snd))
              [(Key, [(Located ModuleName, FilePathId)])]
successNodes
        moduleDeps :: FilePathIdMap FilePathIdSet
moduleDeps =
          [(Key, FilePathIdSet)] -> FilePathIdMap FilePathIdSet
forall a. [(Key, a)] -> IntMap a
IntMap.fromList ([(Key, FilePathIdSet)] -> FilePathIdMap FilePathIdSet)
-> [(Key, FilePathIdSet)] -> FilePathIdMap FilePathIdSet
forall a b. (a -> b) -> a -> b
$
          ((FilePathId, [FilePathId]) -> (Key, FilePathIdSet))
-> [(FilePathId, [FilePathId])] -> [(Key, FilePathIdSet)]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePathId Key
v, [FilePathId]
vs) -> (Key
v, [Key] -> FilePathIdSet
IntSet.fromList ([Key] -> FilePathIdSet) -> [Key] -> FilePathIdSet
forall a b. (a -> b) -> a -> b
$ [FilePathId] -> [Key]
forall a b. Coercible a b => a -> b
coerce [FilePathId]
vs))
            [(FilePathId, [FilePathId])]
successEdges
        reverseModuleDeps :: FilePathIdMap FilePathIdSet
reverseModuleDeps =
          ((FilePathId, [FilePathId])
 -> FilePathIdMap FilePathIdSet -> FilePathIdMap FilePathIdSet)
-> FilePathIdMap FilePathIdSet
-> [(FilePathId, [FilePathId])]
-> FilePathIdMap FilePathIdSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(FilePathId
p, [FilePathId]
cs) FilePathIdMap FilePathIdSet
res ->
            let new :: FilePathIdMap FilePathIdSet
new = [(Key, FilePathIdSet)] -> FilePathIdMap FilePathIdSet
forall a. [(Key, a)] -> IntMap a
IntMap.fromList ((Key -> (Key, FilePathIdSet)) -> [Key] -> [(Key, FilePathIdSet)]
forall a b. (a -> b) -> [a] -> [b]
map (, Key -> FilePathIdSet
IntSet.singleton (FilePathId -> Key
forall a b. Coercible a b => a -> b
coerce FilePathId
p)) ([FilePathId] -> [Key]
forall a b. Coercible a b => a -> b
coerce [FilePathId]
cs))
            in (FilePathIdSet -> FilePathIdSet -> FilePathIdSet)
-> FilePathIdMap FilePathIdSet
-> FilePathIdMap FilePathIdSet
-> FilePathIdMap FilePathIdSet
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith FilePathIdSet -> FilePathIdSet -> FilePathIdSet
IntSet.union FilePathIdMap FilePathIdSet
new FilePathIdMap FilePathIdSet
res ) FilePathIdMap FilePathIdSet
forall a. IntMap a
IntMap.empty [(FilePathId, [FilePathId])]
successEdges
        reverseModuleMap :: ModuleEnv FilePathId
reverseModuleMap = [(Module, FilePathId)] -> ModuleEnv FilePathId
forall a. [(Module, a)] -> ModuleEnv a
mkModuleEnv ([(Module, FilePathId)] -> ModuleEnv FilePathId)
-> [(Module, FilePathId)] -> ModuleEnv FilePathId
forall a b. (a -> b) -> a -> b
$ ((Key, ShowableModule) -> (Module, FilePathId))
-> [(Key, ShowableModule)] -> [(Module, FilePathId)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Key
i,ShowableModule
sm) -> (ShowableModule -> Module
showableModule ShowableModule
sm, Key -> FilePathId
FilePathId Key
i)) ([(Key, ShowableModule)] -> [(Module, FilePathId)])
-> [(Key, ShowableModule)] -> [(Module, FilePathId)]
forall a b. (a -> b) -> a -> b
$ FilePathIdMap ShowableModule -> [(Key, ShowableModule)]
forall a. IntMap a -> [(Key, a)]
IntMap.toList FilePathIdMap ShowableModule
rawModuleMap


-- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows:
-- 1. Mark each node that is part of an import cycle as an error node.
-- 2. Mark each node that has a parse error as an error node.
-- 3. Mark each node whose immediate children could not be located as an error.
-- 4. Recursively propagate errors to parents if they are not already error nodes.
buildResultGraph :: FilePathIdMap (Either ModuleParseError ModuleImports) -> FilePathIdMap NodeResult
buildResultGraph :: IntMap (Either ModuleParseError ModuleImports)
-> FilePathIdMap NodeResult
buildResultGraph IntMap (Either ModuleParseError ModuleImports)
g = FilePathIdMap NodeResult
propagatedErrors
    where
        sccs :: [SCC FilePathId]
sccs = [(FilePathId, FilePathId, [FilePathId])] -> [SCC FilePathId]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp (IntMap (Either ModuleParseError ModuleImports)
-> [(FilePathId, FilePathId, [FilePathId])]
graphEdges IntMap (Either ModuleParseError ModuleImports)
g)
        ([FilePathId]
_, [[FilePathId]]
cycles) = [SCC FilePathId] -> ([FilePathId], [[FilePathId]])
forall a. [SCC a] -> ([a], [[a]])
partitionSCC [SCC FilePathId]
sccs
        cycleErrors :: IntMap NodeResult
        cycleErrors :: FilePathIdMap NodeResult
cycleErrors = (NodeResult -> NodeResult -> NodeResult)
-> [FilePathIdMap NodeResult] -> FilePathIdMap NodeResult
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith NodeResult -> NodeResult -> NodeResult
forall a. Semigroup a => a -> a -> a
(<>) ([FilePathIdMap NodeResult] -> FilePathIdMap NodeResult)
-> [FilePathIdMap NodeResult] -> FilePathIdMap NodeResult
forall a b. (a -> b) -> a -> b
$ ([FilePathId] -> FilePathIdMap NodeResult)
-> [[FilePathId]] -> [FilePathIdMap NodeResult]
forall a b. (a -> b) -> [a] -> [b]
map [FilePathId] -> FilePathIdMap NodeResult
errorsForCycle [[FilePathId]]
cycles
        errorsForCycle :: [FilePathId] -> IntMap NodeResult
        errorsForCycle :: [FilePathId] -> FilePathIdMap NodeResult
errorsForCycle [FilePathId]
files =
          (NodeResult -> NodeResult -> NodeResult)
-> [(Key, NodeResult)] -> FilePathIdMap NodeResult
forall a. (a -> a -> a) -> [(Key, a)] -> IntMap a
IntMap.fromListWith NodeResult -> NodeResult -> NodeResult
forall a. Semigroup a => a -> a -> a
(<>) ([(Key, NodeResult)] -> FilePathIdMap NodeResult)
-> [(Key, NodeResult)] -> FilePathIdMap NodeResult
forall a b. (a -> b) -> a -> b
$ [(FilePathId, NodeResult)] -> [(Key, NodeResult)]
forall a b. Coercible a b => a -> b
coerce ([(FilePathId, NodeResult)] -> [(Key, NodeResult)])
-> [(FilePathId, NodeResult)] -> [(Key, NodeResult)]
forall a b. (a -> b) -> a -> b
$ (FilePathId -> [(FilePathId, NodeResult)])
-> [FilePathId] -> [(FilePathId, NodeResult)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([FilePathId] -> FilePathId -> [(FilePathId, NodeResult)]
cycleErrorsForFile [FilePathId]
files) [FilePathId]
files
        cycleErrorsForFile :: [FilePathId] -> FilePathId -> [(FilePathId,NodeResult)]
        cycleErrorsForFile :: [FilePathId] -> FilePathId -> [(FilePathId, NodeResult)]
cycleErrorsForFile [FilePathId]
cycles' FilePathId
f =
          let entryPoints :: [Located ModuleName]
entryPoints = (FilePathId -> Maybe (Located ModuleName))
-> [FilePathId] -> [Located ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FilePathId -> FilePathId -> Maybe (Located ModuleName)
findImport FilePathId
f) [FilePathId]
cycles'
          in (Located ModuleName -> (FilePathId, NodeResult))
-> [Located ModuleName] -> [(FilePathId, NodeResult)]
forall a b. (a -> b) -> [a] -> [b]
map (\Located ModuleName
imp -> (FilePathId
f, NonEmpty NodeError -> NodeResult
ErrorNode (Located ModuleName -> [FilePathId] -> NodeError
PartOfCycle Located ModuleName
imp [FilePathId]
cycles' NodeError -> [NodeError] -> NonEmpty NodeError
forall a. a -> [a] -> NonEmpty a
:| []))) [Located ModuleName]
entryPoints
        otherErrors :: FilePathIdMap NodeResult
otherErrors = (Either ModuleParseError ModuleImports -> NodeResult)
-> IntMap (Either ModuleParseError ModuleImports)
-> FilePathIdMap NodeResult
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map Either ModuleParseError ModuleImports -> NodeResult
otherErrorsForFile IntMap (Either ModuleParseError ModuleImports)
g
        otherErrorsForFile :: Either ModuleParseError ModuleImports -> NodeResult
        otherErrorsForFile :: Either ModuleParseError ModuleImports -> NodeResult
otherErrorsForFile (Left ModuleParseError
err) = NonEmpty NodeError -> NodeResult
ErrorNode (ModuleParseError -> NodeError
ParseError ModuleParseError
err NodeError -> [NodeError] -> NonEmpty NodeError
forall a. a -> [a] -> NonEmpty a
:| [])
        otherErrorsForFile (Right ModuleImports{[(Located ModuleName, Maybe FilePathId)]
moduleImports :: ModuleImports -> [(Located ModuleName, Maybe FilePathId)]
moduleImports :: [(Located ModuleName, Maybe FilePathId)]
moduleImports}) =
          let toEither :: (a, Maybe b) -> Either a (a, b)
toEither (a
imp, Maybe b
Nothing)   = a -> Either a (a, b)
forall a b. a -> Either a b
Left a
imp
              toEither (a
imp, Just b
path) = (a, b) -> Either a (a, b)
forall a b. b -> Either a b
Right (a
imp, b
path)
              ([Located ModuleName]
errs, [(Located ModuleName, FilePathId)]
imports') = [Either (Located ModuleName) (Located ModuleName, FilePathId)]
-> ([Located ModuleName], [(Located ModuleName, FilePathId)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (((Located ModuleName, Maybe FilePathId)
 -> Either (Located ModuleName) (Located ModuleName, FilePathId))
-> [(Located ModuleName, Maybe FilePathId)]
-> [Either (Located ModuleName) (Located ModuleName, FilePathId)]
forall a b. (a -> b) -> [a] -> [b]
map (Located ModuleName, Maybe FilePathId)
-> Either (Located ModuleName) (Located ModuleName, FilePathId)
forall {a} {b}. (a, Maybe b) -> Either a (a, b)
toEither [(Located ModuleName, Maybe FilePathId)]
moduleImports)
          in case [Located ModuleName] -> Maybe (NonEmpty (Located ModuleName))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Located ModuleName]
errs of
            Maybe (NonEmpty (Located ModuleName))
Nothing    -> [(Located ModuleName, FilePathId)] -> NodeResult
SuccessNode [(Located ModuleName, FilePathId)]
imports'
            Just NonEmpty (Located ModuleName)
errs' -> NonEmpty NodeError -> NodeResult
ErrorNode ((Located ModuleName -> NodeError)
-> NonEmpty (Located ModuleName) -> NonEmpty NodeError
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map Located ModuleName -> NodeError
FailedToLocateImport NonEmpty (Located ModuleName)
errs')

        unpropagatedErrors :: FilePathIdMap NodeResult
unpropagatedErrors = (NodeResult -> NodeResult -> NodeResult)
-> FilePathIdMap NodeResult
-> FilePathIdMap NodeResult
-> FilePathIdMap NodeResult
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith NodeResult -> NodeResult -> NodeResult
forall a. Semigroup a => a -> a -> a
(<>) FilePathIdMap NodeResult
cycleErrors FilePathIdMap NodeResult
otherErrors
        -- The recursion here is fine since we use a lazy map and
        -- we only recurse on SuccessNodes. In particular, we do not recurse
        -- on nodes that are part of a cycle as they are already marked as
        -- error nodes.
        propagatedErrors :: FilePathIdMap NodeResult
propagatedErrors =
          (NodeResult -> NodeResult)
-> FilePathIdMap NodeResult -> FilePathIdMap NodeResult
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMapLazy.map NodeResult -> NodeResult
propagate FilePathIdMap NodeResult
unpropagatedErrors
        propagate :: NodeResult -> NodeResult
        propagate :: NodeResult -> NodeResult
propagate n :: NodeResult
n@(ErrorNode NonEmpty NodeError
_) = NodeResult
n
        propagate n :: NodeResult
n@(SuccessNode [(Located ModuleName, FilePathId)]
imps) =
          let results :: [(Located ModuleName, NodeResult)]
results = ((Located ModuleName, FilePathId)
 -> (Located ModuleName, NodeResult))
-> [(Located ModuleName, FilePathId)]
-> [(Located ModuleName, NodeResult)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Located ModuleName
imp, FilePathId Key
dep) -> (Located ModuleName
imp, FilePathIdMap NodeResult
propagatedErrors FilePathIdMap NodeResult -> Key -> NodeResult
forall a. IntMap a -> Key -> a
IntMap.! Key
dep)) [(Located ModuleName, FilePathId)]
imps
              ([(Located ModuleName, NonEmpty NodeError)]
errs, [(Located ModuleName, [(Located ModuleName, FilePathId)])]
_) = [(Located ModuleName, NodeResult)]
-> ([(Located ModuleName, NonEmpty NodeError)],
    [(Located ModuleName, [(Located ModuleName, FilePathId)])])
forall a.
[(a, NodeResult)]
-> ([(a, NonEmpty NodeError)],
    [(a, [(Located ModuleName, FilePathId)])])
partitionNodeResults [(Located ModuleName, NodeResult)]
results
          in case [(Located ModuleName, NonEmpty NodeError)]
-> Maybe (NonEmpty (Located ModuleName, NonEmpty NodeError))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(Located ModuleName, NonEmpty NodeError)]
errs of
               Maybe (NonEmpty (Located ModuleName, NonEmpty NodeError))
Nothing -> NodeResult
n
               Just NonEmpty (Located ModuleName, NonEmpty NodeError)
errs' -> NonEmpty NodeError -> NodeResult
ErrorNode (((Located ModuleName, NonEmpty NodeError) -> NodeError)
-> NonEmpty (Located ModuleName, NonEmpty NodeError)
-> NonEmpty NodeError
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (Located ModuleName -> NodeError
ParentOfErrorNode (Located ModuleName -> NodeError)
-> ((Located ModuleName, NonEmpty NodeError) -> Located ModuleName)
-> (Located ModuleName, NonEmpty NodeError)
-> NodeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located ModuleName, NonEmpty NodeError) -> Located ModuleName
forall a b. (a, b) -> a
fst) NonEmpty (Located ModuleName, NonEmpty NodeError)
errs')
        findImport :: FilePathId -> FilePathId -> Maybe (Located ModuleName)
        findImport :: FilePathId -> FilePathId -> Maybe (Located ModuleName)
findImport (FilePathId Key
file) FilePathId
importedFile =
          case IntMap (Either ModuleParseError ModuleImports)
g IntMap (Either ModuleParseError ModuleImports)
-> Key -> Either ModuleParseError ModuleImports
forall a. IntMap a -> Key -> a
IntMap.! Key
file of
            Left ModuleParseError
_ -> String -> Maybe (Located ModuleName)
forall a. HasCallStack => String -> a
error String
"Tried to call findImport on a module with a parse error"
            Right ModuleImports{[(Located ModuleName, Maybe FilePathId)]
moduleImports :: ModuleImports -> [(Located ModuleName, Maybe FilePathId)]
moduleImports :: [(Located ModuleName, Maybe FilePathId)]
moduleImports} ->
              ((Located ModuleName, Maybe FilePathId) -> Located ModuleName)
-> Maybe (Located ModuleName, Maybe FilePathId)
-> Maybe (Located ModuleName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Located ModuleName, Maybe FilePathId) -> Located ModuleName
forall a b. (a, b) -> a
fst (Maybe (Located ModuleName, Maybe FilePathId)
 -> Maybe (Located ModuleName))
-> Maybe (Located ModuleName, Maybe FilePathId)
-> Maybe (Located ModuleName)
forall a b. (a -> b) -> a -> b
$ ((Located ModuleName, Maybe FilePathId) -> Bool)
-> [(Located ModuleName, Maybe FilePathId)]
-> Maybe (Located ModuleName, Maybe FilePathId)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Located ModuleName
_, Maybe FilePathId
resolvedImp) -> Maybe FilePathId
resolvedImp Maybe FilePathId -> Maybe FilePathId -> Bool
forall a. Eq a => a -> a -> Bool
== FilePathId -> Maybe FilePathId
forall a. a -> Maybe a
Just FilePathId
importedFile) [(Located ModuleName, Maybe FilePathId)]
moduleImports

graphEdges :: FilePathIdMap (Either ModuleParseError ModuleImports) -> [(FilePathId, FilePathId, [FilePathId])]
graphEdges :: IntMap (Either ModuleParseError ModuleImports)
-> [(FilePathId, FilePathId, [FilePathId])]
graphEdges IntMap (Either ModuleParseError ModuleImports)
g =
  ((Key, Either ModuleParseError ModuleImports)
 -> (FilePathId, FilePathId, [FilePathId]))
-> [(Key, Either ModuleParseError ModuleImports)]
-> [(FilePathId, FilePathId, [FilePathId])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Key
k, Either ModuleParseError ModuleImports
v) -> (Key -> FilePathId
FilePathId Key
k, Key -> FilePathId
FilePathId Key
k, Either ModuleParseError ModuleImports -> [FilePathId]
forall e. Either e ModuleImports -> [FilePathId]
deps Either ModuleParseError ModuleImports
v)) ([(Key, Either ModuleParseError ModuleImports)]
 -> [(FilePathId, FilePathId, [FilePathId])])
-> [(Key, Either ModuleParseError ModuleImports)]
-> [(FilePathId, FilePathId, [FilePathId])]
forall a b. (a -> b) -> a -> b
$ IntMap (Either ModuleParseError ModuleImports)
-> [(Key, Either ModuleParseError ModuleImports)]
forall a. IntMap a -> [(Key, a)]
IntMap.toList IntMap (Either ModuleParseError ModuleImports)
g
  where deps :: Either e ModuleImports -> [FilePathId]
        deps :: forall e. Either e ModuleImports -> [FilePathId]
deps (Left e
_)                             = []
        deps (Right ModuleImports{[(Located ModuleName, Maybe FilePathId)]
moduleImports :: ModuleImports -> [(Located ModuleName, Maybe FilePathId)]
moduleImports :: [(Located ModuleName, Maybe FilePathId)]
moduleImports}) = ((Located ModuleName, Maybe FilePathId) -> Maybe FilePathId)
-> [(Located ModuleName, Maybe FilePathId)] -> [FilePathId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Located ModuleName, Maybe FilePathId) -> Maybe FilePathId
forall a b. (a, b) -> b
snd [(Located ModuleName, Maybe FilePathId)]
moduleImports

partitionSCC :: [SCC a] -> ([a], [[a]])
partitionSCC :: forall a. [SCC a] -> ([a], [[a]])
partitionSCC (CyclicSCC [a]
xs:[SCC a]
rest) = ([[a]] -> [[a]]) -> ([a], [[a]]) -> ([a], [[a]])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([a]
xs:) (([a], [[a]]) -> ([a], [[a]])) -> ([a], [[a]]) -> ([a], [[a]])
forall a b. (a -> b) -> a -> b
$ [SCC a] -> ([a], [[a]])
forall a. [SCC a] -> ([a], [[a]])
partitionSCC [SCC a]
rest
partitionSCC (AcyclicSCC a
x:[SCC a]
rest) = ([a] -> [a]) -> ([a], [[a]]) -> ([a], [[a]])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a
x:)   (([a], [[a]]) -> ([a], [[a]])) -> ([a], [[a]]) -> ([a], [[a]])
forall a b. (a -> b) -> a -> b
$ [SCC a] -> ([a], [[a]])
forall a. [SCC a] -> ([a], [[a]])
partitionSCC [SCC a]
rest
partitionSCC []                  = ([], [])

-- | Transitive reverse dependencies of a file
transitiveReverseDependencies :: NormalizedFilePath -> DependencyInformation -> Maybe [NormalizedFilePath]
transitiveReverseDependencies :: NormalizedFilePath
-> DependencyInformation -> Maybe [NormalizedFilePath]
transitiveReverseDependencies NormalizedFilePath
file DependencyInformation{FilePathIdMap (NonEmpty NodeError)
FilePathIdMap FilePathIdSet
FilePathIdMap ShowableModule
BootIdMap
ModuleGraph
ShowableModuleEnv FilePathId
PathIdMap
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
depModules :: DependencyInformation -> FilePathIdMap ShowableModule
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depPathIdMap :: DependencyInformation -> PathIdMap
depBootMap :: DependencyInformation -> BootIdMap
depModuleFiles :: DependencyInformation -> ShowableModuleEnv FilePathId
depModuleGraph :: DependencyInformation -> ModuleGraph
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depModules :: FilePathIdMap ShowableModule
depModuleDeps :: FilePathIdMap FilePathIdSet
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depPathIdMap :: PathIdMap
depBootMap :: BootIdMap
depModuleFiles :: ShowableModuleEnv FilePathId
depModuleGraph :: ModuleGraph
..} = do
    FilePathId Key
cur_id <- PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId PathIdMap
depPathIdMap NormalizedFilePath
file
    [NormalizedFilePath] -> Maybe [NormalizedFilePath]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([NormalizedFilePath] -> Maybe [NormalizedFilePath])
-> [NormalizedFilePath] -> Maybe [NormalizedFilePath]
forall a b. (a -> b) -> a -> b
$ (Key -> NormalizedFilePath) -> [Key] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap (FilePathId -> NormalizedFilePath)
-> (Key -> FilePathId) -> Key -> NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> FilePathId
FilePathId) (FilePathIdSet -> [Key]
IntSet.toList (Key -> FilePathIdSet -> FilePathIdSet
go Key
cur_id FilePathIdSet
IntSet.empty))
  where
    go :: Int -> IntSet -> IntSet
    go :: Key -> FilePathIdSet -> FilePathIdSet
go Key
k FilePathIdSet
i =
      let outwards :: FilePathIdSet
outwards = FilePathIdSet
-> Key -> FilePathIdMap FilePathIdSet -> FilePathIdSet
forall a. a -> Key -> IntMap a -> a
IntMap.findWithDefault FilePathIdSet
IntSet.empty Key
k FilePathIdMap FilePathIdSet
depReverseModuleDeps
          res :: FilePathIdSet
res = FilePathIdSet -> FilePathIdSet -> FilePathIdSet
IntSet.union FilePathIdSet
i FilePathIdSet
outwards
          new :: FilePathIdSet
new = FilePathIdSet -> FilePathIdSet -> FilePathIdSet
IntSet.difference FilePathIdSet
i FilePathIdSet
outwards
      in (Key -> FilePathIdSet -> FilePathIdSet)
-> FilePathIdSet -> FilePathIdSet -> FilePathIdSet
forall b. (Key -> b -> b) -> b -> FilePathIdSet -> b
IntSet.foldr Key -> FilePathIdSet -> FilePathIdSet
go FilePathIdSet
res FilePathIdSet
new

-- | Immediate reverse dependencies of a file
immediateReverseDependencies :: NormalizedFilePath -> DependencyInformation -> Maybe [NormalizedFilePath]
immediateReverseDependencies :: NormalizedFilePath
-> DependencyInformation -> Maybe [NormalizedFilePath]
immediateReverseDependencies NormalizedFilePath
file DependencyInformation{FilePathIdMap (NonEmpty NodeError)
FilePathIdMap FilePathIdSet
FilePathIdMap ShowableModule
BootIdMap
ModuleGraph
ShowableModuleEnv FilePathId
PathIdMap
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
depModules :: DependencyInformation -> FilePathIdMap ShowableModule
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depPathIdMap :: DependencyInformation -> PathIdMap
depBootMap :: DependencyInformation -> BootIdMap
depModuleFiles :: DependencyInformation -> ShowableModuleEnv FilePathId
depModuleGraph :: DependencyInformation -> ModuleGraph
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depModules :: FilePathIdMap ShowableModule
depModuleDeps :: FilePathIdMap FilePathIdSet
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depPathIdMap :: PathIdMap
depBootMap :: BootIdMap
depModuleFiles :: ShowableModuleEnv FilePathId
depModuleGraph :: ModuleGraph
..} = do
  FilePathId Key
cur_id <- PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId PathIdMap
depPathIdMap NormalizedFilePath
file
  [NormalizedFilePath] -> Maybe [NormalizedFilePath]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([NormalizedFilePath] -> Maybe [NormalizedFilePath])
-> [NormalizedFilePath] -> Maybe [NormalizedFilePath]
forall a b. (a -> b) -> a -> b
$ (Key -> NormalizedFilePath) -> [Key] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap (FilePathId -> NormalizedFilePath)
-> (Key -> FilePathId) -> Key -> NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> FilePathId
FilePathId) ([Key] -> (FilePathIdSet -> [Key]) -> Maybe FilePathIdSet -> [Key]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Key]
forall a. Monoid a => a
mempty FilePathIdSet -> [Key]
IntSet.toList (Key -> FilePathIdMap FilePathIdSet -> Maybe FilePathIdSet
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Key
cur_id FilePathIdMap FilePathIdSet
depReverseModuleDeps))

-- | returns all transitive dependencies in topological order.
transitiveDeps :: DependencyInformation -> NormalizedFilePath -> Maybe TransitiveDependencies
transitiveDeps :: DependencyInformation
-> NormalizedFilePath -> Maybe TransitiveDependencies
transitiveDeps DependencyInformation{FilePathIdMap (NonEmpty NodeError)
FilePathIdMap FilePathIdSet
FilePathIdMap ShowableModule
BootIdMap
ModuleGraph
ShowableModuleEnv FilePathId
PathIdMap
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
depModules :: DependencyInformation -> FilePathIdMap ShowableModule
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depPathIdMap :: DependencyInformation -> PathIdMap
depBootMap :: DependencyInformation -> BootIdMap
depModuleFiles :: DependencyInformation -> ShowableModuleEnv FilePathId
depModuleGraph :: DependencyInformation -> ModuleGraph
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depModules :: FilePathIdMap ShowableModule
depModuleDeps :: FilePathIdMap FilePathIdSet
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depPathIdMap :: PathIdMap
depBootMap :: BootIdMap
depModuleFiles :: ShowableModuleEnv FilePathId
depModuleGraph :: ModuleGraph
..} NormalizedFilePath
file = do
  !FilePathId
fileId <- PathIdMap -> NormalizedFilePath -> Maybe FilePathId
pathToId PathIdMap
depPathIdMap NormalizedFilePath
file
  FilePathIdSet
reachableVs <-
      -- Delete the starting node
      Key -> FilePathIdSet -> FilePathIdSet
IntSet.delete (FilePathId -> Key
getFilePathId FilePathId
fileId) (FilePathIdSet -> FilePathIdSet)
-> (Key -> FilePathIdSet) -> Key -> FilePathIdSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Key] -> FilePathIdSet
IntSet.fromList ([Key] -> FilePathIdSet) -> (Key -> [Key]) -> Key -> FilePathIdSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> Key) -> [Key] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map ((Key, Key, [Key]) -> Key
forall a b c. (a, b, c) -> a
fst3 ((Key, Key, [Key]) -> Key)
-> (Key -> (Key, Key, [Key])) -> Key -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> (Key, Key, [Key])
fromVertex) ([Key] -> [Key]) -> (Key -> [Key]) -> Key -> [Key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Graph -> Key -> [Key]
reachable Graph
g (Key -> FilePathIdSet) -> Maybe Key -> Maybe FilePathIdSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Maybe Key
toVertex (FilePathId -> Key
getFilePathId FilePathId
fileId)
  let transitiveModuleDepIds :: [Key]
transitiveModuleDepIds =
        (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Key
v -> Key
v Key -> FilePathIdSet -> Bool
`IntSet.member` FilePathIdSet
reachableVs) ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ (Key -> Key) -> [Key] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map ((Key, Key, [Key]) -> Key
forall a b c. (a, b, c) -> a
fst3 ((Key, Key, [Key]) -> Key)
-> (Key -> (Key, Key, [Key])) -> Key -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> (Key, Key, [Key])
fromVertex) [Key]
vs
  let transitiveModuleDeps :: [NormalizedFilePath]
transitiveModuleDeps =
        (Key -> NormalizedFilePath) -> [Key] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap (FilePathId -> NormalizedFilePath)
-> (Key -> FilePathId) -> Key -> NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> FilePathId
FilePathId) [Key]
transitiveModuleDepIds
  TransitiveDependencies -> Maybe TransitiveDependencies
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransitiveDependencies {[NormalizedFilePath]
transitiveModuleDeps :: [NormalizedFilePath]
transitiveModuleDeps :: [NormalizedFilePath]
..}
  where
    (Graph
g, Key -> (Key, Key, [Key])
fromVertex, Key -> Maybe Key
toVertex) = [(Key, Key, [Key])]
-> (Graph, Key -> (Key, Key, [Key]), Key -> Maybe Key)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Key -> (node, key, [key]), key -> Maybe Key)
graphFromEdges [(Key, Key, [Key])]
edges
    edges :: [(Key, Key, [Key])]
edges = ((Key, FilePathIdSet) -> (Key, Key, [Key]))
-> [(Key, FilePathIdSet)] -> [(Key, Key, [Key])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Key
f, FilePathIdSet
fs) -> (Key
f, Key
f, FilePathIdSet -> [Key]
IntSet.toList FilePathIdSet
fs [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ Key -> [Key]
boot_edge Key
f)) ([(Key, FilePathIdSet)] -> [(Key, Key, [Key])])
-> [(Key, FilePathIdSet)] -> [(Key, Key, [Key])]
forall a b. (a -> b) -> a -> b
$ FilePathIdMap FilePathIdSet -> [(Key, FilePathIdSet)]
forall a. IntMap a -> [(Key, a)]
IntMap.toList FilePathIdMap FilePathIdSet
depModuleDeps

    -- Need to add an edge between the .hs and .hs-boot file if it exists
    -- so the .hs file gets loaded after the .hs-boot file and the right
    -- stuff ends up in the HPT. If you don't have this check then GHC will
    -- fail to work with ghcide.
    boot_edge :: Key -> [Key]
boot_edge Key
f = [FilePathId -> Key
getFilePathId FilePathId
f' | Just FilePathId
f' <- [Key -> BootIdMap -> Maybe FilePathId
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Key
f BootIdMap
depBootMap]]

    vs :: [Key]
vs = Graph -> [Key]
topSort Graph
g

lookupModuleFile :: Module -> DependencyInformation -> Maybe NormalizedFilePath
lookupModuleFile :: Module -> DependencyInformation -> Maybe NormalizedFilePath
lookupModuleFile Module
mod DependencyInformation{FilePathIdMap (NonEmpty NodeError)
FilePathIdMap FilePathIdSet
FilePathIdMap ShowableModule
BootIdMap
ModuleGraph
ShowableModuleEnv FilePathId
PathIdMap
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
depModules :: DependencyInformation -> FilePathIdMap ShowableModule
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depPathIdMap :: DependencyInformation -> PathIdMap
depBootMap :: DependencyInformation -> BootIdMap
depModuleFiles :: DependencyInformation -> ShowableModuleEnv FilePathId
depModuleGraph :: DependencyInformation -> ModuleGraph
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depModules :: FilePathIdMap ShowableModule
depModuleDeps :: FilePathIdMap FilePathIdSet
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depPathIdMap :: PathIdMap
depBootMap :: BootIdMap
depModuleFiles :: ShowableModuleEnv FilePathId
depModuleGraph :: ModuleGraph
..}
  = PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap (FilePathId -> NormalizedFilePath)
-> Maybe FilePathId -> Maybe NormalizedFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleEnv FilePathId -> Module -> Maybe FilePathId
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv (ShowableModuleEnv FilePathId -> ModuleEnv FilePathId
forall a. ShowableModuleEnv a -> ModuleEnv a
showableModuleEnv ShowableModuleEnv FilePathId
depModuleFiles) Module
mod

newtype TransitiveDependencies = TransitiveDependencies
  { TransitiveDependencies -> [NormalizedFilePath]
transitiveModuleDeps :: [NormalizedFilePath]
  -- ^ Transitive module dependencies in topological order.
  -- The module itself is not included.
  } deriving (TransitiveDependencies -> TransitiveDependencies -> Bool
(TransitiveDependencies -> TransitiveDependencies -> Bool)
-> (TransitiveDependencies -> TransitiveDependencies -> Bool)
-> Eq TransitiveDependencies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransitiveDependencies -> TransitiveDependencies -> Bool
== :: TransitiveDependencies -> TransitiveDependencies -> Bool
$c/= :: TransitiveDependencies -> TransitiveDependencies -> Bool
/= :: TransitiveDependencies -> TransitiveDependencies -> Bool
Eq, Key -> TransitiveDependencies -> ShowS
[TransitiveDependencies] -> ShowS
TransitiveDependencies -> String
(Key -> TransitiveDependencies -> ShowS)
-> (TransitiveDependencies -> String)
-> ([TransitiveDependencies] -> ShowS)
-> Show TransitiveDependencies
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> TransitiveDependencies -> ShowS
showsPrec :: Key -> TransitiveDependencies -> ShowS
$cshow :: TransitiveDependencies -> String
show :: TransitiveDependencies -> String
$cshowList :: [TransitiveDependencies] -> ShowS
showList :: [TransitiveDependencies] -> ShowS
Show, (forall x. TransitiveDependencies -> Rep TransitiveDependencies x)
-> (forall x.
    Rep TransitiveDependencies x -> TransitiveDependencies)
-> Generic TransitiveDependencies
forall x. Rep TransitiveDependencies x -> TransitiveDependencies
forall x. TransitiveDependencies -> Rep TransitiveDependencies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TransitiveDependencies -> Rep TransitiveDependencies x
from :: forall x. TransitiveDependencies -> Rep TransitiveDependencies x
$cto :: forall x. Rep TransitiveDependencies x -> TransitiveDependencies
to :: forall x. Rep TransitiveDependencies x -> TransitiveDependencies
Generic)

instance NFData TransitiveDependencies

data NamedModuleDep = NamedModuleDep {
  NamedModuleDep -> NormalizedFilePath
nmdFilePath    :: !NormalizedFilePath,
  NamedModuleDep -> ModuleName
nmdModuleName  :: !ModuleName,
  NamedModuleDep -> Maybe ModLocation
nmdModLocation :: !(Maybe ModLocation)
  }
  deriving (forall x. NamedModuleDep -> Rep NamedModuleDep x)
-> (forall x. Rep NamedModuleDep x -> NamedModuleDep)
-> Generic NamedModuleDep
forall x. Rep NamedModuleDep x -> NamedModuleDep
forall x. NamedModuleDep -> Rep NamedModuleDep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NamedModuleDep -> Rep NamedModuleDep x
from :: forall x. NamedModuleDep -> Rep NamedModuleDep x
$cto :: forall x. Rep NamedModuleDep x -> NamedModuleDep
to :: forall x. Rep NamedModuleDep x -> NamedModuleDep
Generic

instance Eq NamedModuleDep where
  NamedModuleDep
a == :: NamedModuleDep -> NamedModuleDep -> Bool
== NamedModuleDep
b = NamedModuleDep -> NormalizedFilePath
nmdFilePath NamedModuleDep
a NormalizedFilePath -> NormalizedFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== NamedModuleDep -> NormalizedFilePath
nmdFilePath NamedModuleDep
b

instance NFData NamedModuleDep where
  rnf :: NamedModuleDep -> ()
rnf NamedModuleDep{Maybe ModLocation
ModuleName
NormalizedFilePath
nmdFilePath :: NamedModuleDep -> NormalizedFilePath
nmdModuleName :: NamedModuleDep -> ModuleName
nmdModLocation :: NamedModuleDep -> Maybe ModLocation
nmdFilePath :: NormalizedFilePath
nmdModuleName :: ModuleName
nmdModLocation :: Maybe ModLocation
..} =
    NormalizedFilePath -> ()
forall a. NFData a => a -> ()
rnf NormalizedFilePath
nmdFilePath () -> () -> ()
forall a b. a -> b -> b
`seq`
    ModuleName -> ()
forall a. NFData a => a -> ()
rnf ModuleName
nmdModuleName () -> () -> ()
forall a b. a -> b -> b
`seq`
    -- 'ModLocation' lacks an 'NFData' instance
    Maybe ModLocation -> ()
forall a. a -> ()
rwhnf Maybe ModLocation
nmdModLocation

instance Show NamedModuleDep where
  show :: NamedModuleDep -> String
show NamedModuleDep{Maybe ModLocation
ModuleName
NormalizedFilePath
nmdFilePath :: NamedModuleDep -> NormalizedFilePath
nmdModuleName :: NamedModuleDep -> ModuleName
nmdModLocation :: NamedModuleDep -> Maybe ModLocation
nmdFilePath :: NormalizedFilePath
nmdModuleName :: ModuleName
nmdModLocation :: Maybe ModLocation
..} = NormalizedFilePath -> String
forall a. Show a => a -> String
show NormalizedFilePath
nmdFilePath