module GHC.Iface.Recomp.Types (
  IfaceSelfRecomp(..),
  IfaceDynFlags(..),
  pprIfaceDynFlags,
  missingExtraFlagInfo,
) where

import GHC.Prelude
import GHC.Fingerprint
import GHC.Utils.Outputable
import GHC.Iface.Flags
import GHC.Types.SafeHaskell
import GHC.Unit.Module.Deps
import GHC.Unit.Module

import GHC.Utils.Binary

import Control.DeepSeq

{-
Note [Self recompilation information in interface files]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The flag -fwrite-if-self-recomp controls whether
interface files contain the information necessary to answer the
question:

  Is the interface file up-to-date, relative to:
    * the source file it corresponds to,
    * the flags passed to the GHC invocation to compile it,
    * its dependencies (e.g. imported items, watched files added by addDependentFile, ...)

If there is no self-recompilation information stored, then we always re-generate
the interface file from scratch.

Why? Most packages are only built once either by a distribution or cabal
and then placed into an immutable store, after which we will never ask
this question. Therefore we can derive two benefits from omitting this
information.

* Primary motivation: It vastly reduces the surface area for creating
  non-deterministic interface files. See issue #10424 which motivated a
  proper fix to that issue. Distributions have long contained versions
  of GHC which just have broken self-recompilation checking (in order to
  get deterministic interface files).

* Secondary motivation: This reduces the size of interface files
  slightly.. the `mi_usages` field can be quite big but probably this
  isn't such a great benefit.

* Third motivation: Conceptually clarity about which parts of an
  interface file are used in order to **communicate** with subsequent
  packages about the **interface** for a module. And which parts are
  used to self-communicate during recompilation checking.

The main tracking issue is #22188 but fixes issues such as #10424 in a
proper way.

-}

