{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module      :  Haddock.InterfaceFile
-- Copyright   :  (c) David Waern       2006-2009,
--                    Mateusz Kowalczyk 2013
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- Reading and writing the .haddock interface file
module Haddock.InterfaceFile
  ( InterfaceFile (..)
  , PackageInfo (..)
  , ifUnitId
  , ifModule
  , PackageInterfaces (..)
  , mkPackageInterfaces
  , ppPackageInfo
  , readInterfaceFile
  , writeInterfaceFile
  , freshNameCache
  , binaryInterfaceVersion
  , binaryInterfaceVersionCompatibility
  ) where

import Data.Coerce (coerce)
import Data.Function ((&))
import Data.IORef
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Version
import Data.Word
import GHC hiding (NoLink)
import GHC.Data.FastMutInt
import GHC.Data.FastString
import GHC.Iface.Binary (getWithUserData, putSymbolTable)
import GHC.Iface.Type (IfaceType, putIfaceType)
import GHC.Types.Name.Cache
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Unit.State
import GHC.Utils.Binary
import Haddock.Types
import Text.ParserCombinators.ReadP (readP_to_S)

import Haddock.Options (Visibility (..))

data InterfaceFile = InterfaceFile
  { InterfaceFile -> LinkEnv
ifLinkEnv :: LinkEnv
  , InterfaceFile -> PackageInfo
ifPackageInfo :: PackageInfo
  -- ^ Package meta data.  Currently it only consist of a package name, which
  -- is not read from the interface file, but inferred from its name.
  --
  -- issue #
  , InterfaceFile -> [InstalledInterface]
ifInstalledIfaces :: [InstalledInterface]
  }

data PackageInfo = PackageInfo
  { PackageInfo -> PackageName
piPackageName :: PackageName
  , PackageInfo -> Version
piPackageVersion :: Data.Version.Version
  }

ppPackageInfo :: PackageInfo -> String
ppPackageInfo :: PackageInfo -> String
ppPackageInfo (PackageInfo PackageName
name Version
version)
  | Version
version Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Version
makeVersion [] =
      FastString -> String
unpackFS (PackageName -> FastString
unPackageName PackageName
name)
ppPackageInfo (PackageInfo PackageName
name Version
version) = FastString -> String
unpackFS (PackageName -> FastString
unPackageName PackageName
name) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version

data PackageInterfaces = PackageInterfaces
  { PackageInterfaces -> PackageInfo
piPackageInfo :: PackageInfo
  , PackageInterfaces -> Visibility
piVisibility :: Visibility
  , PackageInterfaces -> [InstalledInterface]
piInstalledInterfaces :: [InstalledInterface]
  }

mkPackageInterfaces :: Visibility -> InterfaceFile -> PackageInterfaces
mkPackageInterfaces :: Visibility -> InterfaceFile -> PackageInterfaces
mkPackageInterfaces
  Visibility
piVisibility
  InterfaceFile
    { PackageInfo
ifPackageInfo :: InterfaceFile -> PackageInfo
ifPackageInfo :: PackageInfo
ifPackageInfo
    , [InstalledInterface]
ifInstalledIfaces :: InterfaceFile -> [InstalledInterface]
ifInstalledIfaces :: [InstalledInterface]
ifInstalledIfaces
    } =
    PackageInterfaces
      { piPackageInfo :: PackageInfo
piPackageInfo = PackageInfo
ifPackageInfo
      , Visibility
piVisibility :: Visibility
piVisibility :: Visibility
piVisibility
      , piInstalledInterfaces :: [InstalledInterface]
piInstalledInterfaces = [InstalledInterface]
ifInstalledIfaces
      }

ifModule :: InterfaceFile -> Module
ifModule :: InterfaceFile -> GenModule Unit
ifModule InterfaceFile
if_ =
  case InterfaceFile -> [InstalledInterface]
ifInstalledIfaces InterfaceFile
if_ of
    [] -> String -> GenModule Unit
forall a. HasCallStack => String -> a
error String
"empty InterfaceFile"
    InstalledInterface
iface : [InstalledInterface]
_ -> InstalledInterface -> GenModule Unit
instMod InstalledInterface
iface

ifUnitId :: InterfaceFile -> Unit
ifUnitId :: InterfaceFile -> Unit
ifUnitId InterfaceFile
if_ =
  case InterfaceFile -> [InstalledInterface]
ifInstalledIfaces InterfaceFile
if_ of
    [] -> String -> Unit
forall a. HasCallStack => String -> a
error String
"empty InterfaceFile"
    InstalledInterface
iface : [InstalledInterface]
_ -> GenModule Unit -> Unit
forall unit. GenModule unit -> unit
moduleUnit (GenModule Unit -> Unit) -> GenModule Unit -> Unit
forall a b. (a -> b) -> a -> b
$ InstalledInterface -> GenModule Unit
instMod InstalledInterface
iface

binaryInterfaceMagic :: Word32
binaryInterfaceMagic :: Word32
binaryInterfaceMagic = Word32
0xD0Cface

-- Note [The DocModule story]
--
-- Breaking changes to the DocH type result in Haddock being unable to read
-- existing interfaces. This is especially painful for interfaces shipped
-- with GHC distributions since there is no easy way to regenerate them!
--
-- PR #1315 introduced a breaking change to the DocModule constructor. To
-- maintain backward compatibility we
--
-- Parse the old DocModule constructor format (tag 5) and parse the contained
-- string into a proper ModLink structure. When writing interfaces we exclusively
-- use the new DocModule format (tag 24)

-- IMPORTANT: Since datatypes in the GHC API might change between major
-- versions, and because we store GHC datatypes in our interface files, we need
-- to make sure we version our interface files accordingly.
--
-- If you change the interface file format or adapt Haddock to work with a new
-- major version of GHC (so that the format changes indirectly) *you* need to
-- follow these steps:
--
-- (1) increase `binaryInterfaceVersion`
--
-- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion]
--
binaryInterfaceVersion :: Word16
#if MIN_VERSION_ghc(9,11,0) && !MIN_VERSION_ghc(9,14,0)
binaryInterfaceVersion :: Word16
binaryInterfaceVersion = Word16
46

