-- 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 Int -> ModuleImports -> ShowS
[ModuleImports] -> ShowS
ModuleImports -> String
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: FilePathId -> ()
$crnf :: FilePathId -> ()
NFData, FilePathId -> FilePathId -> Bool
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
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
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 -> Int
nextFreshId :: !Int
  }
  deriving (Int -> PathIdMap -> ShowS
[PathIdMap] -> ShowS
PathIdMap -> String
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. 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 -> Int -> PathIdMap
PathIdMap forall a. IntMap a
IntMap.empty forall k v. HashMap k v
HMS.empty Int
0

getPathId :: ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)
getPathId :: ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)
getPathId ArtifactsLocation
path m :: PathIdMap
m@PathIdMap{Int
HashMap NormalizedFilePath FilePathId
FilePathIdMap ArtifactsLocation
nextFreshId :: Int
pathToIdMap :: HashMap NormalizedFilePath FilePathId
idToPathMap :: FilePathIdMap ArtifactsLocation
nextFreshId :: PathIdMap -> Int
pathToIdMap :: PathIdMap -> HashMap NormalizedFilePath FilePathId
idToPathMap :: PathIdMap -> FilePathIdMap ArtifactsLocation
..} =
    case 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
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 -> Int -> PathIdMap
PathIdMap
            (forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (FilePathId -> Int
getFilePathId FilePathId
fileId) ArtifactsLocation
path FilePathIdMap ArtifactsLocation
idToPathMap)
            (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)
            (forall a. Enum a => a -> a
succ Int
nextFreshId)

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

type BootIdMap = FilePathIdMap FilePathId

insertBootId :: FilePathId -> FilePathId -> BootIdMap -> BootIdMap
insertBootId :: FilePathId -> FilePathId -> BootIdMap -> BootIdMap
insertBootId FilePathId
k = 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 -> FilePathIdMap ShowableModule
rawModuleMap :: !(FilePathIdMap ShowableModule)
    } deriving Int -> RawDependencyInformation -> ShowS
[RawDependencyInformation] -> ShowS
RawDependencyInformation -> String
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

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 (Int -> DependencyInformation -> ShowS
[DependencyInformation] -> ShowS
DependencyInformation -> String
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. 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 ShowableModule =
  ShowableModule {ShowableModule -> Module
showableModule :: Module}
  deriving ShowableModule -> ()
forall a. (a -> ()) -> NFData a
rnf :: ShowableModule -> ()
$crnf :: 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) = forall a. Show a => a -> String
show (forall a. ModuleEnv a -> [(Module, a)]
moduleEnvToList ModuleEnv a
x)
instance NFData a => NFData (ShowableModuleEnv a) where
  rnf :: ShowableModuleEnv a -> ()
rnf = forall a. a -> ()
rwhnf

instance Show ShowableModule where show :: ShowableModule -> String
show = ModuleName -> String
moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
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
depModuleGraph :: ModuleGraph
depModuleFiles :: ShowableModuleEnv FilePathId
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModules :: FilePathIdMap ShowableModule
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depModuleGraph :: DependencyInformation -> ModuleGraph
depModuleFiles :: DependencyInformation -> ShowableModuleEnv FilePathId
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModules :: DependencyInformation -> FilePathIdMap ShowableModule
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
..} =
    forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePathId
