{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
{-# 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(..), ifUnitId, ifModule,
  readInterfaceFile, nameCacheFromGhc, freshNameCache, NameCacheAccessor,
  writeInterfaceFile, binaryInterfaceVersion, binaryInterfaceVersionCompatibility
) where


import Haddock.Types

import Control.Monad
import Control.Monad.IO.Class ( MonadIO(..) )
import Data.Array
import Data.IORef
import Data.List (mapAccumR)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Word

import BinIface (getSymtabName, getDictFastString)
import Binary
import FastMutInt
import FastString
import GHC hiding (NoLink)
import GhcMonad (withSession)
import HscTypes
import NameCache
import IfaceEnv
import Name
import UniqFM
import UniqSupply
import Unique

data InterfaceFile = InterfaceFile {
  InterfaceFile -> LinkEnv
ifLinkEnv         :: LinkEnv,
  InterfaceFile -> [InstalledInterface]
ifInstalledIfaces :: [InstalledInterface]
}


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

ifUnitId :: InterfaceFile -> UnitId
ifUnitId :: InterfaceFile -> UnitId
ifUnitId InterfaceFile
if_ =
  case InterfaceFile -> [InstalledInterface]
ifInstalledIfaces InterfaceFile
if_ of
    [] -> [Char] -> UnitId
forall a. HasCallStack => [Char] -> a
error [Char]
"empty InterfaceFile"
    InstalledInterface
iface:[InstalledInterface]
_ -> Module -> UnitId
moduleUnitId (Module -> UnitId) -> Module -> UnitId
forall a b. (a -> b) -> a -> b
$ InstalledInterface -> Module
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 (__GLASGOW_HASKELL__ >= 809) && (__GLASGOW_HASKELL__ < 811)
binaryInterfaceVersion :: Word16
binaryInterfaceVersion = Word16
38

binaryInterfaceVersionCompatibility :: [Word16]
binaryInterfaceVersionCompatibility :: [Word16]
binaryInterfaceVersionCompatibility = [Word16
37, 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 :: [Char] -> InterfaceFile -> IO ()
writeInterfaceFile [Char]
filename InterfaceFile
iface = do
  BinHandle
bh0 <- Int -> IO BinHandle
openBinMem Int
initBinMemSize
  BinHandle -> Word32 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh0 Word32
binaryInterfaceMagic
  BinHandle -> Word16 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh0 Word16
binaryInterfaceVersion

  -- remember where the dictionary pointer will go
  Bin (Bin Any)
dict_p_p <- BinHandle -> IO (Bin (Bin Any))
forall k (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh0
  BinHandle -> Bin (Bin Any) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh0 Bin (Bin Any)
dict_p_p

  -- remember where the symbol table pointer will go
  Bin (Bin Any)
symtab_p_p <- BinHandle -> IO (Bin (Bin Any))
forall k (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh0
  BinHandle -> Bin (Bin Any) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh0 Bin (Bin Any)
symtab_p_p

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

  -- put the main thing
  let bh :: BinHandle
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)
  BinHandle -> InterfaceFile -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh InterfaceFile
iface

  -- write the symtab pointer at the front of the file
  Bin Any
symtab_p <- BinHandle -> IO (Bin Any)
forall k (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh
  BinHandle -> Bin (Bin Any) -> Bin Any -> IO ()
forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
putAt BinHandle
bh Bin (Bin Any)
symtab_p_p Bin Any
symtab_p
  BinHandle -> Bin Any -> IO ()
forall k (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bh Bin Any
symtab_p

  -- write the symbol table itself
  Int
symtab_next' <- FastMutInt -> IO Int
readFastMutInt FastMutInt
symtab_next
  UniqFM (Int, Name)
symtab_map'  <- IORef (UniqFM (Int, Name)) -> IO (UniqFM (Int, Name))
forall a. IORef a -> IO a
readIORef IORef (UniqFM (Int, Name))
symtab_map
  BinHandle -> Int -> UniqFM (Int, Name) -> IO ()
putSymbolTable BinHandle
bh Int
symtab_next' UniqFM (Int, Name)
symtab_map'

  -- write the dictionary pointer at the fornt of the file
  Bin Any
dict_p <- BinHandle -> IO (Bin Any)
forall k (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh
  BinHandle -> Bin (Bin Any) -> Bin Any -> IO ()
forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
putAt BinHandle
bh Bin (Bin Any)
dict_p_p Bin Any
dict_p
  BinHandle -> Bin Any -> IO ()
forall k (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bh Bin Any
dict_p

  -- write the dictionary itself
  Int
dict_next <- FastMutInt -> IO Int
readFastMutInt FastMutInt
dict_next_ref
  UniqFM (Int, FastString)
dict_map  <- IORef (UniqFM (Int, FastString)) -> IO (UniqFM (Int, FastString))
forall a. IORef a -> IO a
readIORef IORef (UniqFM (Int, FastString))
dict_map_ref
  BinHandle -> Int -> UniqFM (Int, FastString) -> IO ()
putDictionary BinHandle
bh Int
dict_next UniqFM (Int, FastString)
dict_map

  -- and send the result to the file
  BinHandle -> [Char] -> IO ()
writeBinMem BinHandle
bh [Char]
filename
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


type NameCacheAccessor m = (m NameCache, NameCache -> m ())


nameCacheFromGhc :: GhcMonad m => NameCacheAccessor m
nameCacheFromGhc :: NameCacheAccessor m
nameCacheFromGhc = ( m NameCache
read_from_session , NameCache -> m ()
forall (m :: * -> *). GhcMonad m => NameCache -> m ()
write_to_session )
  where
    read_from_session :: m NameCache
read_from_session = do
       IORef NameCache
ref <- (HscEnv -> m (IORef NameCache)) -> m (IORef NameCache)
forall (m :: * -> *) a. GhcMonad m => (HscEnv -> m a) -> m a
withSession (IORef NameCache -> m (IORef NameCache)
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef NameCache -> m (IORef NameCache))
-> (HscEnv -> IORef NameCache) -> HscEnv -> m (IORef NameCache)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> IORef NameCache
hsc_NC)
       IO NameCache -> m NameCache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NameCache -> m NameCache) -> IO NameCache -> m NameCache
forall a b. (a -> b) -> a -> b
$ IORef NameCache -> IO NameCache
forall a. IORef a -> IO a
readIORef IORef NameCache
ref
    write_to_session :: NameCache -> m ()
write_to_session NameCache
nc' = do
       IORef NameCache
ref <- (HscEnv -> m (IORef NameCache)) -> m (IORef NameCache)
forall (m :: * -> *) a. GhcMonad m => (HscEnv -> m a) -> m a
withSession (IORef NameCache -> m (IORef NameCache)
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef NameCache -> m (IORef NameCache))
-> (HscEnv -> IORef NameCache) -> HscEnv -> m (IORef NameCache)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> IORef NameCache
hsc_NC)
       IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef NameCache -> NameCache -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef NameCache
ref NameCache
nc'


freshNameCache :: NameCacheAccessor IO
freshNameCache :: NameCacheAccessor IO
freshNameCache = ( IO NameCache
create_fresh_nc , \NameCache
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () )
  where
    create_fresh_nc :: IO NameCache
create_fresh_nc = do
       UniqSupply
u  <- Char -> IO UniqSupply
mkSplitUniqSupply Char
'a' -- ??
       NameCache -> IO NameCache
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqSupply -> [Name] -> NameCache
initNameCache UniqSupply
u [])


-- | 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.  The function is therefore generic in the
-- monad being used.  The exact monad is whichever monad the first
-- argument, the getter and setter of the name cache, requires.
--
readInterfaceFile :: forall m.
                     MonadIO m
                  => NameCacheAccessor m
                  -> FilePath
                  -> Bool  -- ^ Disable version check. Can cause runtime crash.
                  -> m (Either String InterfaceFile)
readInterfaceFile :: NameCacheAccessor m
-> [Char] -> Bool -> m (Either [Char] InterfaceFile)
readInterfaceFile (m NameCache
get_name_cache, NameCache -> m ()
set_name_cache) [Char]
filename Bool
bypass_checks = do
  BinHandle
bh0 <- IO BinHandle -> m BinHandle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BinHandle -> m BinHandle) -> IO BinHandle -> m BinHandle
forall a b. (a -> b) -> a -> b
$ [Char] -> IO BinHandle
readBinMem [Char]
filename

  Word32
magic   <- IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ BinHandle -> IO Word32
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh0
  Word16
version <- IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ BinHandle -> IO Word16
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh0

  case () of
    ()
_ | Word32
magic Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
binaryInterfaceMagic -> Either [Char] InterfaceFile -> m (Either [Char] InterfaceFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] InterfaceFile -> m (Either [Char] InterfaceFile))
-> ([Char] -> Either [Char] InterfaceFile)
-> [Char]
-> m (Either [Char] InterfaceFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] InterfaceFile
forall a b. a -> Either a b
Left ([Char] -> m (Either [Char] InterfaceFile))
-> [Char] -> m (Either [Char] InterfaceFile)
forall a b. (a -> b) -> a -> b
$
      [Char]
"Magic number mismatch: couldn't load interface file: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
filename
      | Bool -> Bool
not Bool
bypass_checks
      , (Word16
version Word16 -> [Word16] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Word16]
binaryInterfaceVersionCompatibility) -> Either [Char] InterfaceFile -> m (Either [Char] InterfaceFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] InterfaceFile -> m (Either [Char] InterfaceFile))
-> ([Char] -> Either [Char] InterfaceFile)
-> [Char]
-> m (Either [Char] InterfaceFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] InterfaceFile
forall a b. a -> Either a b
Left ([Char] -> m (Either [Char] InterfaceFile))
-> [Char] -> m (Either [Char] InterfaceFile)
forall a b. (a -> b) -> a -> b
$
      [Char]