binaryInterfaceVersionCompatibility :: [Word16]
binaryInterfaceVersionCompatibility :: [Word16]
binaryInterfaceVersionCompatibility = [Word16
binaryInterfaceVersion]
#else
#error Unsupported GHC version
#endif

initBinMemSize :: Int
initBinMemSize :: Int
initBinMemSize = Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

writeInterfaceFile :: FilePath -> InterfaceFile -> IO ()
writeInterfaceFile :: String -> InterfaceFile -> IO ()
writeInterfaceFile String
filename InterfaceFile
iface = do
  bh0 <- Int -> IO WriteBinHandle
openBinMem Int
initBinMemSize
  put_ bh0 binaryInterfaceMagic
  put_ bh0 binaryInterfaceVersion

  -- remember where the dictionary pointer will go
  dict_p_p <- tellBinWriter bh0
  put_ bh0 dict_p_p

  -- remember where the symbol table pointer will go
  symtab_p_p <- tellBinWriter bh0
  put_ bh0 symtab_p_p

  -- remember where the iface type table pointer will go
  ifacetype_p_p <- tellBinWriter bh0
  put_ bh0 ifacetype_p_p

  -- Make some intial state
  symtab_next <- newFastMutInt 0
  symtab_map <- newIORef emptyUFM
  let bin_symtab =
        BinSymbolTable
          { bin_symtab_next :: FastMutInt
bin_symtab_next = FastMutInt
symtab_next
          , bin_symtab_map :: IORef (UniqFM Name (Int, Name))
bin_symtab_map = IORef (UniqFM Name (Int, Name))
symtab_map
          }
  dict_next_ref <- newFastMutInt 0
  dict_map_ref <- newIORef emptyUFM
  let bin_dict =
        BinDictionary
          { bin_dict_next :: FastMutInt
bin_dict_next = FastMutInt
dict_next_ref
          , bin_dict_map :: IORef (UniqFM FastString (Int, FastString))
bin_dict_map = IORef (UniqFM FastString (Int, FastString))
dict_map_ref
          }

  iface_type_dict <- initGenericSymbolTable @(Map IfaceType)

  -- put the main thing
  let bh =
        WriteBinHandle
bh0
          WriteBinHandle
-> (WriteBinHandle -> WriteBinHandle) -> WriteBinHandle
forall a b. a -> (a -> b) -> b
& BinaryWriter Name -> WriteBinHandle -> WriteBinHandle
forall a.
Typeable a =>
BinaryWriter a -> WriteBinHandle -> WriteBinHandle
addWriterToUserData ((WriteBinHandle -> Name -> IO ()) -> BinaryWriter Name
forall s. (WriteBinHandle -> s -> IO ()) -> BinaryWriter s
mkWriter ((WriteBinHandle -> Name -> IO ()) -> BinaryWriter Name)
-> (WriteBinHandle -> Name -> IO ()) -> BinaryWriter Name
forall a b. (a -> b) -> a -> b
$ BinSymbolTable -> WriteBinHandle -> Name -> IO ()
putName BinSymbolTable
bin_symtab)
          WriteBinHandle
-> (WriteBinHandle -> WriteBinHandle) -> WriteBinHandle
forall a b. a -> (a -> b) -> b
& BinaryWriter BindingName -> WriteBinHandle -> WriteBinHandle
forall a.
Typeable a =>
BinaryWriter a -> WriteBinHandle -> WriteBinHandle
addWriterToUserData (BinaryWriter Name -> BinaryWriter BindingName
simpleBindingNameWriter (BinaryWriter Name -> BinaryWriter BindingName)
-> BinaryWriter Name -> BinaryWriter BindingName
forall a b. (a -> b) -> a -> b
$ (WriteBinHandle -> Name -> IO ()) -> BinaryWriter Name
forall s. (WriteBinHandle -> s -> IO ()) -> BinaryWriter s
mkWriter ((WriteBinHandle -> Name -> IO ()) -> BinaryWriter Name)
-> (WriteBinHandle -> Name -> IO ()) -> BinaryWriter Name
forall a b. (a -> b) -> a -> b
$ BinSymbolTable -> WriteBinHandle -> Name -> IO ()
putName BinSymbolTable
bin_symtab)
          WriteBinHandle