-- | The information for a module which is only used when deciding whether to recompile
-- itself.
--
-- See Note [Self recompilation information in interface files]
data IfaceSelfRecomp =
    IfaceSelfRecomp { IfaceSelfRecomp -> Fingerprint
mi_sr_src_hash :: !Fingerprint
                       -- ^ Hash of the .hs source, used for recompilation checking.
                       , IfaceSelfRecomp -> [Usage]
mi_sr_usages   :: [Usage]
                       -- ^ Usages; kept sorted so that it's easy to decide
                       -- whether to write a new iface file (changing usages
                       -- doesn't affect the hash of this module)
                       -- NOT STRICT!  we read this field lazily from the interface file
                       -- It is *only* consulted by the recompilation checker

                       , IfaceSelfRecomp -> FingerprintWithValue IfaceDynFlags
mi_sr_flag_hash :: !(FingerprintWithValue IfaceDynFlags)
                       -- ^ Hash of the important flags used when compiling the module, excluding
                       -- optimisation flags
                       , IfaceSelfRecomp -> Fingerprint
mi_sr_opt_hash :: !Fingerprint
                       -- ^ Hash of optimisation flags
                       , IfaceSelfRecomp -> Fingerprint
mi_sr_hpc_hash :: !Fingerprint
                       -- ^ Hash of hpc flags
                       , IfaceSelfRecomp -> Fingerprint
mi_sr_plugin_hash :: !Fingerprint
                       -- ^ Hash of plugins
                       }


instance Binary IfaceSelfRecomp where
  put_ :: WriteBinHandle -> IfaceSelfRecomp -> IO ()
put_ WriteBinHandle
bh (IfaceSelfRecomp{Fingerprint
mi_sr_src_hash :: IfaceSelfRecomp -> Fingerprint
mi_sr_src_hash :: Fingerprint
mi_sr_src_hash, [Usage]
mi_sr_usages :: IfaceSelfRecomp -> [Usage]
mi_sr_usages :: [Usage]
mi_sr_usages, FingerprintWithValue IfaceDynFlags
mi_sr_flag_hash :: IfaceSelfRecomp -> FingerprintWithValue IfaceDynFlags
mi_sr_flag_hash :: FingerprintWithValue IfaceDynFlags
mi_sr_flag_hash, Fingerprint
mi_sr_opt_hash :: IfaceSelfRecomp -> Fingerprint
mi_sr_opt_hash :: Fingerprint
mi_sr_opt_hash, Fingerprint
mi_sr_hpc_hash :: IfaceSelfRecomp -> Fingerprint
mi_sr_hpc_hash :: Fingerprint
mi_sr_hpc_hash, Fingerprint
mi_sr_plugin_hash :: IfaceSelfRecomp -> Fingerprint
mi_sr_plugin_hash :: Fingerprint
mi_sr_plugin_hash}) = do
    WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
mi_sr_src_hash
    WriteBinHandle -> [Usage] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh [Usage]
mi_sr_usages
    WriteBinHandle -> FingerprintWithValue IfaceDynFlags -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FingerprintWithValue IfaceDynFlags
mi_sr_flag_hash
    WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
mi_sr_opt_hash
    WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
mi_sr_hpc_hash
    WriteBinHandle -> Fingerprint -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Fingerprint
mi_sr_plugin_hash

  get :: ReadBinHandle -> IO IfaceSelfRecomp
get ReadBinHandle
bh = do
    src_hash    <- ReadBinHandle -> IO Fingerprint
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    usages      <- lazyGet bh
    flag_hash   <- get bh
    opt_hash    <- get bh
    hpc_hash    <- get bh
    plugin_hash <- get bh
    return $ IfaceSelfRecomp { mi_sr_src_hash = src_hash, mi_sr_usages = usages, mi_sr_flag_hash = flag_hash, mi_sr_opt_hash = opt_hash, mi_sr_hpc_hash = hpc_hash, mi_sr_plugin_hash = plugin_hash }

instance Outputable IfaceSelfRecomp where
  ppr :: IfaceSelfRecomp -> SDoc
ppr (IfaceSelfRecomp{Fingerprint
mi_sr_src_hash :: IfaceSelfRecomp -> Fingerprint
mi_sr_src_hash :: Fingerprint
mi_sr_src_hash, [Usage]
mi_sr_usages :: IfaceSelfRecomp -> [Usage]
mi_sr_usages :: [Usage]
mi_sr_usages, FingerprintWithValue IfaceDynFlags
mi_sr_flag_hash :: IfaceSelfRecomp -> FingerprintWithValue IfaceDynFlags
mi_sr_flag_hash :: FingerprintWithValue IfaceDynFlags
mi_sr_flag_hash, Fingerprint
mi_sr_opt_hash :: IfaceSelfRecomp -> Fingerprint
mi_sr_opt_hash :: Fingerprint
mi_sr_opt_hash, Fingerprint
mi_sr_hpc_hash :: IfaceSelfRecomp -> Fingerprint
mi_sr_hpc_hash :: Fingerprint
mi_sr_hpc_hash, Fingerprint
mi_sr_plugin_hash :: IfaceSelfRecomp -> Fingerprint
mi_sr_plugin_hash :: Fingerprint
mi_sr_plugin_hash})
    = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Self-Recomp"
            , Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"src hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
mi_sr_src_hash
                           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"flags:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> FingerprintWithValue SDoc -> SDoc
pprFingerprintWithValue SDoc
missingExtraFlagInfo ((IfaceDynFlags -> SDoc)
-> FingerprintWithValue IfaceDynFlags -> FingerprintWithValue SDoc
forall a b.
(a -> b) -> FingerprintWithValue a -> FingerprintWithValue b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IfaceDynFlags -> SDoc
pprIfaceDynFlags FingerprintWithValue IfaceDynFlags
mi_sr_flag_hash)
                           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"opt hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
mi_sr_opt_hash
                           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"hpc hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
mi_sr_hpc_hash
                           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"plugin hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
mi_sr_plugin_hash
                           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"usages:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((Usage -> SDoc) -> [Usage] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Usage -> SDoc
pprUsage [Usage]
mi_sr_usages)
                           ])]

instance NFData IfaceSelfRecomp where
  rnf :: IfaceSelfRecomp -> ()
rnf (IfaceSelfRecomp Fingerprint
src_hash [Usage]
usages FingerprintWithValue IfaceDynFlags
flag_hash Fingerprint
opt_hash Fingerprint
hpc_hash Fingerprint
plugin_hash)
    = Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
src_hash () -> () -> ()
forall a b. a -> b -> b
`seq` [Usage] -> ()
forall a. NFData a => a -> ()
rnf [Usage]
usages () -> () -> ()
forall a b. a -> b -> b
`seq` FingerprintWithValue IfaceDynFlags -> ()
forall a. NFData a => a -> ()
rnf FingerprintWithValue IfaceDynFlags
flag_hash () -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
opt_hash () -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
hpc_hash () -> () -> ()
forall a b. a -> b -> b
`seq` Fingerprint -> ()
forall a. NFData a => a -> ()
rnf Fingerprint
plugin_hash () -> () -> ()
forall a b. a -> b -> b
`seq` ()

