{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# 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 Haddock.Types

import Data.IORef
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Version
import Data.Word
import Text.ParserCombinators.ReadP (readP_to_S)

import GHC.Iface.Binary (getWithUserData, putSymbolTable)
import GHC.Unit.State
import GHC.Utils.Binary
import GHC.Data.FastMutInt
import GHC.Data.FastString
import GHC hiding (NoLink)
import GHC.Types.Name.Cache
import GHC.Types.Unique.FM
import GHC.Types.Unique

import Haddock.Options (Visibility (..))

data InterfaceFile = InterfaceFile {
  InterfaceFile -> LinkEnv
ifLinkEnv         :: LinkEnv,
  -- | 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 -> PackageInfo
ifPackageInfo     :: PackageInfo,
  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,9,0) && !MIN_VERSION_ghc(9,11,0)
binaryInterfaceVersion :: Word16
binaryInterfaceVersion = Word16
44

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


initBinMemSize :: Int
initBinMemSize :: Int
initBinMemSize = Int
1024Int -> 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 BinHandle
openBinMem Int
initBinMemSize
  put_ bh0 binaryInterfaceMagic
  put_ bh0 binaryInterfaceVersion

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

  -- remember where the symbol table pointer will go
  symtab_p_p <- tellBin bh0
  put_ bh0 symtab_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 }

  -- put the main thing
  let bh = BinHandle -> UserData -> BinHandle
setUserData BinHandle
bh0 (UserData -> BinHandle) -> UserData -> BinHandle
forall a b. (a -> b) -> a -> b
$ (BinHandle -> Name -> IO ())
-> (BinHandle -> Name -> IO ())
-> (BinHandle -> FastString -> IO ())
-> UserData
newWriteState (BinSymbolTable -> BinHandle -> Name -> IO ()
putName BinSymbolTable
bin_symtab)
                                           (BinSymbolTable -> BinHandle -> Name -> IO ()
putName BinSymbolTable
bin_symtab)
                                           (BinDictionary -> BinHandle -> FastString -> IO ()
putFastString BinDictionary
bin_dict)
  putInterfaceFile_ bh iface

  -- write the symtab pointer at the front of the file
  symtab_p <- tellBin bh
  putAt bh symtab_p_p symtab_p
  seekBin 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 <- tellBin bh
  putAt bh dict_p_p dict_p
  seekBin 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 BinHandle
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 -> BinHandle -> Name -> IO ()
putName :: BinSymbolTable -> BinHandle -> 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 }    BinHandle
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
_) -> BinHandle -> Word32 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
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 -> BinHandle -> FastString -> IO ()
putFastString :: BinDictionary -> BinHandle -> 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}  BinHandle
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
_)  -> BinHandle -> Word32 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
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_ :: BinHandle -> Map k v -> IO ()
put_ BinHandle
bh Map k v
m = BinHandle -> [(k, v)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m)
  get :: BinHandle -> IO (Map k v)
get BinHandle
bh = ([(k, v)] -> Map k v) -> IO [(k, v)] -> IO (Map k v)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) 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) (BinHandle -> IO [(k, v)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)

instance Binary PackageInfo where
  put_ :: BinHandle -> PackageInfo -> IO ()
put_ BinHandle
bh PackageInfo { PackageName
piPackageName :: PackageInfo -> PackageName
piPackageName :: PackageName
piPackageName, Version
piPackageVersion :: PackageInfo -> Version
piPackageVersion :: Version
piPackageVersion } = do
    BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (PackageName -> FastString
unPackageName PackageName
piPackageName)
    BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Version -> String
showVersion Version
piPackageVersion)
  get :: BinHandle -> IO PackageInfo
get BinHandle
bh = do
    name <- FastString -> PackageName
PackageName (FastString -> PackageName) -> IO FastString -> IO PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
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_ :: BinHandle -> InterfaceFile -> IO ()
put_ BinHandle
bh (InterfaceFile LinkEnv
env PackageInfo
info [InstalledInterface]
ifaces) = do
    BinHandle -> LinkEnv -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LinkEnv