-> (WriteBinHandle -> WriteBinHandle) -> WriteBinHandle
forall a b. a -> (a -> b) -> b
& BinaryWriter FastString -> WriteBinHandle -> WriteBinHandle
forall a.
Typeable a =>
BinaryWriter a -> WriteBinHandle -> WriteBinHandle
addWriterToUserData ((WriteBinHandle -> FastString -> IO ()) -> BinaryWriter FastString
forall s. (WriteBinHandle -> s -> IO ()) -> BinaryWriter s
mkWriter ((WriteBinHandle -> FastString -> IO ())
 -> BinaryWriter FastString)
-> (WriteBinHandle -> FastString -> IO ())
-> BinaryWriter FastString
forall a b. (a -> b) -> a -> b
$ BinDictionary -> WriteBinHandle -> FastString -> IO ()
putFastString BinDictionary
bin_dict)
          WriteBinHandle
-> (WriteBinHandle -> WriteBinHandle) -> WriteBinHandle
forall a b. a -> (a -> b) -> b
& BinaryWriter IfaceType -> WriteBinHandle -> WriteBinHandle
forall a.
Typeable a =>
BinaryWriter a -> WriteBinHandle -> WriteBinHandle
addWriterToUserData ((WriteBinHandle -> IfaceType -> IO ()) -> BinaryWriter IfaceType
forall s. (WriteBinHandle -> s -> IO ()) -> BinaryWriter s
mkWriter ((WriteBinHandle -> IfaceType -> IO ()) -> BinaryWriter IfaceType)
-> (WriteBinHandle -> IfaceType -> IO ()) -> BinaryWriter IfaceType
forall a b. (a -> b) -> a -> b
$ GenericSymbolTable (Map IfaceType)
-> WriteBinHandle -> Key (Map IfaceType) -> IO ()
forall (m :: Type -> Type).
TrieMap m =>
GenericSymbolTable m -> WriteBinHandle -> Key m -> IO ()
putGenericSymTab GenericSymbolTable (Map IfaceType)
iface_type_dict)
  putInterfaceFile_ bh iface

  -- write the iface type pointer at the front of the file
  ifacetype_p <- tellBinWriter bh
  putAtRel bh ifacetype_p_p ifacetype_p
  seekBinWriter bh ifacetype_p

  -- write the symbol table itself
  _ <- putGenericSymbolTable iface_type_dict putIfaceType bh

  -- write the symtab pointer at the front of the file
  symtab_p <- tellBinWriter bh
  putAtRel bh symtab_p_p symtab_p
  seekBinWriter bh symtab_p

  -- write the symbol table itself
  symtab_next' <- readFastMutInt symtab_next
  symtab_map' <- readIORef symtab_map
  putSymbolTable bh symtab_next' symtab_map'

  -- write the dictionary pointer at the fornt of the file
  dict_p <- tellBinWriter bh
  putAtRel bh dict_p_p dict_p
  seekBinWriter bh dict_p

  -- write the dictionary itself
  dict_next <- readFastMutInt dict_next_ref
  dict_map <- readIORef dict_map_ref
  putDictionary bh dict_next dict_map

  -- and send the result to the file
  writeBinMem bh filename
  return ()

freshNameCache :: IO NameCache
freshNameCache :: IO NameCache
freshNameCache =
  Char -> [Name] -> IO NameCache
initNameCache
    Char
'a' -- ??
    []

-- | Read a Haddock (@.haddock@) interface file. Return either an
-- 'InterfaceFile' or an error message.
--
-- This function can be called in two ways.  Within a GHC session it will
-- update the use and update the session's name cache.  Outside a GHC session
-- a new empty name cache is used.
readInterfaceFile
  :: NameCache
  -> FilePath
  -> Bool
  -- ^ Disable version check. Can cause runtime crash.
  -> IO (Either String InterfaceFile)
readInterfaceFile :: NameCache -> String -> Bool -> IO (Either String InterfaceFile)
readInterfaceFile NameCache
name_cache String
filename Bool
bypass_checks = do
  bh <- String -> IO ReadBinHandle
readBinMem String
filename
  magic <- get bh
  if magic /= binaryInterfaceMagic
    then return . Left $ "Magic number mismatch: couldn't load interface file: " ++ filename
    else do
      version <- get bh
      if not bypass_checks && (version `notElem` binaryInterfaceVersionCompatibility)
        then return . Left $ "Interface file is of wrong version: " ++ filename
        else Right <$> getWithUserData name_cache bh

-------------------------------------------------------------------------------

-- * Symbol table

-------------------------------------------------------------------------------

putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO ()
putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO ()
putName
  BinSymbolTable
    { bin_symtab_map :: BinSymbolTable -> IORef (UniqFM Name (Int, Name))
bin_symtab_map = IORef (UniqFM Name (Int, Name))
symtab_map_ref
    , bin_symtab_next :: BinSymbolTable -> FastMutInt
bin_symtab_next = FastMutInt
symtab_next
    }
  WriteBinHandle
bh
  Name