"Interface file is of wrong version: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
filename
      | Bool
otherwise -> ((forall (n :: * -> *) b.
  MonadIO n =>
  (NameCache -> n (NameCache, b)) -> n b)
 -> m (Either [Char] InterfaceFile))
-> m (Either [Char] InterfaceFile)
forall a.
((forall (n :: * -> *) b.
  MonadIO n =>
  (NameCache -> n (NameCache, b)) -> n b)
 -> m a)
-> m a
with_name_cache (((forall (n :: * -> *) b.
   MonadIO n =>
   (NameCache -> n (NameCache, b)) -> n b)
  -> m (Either [Char] InterfaceFile))
 -> m (Either [Char] InterfaceFile))
-> ((forall (n :: * -> *) b.
     MonadIO n =>
     (NameCache -> n (NameCache, b)) -> n b)
    -> m (Either [Char] InterfaceFile))
-> m (Either [Char] InterfaceFile)
forall a b. (a -> b) -> a -> b
$ \forall (n :: * -> *) b.
MonadIO n =>
(NameCache -> n (NameCache, b)) -> n b
update_nc -> do

      Dictionary
dict  <- BinHandle -> m Dictionary
forall (m :: * -> *). MonadIO m => BinHandle -> m Dictionary
get_dictionary BinHandle
bh0

      -- read the symbol table so we are capable of reading the actual data
      BinHandle
