-- Copyright (c) 2019 The DAML Authors. All rights reserved.

-- SPDX-License-Identifier: Apache-2.0


module Development.IDE.Import.DependencyInformation
  ( DependencyInformation(..)
  , ModuleImports(..)
  , RawDependencyInformation(..)
  , NodeError(..)
  , ModuleParseError(..)
  , TransitiveDependencies(..)
  , FilePathId(..)
  , NamedModuleDep(..)

  , PathIdMap
  , emptyPathIdMap
  , getPathId
  , lookupPathToId
  , insertImport
  , pathToId
  , idToPath
  , reachableModules
  , processDependencyInformation
  , transitiveDeps
  , transitiveReverseDependencies
  , immediateReverseDependencies

  , BootIdMap
  , insertBootId
  ) where

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

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

import GHC
import Module

-- | The imports for a given module.

data 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)

    , ModuleImports -> Set InstalledUnitId
packageImports :: !(Set InstalledUnitId)
    -- ^ Transitive package dependencies unioned for all imports.

    } deriving Int -> ModuleImports -> ShowS
[ModuleImports] -> ShowS
ModuleImports -> String
(Int -> ModuleImports -> ShowS)
-> (ModuleImports -> String)
-> ([ModuleImports] -> ShowS)
-> Show ModuleImports
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleImports] -> ShowS
$cshowList :: [ModuleImports] -> ShowS
show :: ModuleImports -> String
$cshow :: ModuleImports -> String
showsPrec :: Int -> ModuleImports -> ShowS
$cshowsPrec :: Int -> 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 -> Int
getFilePathId :: Int }
  deriving (Int -> FilePathId -> ShowS
[FilePathId] -> ShowS
FilePathId -> String
(Int -> FilePathId -> ShowS)
-> (FilePathId -> String)
-> ([FilePathId] -> ShowS)
-> Show FilePathId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilePathId] -> ShowS
$cshowList :: [FilePathId] -> ShowS
show :: FilePathId -> String
$cshow :: FilePathId -> String
showsPrec :: Int -> FilePathId -> ShowS
$cshowsPrec :: Int -> FilePathId -> ShowS
Show, FilePathId -> ()
(FilePathId -> ()) -> NFData FilePathId
forall a. (a -> ()) -> NFData a
rnf :: FilePathId -> ()
$crnf :: FilePathId -> ()
NFData, FilePathId -> FilePathId -> Bool
(FilePathId -> FilePathId -> Bool)
-> (FilePathId -> FilePathId -> Bool) -> Eq FilePathId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilePathId -> FilePathId -> Bool
$c/= :: FilePathId -> FilePathId -> Bool
== :: FilePathId -> FilePathId -> Bool
$c== :: 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
min :: FilePathId -> FilePathId -> FilePathId
$cmin :: FilePathId -> FilePathId -> FilePathId
max :: FilePathId -> FilePathId -> FilePathId
$cmax :: FilePathId -> FilePathId -> FilePathId
>= :: FilePathId -> FilePathId -> Bool
$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
compare :: FilePathId -> FilePathId -> Ordering
$ccompare :: FilePathId -> FilePathId -> Ordering
$cp1Ord :: Eq 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)
  }
  deriving (Int -> PathIdMap -> ShowS
[PathIdMap] -> ShowS
PathIdMap -> String
(Int -> PathIdMap -> ShowS)
-> (PathIdMap -> String)
-> ([PathIdMap] -> ShowS)
-> Show PathIdMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathIdMap] -> ShowS
$cshowList :: [PathIdMap] -> ShowS
show :: PathIdMap -> String
$cshow :: PathIdMap -> String
showsPrec :: Int -> PathIdMap -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep PathIdMap x -> PathIdMap
$cfrom :: forall x. PathIdMap -> Rep PathIdMap x
Generic)

instance NFData PathIdMap

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

getPathId :: ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)
getPathId :: ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)
getPathId ArtifactsLocation
path m :: PathIdMap
m@PathIdMap{HashMap NormalizedFilePath FilePathId
FilePathIdMap ArtifactsLocation
pathToIdMap :: HashMap NormalizedFilePath FilePathId
idToPathMap :: FilePathIdMap ArtifactsLocation
pathToIdMap :: PathIdMap -> HashMap NormalizedFilePath FilePathId
idToPathMap :: PathIdMap -> FilePathIdMap ArtifactsLocation
..} =
    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 = Int -> FilePathId
FilePathId (Int -> FilePathId) -> Int -> FilePathId
forall a b. (a -> b) -> a -> b
$ HashMap NormalizedFilePath FilePathId -> Int
forall k v. HashMap k v -> Int
HMS.size HashMap NormalizedFilePath FilePathId
pathToIdMap
            in (FilePathId
newId, ArtifactsLocation -> FilePathId -> PathIdMap -> PathIdMap
insertPathId ArtifactsLocation
path FilePathId
newId PathIdMap
m)
        Just FilePathId
id -> (FilePathId
id, PathIdMap
m)