name =
    do
      symtab_map <- IORef (UniqFM Name (Int, Name)) -> IO (UniqFM Name (Int, Name))
forall a. IORef a -> IO a
readIORef IORef (UniqFM Name (Int, Name))
symtab_map_ref
      case lookupUFM symtab_map name of
        Just (Int
off, Name
_) -> WriteBinHandle -> Word32 -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off :: Word32)
        Maybe (Int, Name)
Nothing -> do
          off <- FastMutInt -> IO Int
readFastMutInt FastMutInt
symtab_next
          writeFastMutInt symtab_next (off + 1)
          writeIORef symtab_map_ref $!
            addToUFM symtab_map name (off, name)
          put_ bh (fromIntegral off :: Word32)

data BinSymbolTable = BinSymbolTable
  { BinSymbolTable -> FastMutInt
bin_symtab_next :: !FastMutInt -- The next index to use
  , BinSymbolTable -> IORef (UniqFM Name (Int, Name))
bin_symtab_map :: !(IORef (UniqFM Name (Int, Name)))
  -- indexed by Name
  }

putFastString :: BinDictionary -> WriteBinHandle -> FastString -> IO ()
putFastString :: BinDictionary -> WriteBinHandle -> FastString -> IO ()
putFastString
  BinDictionary
    { bin_dict_next :: BinDictionary -> FastMutInt
bin_dict_next = FastMutInt
j_r
    , bin_dict_map :: BinDictionary -> IORef (UniqFM FastString (Int, FastString))
bin_dict_map = IORef (UniqFM FastString (Int, FastString))
out_r
    }
  WriteBinHandle
bh
  FastString
f =
    do
      out <- IORef (UniqFM FastString (Int, FastString))
-> IO (UniqFM FastString (Int, FastString))
forall a. IORef a -> IO a
readIORef IORef (UniqFM FastString (Int, FastString))
out_r
      let !unique = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
f
      case lookupUFM_Directly out unique of
        Just (Int
j, FastString
_) -> WriteBinHandle -> Word32 -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j :: Word32)
        Maybe (Int, FastString)
Nothing -> do
          j <- FastMutInt -> IO Int
readFastMutInt FastMutInt
j_r
          put_ bh (fromIntegral j :: Word32)
          writeFastMutInt j_r (j + 1)
          writeIORef out_r $! addToUFM_Directly out unique (j, f)

data BinDictionary = BinDictionary
  { BinDictionary -> FastMutInt
bin_dict_next :: !FastMutInt -- The next index to use
  , BinDictionary -> IORef (UniqFM FastString (Int, FastString))
bin_dict_map :: !(IORef (UniqFM FastString (Int, FastString)))
  -- indexed by FastString
  }

-------------------------------------------------------------------------------

-- * GhcBinary instances

-------------------------------------------------------------------------------

instance (Ord k, Binary k, Binary v) => Binary (Map k v) where
  put_ :: WriteBinHandle -> Map k v -> IO ()
put_ WriteBinHandle
bh Map k v
m = WriteBinHandle -> [(k, v)] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m)
  get :: ReadBinHandle -> IO (Map k v)
get ReadBinHandle
bh = ([(k, v)] -> Map k v) -> IO [(k, v)] -> IO (Map k v)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList) (ReadBinHandle -> IO [(k, v)]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh)

instance Binary PackageInfo where
  put_ :: WriteBinHandle -> PackageInfo -> IO ()
put_ WriteBinHandle
bh PackageInfo{PackageName
piPackageName :: PackageInfo -> PackageName
piPackageName :: PackageName
piPackageName, Version
piPackageVersion :: PackageInfo -> Version
piPackageVersion :: Version
piPackageVersion} = do
    WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (PackageName -> FastString
unPackageName PackageName
piPackageName)
    WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Version -> String
showVersion Version
piPackageVersion)
  get :: ReadBinHandle -> IO PackageInfo
get ReadBinHandle
bh = do
    name <- FastString -> PackageName
PackageName (FastString -> PackageName) -> IO FastString -> IO PackageName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    versionString <- get bh
    let version = case ReadP Version -> ReadS Version
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion String
versionString of
          [] -> [Int] -> Version
makeVersion []
          [(Version, String)]
vs -> (Version, String) -> Version
forall a b. (a, b) -> a
fst ([(Version, String)] -> (Version, String)
forall a. HasCallStack => [a] -> a
last [(Version, String)]
vs)
    return $ PackageInfo name version

instance Binary InterfaceFile where
  put_ :: WriteBinHandle -> InterfaceFile -> IO ()
put_ WriteBinHandle
bh (InterfaceFile LinkEnv
env PackageInfo
info [InstalledInterface]
ifaces) = do
    WriteBinHandle -> LinkEnv -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh LinkEnv
env
    WriteBinHandle -> PackageInfo -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh PackageInfo
info
    WriteBinHandle -> [InstalledInterface] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [InstalledInterface]
ifaces

  get :: ReadBinHandle -> IO InterfaceFile
get ReadBinHandle
bh = do
    env <- ReadBinHandle -> IO LinkEnv
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    info <- get bh
    ifaces <- get bh
    return (InterfaceFile env info ifaces)