bh1 <- do
          let bh1 :: BinHandle
bh1 = BinHandle -> UserData -> BinHandle
setUserData BinHandle
bh0 (UserData -> BinHandle) -> UserData -> BinHandle
forall a b. (a -> b) -> a -> b
$ (BinHandle -> IO Name) -> (BinHandle -> IO FastString) -> UserData
newReadState ([Char] -> BinHandle -> IO Name
forall a. HasCallStack => [Char] -> a
error [Char]
"getSymtabName")
                                                   (Dictionary -> BinHandle -> IO FastString
getDictFastString Dictionary
dict)
          Array Int Name
symtab <- (NameCache -> m (NameCache, Array Int Name)) -> m (Array Int Name)
forall (n :: * -> *) b.
MonadIO n =>
(NameCache -> n (NameCache, b)) -> n b
update_nc (BinHandle -> NameCache -> m (NameCache, Array Int Name)
forall (m :: * -> *).
MonadIO m =>
BinHandle -> NameCache -> m (NameCache, Array Int Name)
get_symbol_table BinHandle
bh1)
          BinHandle -> m BinHandle
forall (m :: * -> *) a. Monad m => a -> m a
return (BinHandle -> m BinHandle) -> BinHandle -> m BinHandle
forall a b. (a -> b) -> a -> b
$ BinHandle -> UserData -> BinHandle
setUserData BinHandle
bh1 (UserData -> BinHandle) -> UserData -> BinHandle
forall a b. (a -> b) -> a -> b
$ (BinHandle -> IO Name) -> (BinHandle -> IO FastString) -> UserData
newReadState (NameCacheUpdater
-> Dictionary -> Array Int Name -> BinHandle -> IO Name
getSymtabName ((forall c. (NameCache -> (NameCache, c)) -> IO c)
-> NameCacheUpdater
NCU (\NameCache -> (NameCache, c)
f -> (NameCache -> IO (NameCache, c)) -> IO c
forall (n :: * -> *) b.
MonadIO n =>
(NameCache -> n (NameCache, b)) -> n b
update_nc ((NameCache, c) -> IO (NameCache, c)
forall (m :: * -> *) a. Monad m => a -> m a
return ((NameCache, c) -> IO (NameCache, c))
-> (NameCache -> (NameCache, c)) -> NameCache -> IO (NameCache, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameCache -> (NameCache, c)
f))) Dictionary
dict Array Int Name
symtab)
                                                  (Dictionary -> BinHandle -> IO FastString
getDictFastString Dictionary
dict)

      -- load the actual data
      InterfaceFile
iface <- IO InterfaceFile -> m InterfaceFile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InterfaceFile -> m InterfaceFile)
-> IO InterfaceFile -> m InterfaceFile
forall a b. (a -> b) -> a -> b
$ BinHandle -> IO InterfaceFile
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh1
      Either [Char] InterfaceFile -> m (Either [Char] InterfaceFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (InterfaceFile -> Either [Char] InterfaceFile
forall a b. b -> Either a b
Right InterfaceFile
iface)
 where
   with_name_cache :: forall a.
                      ((forall n b. MonadIO n
                                => (NameCache -> n (NameCache, b))
                                -> n b)
                       -> m a)
                   -> m a
   with_name_cache :: ((forall (n :: * -> *) b.
  MonadIO n =>
  (NameCache -> n (NameCache, b)) -> n b)
 -> m a)
-> m a
with_name_cache (forall (n :: * -> *) b.
 MonadIO n =>
 (NameCache -> n (NameCache, b)) -> n b)
-> m a
act = do
      IORef NameCache
nc_var <-  m NameCache
get_name_cache m NameCache
-> (NameCache -> m (IORef NameCache)) -> m (IORef NameCache)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO (IORef NameCache) -> m (IORef NameCache)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef NameCache) -> m (IORef NameCache))
-> (NameCache -> IO (IORef NameCache))
-> NameCache
-> m (IORef NameCache)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameCache -> IO (IORef NameCache)
forall a. a -> IO (IORef a)
newIORef)
      a
x <- (forall (n :: * -> *) b.
 MonadIO n =>
 (NameCache -> n (NameCache, b)) -> n b)
-> m a
act ((forall (n :: * -> *) b.
  MonadIO n =>
  (NameCache -> n (NameCache, b)) -> n b)
 -> m a)
-> (forall (n :: * -> *) b.
    MonadIO n =>
    (NameCache -> n (NameCache, b)) -> n b)
-> m a
forall a b. (a -> b) -> a -> b
$ \NameCache -> n (NameCache, b)
f -> do
              NameCache
nc <- IO NameCache -> n NameCache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NameCache -> n NameCache) -> IO NameCache -> n NameCache
forall a b. (a -> b) -> a -> b
$ IORef NameCache -> IO NameCache
forall a. IORef a -> IO a
readIORef IORef NameCache
nc_var
              (NameCache
nc', b
x) <- NameCache -> n (NameCache, b)
f NameCache
nc
              IO () -> n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> n ()) -> IO () -> n ()