env
    BinHandle -> PackageInfo -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh PackageInfo
info
    BinHandle -> [InstalledInterface] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [InstalledInterface]
ifaces

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


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

instance Binary InstalledInterface where
  put_ :: BinHandle -> InstalledInterface -> IO ()
put_ BinHandle
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) = do
    BinHandle -> GenModule Unit -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh GenModule Unit
modu
    BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
is_sig
    BinHandle -> HaddockModInfo Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh HaddockModInfo Name
info
    BinHandle -> (DocMap Name, ArgMap Name) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh (DocMap Name
docMap, ArgMap Name
argMap)
    BinHandle -> [(OccName, Name)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(OccName, Name)]
defMeths
    BinHandle -> [Name] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Name]
exps
    BinHandle -> [Name] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Name]
visExps
    BinHandle -> [DocOption] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [DocOption]
opts
    BinHandle -> Map Name Fixity -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Map Name Fixity
fixMap

  get :: BinHandle -> IO InstalledInterface
get BinHandle
bh = do
    modu    <- BinHandle -> IO (GenModule Unit)
forall a. Binary a => BinHandle -> IO a
get BinHandle
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
    return (InstalledInterface modu is_sig info
            docMap argMap defMeths exps visExps opts fixMap)

instance Binary DocOption where
    put_ :: BinHandle -> DocOption -> IO ()
put_ BinHandle
bh DocOption
OptHide = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh DocOption
OptPrune = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    put_ BinHandle
bh DocOption
OptIgnoreExports = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
    put_ BinHandle
bh DocOption
OptNotHome = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
    put_ BinHandle
bh DocOption
OptShowExtensions = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
    put_ BinHandle
bh DocOption
OptPrintRuntimeRep = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
    get :: BinHandle -> IO DocOption
get BinHandle
bh = do
            h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case h of
              Word8
0 -> do
                    DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DocOption
OptHide
              Word8
1 -> do
                    DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DocOption
OptPrune
              Word8
2 -> do
                    DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DocOption
OptIgnoreExports
              Word8
3 -> do
                    DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DocOption
OptNotHome
              Word8
4 -> do
                    DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DocOption
OptShowExtensions
              Word8
5 -> do
                    DocOption -> IO DocOption
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DocOption
OptPrintRuntimeRep
              Word8
n -> String -> IO DocOption
forall a. String -> IO a
forall (m :: * -> *) 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_ :: BinHandle -> Example -> IO ()
put_ BinHandle
bh (Example String
expression [String]
result) = do
        BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
expression
        BinHandle -> [String] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [String]
result
    get :: BinHandle -> IO Example
get BinHandle
bh = do
        expression <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        result <- get bh
        return (Example expression result)

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

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

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

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

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

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

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

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

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

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

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

    get :: BinHandle -> IO (DocH mod id)
get BinHandle
bh = do
            h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case h of
              Word8
0 -> do
                    DocH mod id -> IO (DocH mod id)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DocH mod id
forall mod id. DocH mod id
DocEmpty
              Word8
1 -> do
                    aa <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    ab <- get bh
                    return (DocAppend aa ab)
              Word8
2 -> do
                    ac <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocString ac)
              Word8
3 -> do
                    ad <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocParagraph ad)
              Word8
4 -> do
                    ae <- BinHandle -> IO id
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocIdentifier ae)
              -- See note [The DocModule story]
              Word8
5 -> do
                    af <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return $ DocModule ModLink
                      { modLinkName  = af
                      , modLinkLabel = Nothing
                      }
              Word8
6 -> do
                    ag <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocEmphasis ag)
              Word8
7 -> do
                    ah <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocMonospaced ah)
              Word8
8 -> do
                    ai <- BinHandle -> IO [DocH mod id]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocUnorderedList ai)
              Word8