putInterfaceFile_ :: WriteBinHandle -> InterfaceFile -> IO ()
putInterfaceFile_ :: WriteBinHandle -> InterfaceFile -> IO ()
putInterfaceFile_ WriteBinHandle
bh (InterfaceFile LinkEnv
env PackageInfo
info [InstalledInterface]
ifaces) = do
  WriteBinHandle -> LinkEnv -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh LinkEnv
env
  WriteBinHandle -> PackageInfo -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh PackageInfo
info
  WriteBinHandle -> [InstalledInterface] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [InstalledInterface]
ifaces

instance Binary InstalledInterface where
  put_ :: WriteBinHandle -> InstalledInterface -> IO ()
put_
    WriteBinHandle
bh
    ( InstalledInterface
        GenModule Unit
modu
        Bool
is_sig
        HaddockModInfo Name
info
        DocMap Name
docMap
        ArgMap Name
argMap
        [(OccName, Name)]
defMeths
        [Name]
exps
        [Name]
visExps
        [DocOption]
opts
        Map Name Fixity
fixMap
        WarningMap
warnMap
        Map Name RealSrcSpan
locMap
      ) = do
      WriteBinHandle -> GenModule Unit -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh GenModule Unit
modu
      WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Bool
is_sig
      WriteBinHandle -> HaddockModInfo Name -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh HaddockModInfo Name
info
      WriteBinHandle -> (DocMap Name, ArgMap Name) -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh (DocMap Name
docMap, ArgMap Name
argMap)
      WriteBinHandle -> [(OccName, Name)] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [(OccName, Name)]
defMeths
      WriteBinHandle -> [Name] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [Name]
exps
      WriteBinHandle -> [Name] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [Name]
visExps
      WriteBinHandle -> [DocOption] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [DocOption]
opts
      WriteBinHandle -> Map Name Fixity -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Map Name Fixity
fixMap
      WriteBinHandle -> WarningMap -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh WarningMap
warnMap
      WriteBinHandle -> Map Name BinSpan -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @_ @(Map Name BinSpan) Map Name RealSrcSpan
locMap)

  get :: ReadBinHandle -> IO InstalledInterface
get ReadBinHandle
bh = do
    modu <- ReadBinHandle -> IO (GenModule Unit)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    is_sig <- get bh
    info <- get bh
    ~(docMap, argMap) <- lazyGet bh
    defMeths <- get bh
    exps <- get bh
    visExps <- get bh
    opts <- get bh
    fixMap <- get bh
    warnMap <- get bh
    locMap <- get bh
    return
      ( InstalledInterface
          modu
          is_sig
          info
          docMap
          argMap
          defMeths
          exps
          visExps
          opts
          fixMap
          warnMap
          (coerce @(Map Name BinSpan) locMap)
      )

instance Binary DocOption where
  put_ :: WriteBinHandle -> DocOption -> IO ()
put_ WriteBinHandle
bh DocOption
OptHide = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
  put_ WriteBinHandle
bh DocOption
OptPrune = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
  put_ WriteBinHandle
bh DocOption
OptIgnoreExports = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
  put_ WriteBinHandle
bh DocOption
OptNotHome = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3
  put_ WriteBinHandle
bh DocOption
OptShowExtensions = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
4
  put_ WriteBinHandle
bh DocOption
OptPrintRuntimeRep = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
5
  get :: ReadBinHandle -> IO DocOption
get ReadBinHandle
bh = do
    h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
    case h of
      Word8
0 -> do
        DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return DocOption
OptHide
      Word8
1 -> do
        DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return DocOption
OptPrune
      Word8
2 -> do
        DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return DocOption
OptIgnoreExports
      Word8
3 -> do
        DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return DocOption
OptNotHome
      Word8
4 -> do
        DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return DocOption
OptShowExtensions
      Word8
5 -> do
        DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return DocOption
OptPrintRuntimeRep
      Word8
n -> String -> IO DocOption
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> IO DocOption) -> String -> IO DocOption
forall a b. (a -> b) -> a -> b
$ String
"invalid binary data found: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
n

instance Binary Example where
  put_ :: WriteBinHandle -> Example -> IO ()
put_ WriteBinHandle
bh (Example String
expression [String]
result) = do
    WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
expression
    WriteBinHandle -> [String] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [String]
result
  get :: ReadBinHandle -> IO Example
get ReadBinHandle
bh = do
    expression <- ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    result <- get bh
    return (Example expression result)

instance Binary a => Binary (Hyperlink a) where
  put_ :: WriteBinHandle -> Hyperlink a -> IO ()
put_ WriteBinHandle
bh (Hyperlink String
url Maybe a
label) = do
    WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
url
    WriteBinHandle -> Maybe a -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe a
label
  get :: ReadBinHandle -> IO (Hyperlink a)
get ReadBinHandle
bh = do
    url <- ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    label <- get bh
    return (Hyperlink url label)

instance Binary a => Binary (ModLink a) where
  put_ :: WriteBinHandle -> ModLink a -> IO ()
put_ WriteBinHandle
bh (ModLink String
m Maybe a
label) = do
    WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