forall a b. (a -> b) -> a -> b
$ IORef NameCache -> NameCache -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef NameCache
nc_var NameCache
nc'
              b -> n b
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
      IO NameCache -> m NameCache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef NameCache -> IO NameCache
forall a. IORef a -> IO a
readIORef IORef NameCache
nc_var) m NameCache -> (NameCache -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameCache -> m ()
set_name_cache
      a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

   get_dictionary :: BinHandle -> m Dictionary
get_dictionary BinHandle
bin_handle = IO Dictionary -> m Dictionary
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Dictionary -> m Dictionary) -> IO Dictionary -> m Dictionary
forall a b. (a -> b) -> a -> b
$ do
      Bin Any
dict_p <- BinHandle -> IO (Bin Any)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bin_handle
      Bin Any
data_p <- BinHandle -> IO (Bin Any)
forall k (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bin_handle
      BinHandle -> Bin Any -> IO ()
forall k (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bin_handle Bin Any
dict_p
      Dictionary
dict <- BinHandle -> IO Dictionary
getDictionary BinHandle
bin_handle
      BinHandle -> Bin Any -> IO ()
forall k (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bin_handle Bin Any
data_p
      Dictionary -> IO Dictionary
forall (m :: * -> *) a. Monad m => a -> m a
return Dictionary
dict

   get_symbol_table :: BinHandle -> NameCache -> m (NameCache, Array Int Name)
get_symbol_table BinHandle
bh1 NameCache
theNC = IO (NameCache, Array Int Name) -> m (NameCache, Array Int Name)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (NameCache, Array Int Name) -> m (NameCache, Array Int Name))
-> IO (NameCache, Array Int Name) -> m (NameCache, Array Int Name)
forall a b. (a -> b) -> a -> b
$ do
      Bin Any
symtab_p <- BinHandle -> IO (Bin Any)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh1
      Bin Any
data_p'  <- BinHandle -> IO (Bin Any)
forall k (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh1
      BinHandle -> Bin Any -> IO ()
forall k (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bh1 Bin Any
symtab_p
      (NameCache
nc', Array Int Name
symtab) <- BinHandle -> NameCache -> IO (NameCache, Array Int Name)
getSymbolTable BinHandle
bh1 NameCache
theNC
      BinHandle -> Bin Any -> IO ()
forall k (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bh1 Bin Any
data_p'
      (NameCache, Array Int Name) -> IO (NameCache, Array Int Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (NameCache
nc', Array Int Name
symtab)


-------------------------------------------------------------------------------
-- * Symbol table
-------------------------------------------------------------------------------


putName :: BinSymbolTable -> BinHandle -> Name -> IO ()
putName :: BinSymbolTable -> BinHandle -> Name -> IO ()
putName BinSymbolTable{
            bin_symtab_map :: BinSymbolTable -> IORef (UniqFM (Int, Name))
bin_symtab_map = IORef (UniqFM (Int, Name))
symtab_map_ref,
            bin_symtab_next :: BinSymbolTable -> FastMutInt
bin_symtab_next = FastMutInt
symtab_next }    BinHandle
bh Name
name
  = do
    UniqFM (Int, Name)
symtab_map <- IORef (UniqFM (Int, Name)) -> IO (UniqFM (Int, Name))
forall a. IORef a -> IO a
readIORef IORef (UniqFM (Int, Name))
symtab_map_ref
    case UniqFM (Int, Name) -> Name -> Maybe (Int, Name)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM UniqFM (Int, Name)
symtab_map Name
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
         Int
off <- FastMutInt -> IO Int
readFastMutInt FastMutInt
symtab_next
         FastMutInt -> Int -> IO ()
writeFastMutInt FastMutInt
symtab_next (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
         IORef (UniqFM (Int, Name)) -> UniqFM (Int, Name) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (UniqFM (Int, Name))
symtab_map_ref
             (UniqFM (Int, Name) -> IO ()) -> UniqFM (Int, Name) -> IO ()
forall a b. (a -> b) -> a -> b
$! UniqFM (Int, Name) -> Name -> (Int, Name) -> UniqFM (Int, Name)
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM UniqFM (Int, Name)
symtab_map Name
name (Int
off,Name
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)


data BinSymbolTable = BinSymbolTable {
        BinSymbolTable -> FastMutInt
bin_symtab_next :: !FastMutInt, -- The next index to use
        BinSymbolTable -> IORef (UniqFM (Int, Name))
bin_symtab_map  :: !(IORef (UniqFM (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 (Int, FastString))
bin_dict_map  = IORef (UniqFM (Int, FastString))
out_r}  BinHandle
bh FastString
f
  = do
    UniqFM (Int, FastString)
out <- IORef (UniqFM (Int, FastString)) -> IO (UniqFM (Int, FastString))
forall a. IORef a -> IO a
readIORef IORef (UniqFM (Int, FastString))
out_r
    let unique :: Unique
unique = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
f
    case UniqFM (Int, FastString) -> Unique -> Maybe (Int, FastString)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM UniqFM (Int, FastString)
out Unique
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
           Int
j <- FastMutInt -> IO Int
readFastMutInt FastMutInt
j_r
           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)
           FastMutInt -> Int -> IO ()
writeFastMutInt FastMutInt
j_r (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
           IORef (UniqFM (Int, FastString))
-> UniqFM (Int, FastString) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (UniqFM (Int, FastString))
out_r (UniqFM (Int, FastString) -> IO ())
-> UniqFM (Int, FastString) -> IO ()
forall a b. (a -> b) -> a -> b
$! UniqFM (Int, FastString)
-> Unique -> (Int, FastString) -> UniqFM (Int, FastString)
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM UniqFM (Int, FastString)
out Unique
unique (Int
j, FastString
f)


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


putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
putSymbolTable :: BinHandle -> Int -> UniqFM (Int, Name) -> IO ()
putSymbolTable BinHandle
bh Int
next_off UniqFM (Int, Name)
symtab = do
  BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
next_off
  let names :: [Name]
names = Array Int Name -> [Name]
forall i e. Array i e -> [e]
elems ((Int, Int) -> [(Int, Name)] -> Array Int Name
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0,Int
next_offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (UniqFM (Int, Name) -> [(Int, Name)]
forall elt. UniqFM elt -> [elt]
eltsUFM UniqFM (Int, Name)
symtab))
  (Name -> IO ()) -> [Name] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Name
n -> BinHandle -> Name -> UniqFM (Int, Name) -> IO ()
serialiseName BinHandle
bh Name
n UniqFM (Int, Name)
symtab) [Name]
names


getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)
getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)
getSymbolTable BinHandle
bh NameCache
namecache = do
  Int
sz <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
  [OnDiskName]
od_names <- Int -> IO OnDiskName -> IO [OnDiskName]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
sz (BinHandle -> IO OnDiskName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
  let arr :: Array Int Name
arr = (Int, Int) -> [Name] -> Array Int Name
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Name]
names
      (NameCache
namecache', [Name]
names) = (NameCache -> OnDiskName -> (NameCache, Name))
-> NameCache -> [OnDiskName] -> (NameCache, [Name])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumR (Array Int Name -> NameCache -> OnDiskName -> (NameCache, Name)
fromOnDiskName Array Int Name
arr) NameCache
namecache [OnDiskName]
od_names
  (NameCache, Array Int Name) -> IO (NameCache, Array Int Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (NameCache
namecache', Array Int Name
arr)


type OnDiskName = (UnitId, ModuleName, OccName)


fromOnDiskName
   :: Array Int Name
   -> NameCache
   -> OnDiskName
   -> (NameCache, Name)
fromOnDiskName :: Array Int Name -> NameCache -> OnDiskName -> (NameCache, Name)
fromOnDiskName Array Int Name
_ NameCache
nc (UnitId
pid, ModuleName
mod_name, OccName
occ) =
  let
        modu :: Module
modu  = UnitId -> ModuleName -> Module
mkModule UnitId
pid ModuleName
mod_name
        cache :: OrigNameCache
cache = NameCache -> OrigNameCache
nsNames NameCache
nc
  in
  case OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache OrigNameCache
cache Module
modu OccName
occ of
     Just Name
name -> (NameCache
nc, Name
name)
     Maybe Name
Nothing   ->
        let
                us :: UniqSupply
us        = NameCache -> UniqSupply
nsUniqs NameCache
nc
                u :: Unique
u         = UniqSupply -> Unique
uniqFromSupply UniqSupply
us
                name :: Name
name      = Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName Unique
u Module
modu OccName
occ SrcSpan
noSrcSpan
                new_cache :: OrigNameCache
new_cache = OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extendNameCache OrigNameCache
cache Module
modu OccName
occ Name
name
        in
        case UniqSupply -> (UniqSupply, UniqSupply)
splitUniqSupply UniqSupply
us of { (UniqSupply
us',UniqSupply
_) ->
        ( NameCache
nc{ nsUniqs :: UniqSupply
nsUniqs = UniqSupply
us', nsNames :: OrigNameCache
nsNames = OrigNameCache
new_cache }, Name
name )
        }


serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
serialiseName :: BinHandle -> Name -> UniqFM (Int, Name) -> IO ()
serialiseName BinHandle
bh Name
name UniqFM (Int, Name)
_ = do
  let modu :: Module
modu = HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name
  BinHandle -> OnDiskName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Module -> UnitId
moduleUnitId Module
modu, Module -> ModuleName
moduleName Module
modu, Name -> OccName
nameOccName Name
name)


-------------------------------------------------------------------------------
-- * 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 (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 InterfaceFile where
  put_ :: BinHandle -> InterfaceFile -> IO ()
put_ BinHandle
bh (InterfaceFile LinkEnv
env [InstalledInterface]
ifaces) = do
    BinHandle -> LinkEnv -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LinkEnv
env
    BinHandle -> [InstalledInterface] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [InstalledInterface]
ifaces

  get :: BinHandle -> IO InterfaceFile
get BinHandle
bh = do
    LinkEnv
env    <- BinHandle -> IO LinkEnv
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    [InstalledInterface]
ifaces <- BinHandle -> IO [InstalledInterface]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    InterfaceFile -> IO InterfaceFile
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkEnv -> [InstalledInterface] -> InterfaceFile
InterfaceFile LinkEnv
env [InstalledInterface]
ifaces)


instance Binary InstalledInterface where
  put_ :: BinHandle -> InstalledInterface -> IO ()
put_ BinHandle
bh (InstalledInterface Module
modu Bool
is_sig HaddockModInfo Name
info DocMap Name
docMap ArgMap Name
argMap
           [Name]
exps [Name]
visExps [DocOption]
opts Map Name Fixity
fixMap) = do
    BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
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 -> [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
    Module
modu    <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Bool
is_sig  <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    HaddockModInfo Name
info    <- BinHandle -> IO (HaddockModInfo Name)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    ~(DocMap Name
docMap, ArgMap Name
argMap) <- BinHandle -> IO (DocMap Name, ArgMap Name)
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
    [Name]
exps    <- BinHandle -> IO [Name]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    [Name]
visExps <- BinHandle -> IO [Name]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    [DocOption]
opts    <- BinHandle -> IO [DocOption]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Map Name Fixity
fixMap  <- BinHandle -> IO (Map Name Fixity)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    InstalledInterface -> IO InstalledInterface
forall (m :: * -> *) a. Monad m => a -> m a
return (Module
-> Bool
-> HaddockModInfo Name
-> DocMap Name
-> ArgMap Name
-> [Name]
-> [Name]
-> [DocOption]
-> Map Name Fixity
-> InstalledInterface
InstalledInterface Module
modu Bool
is_sig HaddockModInfo Name
info DocMap Name
docMap ArgMap Name
argMap
            [Name]
exps [Name]
visExps [DocOption]
opts Map Name Fixity
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
    get :: BinHandle -> IO DocOption
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do
                    DocOption -> IO DocOption
forall (m :: * -> *) a. Monad m => a -> m a
return DocOption
OptHide
              Word8
1 -> do
                    DocOption -> IO DocOption
forall (m :: * -> *) a. Monad m => a -> m a
return DocOption
OptPrune
              Word8
2 -> do
                    DocOption -> IO DocOption
forall (m :: * -> *) a. Monad m => a -> m a
return DocOption
OptIgnoreExports
              Word8
3 -> do
                    DocOption -> IO DocOption
forall (m :: * -> *) a. Monad m => a -> m a
return DocOption
OptNotHome
              Word8
4 -> do
                    DocOption -> IO DocOption
forall (m :: * -> *) a. Monad m => a -> m a
return DocOption
OptShowExtensions
              Word8
_ -> [Char] -> IO DocOption
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid binary data found"


instance Binary Example where
    put_ :: BinHandle -> Example -> IO ()
put_ BinHandle
bh (Example [Char]
expression [[Char]]
result) = do
        BinHandle -> [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Char]
expression
        BinHandle -> [[Char]] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [[Char]]
result
    get :: BinHandle -> IO Example
get BinHandle
bh = do
        [Char]
expression <- BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [[Char]]
result <- BinHandle -> IO [[Char]]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Example -> IO Example
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [[Char]] -> Example
Example [Char]
expression [[Char]]
result)

instance Binary a => Binary (Hyperlink a) where
    put_ :: BinHandle -> Hyperlink a -> IO ()
put_ BinHandle
bh (Hyperlink [Char]
url Maybe a
label) = do
        BinHandle -> [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Char]
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
        [Char]
url <- BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Maybe a
label <- BinHandle -> IO (Maybe a)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Hyperlink a -> IO (Hyperlink a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe a -> Hyperlink a
forall id. [Char] -> Maybe id -> Hyperlink id
Hyperlink [Char]
url Maybe a
label)

instance Binary a => Binary (ModLink a) where
    put_ :: BinHandle -> ModLink a -> IO ()
put_ BinHandle
bh (ModLink [Char]
m Maybe a
label) = do
        BinHandle -> [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Char]
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
        [Char]
m <- BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Maybe a
label <- BinHandle -> IO (Maybe a)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        ModLink a -> IO (ModLink a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe a -> ModLink a
forall id. [Char] -> Maybe id -> ModLink id
ModLink [Char]
m Maybe a
label)

instance Binary Picture where
    put_ :: BinHandle -> Picture -> IO ()
put_ BinHandle
bh (Picture [Char]
uri Maybe [Char]
title) = do
        BinHandle -> [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Char]
uri
        BinHandle -> Maybe [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe [Char]
title
    get :: BinHandle -> IO Picture
get BinHandle
bh = do
        [Char]
uri <- BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Maybe [Char]
title <- BinHandle -> IO (Maybe [Char])
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Picture -> IO Picture
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char] -> Picture
Picture [Char]
uri Maybe [Char]
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
        Int
l <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        a
t <- BinHandle -> IO a
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Header a -> IO (Header a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> a -> Header a
forall id. Int -> id -> Header id
Header Int
l a
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
        [TableRow a]
h <- BinHandle -> IO [TableRow a]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [TableRow a]
b <- BinHandle -> IO [TableRow a]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Table a -> IO (Table a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([TableRow a] -> [TableRow a] -> Table a
forall id. [TableRow id] -> [TableRow id] -> Table id
Table [TableRow a]
h [TableRow a]
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
        [TableCell a]
cs <- BinHandle -> IO [TableCell a]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        TableRow a -> IO (TableRow a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([TableCell a] -> TableRow a
forall id. [TableCell id] -> TableRow id
TableRow [TableCell a]
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
        Int
i <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Int
j <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        a
c <- BinHandle -> IO a
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        TableCell a -> IO (TableCell a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> a -> TableCell a
forall id. Int -> Int -> id -> TableCell id
TableCell Int
i Int
j a
c)

instance Binary Meta where
    put_ :: BinHandle -> Meta -> IO ()
put_ BinHandle
bh (Meta Maybe Version
v Maybe [Char]
p) = do
        BinHandle -> Maybe Version -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Version
v
        BinHandle -> Maybe [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe [Char]
p
    get :: BinHandle -> IO Meta
get BinHandle
bh = do
        Maybe Version
v <- BinHandle -> IO (Maybe Version)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Maybe [Char]
p <- BinHandle -> IO (Maybe [Char])
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Meta -> IO Meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> Maybe [Char] -> Meta
Meta Maybe Version
v Maybe [Char]
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
    Meta
m <- BinHandle -> IO Meta
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    DocH mod id
d <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    MetaDoc mod id -> IO (MetaDoc mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (MetaDoc mod id -> IO (MetaDoc mod id))
-> MetaDoc mod id -> IO (MetaDoc mod id)
forall a b. (a -> b) -> a -> b
$ MetaDoc :: forall mod id. Meta -> DocH mod id -> MetaDoc mod id
MetaDoc { _meta :: Meta
_meta = Meta
m, _doc :: DocH mod id
_doc = DocH mod id
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 [Char]
ac) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
            BinHandle -> [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Char]
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 [DocH mod id]
aj) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
9
            BinHandle -> [DocH mod id] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [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 [Char]
an) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
14
            BinHandle -> [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Char]
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 [Char]
x) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
18
            BinHandle -> [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Char]
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 [Char]
x) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
21
            BinHandle -> [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Char]
x
    put_ BinHandle
bh (DocMathDisplay [Char]
x) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
22
            BinHandle -> [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Char]
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
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return DocH mod id
forall mod id. DocH mod id
DocEmpty
              Word8
1 -> do
                    DocH mod id
aa <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id
ab <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocH mod id -> DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
DocAppend DocH mod id
aa DocH mod id
ab)
              Word8
2 -> do
                    [Char]
ac <- BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> DocH mod id
forall mod id. [Char] -> DocH mod id
DocString [Char]
ac)
              Word8
3 -> do
                    DocH mod id
ad <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
DocParagraph DocH mod id
ad)
              Word8
4 -> do
                    id
ae <- BinHandle -> IO id
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (id -> DocH mod id
forall mod id. id -> DocH mod id
DocIdentifier id
ae)
              -- See note [The DocModule story]
              Word8
5 -> do
                    [Char]
af <- BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocH mod id -> IO (DocH mod id))
-> DocH mod id -> IO (DocH mod id)
forall a b. (a -> b) -> a -> b
$ ModLink (DocH mod id) -> DocH mod id
forall mod id. ModLink (DocH mod id) -> DocH mod id
DocModule ModLink :: forall id. [Char] -> Maybe id -> ModLink id
ModLink
                      { modLinkName :: [Char]
modLinkName  = [Char]
af
                      , modLinkLabel :: Maybe (DocH mod id)
modLinkLabel = Maybe (DocH mod id)
forall a. Maybe a
Nothing
                      }
              Word8
6 -> do
                    DocH mod id
ag <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
DocEmphasis DocH mod id
ag)
              Word8
7 -> do
                    DocH mod id
ah <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
DocMonospaced DocH mod id
ah)
              Word8
8 -> do
                    [DocH mod id]
ai <- BinHandle -> IO [DocH mod id]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([DocH mod id] -> DocH mod id
forall mod id. [DocH mod id] -> DocH mod id
DocUnorderedList [DocH mod id]
ai)
              Word8
9 -> do
                    [DocH mod id]
aj <- BinHandle -> IO [DocH mod id]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([DocH mod id] -> DocH mod id
forall mod id. [DocH mod id] -> DocH mod id
DocOrderedList [DocH mod id]
aj)
              Word8
10 -> do
                    [(DocH mod id, DocH mod id)]
ak <- BinHandle -> IO [(DocH mod id, DocH mod id)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(DocH mod id, DocH mod id)] -> DocH mod id
forall mod id. [(DocH mod id, DocH mod id)] -> DocH mod id
DocDefList [(DocH mod id, DocH mod id)]
ak)
              Word8
11 -> do
                    DocH mod id
al <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
DocCodeBlock DocH mod id
al)
              Word8
12 -> do
                    Hyperlink (DocH mod id)
am <- BinHandle -> IO (Hyperlink (DocH mod id))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (Hyperlink (DocH mod id) -> DocH mod id
forall mod id. Hyperlink (DocH mod id) -> DocH mod id
DocHyperlink Hyperlink (DocH mod id)
am)
              Word8
13 -> do
                    Picture
x <- BinHandle -> IO Picture
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (Picture -> DocH mod id
forall mod id. Picture -> DocH mod id
DocPic Picture
x)
              Word8
14 -> do
                    [Char]
an <- BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> DocH mod id
forall mod id. [Char] -> DocH mod id
DocAName [Char]
an)
              Word8
15 -> do
                    [Example]
ao <- BinHandle -> IO [Example]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Example] -> DocH mod id
forall mod id. [Example] -> DocH mod id
DocExamples [Example]
ao)
              Word8