pprFingerprintWithValue :: SDoc -> FingerprintWithValue SDoc -> SDoc
pprFingerprintWithValue :: SDoc -> FingerprintWithValue SDoc -> SDoc
pprFingerprintWithValue SDoc
missingInfo (FingerprintWithValue Fingerprint
fp Maybe SDoc
mflags)
  = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$
    [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"fingerprint:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
fp)
    ]
    [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ case Maybe SDoc
mflags of
        Maybe SDoc
Nothing -> [SDoc
missingInfo]
        Just SDoc
doc -> [SDoc
doc]

pprUsage :: Usage -> SDoc
pprUsage :: Usage -> SDoc
pprUsage UsagePackageModule{ usg_mod :: Usage -> Module
usg_mod = Module
mod, usg_mod_hash :: Usage -> Fingerprint
usg_mod_hash = Fingerprint
hash, usg_safe :: Usage -> IsSafeImport
usg_safe = IsSafeImport
safe }
  = Module -> Fingerprint -> IsSafeImport -> SDoc
forall mod.
Outputable mod =>
mod -> Fingerprint -> IsSafeImport -> SDoc
pprUsageImport Module
mod Fingerprint
hash IsSafeImport
safe
pprUsage UsageHomeModule{ usg_unit_id :: Usage -> UnitId
usg_unit_id = UnitId
unit_id, usg_mod_name :: Usage -> ModuleName
usg_mod_name = ModuleName
mod_name
                              , usg_mod_hash :: Usage -> Fingerprint
usg_mod_hash = Fingerprint
hash, usg_safe :: Usage -> IsSafeImport
usg_safe = IsSafeImport
safe
                              , usg_exports :: Usage -> Maybe HomeModImport
usg_exports = Maybe HomeModImport
exports, usg_entities :: Usage -> [(OccName, Fingerprint)]
usg_entities = [(OccName, Fingerprint)]
entities }
  = GenModule UnitId -> Fingerprint -> IsSafeImport -> SDoc
forall mod.
Outputable mod =>
mod -> Fingerprint -> IsSafeImport -> SDoc
pprUsageImport (UnitId -> ModuleName -> GenModule UnitId
forall u. u -> ModuleName -> GenModule u
mkModule UnitId
unit_id ModuleName
mod_name) Fingerprint
hash IsSafeImport
safe SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    Int -> SDoc -> SDoc
nest Int
2 (
        SDoc -> (HomeModImport -> SDoc) -> Maybe HomeModImport -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty (\HomeModImport
v -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exports: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> HomeModImport -> SDoc
forall a. Outputable a => a -> SDoc
ppr HomeModImport
v) Maybe HomeModImport
exports SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
v | (OccName
n,Fingerprint
v) <- [(OccName, Fingerprint)]
entities ]
        )
pprUsage usage :: Usage
usage@UsageFile{}
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"addDependentFile",
          SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext (Usage -> FastString
usg_file_path Usage
usage)),
          Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> Fingerprint
usg_file_hash Usage
usage)]
pprUsage usage :: Usage
usage@UsageMergedRequirement{}
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"merged", Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> Module
usg_mod Usage
usage), Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> Fingerprint
usg_mod_hash Usage
usage)]
pprUsage usage :: Usage
usage@UsageHomeModuleInterface{}
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"implementation", ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> ModuleName
usg_mod_name Usage
usage)
                               , UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> UnitId
usg_unit_id Usage
usage)
                               , Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> Fingerprint
usg_iface_hash Usage
usage)]

pprUsageImport :: Outputable mod => mod -> Fingerprint -> IsSafeImport -> SDoc
pprUsageImport :: forall mod.
Outputable mod =>
mod -> Fingerprint -> IsSafeImport -> SDoc
pprUsageImport mod
mod Fingerprint
hash IsSafeImport
safe
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import", SDoc
pp_safe, mod -> SDoc
forall a. Outputable a => a -> SDoc
ppr mod
mod
         , Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
hash ]
    where
        pp_safe :: SDoc
pp_safe | IsSafeImport
safe      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"safe"
                | IsSafeImport
otherwise = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" -/ "