FilePathId) forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [Int]
IntMap.keys FilePathIdMap (NonEmpty NodeError)
depErrorNodes forall a. Semigroup a => a -> a -> a
<> 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
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. 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.
newtype LocateError = LocateError [Diagnostic]
  deriving (LocateError -> LocateError -> Bool
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
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. 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
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. 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 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [FilePathId]
fs
  rnf (FailedToLocateImport Located ModuleName
m) = Located ModuleName
m seq :: forall a b. a -> b -> b
`seq` ()
  rnf (ParseError ModuleParseError
e)           = forall a. NFData a => a -> ()
rnf ModuleParseError
e
  rnf (ParentOfErrorNode Located ModuleName
m)    = Located ModuleName
m seq :: 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 Int -> NodeResult -> ShowS
[NodeResult] -> ShowS
NodeResult -> String
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 :: forall a.
[(a, NodeResult)]
-> ([(a, NonEmpty NodeError)],
    [(a, [(Located ModuleName, FilePathId)])])
partitionNodeResults = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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)   = forall a b. a -> Either a b
Left (a
a, NonEmpty NodeError
errs)
        f (a
a, SuccessNode [(Located ModuleName, FilePathId)]
imps) = 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 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{FilePathIdMap (Either ModuleParseError ModuleImports)
FilePathIdMap ShowableModule
PathIdMap
rawModuleMap :: FilePathIdMap ShowableModule
rawPathIdMap :: PathIdMap
rawImports :: FilePathIdMap (Either ModuleParseError ModuleImports)
rawModuleMap :: RawDependencyInformation -> FilePathIdMap ShowableModule
rawPathIdMap :: RawDependencyInformation -> PathIdMap
rawImports :: RawDependencyInformation
-> FilePathIdMap (Either ModuleParseError ModuleImports)
..} BootIdMap
rawBootMap ModuleGraph
mg =
  DependencyInformation
    { depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depErrorNodes = 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
    , depModules :: FilePathIdMap ShowableModule
depModules = FilePathIdMap ShowableModule
rawModuleMap
    , depPathIdMap :: PathIdMap
depPathIdMap = PathIdMap
rawPathIdMap
    , depBootMap :: BootIdMap
depBootMap = BootIdMap
rawBootMap
    , depModuleFiles :: ShowableModuleEnv FilePathId
depModuleFiles = forall a. ModuleEnv a -> ShowableModuleEnv a
ShowableModuleEnv ModuleEnv FilePathId
reverseModuleMap
    , depModuleGraph :: ModuleGraph
depModuleGraph = ModuleGraph
mg
    }
  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) = forall a.
[(a, NodeResult)]
-> ([(a, NonEmpty NodeError)],
    [(a, [(Located ModuleName, FilePathId)])])
partitionNodeResults forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [(Int, a)]
IntMap.toList FilePathIdMap NodeResult
resultGraph
        successEdges :: [(FilePathId, [FilePathId])]
        successEdges :: [(FilePathId, [FilePathId])]
successEdges =
            forall a b. (a -> b) -> [a] -> [b]
map
              (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Int -> FilePathId
FilePathId (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd))
              [(Int, [(Located ModuleName, FilePathId)])]
successNodes
        moduleDeps :: FilePathIdMap FilePathIdSet
moduleDeps =
          forall a. [(Int, a)] -> IntMap a
IntMap.fromList forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map (\(FilePathId Int
v, [FilePathId]
vs) -> (Int
v, [Int] -> FilePathIdSet
IntSet.fromList forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce [FilePathId]
vs))
            [(FilePathId, [FilePathId])]
successEdges
        reverseModuleDeps :: FilePathIdMap FilePathIdSet
reverseModuleDeps =
          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 = forall a. [(Int, a)] -> IntMap a
IntMap.fromList (forall a b. (a -> b) -> [a] -> [b]
map (, Int -> FilePathIdSet
IntSet.singleton (coerce :: forall a b. Coercible a b => a -> b
coerce FilePathId
p)) (coerce :: forall a b. Coercible a b => a -> b
coerce [FilePathId]
cs))
            in forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith FilePathIdSet -> FilePathIdSet -> FilePathIdSet
IntSet.union FilePathIdMap FilePathIdSet
new FilePathIdMap FilePathIdSet
res ) forall a. IntMap a
IntMap.empty [(FilePathId, [FilePathId])]
successEdges
        reverseModuleMap :: ModuleEnv FilePathId