16 -> do
                    mod
x <- BinHandle -> IO mod
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (mod -> DocH mod id
forall mod id. mod -> DocH mod id
DocIdentifierUnchecked mod
x)
              Word8
17 -> do
                    DocH mod id
ag <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
DocWarning DocH mod id
ag)
              Word8
18 -> do
                    [Char]
x <- BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> DocH mod id
forall mod id. [Char] -> DocH mod id
DocProperty [Char]
x)
              Word8
19 -> do
                    DocH mod id
x <- BinHandle -> IO (DocH mod id)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocH mod id -> DocH mod id
forall mod id. DocH mod id -> DocH mod id
DocBold DocH mod id
x)
              Word8
20 -> do
                    Header (DocH mod id)
aa <- BinHandle -> IO (Header (DocH mod id))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (Header (DocH mod id) -> DocH mod id
forall mod id. Header (DocH mod id) -> DocH mod id
DocHeader Header (DocH mod id)
aa)
              Word8
21 -> do
                    [Char]
x <- BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> DocH mod id
forall mod id. [Char] -> DocH mod id
DocMathInline [Char]
x)
              Word8
22 -> do
                    [Char]
x <- BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> DocH mod id
forall mod id. [Char] -> DocH mod id
DocMathDisplay [Char]
x)
              Word8
