module GHC.Unit.Module.Deps
( Dependencies (..)
, Usage (..)
, noDependencies
)
where
import GHC.Prelude
import GHC.Types.SafeHaskell
import GHC.Types.Name
import GHC.Unit.Module.Name
import GHC.Unit.Module
import GHC.Utils.Fingerprint
import GHC.Utils.Binary
data Dependencies = Deps
{ Dependencies -> [ModuleNameWithIsBoot]
dep_mods :: [ModuleNameWithIsBoot]
, Dependencies -> [(UnitId, Bool)]
dep_pkgs :: [(UnitId, Bool)]
, Dependencies -> [Module]
dep_orphs :: [Module]
, Dependencies -> [Module]
dep_finsts :: [Module]
, Dependencies -> [ModuleName]
dep_plgins :: [ModuleName]
}
deriving( Dependencies -> Dependencies -> Bool
(Dependencies -> Dependencies -> Bool)
-> (Dependencies -> Dependencies -> Bool) -> Eq Dependencies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dependencies -> Dependencies -> Bool
$c/= :: Dependencies -> Dependencies -> Bool
== :: Dependencies -> Dependencies -> Bool
$c== :: Dependencies -> Dependencies -> Bool
Eq )
instance Binary Dependencies where
put_ :: BinHandle -> Dependencies -> IO ()
put_ BinHandle
bh Dependencies
deps = do BinHandle -> [ModuleNameWithIsBoot] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Dependencies -> [ModuleNameWithIsBoot]
dep_mods Dependencies
deps)
BinHandle -> [(UnitId, Bool)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Dependencies -> [(UnitId, Bool)]
dep_pkgs Dependencies
deps)
BinHandle -> [Module] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Dependencies -> [Module]
dep_orphs Dependencies
deps)
BinHandle -> [Module] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Dependencies -> [Module]
dep_finsts Dependencies
deps)
BinHandle -> [ModuleName] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Dependencies -> [ModuleName]
dep_plgins Dependencies
deps)
get :: BinHandle -> IO Dependencies
get BinHandle
bh = do [ModuleNameWithIsBoot]
ms <- BinHandle -> IO [ModuleNameWithIsBoot]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[(UnitId, Bool)]
ps <- BinHandle -> IO [(UnitId, Bool)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[Module]
os <- BinHandle -> IO [Module]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[Module]
fis <- BinHandle -> IO [Module]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[ModuleName]
pl <- BinHandle -> IO [ModuleName]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Dependencies -> IO Dependencies
forall (m :: * -> *) a. Monad m => a -> m a
return (Deps { dep_mods :: [ModuleNameWithIsBoot]
dep_mods = [ModuleNameWithIsBoot]
ms, dep_pkgs :: [(UnitId, Bool)]
dep_pkgs = [(UnitId, Bool)]
ps, dep_orphs :: [Module]
dep_orphs = [Module]
os,
dep_finsts :: [Module]
dep_finsts = [Module]
fis, dep_plgins :: [ModuleName]
dep_plgins = [ModuleName]
pl })
noDependencies :: Dependencies
noDependencies :: Dependencies
noDependencies = [ModuleNameWithIsBoot]
-> [(UnitId, Bool)]
-> [Module]
-> [Module]
-> [ModuleName]
-> Dependencies
Deps [] [] [] [] []
data Usage
= UsagePackageModule {
Usage -> Module
usg_mod :: Module,
Usage -> Fingerprint
usg_mod_hash :: Fingerprint,
Usage -> Bool
usg_safe :: IsSafeImport
}
| UsageHomeModule {
Usage -> ModuleName
usg_mod_name :: ModuleName,
usg_mod_hash :: Fingerprint,
Usage -> [(OccName, Fingerprint)]
usg_entities :: [(OccName,Fingerprint)],
Usage -> Maybe Fingerprint
usg_exports :: Maybe Fingerprint,
usg_safe :: IsSafeImport
}
| UsageFile {
Usage -> FilePath
usg_file_path :: FilePath,
Usage -> Fingerprint
usg_file_hash :: Fingerprint
}
| UsageMergedRequirement {
usg_mod :: Module,
usg_mod_hash :: Fingerprint
}
deriving( Usage -> Usage -> Bool
(Usage -> Usage -> Bool) -> (Usage -> Usage -> Bool) -> Eq Usage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Usage -> Usage -> Bool
$c/= :: Usage -> Usage -> Bool
== :: Usage -> Usage -> Bool
$c== :: Usage -> Usage -> Bool
Eq )
instance Binary Usage where
put_ :: BinHandle -> Usage -> IO ()
put_ BinHandle
bh usg :: Usage
usg@UsagePackageModule{} = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Module
usg_mod Usage
usg)
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Fingerprint
usg_mod_hash Usage
usg)
BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Bool
usg_safe Usage
usg)
put_ BinHandle
bh usg :: Usage
usg@UsageHomeModule{} = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> ModuleName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> ModuleName
usg_mod_name Usage
usg)
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Fingerprint
usg_mod_hash Usage
usg)
BinHandle -> Maybe Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Maybe Fingerprint
usg_exports Usage
usg)
BinHandle -> [(OccName, Fingerprint)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> [(OccName, Fingerprint)]
usg_entities Usage
usg)
BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Bool
usg_safe Usage
usg)
put_ BinHandle
bh usg :: Usage
usg@UsageFile{} = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> FilePath -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> FilePath
usg_file_path Usage
usg)
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Fingerprint
usg_file_hash Usage
usg)
put_ BinHandle
bh usg :: Usage
usg@UsageMergedRequirement{} = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Module
usg_mod Usage
usg)
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Fingerprint
usg_mod_hash Usage
usg)
get :: BinHandle -> IO Usage
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> do
Module
nm <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
mod <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Bool
safe <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Usage -> IO Usage
forall (m :: * -> *) a. Monad m => a -> m a
return UsagePackageModule { usg_mod :: Module
usg_mod = Module
nm, usg_mod_hash :: Fingerprint
usg_mod_hash = Fingerprint
mod, usg_safe :: Bool
usg_safe = Bool
safe }
Word8
1 -> do
ModuleName
nm <- BinHandle -> IO ModuleName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
mod <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Maybe Fingerprint
exps <- BinHandle -> IO (Maybe Fingerprint)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[(OccName, Fingerprint)]
ents <- BinHandle -> IO [(OccName, Fingerprint)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Bool
safe <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Usage -> IO Usage
forall (m :: * -> *) a. Monad m => a -> m a
return UsageHomeModule { usg_mod_name :: ModuleName
usg_mod_name = ModuleName
nm, usg_mod_hash :: Fingerprint
usg_mod_hash = Fingerprint
mod,
usg_exports :: Maybe Fingerprint
usg_exports = Maybe Fingerprint
exps, usg_entities :: [(OccName, Fingerprint)]
usg_entities = [(OccName, Fingerprint)]
ents, usg_safe :: Bool
usg_safe = Bool
safe }
Word8
2 -> do
FilePath
fp <- BinHandle -> IO FilePath
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Usage -> IO Usage
forall (m :: * -> *) a. Monad m => a -> m a
return UsageFile { usg_file_path :: FilePath
usg_file_path = FilePath
fp, usg_file_hash :: Fingerprint
usg_file_hash = Fingerprint
hash }
Word8
3 -> do
Module
mod <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Usage -> IO Usage
forall (m :: * -> *) a. Monad m => a -> m a
return UsageMergedRequirement { usg_mod :: Module
usg_mod = Module
mod, usg_mod_hash :: Fingerprint
usg_mod_hash = Fingerprint
hash }
Word8
i -> FilePath -> IO Usage
forall a. HasCallStack => FilePath -> a
error (FilePath
"Binary.get(Usage): " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Word8 -> FilePath
forall a. Show a => a -> FilePath
show Word8
i)