9 -> do
                    aj <- BinHandle -> IO [(Int, DocH mod id)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocOrderedList aj)
              Word8
10 -> do
                    ak <- BinHandle -> IO [(DocH mod id, DocH mod id)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocDefList ak)
              Word8
11 -> do
                    al <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocCodeBlock al)
              Word8
12 -> do
                    am <- BinHandle -> IO (Hyperlink (DocH mod id))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocHyperlink am)
              Word8
13 -> do
                    x <- BinHandle -> IO Picture
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocPic x)
              Word8
14 -> do
                    an <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocAName an)
              Word8
15 -> do
                    ao <- BinHandle -> IO [Example]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocExamples ao)
              Word8
16 -> do
                    x <- BinHandle -> IO mod
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocIdentifierUnchecked x)
              Word8
17 -> do
                    ag <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocWarning ag)
              Word8
18 -> do
                    x <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocProperty x)
              Word8
19 -> do
                    x <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocBold x)
              Word8
20 -> do
                    aa <- BinHandle -> IO (Header (DocH mod id))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocHeader aa)
              Word8
21 -> do
                    x <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocMathInline x)
              Word8
22 -> do
                    x <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocMathDisplay x)
              Word8
23 -> do
                    x <- BinHandle -> IO (Table (DocH mod id))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    return (DocTable x)
              -- See note [The DocModule story]
              Word8
24 -> do
                    af <- BinHandle -> IO (ModLink (DocH mod id))
forall a. Binary a => BinHandle -> IO a
get BinHandle
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_ :: BinHandle -> HaddockModInfo name -> IO ()
put_ BinHandle
bh HaddockModInfo name
hmi = do
    BinHandle -> Maybe (Doc name) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe (Doc name)
forall name. HaddockModInfo name -> Maybe (Doc name)
hmi_description HaddockModInfo name
hmi)
    BinHandle -> Maybe String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_copyright   HaddockModInfo name
hmi)
    BinHandle -> Maybe String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_license     HaddockModInfo name
hmi)
    BinHandle -> Maybe String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_maintainer  HaddockModInfo name
hmi)
    BinHandle -> Maybe String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_stability   HaddockModInfo name
hmi)
    BinHandle -> Maybe String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_portability HaddockModInfo name
hmi)
    BinHandle -> Maybe String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_safety      HaddockModInfo name
hmi)
    BinHandle -> Maybe Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Language -> Int
forall a. Enum a => a -> Int
fromEnum (Language -> Int) -> Maybe Language -> Maybe Int
forall (f :: * -> *) 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)
    BinHandle -> [Int] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
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 :: BinHandle -> IO (HaddockModInfo name)
get BinHandle
bh = do
    descr <- BinHandle -> IO (Maybe (Doc name))
forall a. Binary a => BinHandle -> IO a
get BinHandle
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_ :: BinHandle -> DocName -> IO ()
put_ BinHandle
bh (Documented Name
name GenModule Unit
modu) = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    BinHandle -> Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
name
    BinHandle -> GenModule Unit -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh GenModule Unit
modu
  put_ BinHandle
bh (Undocumented Name
name) = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    BinHandle -> Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
name

  get :: BinHandle -> IO DocName
get BinHandle
bh = do
    h <- BinHandle -> IO Word8
getByte BinHandle
bh
    case h of
      Word8
0 -> do
        name <- BinHandle -> IO Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        modu <- get bh
        return (Documented name modu)
      Word8
1 -> do
        name <- BinHandle -> IO Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
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_ :: BinHandle -> Wrap n -> IO ()
put_ BinHandle
bh (Unadorned n
n) = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    BinHandle -> n -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh n
n
  put_ BinHandle
bh (Parenthesized n
n) = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    BinHandle -> n -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh n
n
  put_ BinHandle
bh (Backticked n
n) = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
    BinHandle -> n -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh n
n

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