m
    WriteBinHandle -> Maybe a -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe a
label
  get :: ReadBinHandle -> IO (ModLink a)
get ReadBinHandle
bh = do
    m <- ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    label <- get bh
    return (ModLink m label)

instance Binary Picture where
  put_ :: WriteBinHandle -> Picture -> IO ()
put_ WriteBinHandle
bh (Picture String
uri Maybe String
title) = do
    WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
uri
    WriteBinHandle -> Maybe String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe String
title
  get :: ReadBinHandle -> IO Picture
get ReadBinHandle
bh = do
    uri <- ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    title <- get bh
    return (Picture uri title)

instance Binary a => Binary (Header a) where
  put_ :: WriteBinHandle -> Header a -> IO ()
put_ WriteBinHandle
bh (Header Int
l a
t) = do
    WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
l
    WriteBinHandle -> a -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh a
t
  get :: ReadBinHandle -> IO (Header a)
get ReadBinHandle
bh = do
    l <- ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    t <- get bh
    return (Header l t)

instance Binary a => Binary (Table a) where
  put_ :: WriteBinHandle -> Table a -> IO ()
put_ WriteBinHandle
bh (Table [TableRow a]
h [TableRow a]
b) = do
    WriteBinHandle -> [TableRow a] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [TableRow a]
h
    WriteBinHandle -> [TableRow a] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [TableRow a]
b
  get :: ReadBinHandle -> IO (Table a)
get ReadBinHandle
bh = do
    h <- ReadBinHandle -> IO [TableRow a]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    b <- get bh
    return (Table h b)

instance Binary a => Binary (TableRow a) where
  put_ :: WriteBinHandle -> TableRow a -> IO ()
put_ WriteBinHandle
bh (TableRow [TableCell a]
cs) = WriteBinHandle -> [TableCell a] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [TableCell a]
cs
  get :: ReadBinHandle -> IO (TableRow a)
get ReadBinHandle
bh = do
    cs <- ReadBinHandle -> IO [TableCell a]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    return (TableRow cs)

instance Binary a => Binary (TableCell a) where
  put_ :: WriteBinHandle -> TableCell a -> IO ()
put_ WriteBinHandle
bh (TableCell Int
i Int
j a
c) = do
    WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
i
    WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
j
    WriteBinHandle -> a -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh a
c
  get :: ReadBinHandle -> IO (TableCell a)
get ReadBinHandle
bh = do
    i <- ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    j <- get bh
    c <- get bh
    return (TableCell i j c)

instance Binary Meta where
  put_ :: WriteBinHandle -> Meta -> IO ()
put_ WriteBinHandle
bh (Meta Maybe MetaSince
since) = do
    WriteBinHandle -> Maybe MetaSince -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe MetaSince
since
  get :: ReadBinHandle -> IO Meta
get ReadBinHandle
bh = do
    since <- ReadBinHandle -> IO (Maybe MetaSince)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    return (Meta since)

instance Binary MetaSince where
  put_ :: WriteBinHandle -> MetaSince -> IO ()
put_ WriteBinHandle
bh (MetaSince Maybe String
v [Int]
p) = do
    WriteBinHandle -> Maybe String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe String
v
    WriteBinHandle -> [Int] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [Int]
p
  get :: ReadBinHandle -> IO MetaSince
get ReadBinHandle
bh = do
    v <- ReadBinHandle -> IO (Maybe String)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    p <- get bh
    return (MetaSince v p)

instance (Binary mod, Binary id) => Binary (MetaDoc mod id) where
  put_ :: WriteBinHandle -> MetaDoc mod id -> IO ()
put_ WriteBinHandle
bh MetaDoc{_meta :: forall mod id. MetaDoc mod id -> Meta
_meta = Meta
m, _doc :: forall mod id. MetaDoc mod id -> DocH mod id
_doc = DocH mod id
d} = do
    WriteBinHandle -> Meta -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Meta
m
    WriteBinHandle -> DocH mod id -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh DocH mod id
d
  get :: ReadBinHandle -> IO (MetaDoc mod id)
get ReadBinHandle
bh = do
    m <- ReadBinHandle -> IO Meta
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    d <- get bh
    return $ MetaDoc{_meta = m, _doc = d}

instance (Binary mod, Binary id) => Binary (DocH mod id) where
  put_ :: WriteBinHandle -> DocH mod id -> IO ()
put_ WriteBinHandle
bh DocH mod id
DocEmpty = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
  put_ WriteBinHandle
bh (DocAppend DocH mod id
aa DocH mod id
ab) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    WriteBinHandle -> DocH mod id -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh DocH mod id
aa
    WriteBinHandle -> DocH mod id -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh DocH mod id
ab
  put_ WriteBinHandle
bh (DocString String
ac) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
    WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
ac
  put_ WriteBinHandle
bh (DocParagraph DocH mod id
ad) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3
    WriteBinHandle -> DocH mod id -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh DocH mod id
ad
  put_ WriteBinHandle
bh (DocIdentifier id
ae) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
4
    WriteBinHandle -> id -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh id
ae
  put_ WriteBinHandle