insertPathId :: ArtifactsLocation -> FilePathId -> PathIdMap -> PathIdMap
insertPathId :: ArtifactsLocation -> FilePathId -> PathIdMap -> PathIdMap
insertPathId ArtifactsLocation
path FilePathId
id PathIdMap{HashMap NormalizedFilePath FilePathId
FilePathIdMap ArtifactsLocation
pathToIdMap :: HashMap NormalizedFilePath FilePathId
idToPathMap :: FilePathIdMap ArtifactsLocation
pathToIdMap :: PathIdMap -> HashMap NormalizedFilePath FilePathId
idToPathMap :: PathIdMap -> FilePathIdMap ArtifactsLocation
..} =
    FilePathIdMap ArtifactsLocation
-> HashMap NormalizedFilePath FilePathId -> PathIdMap
PathIdMap (Int
-> ArtifactsLocation
-> FilePathIdMap ArtifactsLocation
-> FilePathIdMap ArtifactsLocation
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (FilePathId -> Int
getFilePathId FilePathId
id) 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
id HashMap NormalizedFilePath FilePathId
pathToIdMap)

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

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

lookupPathToId :: PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId :: PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId PathIdMap{HashMap NormalizedFilePath FilePathId
pathToIdMap :: HashMap NormalizedFilePath FilePathId
pathToIdMap :: PathIdMap -> 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 :: FilePathIdMap ArtifactsLocation
idToPathMap :: PathIdMap -> FilePathIdMap ArtifactsLocation
idToPathMap} (FilePathId Int
id) = FilePathIdMap ArtifactsLocation
idToPathMap FilePathIdMap ArtifactsLocation -> Int -> ArtifactsLocation
forall a. IntMap a -> Int -> a
IntMap.! Int
id

type BootIdMap = FilePathIdMap FilePathId

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

-- | Unprocessed results that we find by following imports recursively.

data RawDependencyInformation = RawDependencyInformation
    { RawDependencyInformation
-> FilePathIdMap (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 -> BootIdMap
rawBootMap :: !BootIdMap
    } deriving Int -> RawDependencyInformation -> ShowS
[RawDependencyInformation] -> ShowS
RawDependencyInformation -> String
(Int -> RawDependencyInformation -> ShowS)
-> (RawDependencyInformation -> String)
-> ([RawDependencyInformation] -> ShowS)
-> Show RawDependencyInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawDependencyInformation] -> ShowS
$cshowList :: [RawDependencyInformation] -> ShowS
show :: RawDependencyInformation -> String
$cshow :: RawDependencyInformation -> String
showsPrec :: Int -> RawDependencyInformation -> ShowS
$cshowsPrec :: Int -> RawDependencyInformation -> ShowS
Show

pkgDependencies :: RawDependencyInformation -> FilePathIdMap (Set InstalledUnitId)
pkgDependencies :: RawDependencyInformation -> FilePathIdMap (Set InstalledUnitId)
pkgDependencies RawDependencyInformation{FilePathIdMap (Either ModuleParseError ModuleImports)
BootIdMap
PathIdMap
rawBootMap :: BootIdMap
rawPathIdMap :: PathIdMap
rawImports :: FilePathIdMap (Either ModuleParseError ModuleImports)
rawBootMap :: RawDependencyInformation -> BootIdMap
rawPathIdMap :: RawDependencyInformation -> PathIdMap
rawImports :: RawDependencyInformation
-> FilePathIdMap (Either ModuleParseError ModuleImports)
..} =
    (Either ModuleParseError ModuleImports -> Set InstalledUnitId)
-> FilePathIdMap (Either ModuleParseError ModuleImports)
-> FilePathIdMap (Set InstalledUnitId)
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map ((ModuleParseError -> Set InstalledUnitId)
-> (ModuleImports -> Set InstalledUnitId)
-> Either ModuleParseError ModuleImports
-> Set InstalledUnitId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Set InstalledUnitId -> ModuleParseError -> Set InstalledUnitId
forall a b. a -> b -> a
const Set InstalledUnitId
forall a. Set a
Set.empty) ModuleImports -> Set InstalledUnitId
packageImports) FilePathIdMap (Either ModuleParseError ModuleImports)
rawImports

data DependencyInformation =
  DependencyInformation
    { DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
depErrorNodes :: !(FilePathIdMap (NonEmpty NodeError))
    -- ^ Nodes that cannot be processed correctly.

    , DependencyInformation -> FilePathIdMap ShowableModuleName
depModuleNames :: !(FilePathIdMap ShowableModuleName)
    , 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 -> FilePathIdMap (Set InstalledUnitId)
depPkgDeps :: !(FilePathIdMap (Set InstalledUnitId))
    -- ^ For a non-error node, this contains the set of immediate pkg deps.

    , DependencyInformation -> PathIdMap
depPathIdMap :: !PathIdMap
    -- ^ Map from FilePath to FilePathId

    , DependencyInformation -> BootIdMap
depBootMap :: !BootIdMap
    -- ^ Map from hs-boot file to the corresponding hs file

    } deriving (Int -> DependencyInformation -> ShowS
[DependencyInformation] -> ShowS
DependencyInformation -> String
(Int -> DependencyInformation -> ShowS)
-> (DependencyInformation -> String)
-> ([DependencyInformation] -> ShowS)
-> Show DependencyInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DependencyInformation] -> ShowS
$cshowList :: [DependencyInformation] -> ShowS
show :: DependencyInformation -> String
$cshow :: DependencyInformation -> String
showsPrec :: Int -> DependencyInformation -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep DependencyInformation x -> DependencyInformation
$cfrom :: forall x. DependencyInformation -> Rep DependencyInformation x
Generic)