23 -> do
                    Table (DocH mod id)
x <- BinHandle -> IO (Table (DocH mod id))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (Table (DocH mod id) -> DocH mod id
forall mod id. Table (DocH mod id) -> DocH mod id
DocTable Table (DocH mod id)
x)
              -- See note [The DocModule story]
              Word8
24 -> do
                    ModLink (DocH mod id)
af <- BinHandle -> IO (ModLink (DocH mod id))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    DocH mod id -> IO (DocH mod id)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModLink (DocH mod id) -> DocH mod id
forall mod id. ModLink (DocH mod id) -> DocH mod id
DocModule ModLink (DocH mod id)
af)
              Word8
_ -> [Char] -> IO (DocH mod id)
forall a. HasCallStack => [Char] -> a
error [Char]
"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 [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
hmi_copyright   HaddockModInfo name
hmi)
    BinHandle -> Maybe [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
hmi_license     HaddockModInfo name
hmi)
    BinHandle -> Maybe [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
hmi_maintainer  HaddockModInfo name
hmi)
    BinHandle -> Maybe [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
hmi_stability   HaddockModInfo name
hmi)
    BinHandle -> Maybe [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
hmi_portability HaddockModInfo name
hmi)
    BinHandle -> Maybe [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HaddockModInfo name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
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 -> Version -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ((Extension -> Int) -> [Extension] -> Version
forall a b. (a -> b) -> [a] -> [b]
map Extension -> Int
forall a. Enum a => a -> Int
fromEnum ([Extension] -> Version) -> [Extension] -> Version
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
    Maybe (Doc name)
descr <- BinHandle -> IO (Maybe (Doc name))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Maybe [Char]
copyr <- BinHandle -> IO (Maybe [Char])
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Maybe [Char]
licen <- BinHandle -> IO (Maybe [Char])
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Maybe [Char]
maint <- BinHandle -> IO (Maybe [Char])
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Maybe [Char]
stabi <- BinHandle -> IO (Maybe [Char])
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Maybe [Char]
porta <- BinHandle -> IO (Maybe [Char])
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Maybe [Char]
safet <- BinHandle -> IO (Maybe [Char])
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Maybe Language
langu <- (Int -> Language) -> Maybe Int -> Maybe Language
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Language
forall a. Enum a => Int -> a
toEnum (Maybe Int -> Maybe Language)
-> IO (Maybe Int) -> IO (Maybe Language)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe Int)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    [Extension]
exten <- (Int -> Extension) -> Version -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Extension
forall a. Enum a => Int -> a
toEnum (Version -> [Extension]) -> IO Version -> IO [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Version
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    HaddockModInfo name -> IO (HaddockModInfo name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Doc name)
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe Language
-> [Extension]
-> HaddockModInfo name
forall name.
Maybe (Doc name)
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Maybe Language
-> [Extension]
-> HaddockModInfo name
HaddockModInfo Maybe (Doc name)
descr Maybe [Char]
copyr Maybe [Char]
licen Maybe [Char]
maint Maybe [Char]
stabi Maybe [Char]
porta Maybe [Char]
safet Maybe Language
langu [Extension]
exten)

instance Binary DocName where
  put_ :: BinHandle -> DocName -> IO ()
put_ BinHandle
bh (Documented Name
name Module
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 -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
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
    Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
    case Word8
h of
      Word8
0 -> do
        Name
name <- BinHandle -> IO Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Module
modu <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        DocName -> IO DocName
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Module -> DocName
Documented Name
name Module
modu)
      Word8
1 -> do
        Name
name <- BinHandle -> IO Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        DocName -> IO DocName
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> DocName
Undocumented Name
name)
      Word8
_ -> [Char] -> IO DocName
forall a. HasCallStack => [Char] -> a
error [Char]
"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
    Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
    case Word8
h of
      Word8
0 -> do
        n
name <- BinHandle -> IO n
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Wrap n -> IO (Wrap n)
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> Wrap n
forall n. n -> Wrap n
Unadorned n
name)
      Word8
1 -> do
        n
name <- BinHandle -> IO n
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Wrap n -> IO (Wrap n)
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> Wrap n
forall n. n -> Wrap n
Parenthesized n
name)
      Word8
2 -> do
        n
name <- BinHandle -> IO n
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Wrap n -> IO (Wrap n)
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> Wrap n
forall n. n -> Wrap n
Backticked n
name)
      Word8
_ -> [Char] -> IO (Wrap n)
forall a. HasCallStack => [Char] -> a
error [Char]
"get Wrap: Bad h"