{-# LANGUAGE LambdaCase #-}
module GHC.Unit.Module.ModSummary
( ExtendedModSummary (..)
, extendModSummaryNoDeps
, ModSummary (..)
, ms_installed_mod
, ms_mod_name
, ms_imps
, ms_home_allimps
, ms_home_srcimps
, ms_home_imps
, msHiFilePath
, msHsFilePath
, msObjFilePath
, msDynObjFilePath
, isBootSummary
, findTarget
)
where
import GHC.Prelude
import GHC.Hs
import GHC.Driver.Session
import GHC.Unit.Types
import GHC.Unit.Module
import GHC.Types.SourceFile ( HscSource(..), hscSourceString )
import GHC.Types.SrcLoc
import GHC.Types.Target
import GHC.Data.Maybe
import GHC.Data.FastString
import GHC.Data.StringBuffer ( StringBuffer )
import GHC.Utils.Outputable
import Data.Time
data ExtendedModSummary = ExtendedModSummary
{ ExtendedModSummary -> ModSummary
emsModSummary :: {-# UNPACK #-} !ModSummary
, ExtendedModSummary -> [InstantiatedUnit]
emsInstantiatedUnits :: [InstantiatedUnit]
}
instance Outputable ExtendedModSummary where
ppr :: ExtendedModSummary -> SDoc
ppr = \case
ExtendedModSummary ModSummary
ms [InstantiatedUnit]
bds -> forall a. Outputable a => a -> SDoc
ppr ModSummary
ms SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [InstantiatedUnit]
bds
extendModSummaryNoDeps :: ModSummary -> ExtendedModSummary
extendModSummaryNoDeps :: ModSummary -> ExtendedModSummary
extendModSummaryNoDeps ModSummary
ms = ModSummary -> [InstantiatedUnit] -> ExtendedModSummary
ExtendedModSummary ModSummary
ms []
data ModSummary
= ModSummary {
ModSummary -> Module
ms_mod :: Module,
ModSummary -> HscSource
ms_hsc_src :: HscSource,
ModSummary -> ModLocation
ms_location :: ModLocation,
ModSummary -> UTCTime
ms_hs_date :: UTCTime,
ModSummary -> Maybe UTCTime
ms_obj_date :: Maybe UTCTime,
ModSummary -> Maybe UTCTime
ms_iface_date :: Maybe UTCTime,
ModSummary -> Maybe UTCTime
ms_hie_date :: Maybe UTCTime,
ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_srcimps :: [(Maybe FastString, Located ModuleName)],
ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_textual_imps :: [(Maybe FastString, Located ModuleName)],
ModSummary -> Maybe HsParsedModule
ms_parsed_mod :: Maybe HsParsedModule,
ModSummary -> FilePath
ms_hspp_file :: FilePath,
ModSummary -> DynFlags
ms_hspp_opts :: DynFlags,
ModSummary -> Maybe StringBuffer
ms_hspp_buf :: Maybe StringBuffer
}
ms_installed_mod :: ModSummary -> InstalledModule
ms_installed_mod :: ModSummary -> InstalledModule
ms_installed_mod = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
ms_mod
ms_mod_name :: ModSummary -> ModuleName
ms_mod_name :: ModSummary -> ModuleName
ms_mod_name = forall unit. GenModule unit -> ModuleName
moduleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
ms_mod
ms_imps :: ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_imps :: ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_imps ModSummary
ms =
ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_textual_imps ModSummary
ms forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map forall {e} {a}. e -> (Maybe a, Located e)
mk_additional_import (DynFlags -> [ModuleName]
dynFlagDependencies (ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms))
where
mk_additional_import :: e -> (Maybe a, Located e)
mk_additional_import e
mod_nm = (forall a. Maybe a
Nothing, forall e. e -> Located e
noLoc e
mod_nm)
home_imps :: [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]
home_imps :: [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]
home_imps [(Maybe FastString, Located ModuleName)]
imps = [ Located ModuleName
lmodname | (Maybe FastString
mb_pkg, Located ModuleName
lmodname) <- [(Maybe FastString, Located ModuleName)]
imps,
Maybe FastString -> Bool
isLocal Maybe FastString
mb_pkg ]
where isLocal :: Maybe FastString -> Bool
isLocal Maybe FastString
Nothing = Bool
True
isLocal (Just FastString
pkg) | FastString
pkg forall a. Eq a => a -> a -> Bool
== FilePath -> FastString
fsLit FilePath
"this" = Bool
True
isLocal Maybe FastString
_ = Bool
False
ms_home_allimps :: ModSummary -> [ModuleName]
ms_home_allimps :: ModSummary -> [ModuleName]
ms_home_allimps ModSummary
ms = forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc (ModSummary -> [Located ModuleName]
ms_home_srcimps ModSummary
ms forall a. [a] -> [a] -> [a]
++ ModSummary -> [Located ModuleName]
ms_home_imps ModSummary
ms)
ms_home_srcimps :: ModSummary -> [Located ModuleName]
ms_home_srcimps :: ModSummary -> [Located ModuleName]
ms_home_srcimps = [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]
home_imps forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_srcimps
ms_home_imps :: ModSummary -> [Located ModuleName]
ms_home_imps :: ModSummary -> [Located ModuleName]
ms_home_imps = [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]
home_imps forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_imps
msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath
msHsFilePath :: ModSummary -> FilePath
msHsFilePath ModSummary
ms = forall a. HasCallStack => FilePath -> Maybe a -> a
expectJust FilePath
"msHsFilePath" (ModLocation -> Maybe FilePath
ml_hs_file (ModSummary -> ModLocation
ms_location ModSummary
ms))
msHiFilePath :: ModSummary -> FilePath
msHiFilePath ModSummary
ms = ModLocation -> FilePath
ml_hi_file (ModSummary -> ModLocation
ms_location ModSummary
ms)
msObjFilePath :: ModSummary -> FilePath
msObjFilePath ModSummary
ms = ModLocation -> FilePath
ml_obj_file (ModSummary -> ModLocation
ms_location ModSummary
ms)
msDynObjFilePath :: ModSummary -> DynFlags -> FilePath
msDynObjFilePath :: ModSummary -> DynFlags -> FilePath
msDynObjFilePath ModSummary
ms DynFlags
dflags = DynFlags -> FilePath -> FilePath
dynamicOutputFile DynFlags
dflags (ModSummary -> FilePath
msObjFilePath ModSummary
ms)
isBootSummary :: ModSummary -> IsBootInterface
isBootSummary :: ModSummary -> IsBootInterface
isBootSummary ModSummary
ms = if ModSummary -> HscSource
ms_hsc_src ModSummary
ms forall a. Eq a => a -> a -> Bool
== HscSource
HsBootFile then IsBootInterface
IsBoot else IsBootInterface
NotBoot
instance Outputable ModSummary where
ppr :: ModSummary -> SDoc
ppr ModSummary
ms
= [SDoc] -> SDoc
sep [FilePath -> SDoc
text FilePath
"ModSummary {",
Int -> SDoc -> SDoc
nest Int
3 ([SDoc] -> SDoc
sep [FilePath -> SDoc
text FilePath
"ms_hs_date = " SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text (forall a. Show a => a -> FilePath
show (ModSummary -> UTCTime
ms_hs_date ModSummary
ms)),
FilePath -> SDoc
text FilePath
"ms_mod =" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ModSummary -> Module
ms_mod ModSummary
ms)
SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text (HscSource -> FilePath
hscSourceString (ModSummary -> HscSource
ms_hsc_src ModSummary
ms)) SDoc -> SDoc -> SDoc
<> SDoc
comma,
FilePath -> SDoc
text FilePath
"ms_textual_imps =" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_textual_imps ModSummary
ms),
FilePath -> SDoc
text FilePath
"ms_srcimps =" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_srcimps ModSummary
ms)]),
Char -> SDoc
char Char
'}'
]
findTarget :: ModSummary -> [Target] -> Maybe Target
findTarget :: ModSummary -> [Target] -> Maybe Target
findTarget ModSummary
ms [Target]
ts =
case forall a. (a -> Bool) -> [a] -> [a]
filter (ModSummary -> Target -> Bool
matches ModSummary
ms) [Target]
ts of
[] -> forall a. Maybe a
Nothing
(Target
t:[Target]
_) -> forall a. a -> Maybe a
Just Target
t
where
ModSummary
summary matches :: ModSummary -> Target -> Bool
`matches` Target (TargetModule ModuleName
m) Bool
_ Maybe (StringBuffer, UTCTime)
_
= ModSummary -> ModuleName
ms_mod_name ModSummary
summary forall a. Eq a => a -> a -> Bool
== ModuleName
m
ModSummary
summary `matches` Target (TargetFile FilePath
f Maybe Phase
_) Bool
_ Maybe (StringBuffer, UTCTime)
_
| Just FilePath
f' <- ModLocation -> Maybe FilePath
ml_hs_file (ModSummary -> ModLocation
ms_location ModSummary
summary)
= FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
f'
ModSummary
_ `matches` Target
_
= Bool
False