bh (DocEmphasis DocH mod id
ag) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
6
    WriteBinHandle -> DocH mod id -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh DocH mod id
ag
  put_ WriteBinHandle
bh (DocMonospaced DocH mod id
ah) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
7
    WriteBinHandle -> DocH mod id -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh DocH mod id
ah
  put_ WriteBinHandle
bh (DocUnorderedList [DocH mod id]
ai) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
8
    WriteBinHandle -> [DocH mod id] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [DocH mod id]
ai
  put_ WriteBinHandle
bh (DocOrderedList [(Int, DocH mod id)]
aj) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
9
    WriteBinHandle -> [(Int, DocH mod id)] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [(Int, DocH mod id)]
aj
  put_ WriteBinHandle
bh (DocDefList [(DocH mod id, DocH mod id)]
ak) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
10
    WriteBinHandle -> [(DocH mod id, DocH mod id)] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [(DocH mod id, DocH mod id)]
ak
  put_ WriteBinHandle
bh (DocCodeBlock DocH mod id
al) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
11
    WriteBinHandle -> DocH mod id -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh DocH mod id
al
  put_ WriteBinHandle
bh (DocHyperlink Hyperlink (DocH mod id)
am) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
12
    WriteBinHandle -> Hyperlink (DocH mod id) -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Hyperlink (DocH mod id)
am
  put_ WriteBinHandle
bh (DocPic Picture
x) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
13
    WriteBinHandle -> Picture -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Picture
x
  put_ WriteBinHandle
bh (DocAName String
an) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
14
    WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
an
  put_ WriteBinHandle
bh (DocExamples [Example]
ao) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
15
    WriteBinHandle -> [Example] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [Example]
ao
  put_ WriteBinHandle
bh (DocIdentifierUnchecked mod
x) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
16
    WriteBinHandle -> mod -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh mod
x
  put_ WriteBinHandle
bh (DocWarning DocH mod id
ag) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
17
    WriteBinHandle -> DocH mod id -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh DocH mod id
ag
  put_ WriteBinHandle
bh (DocProperty String
x) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
18
    WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
x
  put_ WriteBinHandle
bh (DocBold DocH mod id
x) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
19
    WriteBinHandle -> DocH mod id -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh DocH mod id
x
  put_ WriteBinHandle
bh (DocHeader Header (DocH mod id)
aa) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
20
    WriteBinHandle -> Header (DocH mod id) -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Header (DocH mod id)
aa
  put_ WriteBinHandle
bh (DocMathInline String
x) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
21
    WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
x
  put_ WriteBinHandle
bh (DocMathDisplay String
x) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
22
    WriteBinHandle -> String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh String
x
  put_ WriteBinHandle
bh (DocTable Table (DocH mod id)
x) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
23
    WriteBinHandle -> Table (DocH mod id) -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Table (DocH mod id)
x
  -- See note [The DocModule story]
  put_ WriteBinHandle
bh (DocModule ModLink (DocH mod id)
af) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
24
    WriteBinHandle -> ModLink (DocH mod id) -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ModLink (DocH mod id)
af

  get :: ReadBinHandle -> IO (DocH mod id)
get ReadBinHandle
bh = do
    h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
    case h of
      Word8
0 -> do
        DocH mod id -> IO (DocH mod id)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return DocH mod id
forall mod id. DocH mod id
DocEmpty
      Word8
1 -> do
        aa <- ReadBinHandle -> IO (DocH mod id)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        ab <- get bh
        return (DocAppend aa ab)
      Word8
2 -> do
        ac <- ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocString ac)
      Word8
3 -> do
        ad <- ReadBinHandle -> IO (DocH mod id)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocParagraph ad)
      Word8
4 -> do
        ae <- ReadBinHandle -> IO id
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocIdentifier ae)
      -- See note [The DocModule story]
      Word8
5 -> do
        af <- ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return $
          DocModule
            ModLink
              { modLinkName = af
              , modLinkLabel = Nothing
              }
      Word8
6 -> do
        ag <- ReadBinHandle -> IO (DocH mod id)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocEmphasis ag)
      Word8
7 -> do
        ah <- ReadBinHandle -> IO (DocH mod id)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocMonospaced ah)
      Word8
8 -> do
        ai <- ReadBinHandle -> IO [DocH mod id]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocUnorderedList ai)
      Word8
9 -> do
        aj <- ReadBinHandle -> IO [(Int, DocH mod id)]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocOrderedList aj)
      Word8
10 -> do
        ak <- ReadBinHandle -> IO [(DocH mod id, DocH mod id)]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocDefList ak)
      Word8
11 -> do
        al <- ReadBinHandle -> IO (DocH mod id)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocCodeBlock al)
      Word8
12 -> do
        am <- ReadBinHandle -> IO (Hyperlink (DocH mod id))
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocHyperlink am)
      Word8
13 -> do
        x <- ReadBinHandle -> IO Picture
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocPic x)
      Word8
14 -> do
        an <- ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocAName an)
      Word8
15 -> do
        ao <- ReadBinHandle -> IO [Example]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocExamples ao)
      Word8
16 -> do
        x <- ReadBinHandle -> IO mod
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocIdentifierUnchecked x)
      Word8