reverseModuleMap = forall a. [(Module, a)] -> ModuleEnv a
mkModuleEnv forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,ShowableModule
sm) -> (ShowableModule -> Module
showableModule ShowableModule
sm, Int -> FilePathId
FilePathId Int
i)) forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [(Int, 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 :: FilePathIdMap (Either ModuleParseError ModuleImports)
-> FilePathIdMap NodeResult
buildResultGraph FilePathIdMap (Either ModuleParseError ModuleImports)
g = FilePathIdMap NodeResult
propagatedErrors
    where
        sccs :: [SCC FilePathId]
sccs = 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) = forall a. [SCC a] -> ([a], [[a]])
partitionSCC [SCC FilePathId]
sccs
        cycleErrors :: IntMap NodeResult
        cycleErrors :: FilePathIdMap NodeResult
cycleErrors = forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ 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 =
          forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FilePathId -> FilePathId -> Maybe (Located ModuleName)
findImport FilePathId
f) [FilePathId]
cycles'
          in 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' forall a. a -> [a] -> NonEmpty a
:| []))) [Located ModuleName]
entryPoints
        otherErrors :: FilePathIdMap NodeResult
otherErrors = 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 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)   = forall a b. a -> Either a b
Left a
imp
              toEither (a
imp, Just b
path) = forall a b. b -> Either a b
Right (a
imp, b
path)
              ([Located ModuleName]
errs, [(Located ModuleName, FilePathId)]
imports') = forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. (a, Maybe b) -> Either a (a, b)
toEither [(Located ModuleName, Maybe FilePathId)]
moduleImports)
          in case 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 (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map Located ModuleName -> NodeError
FailedToLocateImport NonEmpty (Located ModuleName)
errs')

        unpropagatedErrors :: FilePathIdMap NodeResult
unpropagatedErrors = forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith 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 =
          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 = forall a b. (a -> b) -> [a] -> [b]
map (\(Located ModuleName
imp, FilePathId Int
dep) -> (Located ModuleName
imp, FilePathIdMap NodeResult
propagatedErrors forall a. IntMap a -> Int -> a
IntMap.! Int
dep)) [(Located ModuleName, FilePathId)]
imps
              ([(Located ModuleName, NonEmpty NodeError)]
errs, [(Located ModuleName, [(Located ModuleName, FilePathId)])]
_) = forall a.
[(a, NodeResult)]
-> ([(a, NonEmpty NodeError)],
    [(a, [(Located ModuleName, FilePathId)])])
partitionNodeResults [(Located ModuleName, NodeResult)]
results
          in case 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 (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (Located ModuleName -> NodeError
ParentOfErrorNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. IntMap a -> Int -> a
IntMap.! Int
file of
            Left ModuleParseError
_ -> 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} ->
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Located ModuleName
_, Maybe FilePathId
resolvedImp) -> Maybe FilePathId
resolvedImp forall a. Eq a => a -> a -> Bool
== 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 =
  forall a b. (a -> b) -> [a] -> [b]
map (\(Int
k, Either ModuleParseError ModuleImports
v) -> (Int -> FilePathId
FilePathId Int
k, Int -> FilePathId
FilePathId Int
k, forall e. Either e ModuleImports -> [FilePathId]
deps Either ModuleParseError ModuleImports
v)) forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [(Int, a)]
IntMap.toList FilePathIdMap (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 :: [(Located ModuleName, Maybe FilePathId)]
moduleImports :: ModuleImports -> [(Located ModuleName, Maybe FilePathId)]
moduleImports}) = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe 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) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([a]
xsforall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall a. [SCC a] -> ([a], [[a]])
partitionSCC [SCC a]
rest
partitionSCC (AcyclicSCC a
x:[SCC a]
rest) = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a
xforall a. a -> [a] -> [a]
:)   forall a b. (a -> b) -> a -> b
$ 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
depModuleGraph :: ModuleGraph
depModuleFiles :: ShowableModuleEnv FilePathId
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModules :: FilePathIdMap ShowableModule
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depModuleGraph :: DependencyInformation -> ModuleGraph
depModuleFiles :: DependencyInformation -> ShowableModuleEnv FilePathId
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModules :: DependencyInformation -> FilePathIdMap ShowableModule
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
..} = do
    FilePathId Int
