module Development.IDE.Import.DependencyInformation
( DependencyInformation(..)
, ModuleImports(..)
, RawDependencyInformation(..)
, NodeError(..)
, ModuleParseError(..)
, TransitiveDependencies(..)
, FilePathId(..)
, NamedModuleDep(..)
, ShowableModuleName(..)
, 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.Either
import Data.Graph
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 Development.IDE.Import.FindImports (ArtifactsLocation (..))
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Location
import GHC
newtype ModuleImports = ModuleImports
{ ModuleImports -> [(Located ModuleName, Maybe FilePathId)]
moduleImports :: [(Located ModuleName, Maybe FilePathId)]
} 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
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)
type FilePathIdMap = IntMap
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
(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 -> Int -> PathIdMap
PathIdMap FilePathIdMap ArtifactsLocation
forall a. IntMap a
IntMap.empty HashMap NormalizedFilePath FilePathId
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 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
nextFreshId
in (FilePathId
newId, ArtifactsLocation -> FilePathId -> PathIdMap -> PathIdMap
insertPathId ArtifactsLocation
path FilePathId
newId PathIdMap
m)
Just FilePathId
id -> (FilePathId
id, PathIdMap
m)
where
insertPathId :: ArtifactsLocation -> FilePathId -> PathIdMap -> PathIdMap
insertPathId :: ArtifactsLocation -> FilePathId -> PathIdMap -> PathIdMap
insertPathId ArtifactsLocation
path FilePathId
id 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
..} =
FilePathIdMap ArtifactsLocation
-> HashMap NormalizedFilePath FilePathId -> Int -> 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)
(Int -> Int
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 = 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)
data RawDependencyInformation = RawDependencyInformation
{ RawDependencyInformation
-> FilePathIdMap (Either ModuleParseError ModuleImports)
rawImports :: !(FilePathIdMap (Either ModuleParseError ModuleImports))
, RawDependencyInformation -> PathIdMap
rawPathIdMap :: !PathIdMap
, 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
data DependencyInformation =
DependencyInformation
{ DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
depErrorNodes :: !(FilePathIdMap (NonEmpty NodeError))
, DependencyInformation -> FilePathIdMap ShowableModuleName
depModuleNames :: !(FilePathIdMap ShowableModuleName)
, DependencyInformation -> FilePathIdMap FilePathIdSet
depModuleDeps :: !(FilePathIdMap FilePathIdSet)
, DependencyInformation -> FilePathIdMap FilePathIdSet
depReverseModuleDeps :: !(IntMap IntSet)
, DependencyInformation -> PathIdMap
depPathIdMap :: !PathIdMap
, DependencyInformation -> BootIdMap
depBootMap :: !BootIdMap
} 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 ShowableModuleName
BootIdMap
PathIdMap
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModuleNames :: FilePathIdMap ShowableModuleName
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
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
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
newtype LocateError = LocateError [Diagnostic]
deriving (LocateError -> LocateError -> Bool
(LocateError -> LocateError -> Bool)
-> (LocateError -> LocateError -> Bool) -> Eq LocateError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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
data NodeError
= PartOfCycle (Located ModuleName) [FilePathId]
| FailedToLocateImport (Located ModuleName)
| ParseError ModuleParseError
| ParentOfErrorNode (Located ModuleName)
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` ()
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 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
-> 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
, 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
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
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 [] = ([], [])
transitiveReverseDependencies :: NormalizedFilePath -> DependencyInformation -> Maybe [NormalizedFilePath]
transitiveReverseDependencies :: NormalizedFilePath
-> DependencyInformation -> Maybe [NormalizedFilePath]
transitiveReverseDependencies NormalizedFilePath
file DependencyInformation{FilePathIdMap (NonEmpty NodeError)
FilePathIdMap FilePathIdSet
FilePathIdMap ShowableModuleName
BootIdMap
PathIdMap
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModuleNames :: FilePathIdMap ShowableModuleName
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
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
-> Int -> FilePathIdMap FilePathIdSet -> FilePathIdSet
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 (Int -> FilePathIdSet -> FilePathIdSet)
-> FilePathIdSet -> FilePathIdSet -> FilePathIdSet
forall b. (Int -> b -> b) -> b -> FilePathIdSet -> b
IntSet.foldr Int -> FilePathIdSet -> FilePathIdSet
go FilePathIdSet
res FilePathIdSet
new
immediateReverseDependencies :: NormalizedFilePath -> DependencyInformation -> Maybe [NormalizedFilePath]
immediateReverseDependencies :: NormalizedFilePath
-> DependencyInformation -> Maybe [NormalizedFilePath]
immediateReverseDependencies NormalizedFilePath
file DependencyInformation{FilePathIdMap (NonEmpty NodeError)
FilePathIdMap FilePathIdSet
FilePathIdMap ShowableModuleName
BootIdMap
PathIdMap
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModuleNames :: FilePathIdMap ShowableModuleName
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
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 ShowableModuleName
BootIdMap
PathIdMap
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depReverseModuleDeps :: FilePathIdMap FilePathIdSet
depModuleDeps :: FilePathIdMap FilePathIdSet
depModuleNames :: FilePathIdMap ShowableModuleName
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
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 <-
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 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
TransitiveDependencies -> Maybe TransitiveDependencies
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransitiveDependencies :: [NormalizedFilePath] -> TransitiveDependencies
TransitiveDependencies {[NormalizedFilePath]
transitiveModuleDeps :: [NormalizedFilePath]
transitiveModuleDeps :: [NormalizedFilePath]
..}
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
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
newtype TransitiveDependencies = TransitiveDependencies
{ TransitiveDependencies -> [NormalizedFilePath]
transitiveModuleDeps :: [NormalizedFilePath]
} 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`
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