newtype ShowableModuleName =
  ShowableModuleName {ShowableModuleName -> ModuleName
showableModuleName :: ModuleName}
  deriving ShowableModuleName -> ()
(ShowableModuleName -> ()) -> NFData ShowableModuleName
forall a. (a -> ()) -> NFData a
rnf :: ShowableModuleName -> ()
$crnf :: ShowableModuleName -> ()
NFData

instance Show ShowableModuleName where show :: ShowableModuleName -> String
show = ModuleName -> String
moduleNameString (ModuleName -> String)
-> (ShowableModuleName -> ModuleName)
-> ShowableModuleName
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowableModuleName -> ModuleName
showableModuleName

reachableModules :: DependencyInformation -> [NormalizedFilePath]
reachableModules :: DependencyInformation -> [NormalizedFilePath]
reachableModules DependencyInformation{FilePathIdMap (NonEmpty NodeError)
FilePathIdMap FilePathIdSet
FilePathIdMap (Set InstalledUnitId)
FilePathIdMap ShowableModuleName
BootIdMap
PathIdMap
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depPkgDeps :: FilePathIdMap (Set InstalledUnitId)
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModuleNames :: FilePathIdMap ShowableModuleName
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
depPkgDeps :: DependencyInformation -> FilePathIdMap (Set InstalledUnitId)
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleNames :: DependencyInformation -> FilePathIdMap ShowableModuleName
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
..} =
    (Int -> NormalizedFilePath) -> [Int] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap (FilePathId -> NormalizedFilePath)
-> (Int -> FilePathId) -> Int -> NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePathId
FilePathId) ([Int] -> [NormalizedFilePath]) -> [Int] -> [NormalizedFilePath]
forall a b. (a -> b) -> a -> b
$ FilePathIdMap (NonEmpty NodeError) -> [Int]
forall a. IntMap a -> [Int]
IntMap.keys FilePathIdMap (NonEmpty NodeError)
depErrorNodes [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> FilePathIdMap FilePathIdSet -> [Int]
forall a. IntMap a -> [Int]
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 (Int -> ModuleParseError -> ShowS
[ModuleParseError] -> ShowS
ModuleParseError -> String
(Int -> ModuleParseError -> ShowS)
-> (ModuleParseError -> String)
-> ([ModuleParseError] -> ShowS)
-> Show ModuleParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleParseError] -> ShowS
$cshowList :: [ModuleParseError] -> ShowS
show :: ModuleParseError -> String
$cshow :: ModuleParseError -> String
showsPrec :: Int -> ModuleParseError -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep ModuleParseError x -> ModuleParseError
$cfrom :: forall x. ModuleParseError -> Rep ModuleParseError x
Generic)

instance NFData ModuleParseError

-- | Error when trying to locate a module.

data 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
/= :: LocateError -> LocateError -> Bool
$c/= :: LocateError -> LocateError -> Bool
== :: LocateError -> LocateError -> Bool
$c== :: LocateError -> LocateError -> Bool
Eq, Int -> LocateError -> ShowS
[LocateError] -> ShowS
LocateError -> String
(Int -> LocateError -> ShowS)
-> (LocateError -> String)
-> ([LocateError] -> ShowS)
-> Show LocateError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocateError] -> ShowS
$cshowList :: [LocateError] -> ShowS
show :: LocateError -> String
$cshow :: LocateError -> String
showsPrec :: Int -> LocateError -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep LocateError x -> LocateError
$cfrom :: forall x. LocateError -> Rep LocateError x
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 (Int -> NodeError -> ShowS
[NodeError] -> ShowS
NodeError -> String
(Int -> NodeError -> ShowS)
-> (NodeError -> String)
-> ([NodeError] -> ShowS)
-> Show NodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeError] -> ShowS
$cshowList :: [NodeError] -> ShowS
show :: NodeError -> String
$cshow :: NodeError -> String
showsPrec :: Int -> NodeError -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep NodeError x -> NodeError
$cfrom :: forall x. NodeError -> Rep NodeError x
Generic)

instance NFData NodeError where
  rnf :: NodeError -> ()