cur_id <- PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId PathIdMap
depPathIdMap NormalizedFilePath
file
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap 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 = forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault FilePathIdSet
IntSet.empty 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 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 ShowableModule
BootIdMap
ModuleGraph
ShowableModuleEnv FilePathId
PathIdMap
depModuleGraph :: ModuleGraph
depModuleFiles :: ShowableModuleEnv FilePathId
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModules :: FilePathIdMap ShowableModule
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depModuleGraph :: DependencyInformation -> ModuleGraph
depModuleFiles :: DependencyInformation -> ShowableModuleEnv FilePathId
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModules :: DependencyInformation -> FilePathIdMap ShowableModule
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
..} = do
  FilePathId Int
cur_id <- PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId PathIdMap
depPathIdMap NormalizedFilePath
file
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePathId
FilePathId) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty FilePathIdSet -> [Int]
IntSet.toList (forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
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
depModuleGraph :: ModuleGraph
depModuleFiles :: ShowableModuleEnv FilePathId
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModules :: FilePathIdMap ShowableModule
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depModuleGraph :: DependencyInformation -> ModuleGraph
depModuleFiles :: DependencyInformation -> ShowableModuleEnv FilePathId
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModules :: DependencyInformation -> FilePathIdMap ShowableModule
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
..} NormalizedFilePath
file = do
  !FilePathId
fileId <- PathIdMap -> NormalizedFilePath -> Maybe FilePathId
pathToId PathIdMap
depPathIdMap NormalizedFilePath
file
  FilePathIdSet
reachableVs <-
      -- Delete the starting node
      Int -> FilePathIdSet -> FilePathIdSet
IntSet.delete (FilePathId -> Int
getFilePathId FilePathId
fileId) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Int] -> FilePathIdSet
IntSet.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a, b, c) -> a
fst3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int, Int, [Int])
fromVertex) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Graph -> Int -> [Int]
reachable Graph
g 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 =
        forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
v -> Int
v Int -> FilePathIdSet -> Bool
`IntSet.member` FilePathIdSet
reachableVs) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a, b, c) -> a
fst3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int, Int, [Int])
fromVertex) [Int]
vs
  let transitiveModuleDeps :: [NormalizedFilePath]
transitiveModuleDeps =
        forall a b. (a -> b) -> [a] -> [b]
map (PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePathId
FilePathId) [Int]
transitiveModuleDepIds
  forall (f :: * -> *) a. Applicative f => a -> f a
pure TransitiveDependencies {[NormalizedFilePath]
transitiveModuleDeps :: [NormalizedFilePath]
transitiveModuleDeps :: [NormalizedFilePath]
..}
  where
    (Graph
g, Int -> (Int, Int, [Int])
fromVertex, Int -> Maybe Int
toVertex) = 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 = forall a b. (a -> b) -> [a] -> [b]
map (\(Int
f, FilePathIdSet
fs) -> (Int
f, Int
f, FilePathIdSet -> [Int]
IntSet.toList FilePathIdSet
fs forall a. [a] -> [a] -> [a]
++ Int -> [Int]
boot_edge Int
f)) forall a b. (a -> b) -> a -> b
$ 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' <- [forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
f BootIdMap
depBootMap]]

    vs :: [Int]
vs = Graph -> [Int]
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
depModuleGraph :: ModuleGraph
depModuleFiles :: ShowableModuleEnv FilePathId
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModules :: FilePathIdMap ShowableModule
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depModuleGraph :: DependencyInformation -> ModuleGraph
depModuleFiles :: DependencyInformation -> ShowableModuleEnv FilePathId
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
depReverseModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleDeps :: DependencyInformation -> FilePathIdMap FilePathIdSet
depModules :: DependencyInformation -> FilePathIdMap ShowableModule
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
..}
  = PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv (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
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
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. 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. 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 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
..} =
    forall a. NFData a => a -> ()
rnf NormalizedFilePath
nmdFilePath seq :: forall a b. a -> b -> b
`seq`
    forall a. NFData a => a -> ()
rnf ModuleName
nmdModuleName seq :: forall a b. a -> b -> b
`seq`
    -- 'ModLocation' lacks an 'NFData' instance
    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
..} = forall a. Show a => a -> String
show NormalizedFilePath
nmdFilePath