17 -> do
        ag <- ReadBinHandle -> IO (DocH mod id)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocWarning ag)
      Word8
18 -> do
        x <- ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocProperty x)
      Word8
19 -> do
        x <- ReadBinHandle -> IO (DocH mod id)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocBold x)
      Word8
20 -> do
        aa <- ReadBinHandle -> IO (Header (DocH mod id))
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocHeader aa)
      Word8
21 -> do
        x <- ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocMathInline x)
      Word8
22 -> do
        x <- ReadBinHandle -> IO String
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocMathDisplay x)
      Word8
23 -> do
        x <- ReadBinHandle -> IO (Table (DocH mod id))
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocTable x)
      -- See note [The DocModule story]
      Word8
24 -> do
        af <- ReadBinHandle -> IO (ModLink (DocH mod id))
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (DocModule af)
      Word8
_ -> String -> IO (DocH mod id)
forall a. HasCallStack => String -> a
error String
"invalid binary data found in the interface file"

instance Binary name => Binary (HaddockModInfo name) where
  put_ :: WriteBinHandle -> HaddockModInfo name -> IO ()
put_ WriteBinHandle
bh HaddockModInfo name
hmi = do
    WriteBinHandle -> Maybe (Doc name) -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (HaddockModInfo name -> Maybe (Doc name)
forall name. HaddockModInfo name -> Maybe (Doc name)
hmi_description HaddockModInfo name
hmi)
    WriteBinHandle -> Maybe String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_copyright HaddockModInfo name
hmi)
    WriteBinHandle -> Maybe String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_license HaddockModInfo name
hmi)
    WriteBinHandle -> Maybe String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_maintainer HaddockModInfo name
hmi)
    WriteBinHandle -> Maybe String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_stability HaddockModInfo name
hmi)
    WriteBinHandle -> Maybe String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_portability HaddockModInfo name
hmi)
    WriteBinHandle -> Maybe String -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_safety HaddockModInfo name
hmi)
    WriteBinHandle -> Maybe Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Language -> Int
forall a. Enum a => a -> Int
fromEnum (Language -> Int) -> Maybe Language -> Maybe Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> HaddockModInfo name -> Maybe Language
forall name. HaddockModInfo name -> Maybe Language
hmi_language HaddockModInfo name
hmi)
    WriteBinHandle -> [Int] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ((Extension -> Int) -> [Extension] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Extension -> Int
forall a. Enum a => a -> Int
fromEnum ([Extension] -> [Int]) -> [Extension] -> [Int]
forall a b. (a -> b) -> a -> b
$ HaddockModInfo name -> [Extension]
forall name. HaddockModInfo name -> [Extension]
hmi_extensions HaddockModInfo name
hmi)

  get :: ReadBinHandle -> IO (HaddockModInfo name)
get ReadBinHandle
bh = do
    descr <- ReadBinHandle -> IO (Maybe (Doc name))
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    copyr <- get bh
    licen <- get bh
    maint <- get bh
    stabi <- get bh
    porta <- get bh
    safet <- get bh
    langu <- fmap toEnum <$> get bh
    exten <- map toEnum <$> get bh
    return (HaddockModInfo descr copyr licen maint stabi porta safet langu exten)

instance Binary DocName where
  put_ :: WriteBinHandle -> DocName -> IO ()
put_ WriteBinHandle
bh (Documented Name
name GenModule Unit
modu) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    WriteBinHandle -> Name -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Name
name
    WriteBinHandle -> GenModule Unit -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh GenModule Unit
modu
  put_ WriteBinHandle
bh (Undocumented Name
name) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    WriteBinHandle -> Name -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Name
name

  get :: ReadBinHandle -> IO DocName
get ReadBinHandle
bh = do
    h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
    case h of
      Word8
0 -> do
        name <- ReadBinHandle -> IO Name
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        modu <- get bh
        return (Documented name modu)
      Word8
1 -> do
        name <- ReadBinHandle -> IO Name
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (Undocumented name)
      Word8
_ -> String -> IO DocName
forall a. HasCallStack => String -> a
error String
"get DocName: Bad h"

instance Binary n => Binary (Wrap n) where
  put_ :: WriteBinHandle -> Wrap n -> IO ()
put_ WriteBinHandle
bh (Unadorned n
n) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    WriteBinHandle -> n -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh n
n
  put_ WriteBinHandle
bh (Parenthesized n
n) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    WriteBinHandle -> n -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh n
n
  put_ WriteBinHandle
bh (Backticked n
n) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
    WriteBinHandle -> n -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh n
n

  get :: ReadBinHandle -> IO (Wrap n)
get ReadBinHandle
bh = do
    h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
    case h of
      Word8
0 -> do
        name <- ReadBinHandle -> IO n
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (Unadorned name)
      Word8
1 -> do
        name <- ReadBinHandle -> IO n
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (Parenthesized name)
      Word8
2 -> do
        name <- ReadBinHandle -> IO n
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        return (Backticked name)
      Word8
_ -> String -> IO (Wrap n)
forall a. HasCallStack => String -> a
error String
"get Wrap: Bad h"