rnf (PartOfCycle Located ModuleName
m [FilePathId]
fs) = Located ModuleName
m Located ModuleName -> () -> ()
`seq` [FilePathId] -> ()
forall a. NFData a => a -> ()
rnf [FilePathId]
fs
  rnf (FailedToLocateImport Located ModuleName
m) = Located ModuleName
m Located ModuleName -> () -> ()
`seq` ()
  rnf (ParseError ModuleParseError
e) = ModuleParseError -> ()
forall a. NFData a => a -> ()
rnf ModuleParseError
e
  rnf (ParentOfErrorNode Located ModuleName
m) = Located ModuleName
m Located ModuleName -> () -> ()
`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 Int -> NodeResult -> ShowS
[NodeResult] -> ShowS
NodeResult -> String
(Int -> NodeResult -> ShowS)
-> (NodeResult -> String)
-> ([NodeResult] -> ShowS)
-> Show NodeResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeResult] -> ShowS
$cshowList :: [NodeResult] -> ShowS
show :: NodeResult -> String
$cshow :: NodeResult -> String
showsPrec :: Int -> NodeResult -> ShowS
$cshowsPrec :: Int -> NodeResult -> ShowS
Show

partitionNodeResults
    :: [(a, NodeResult)]
    -> ([(a, NonEmpty NodeError)], [(a, [(Located ModuleName, FilePathId)])])
partitionNodeResults :: [(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 -> DependencyInformation
processDependencyInformation :: RawDependencyInformation -> DependencyInformation
processDependencyInformation rawDepInfo :: RawDependencyInformation
rawDepInfo@RawDependencyInformation{FilePathIdMap (Either ModuleParseError ModuleImports)
BootIdMap
PathIdMap
rawBootMap :: BootIdMap
rawPathIdMap :: PathIdMap
rawImports :: FilePathIdMap (Either ModuleParseError ModuleImports)
rawBootMap :: RawDependencyInformation -> BootIdMap
rawPathIdMap :: RawDependencyInformation -> PathIdMap
rawImports :: RawDependencyInformation
-> FilePathIdMap (Either ModuleParseError ModuleImports)
..} =
  DependencyInformation :: FilePathIdMap (NonEmpty NodeError)
-> FilePathIdMap ShowableModuleName
-> FilePathIdMap FilePathIdSet
-> FilePathIdMap FilePathIdSet
-> FilePathIdMap (Set InstalledUnitId)
-> PathIdMap
-> BootIdMap
-> DependencyInformation
DependencyInformation
    { depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depErrorNodes = [(Int, NonEmpty NodeError)] -> FilePathIdMap (NonEmpty NodeError)
forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int, NonEmpty NodeError)]
errorNodes
    , depModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps = FilePathIdMap FilePathIdSet
moduleDeps
    , depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depReverseModuleDeps = FilePathIdMap FilePathIdSet
reverseModuleDeps
    , depModuleNames :: FilePathIdMap ShowableModuleName
depModuleNames = [(Int, ShowableModuleName)] -> FilePathIdMap ShowableModuleName
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, ShowableModuleName)] -> FilePathIdMap ShowableModuleName)
-> [(Int, ShowableModuleName)] -> FilePathIdMap ShowableModuleName
forall a b. (a -> b) -> a -> b
$ [(FilePathId, ModuleName)] -> [(Int, ShowableModuleName)]
coerce [(FilePathId, ModuleName)]
moduleNames
    , depPkgDeps :: FilePathIdMap (Set InstalledUnitId)
depPkgDeps = RawDependencyInformation -> FilePathIdMap (Set InstalledUnitId)
pkgDependencies RawDependencyInformation
rawDepInfo
    , depPathIdMap :: PathIdMap
depPathIdMap = PathIdMap
rawPathIdMap
    , depBootMap :: BootIdMap
depBootMap = BootIdMap
rawBootMap
    }
  where resultGraph :: FilePathIdMap NodeResult
resultGraph = FilePathIdMap (Either ModuleParseError ModuleImports)
-> FilePathIdMap NodeResult
buildResultGraph FilePathIdMap (Either ModuleParseError ModuleImports)
rawImports
        ([(Int, NonEmpty NodeError)]
errorNodes, [(Int, [(Located ModuleName, FilePathId)])]
successNodes) = [(Int, NodeResult)]
-> ([(Int, NonEmpty NodeError)],
    [(Int, [(Located ModuleName, FilePathId)])])
forall a.
[(a, NodeResult)]
-> ([(a, NonEmpty NodeError)],
    [(a, [(Located ModuleName, FilePathId)])])
partitionNodeResults ([(Int, NodeResult)]
 -> ([(Int, NonEmpty NodeError)],
     [(Int, [(Located ModuleName, FilePathId)])]))
-> [(Int, NodeResult)]
-> ([(Int, NonEmpty NodeError)],
    [(Int, [(Located ModuleName, FilePathId)])])
forall a b. (a -> b) -> a -> b
$ FilePathIdMap NodeResult -> [(Int, NodeResult)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList FilePathIdMap NodeResult
resultGraph
        moduleNames :: [(FilePathId, ModuleName)]
        moduleNames :: [(FilePathId, ModuleName)]
moduleNames =
          [ (FilePathId
fId, ModuleName
modName) | (Int
_, [(Located ModuleName, FilePathId)]
imports) <- [(Int, [(Located ModuleName, FilePathId)])]
successNodes, (L SrcSpan
_ ModuleName
modName, FilePathId
fId) <- [(Located ModuleName, FilePathId)]
imports]
        successEdges :: [(FilePathId, [FilePathId])]
        successEdges :: [(FilePathId, [FilePathId])]
successEdges =
            ((Int, [(Located ModuleName, FilePathId)])
 -> (FilePathId, [FilePathId]))
-> [(Int, [(Located ModuleName, FilePathId)])]
-> [(FilePathId, [FilePathId])]
forall a b. (a -> b) -> [a] -> [b]
map
              ((Int -> FilePathId)
-> ([(Located ModuleName, FilePathId)] -> [FilePathId])
-> (Int, [(Located ModuleName, FilePathId)])
-> (FilePathId, [FilePathId])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Int -> 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))
              [(Int, [(Located ModuleName, FilePathId)])]
successNodes
        moduleDeps :: FilePathIdMap FilePathIdSet
moduleDeps =
          [(Int, FilePathIdSet)] -> FilePathIdMap FilePathIdSet
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, FilePathIdSet)] -> FilePathIdMap FilePathIdSet)
-> [(Int, FilePathIdSet)] -> FilePathIdMap FilePathIdSet
forall a b. (a -> b) -> a -> b
$
          ((FilePathId, [FilePathId]) -> (Int, FilePathIdSet))
-> [(FilePathId, [FilePathId])] -> [(Int, FilePathIdSet)]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePathId Int
v, [FilePathId]
vs) -> (Int
v, [Int] -> FilePathIdSet
IntSet.fromList ([Int] -> FilePathIdSet) -> [Int] -> FilePathIdSet
forall a b. (a -> b) -> a -> b
$ [FilePathId] -> [Int]
coerce [FilePathId]
vs))
            [(FilePathId, [FilePathId])]
successEdges
        reverseModuleDeps :: FilePathIdMap FilePathIdSet
reverseModuleDeps =
          ((FilePathId, [FilePathId])
 -> FilePathIdMap FilePathIdSet -> FilePathIdMap FilePathIdSet)
-> FilePathIdMap FilePathIdSet
-> [(FilePathId, [FilePathId])]
-> FilePathIdMap FilePathIdSet
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 = [(Int, FilePathIdSet)] -> FilePathIdMap FilePathIdSet
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ((Int -> (Int, FilePathIdSet)) -> [Int] -> [(Int, FilePathIdSet)]
forall a b. (a -> b) -> [a] -> [b]
map (, Int -> FilePathIdSet
IntSet.singleton (FilePathId -> Int
coerce FilePathId
p)) ([FilePathId] -> [Int]
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


-- | 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 :: FilePathIdMap (Either ModuleParseError ModuleImports)
-> FilePathIdMap NodeResult
buildResultGraph FilePathIdMap (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 (FilePathIdMap (Either ModuleParseError ModuleImports)
-> [(FilePathId, FilePathId, [FilePathId])]
graphEdges FilePathIdMap (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)
-> [(Int, NodeResult)] -> FilePathIdMap NodeResult
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith NodeResult -> NodeResult -> NodeResult
forall a. Semigroup a => a -> a -> a
(<>) ([(Int, NodeResult)] -> FilePathIdMap NodeResult)
-> [(Int, NodeResult)] -> FilePathIdMap NodeResult
forall a b. (a -> b) -> a -> b
$ [(FilePathId, NodeResult)] -> [(Int, NodeResult)]
coerce ([(FilePathId, NodeResult)] -> [(Int, NodeResult)])
-> [(FilePathId, NodeResult)] -> [(Int, 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]
cycle 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]
cycle
          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]
cycle NodeError -> [NodeError] -> NonEmpty NodeError
forall a. a -> [a] -> NonEmpty a
:| []))) [Located ModuleName]
entryPoints
        otherErrors :: FilePathIdMap NodeResult
otherErrors = (Either ModuleParseError ModuleImports -> NodeResult)
-> FilePathIdMap (Either ModuleParseError ModuleImports)
-> FilePathIdMap NodeResult
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map Either ModuleParseError ModuleImports -> NodeResult
otherErrorsForFile FilePathIdMap (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 :: [(Located ModuleName, Maybe FilePathId)]
moduleImports :: 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 Int
dep) -> (Located ModuleName
imp, FilePathIdMap NodeResult
propagatedErrors FilePathIdMap NodeResult -> Int -> NodeResult
forall a. IntMap a -> Int -> a
IntMap.! Int
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 Int
file) FilePathId
importedFile =
          case FilePathIdMap (Either ModuleParseError ModuleImports)
g FilePathIdMap (Either ModuleParseError ModuleImports)
-> Int -> Either ModuleParseError ModuleImports
forall a. IntMap a -> Int -> a
IntMap.! Int
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 :: [(Located ModuleName, Maybe FilePathId)]
moduleImports :: ModuleImports -> [(Located ModuleName, Maybe FilePathId)]
moduleImports} ->
              ((Located ModuleName, Maybe FilePathId) -> Located ModuleName)
-> Maybe (Located ModuleName, Maybe FilePathId)
-> Maybe (Located ModuleName)
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 :: FilePathIdMap (Either ModuleParseError ModuleImports)
-> [(FilePathId, FilePathId, [FilePathId])]
graphEdges FilePathIdMap (Either ModuleParseError ModuleImports)
g =
  ((Int, Either ModuleParseError ModuleImports)
 -> (FilePathId, FilePathId, [FilePathId]))
-> [(Int, Either ModuleParseError ModuleImports)]
-> [(FilePathId, FilePathId, [FilePathId])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
k, Either ModuleParseError ModuleImports
v) -> (Int -> FilePathId
FilePathId Int
k, Int -> FilePathId
FilePathId Int
k, Either ModuleParseError ModuleImports -> [FilePathId]
forall e. Either e ModuleImports -> [FilePathId]
deps Either ModuleParseError ModuleImports
v)) ([(Int, Either ModuleParseError ModuleImports)]
 -> [(FilePathId, FilePathId, [FilePathId])])
-> [(Int, Either ModuleParseError ModuleImports)]
-> [(FilePathId, FilePathId, [FilePathId])]
forall a b. (a -> b) -> a -> b
$ FilePathIdMap (Either ModuleParseError ModuleImports)
-> [(Int, Either ModuleParseError ModuleImports)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList FilePathIdMap (Either ModuleParseError ModuleImports)
g
  where deps :: Either e ModuleImports -> [FilePathId]
        deps :: Either e ModuleImports -> [FilePathId]
deps (Left e
_) = []
        deps (Right ModuleImports{[(Located ModuleName, Maybe FilePathId)]
moduleImports :: [(Located ModuleName, Maybe FilePathId)]
moduleImports :: 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 :: [SCC a] -> ([a], [[a]])
partitionSCC (CyclicSCC [a]
xs:[SCC a]
rest) = ([[a]] -> [[a]]) -> ([a], [[a]]) -> ([a], [[a]])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([a]
xs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:) (([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 (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)   (([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 (Set InstalledUnitId)
FilePathIdMap ShowableModuleName
BootIdMap
PathIdMap
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depPkgDeps :: FilePathIdMap (Set InstalledUnitId)
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModuleNames :: FilePathIdMap ShowableModuleName
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
depPkgDeps :: DependencyInformation -> FilePathIdMap (Set InstalledUnitId)
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleNames :: DependencyInformation -> FilePathIdMap ShowableModuleName
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
..} = do
    FilePathId Int
cur_id <- PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId PathIdMap
depPathIdMap NormalizedFilePath
file
    [NormalizedFilePath] -> Maybe [NormalizedFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([NormalizedFilePath] -> Maybe [NormalizedFilePath])
-> [NormalizedFilePath] -> Maybe [NormalizedFilePath]
forall a b. (a -> b) -> a -> b
$ (Int -> NormalizedFilePath) -> [Int] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap (FilePathId -> NormalizedFilePath)
-> (Int -> FilePathId) -> Int -> NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePathId
FilePathId) (FilePathIdSet -> [Int]
IntSet.toList (Int -> FilePathIdSet -> FilePathIdSet
go Int
cur_id FilePathIdSet
IntSet.empty))
  where
    go :: Int -> IntSet -> IntSet
    go :: Int -> FilePathIdSet -> FilePathIdSet
go Int
k FilePathIdSet
i =
      let outwards :: FilePathIdSet
outwards = FilePathIdSet -> Maybe FilePathIdSet -> FilePathIdSet
forall a. a -> Maybe a -> a
fromMaybe FilePathIdSet
IntSet.empty (Int -> FilePathIdMap FilePathIdSet -> Maybe FilePathIdSet
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
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 (Int -> FilePathIdSet -> FilePathIdSet)
-> FilePathIdSet -> FilePathIdSet -> FilePathIdSet
forall b. (Int -> b -> b) -> b -> FilePathIdSet -> b
IntSet.foldr Int -> 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 (Set InstalledUnitId)
FilePathIdMap ShowableModuleName
BootIdMap
PathIdMap
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depPkgDeps :: FilePathIdMap (Set InstalledUnitId)
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModuleNames :: FilePathIdMap ShowableModuleName
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
depPkgDeps :: DependencyInformation -> FilePathIdMap (Set InstalledUnitId)
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleNames :: DependencyInformation -> FilePathIdMap ShowableModuleName
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
..} = do
  FilePathId Int
cur_id <- PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId PathIdMap
depPathIdMap NormalizedFilePath
file
  [NormalizedFilePath] -> Maybe [NormalizedFilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([NormalizedFilePath] -> Maybe [NormalizedFilePath])
-> [NormalizedFilePath] -> Maybe [NormalizedFilePath]
forall a b. (a -> b) -> a -> b
$ (Int -> NormalizedFilePath) -> [Int] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap (FilePathId -> NormalizedFilePath)
-> (Int -> FilePathId) -> Int -> NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePathId
FilePathId) ([Int] -> (FilePathIdSet -> [Int]) -> Maybe FilePathIdSet -> [Int]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Int]
forall a. Monoid a => a
mempty FilePathIdSet -> [Int]
IntSet.toList (Int -> FilePathIdMap FilePathIdSet -> Maybe FilePathIdSet
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
cur_id FilePathIdMap FilePathIdSet
depReverseModuleDeps))

transitiveDeps :: DependencyInformation -> NormalizedFilePath -> Maybe TransitiveDependencies
transitiveDeps :: DependencyInformation
-> NormalizedFilePath -> Maybe TransitiveDependencies
transitiveDeps DependencyInformation{FilePathIdMap (NonEmpty NodeError)
FilePathIdMap FilePathIdSet
FilePathIdMap (Set InstalledUnitId)
FilePathIdMap ShowableModuleName
BootIdMap
PathIdMap
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depPkgDeps :: FilePathIdMap (Set InstalledUnitId)
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModuleNames :: FilePathIdMap ShowableModuleName
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
depPkgDeps :: DependencyInformation -> FilePathIdMap (Set InstalledUnitId)
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleNames :: DependencyInformation -> FilePathIdMap ShowableModuleName
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
..} NormalizedFilePath
file = do
  let !fileId :: FilePathId
fileId = PathIdMap -> NormalizedFilePath -> FilePathId
pathToId PathIdMap
depPathIdMap NormalizedFilePath
file
  FilePathIdSet
reachableVs <-
      -- Delete the starting node

      Int -> FilePathIdSet -> FilePathIdSet
IntSet.delete (FilePathId -> Int
getFilePathId FilePathId
fileId) (FilePathIdSet -> FilePathIdSet)
-> (Int -> FilePathIdSet) -> Int -> FilePathIdSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Int] -> FilePathIdSet
IntSet.fromList ([Int] -> FilePathIdSet) -> (Int -> [Int]) -> Int -> FilePathIdSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int, [Int]) -> Int
forall a b c. (a, b, c) -> a
fst3 ((Int, Int, [Int]) -> Int)
-> (Int -> (Int, Int, [Int])) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int, Int, [Int])
fromVertex) ([Int] -> [Int]) -> (Int -> [Int]) -> Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Graph -> Int -> [Int]
reachable Graph
g (Int -> FilePathIdSet) -> Maybe Int -> Maybe FilePathIdSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Maybe Int
toVertex (FilePathId -> Int
getFilePathId FilePathId
fileId)
  let transitiveModuleDepIds :: [Int]
transitiveModuleDepIds =
        (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
v -> Int
v Int -> FilePathIdSet -> Bool
`IntSet.member` FilePathIdSet
reachableVs) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int, [Int]) -> Int
forall a b c. (a, b, c) -> a
fst3 ((Int, Int, [Int]) -> Int)
-> (Int -> (Int, Int, [Int])) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int, Int, [Int])
fromVertex) [Int]
vs
  let transitivePkgDeps :: [InstalledUnitId]
transitivePkgDeps =
          Set InstalledUnitId -> [InstalledUnitId]
forall a. Set a -> [a]
Set.toList (Set InstalledUnitId -> [InstalledUnitId])
-> Set InstalledUnitId -> [InstalledUnitId]
forall a b. (a -> b) -> a -> b
$ [Set InstalledUnitId] -> Set InstalledUnitId
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set InstalledUnitId] -> Set InstalledUnitId)
-> [Set InstalledUnitId] -> Set InstalledUnitId
forall a b. (a -> b) -> a -> b
$
          (Int -> Set InstalledUnitId) -> [Int] -> [Set InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
f -> Set InstalledUnitId
-> Int
-> FilePathIdMap (Set InstalledUnitId)
-> Set InstalledUnitId
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault Set InstalledUnitId
forall a. Set a
Set.empty Int
f FilePathIdMap (Set InstalledUnitId)
depPkgDeps) ([Int] -> [Set InstalledUnitId]) -> [Int] -> [Set InstalledUnitId]
forall a b. (a -> b) -> a -> b
$
          FilePathId -> Int
getFilePathId FilePathId
fileId Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
transitiveModuleDepIds
  let transitiveModuleDeps :: [NormalizedFilePath]
transitiveModuleDeps =
        (Int -> NormalizedFilePath) -> [Int] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap (FilePathId -> NormalizedFilePath)
-> (Int -> FilePathId) -> Int -> NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePathId
FilePathId) [Int]
transitiveModuleDepIds
  let transitiveNamedModuleDeps :: [NamedModuleDep]
transitiveNamedModuleDeps =
        [ NormalizedFilePath
-> ModuleName -> Maybe ModLocation -> NamedModuleDep
NamedModuleDep (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap (Int -> FilePathId
FilePathId Int
fid)) ModuleName
mn Maybe ModLocation
artifactModLocation
        | (Int
fid, ShowableModuleName ModuleName
mn) <- FilePathIdMap ShowableModuleName -> [(Int, ShowableModuleName)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList FilePathIdMap ShowableModuleName
depModuleNames
        , let ArtifactsLocation{Maybe ModLocation
artifactModLocation :: ArtifactsLocation -> Maybe ModLocation
artifactModLocation :: Maybe ModLocation
artifactModLocation} = PathIdMap -> FilePathIdMap ArtifactsLocation
idToPathMap PathIdMap
depPathIdMap FilePathIdMap ArtifactsLocation -> Int -> ArtifactsLocation
forall a. IntMap a -> Int -> a
IntMap.! Int
fid
        ]
  TransitiveDependencies -> Maybe TransitiveDependencies
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransitiveDependencies :: [NormalizedFilePath]
-> [NamedModuleDep] -> [InstalledUnitId] -> TransitiveDependencies
TransitiveDependencies {[InstalledUnitId]
[NormalizedFilePath]
[NamedModuleDep]
transitivePkgDeps :: [InstalledUnitId]
transitiveNamedModuleDeps :: [NamedModuleDep]
transitiveModuleDeps :: [NormalizedFilePath]
transitiveNamedModuleDeps :: [NamedModuleDep]
transitiveModuleDeps :: [NormalizedFilePath]
transitivePkgDeps :: [InstalledUnitId]
..}
  where
    (Graph
g, Int -> (Int, Int, [Int])
fromVertex, Int -> Maybe Int
toVertex) = [(Int, Int, [Int])]
-> (Graph, Int -> (Int, Int, [Int]), Int -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
graphFromEdges [(Int, Int, [Int])]
edges
    edges :: [(Int, Int, [Int])]
edges = ((Int, FilePathIdSet) -> (Int, Int, [Int]))
-> [(Int, FilePathIdSet)] -> [(Int, Int, [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
f, FilePathIdSet
fs) -> (Int
f, Int
f, FilePathIdSet -> [Int]
IntSet.toList FilePathIdSet
fs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
boot_edge Int
f)) ([(Int, FilePathIdSet)] -> [(Int, Int, [Int])])
-> [(Int, FilePathIdSet)] -> [(Int, Int, [Int])]
forall a b. (a -> b) -> a -> b
$ FilePathIdMap FilePathIdSet -> [(Int, FilePathIdSet)]
forall a. IntMap a -> [(Int, 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 :: Int -> [Int]
boot_edge Int
f = [FilePathId -> Int
getFilePathId FilePathId
f' | Just FilePathId
f' <- [Int -> BootIdMap -> Maybe FilePathId
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
f BootIdMap
depBootMap]]

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

data TransitiveDependencies = TransitiveDependencies
  { TransitiveDependencies -> [NormalizedFilePath]
transitiveModuleDeps :: [NormalizedFilePath]
  -- ^ Transitive module dependencies in topological order.

  -- The module itself is not included.

  , TransitiveDependencies -> [NamedModuleDep]
transitiveNamedModuleDeps :: [NamedModuleDep]
  -- ^ Transitive module dependencies in topological order.

  -- The module itself is not included.

  , TransitiveDependencies -> [InstalledUnitId]
transitivePkgDeps :: [InstalledUnitId]
  -- ^ Transitive pkg dependencies in unspecified order.

  } deriving (TransitiveDependencies -> TransitiveDependencies -> Bool
(TransitiveDependencies -> TransitiveDependencies -> Bool)
-> (TransitiveDependencies -> TransitiveDependencies -> Bool)
-> Eq TransitiveDependencies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransitiveDependencies -> TransitiveDependencies -> Bool
$c/= :: TransitiveDependencies -> TransitiveDependencies -> Bool
== :: TransitiveDependencies -> TransitiveDependencies -> Bool
$c== :: TransitiveDependencies -> TransitiveDependencies -> Bool
Eq, Int -> TransitiveDependencies -> ShowS
[TransitiveDependencies] -> ShowS
TransitiveDependencies -> String
(Int -> TransitiveDependencies -> ShowS)
-> (TransitiveDependencies -> String)
-> ([TransitiveDependencies] -> ShowS)
-> Show TransitiveDependencies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransitiveDependencies] -> ShowS
$cshowList :: [TransitiveDependencies] -> ShowS
show :: TransitiveDependencies -> String
$cshow :: TransitiveDependencies -> String
showsPrec :: Int -> TransitiveDependencies -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep TransitiveDependencies x -> TransitiveDependencies
$cfrom :: forall x. TransitiveDependencies -> Rep TransitiveDependencies x
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
$cto :: forall x. Rep NamedModuleDep x -> NamedModuleDep
$cfrom :: forall x. NamedModuleDep -> Rep NamedModuleDep x
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
nmdModLocation :: Maybe ModLocation
nmdModuleName :: ModuleName
nmdFilePath :: NormalizedFilePath
nmdModLocation :: NamedModuleDep -> Maybe ModLocation
nmdModuleName :: NamedModuleDep -> ModuleName
nmdFilePath :: NamedModuleDep -> NormalizedFilePath
..} =
    NormalizedFilePath -> ()
forall a. NFData a => a -> ()
rnf NormalizedFilePath
nmdFilePath () -> () -> ()
`seq`
    ModuleName -> ()
forall a. NFData a => a -> ()
rnf ModuleName
nmdModuleName () -> () -> ()
`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
nmdModLocation :: Maybe ModLocation
nmdModuleName :: ModuleName
nmdFilePath :: NormalizedFilePath
nmdModLocation :: NamedModuleDep -> Maybe ModLocation
nmdModuleName :: NamedModuleDep -> ModuleName
nmdFilePath :: NamedModuleDep -> NormalizedFilePath
..} = NormalizedFilePath -> String
forall a. Show a => a -> String
show NormalizedFilePath
nmdFilePath