{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Haddock.InterfaceFile
-- Copyright   :  (c) David Waern 2006-2009
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- Reading and writing the .haddock interface file
-----------------------------------------------------------------------------
module Haddock.InterfaceFile (
  InterfaceFile(..), ifPackageId,
  readInterfaceFile, nameCacheFromGhc, freshNameCache, NameCacheAccessor,
  writeInterfaceFile
) where


import Haddock.Types
import Haddock.Utils hiding (out)

import Data.List
import Data.Word
import Data.Array
import Data.IORef
import qualified Data.Map as Map
import Data.Map (Map)

import GHC hiding (NoLink)
import Binary
import Name
import UniqSupply
import UniqFM
import IfaceEnv
import HscTypes
#if MIN_VERSION_ghc(7,1,0)
import GhcMonad (withSession)
#endif
import FastMutInt
import FastString
import Unique


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


ifPackageId :: InterfaceFile -> PackageId
ifPackageId if_ =
  case ifInstalledIfaces :: InterfaceFile -> [InstalledInterface]ifInstalledIfaces if_ :: InterfaceFileif_ of
    [] -> error :: [Char] -> aerror "empty InterfaceFile"
    iface:_ -> modulePackageId :: Module -> PackageIdmodulePackageId ($) :: (a -> b) -> a -> b$ instMod :: InstalledInterface -> ModuleinstMod iface :: InstalledInterfaceiface


binaryInterfaceMagic :: Word32
binaryInterfaceMagic = 0xD0Cface


-- 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.
binaryInterfaceVersion :: Word16
#if __GLASGOW_HASKELL__ == 700
binaryInterfaceVersion = 16
#elif __GLASGOW_HASKELL__ == 701
binaryInterfaceVersion = 16
#else
#error Unknown GHC version
#endif


initBinMemSize :: Int
initBinMemSize = 1024(*) :: Num a => a -> a -> a*1024


writeInterfaceFile :: FilePath -> InterfaceFile -> IO ()
writeInterfaceFile filename iface = do 
  bh0 <- openBinMem :: Int -> IO BinHandleopenBinMem initBinMemSize :: IntinitBinMemSize
  put_ :: Binary a => BinHandle -> a -> IO ()put_ bh0 :: BinHandlebh0 binaryInterfaceMagic :: Word32binaryInterfaceMagic
  put_ :: Binary a => BinHandle -> a -> IO ()put_ bh0 :: BinHandlebh0 binaryInterfaceVersion :: Word16binaryInterfaceVersion

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

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

  -- Make some intial state
  symtab_next <- newFastMutInt :: IO FastMutIntnewFastMutInt
  writeFastMutInt :: FastMutInt -> Int -> IO ()writeFastMutInt symtab_next :: FastMutIntsymtab_next 0
  symtab_map <- newIORef :: a -> IO (IORef a)newIORef emptyUFM :: UniqFM eltemptyUFM
  let bin_symtab = BinSymbolTable {
                      bin_symtab_next = symtab_next :: FastMutIntsymtab_next,
                      bin_symtab_map  = symtab_map :: IORef (UniqFM (Int, Name))symtab_map }
  dict_next_ref <- newFastMutInt :: IO FastMutIntnewFastMutInt
  writeFastMutInt :: FastMutInt -> Int -> IO ()writeFastMutInt dict_next_ref :: FastMutIntdict_next_ref 0
  dict_map_ref <- newIORef :: a -> IO (IORef a)newIORef emptyUFM :: UniqFM eltemptyUFM
  let bin_dict = BinDictionary {
                      bin_dict_next = dict_next_ref :: FastMutIntdict_next_ref,
                      bin_dict_map  = dict_map_ref :: IORef (UniqFM (Int, FastString))dict_map_ref }
  ud <- newWriteState ::
  (BinHandle -> Name -> IO ())
  -> (BinHandle -> FastString -> IO ())
  -> IO UserDatanewWriteState (putName :: BinSymbolTable -> BinHandle -> Name -> IO ()putName bin_symtab :: BinSymbolTablebin_symtab) (putFastString :: BinDictionary -> BinHandle -> FastString -> IO ()putFastString bin_dict :: BinDictionarybin_dict)

  -- put the main thing
  bh <- return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ setUserData :: BinHandle -> UserData -> BinHandlesetUserData bh0 :: BinHandlebh0 ud :: UserDataud
  put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh iface :: InstalledInterfaceiface

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

  -- write the symbol table itself
  symtab_next' <- readFastMutInt :: FastMutInt -> IO IntreadFastMutInt symtab_next :: FastMutIntsymtab_next
  symtab_map'  <- readIORef :: IORef a -> IO areadIORef symtab_map :: IORef (UniqFM (Int, Name))symtab_map
  putSymbolTable :: BinHandle -> Int -> UniqFM (Int, Name) -> IO ()putSymbolTable bh :: BinHandlebh symtab_next' :: Intsymtab_next' symtab_map' :: UniqFM (Int, Name)symtab_map'

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

  -- write the dictionary itself
  dict_next <- readFastMutInt :: FastMutInt -> IO IntreadFastMutInt dict_next_ref :: FastMutIntdict_next_ref
  dict_map  <- readIORef :: IORef a -> IO areadIORef dict_map_ref :: IORef (UniqFM (Int, FastString))dict_map_ref
  putDictionary ::
  BinHandle -> Int -> UniqFM (Int, FastString) -> IO ()putDictionary bh :: BinHandlebh dict_next :: Intdict_next dict_map :: UniqFM (Int, FastString)dict_map

  -- and send the result to the file
  writeBinMem :: BinHandle -> FilePath -> IO ()writeBinMem bh :: BinHandlebh filename :: FilePathfilename
  return :: Monad m => forall a. a -> m areturn ()


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


nameCacheFromGhc :: NameCacheAccessor Ghc
nameCacheFromGhc = ( read_from_session :: Ghc NameCacheread_from_session , write_to_session :: NameCache -> m ()write_to_session )
  where
    read_from_session = do
       ref <- withSession :: GhcMonad m => (HscEnv -> m a) -> m awithSession (return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. hsc_NC :: HscEnv -> IORef NameCachehsc_NC)
       liftIO :: MonadIO m => forall a. IO a -> m aliftIO ($) :: (a -> b) -> a -> b$ readIORef :: IORef a -> IO areadIORef ref :: IORef NameCacheref
    write_to_session nc' = do
       ref <- withSession :: GhcMonad m => (HscEnv -> m a) -> m awithSession (return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. hsc_NC :: HscEnv -> IORef NameCachehsc_NC)
       liftIO :: MonadIO m => forall a. IO a -> m aliftIO ($) :: (a -> b) -> a -> b$ writeIORef :: IORef a -> a -> IO ()writeIORef ref :: IORef NameCacheref nc' :: NameCachenc'


freshNameCache :: NameCacheAccessor IO
freshNameCache = ( create_fresh_nc :: IO NameCachecreate_fresh_nc , \_ -> return :: Monad m => forall a. a -> m areturn () )
  where
    create_fresh_nc = do
       u  <- mkSplitUniqSupply :: Char -> IO UniqSupplymkSplitUniqSupply 'a' -- ??
       return :: Monad m => forall a. a -> m areturn (initNameCache :: UniqSupply -> [Name] -> NameCacheinitNameCache u :: UniqSupplyu [] :: [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.  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 :: MonadIO m =>
                     NameCacheAccessor m
                  -> FilePath -> m (Either String InterfaceFile)
readInterfaceFile (get_name_cache, set_name_cache) filename = do
  bh0 <- liftIO :: MonadIO m => forall a. IO a -> m aliftIO ($) :: (a -> b) -> a -> b$ readBinMem :: FilePath -> IO BinHandlereadBinMem filename :: FilePathfilename

  magic   <- liftIO :: MonadIO m => forall a. IO a -> m aliftIO ($) :: (a -> b) -> a -> b$ get :: Binary a => BinHandle -> IO aget bh0 :: BinHandlebh0
  version <- liftIO :: MonadIO m => forall a. IO a -> m aliftIO ($) :: (a -> b) -> a -> b$ get :: Binary a => BinHandle -> IO aget bh0 :: BinHandlebh0

  case () of
    _ | magic :: Word32magic (/=) :: Eq a => a -> a -> Bool/= binaryInterfaceMagic :: Word32binaryInterfaceMagic -> return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. Left :: a -> Either a bLeft ($) :: (a -> b) -> a -> b$
      "Magic number mismatch: couldn't load interface file: " (++) :: [a] -> [a] -> [a]++ filename :: FilePathfilename
      | version :: Word16version (/=) :: Eq a => a -> a -> Bool/= binaryInterfaceVersion :: Word16binaryInterfaceVersion -> return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. Left :: a -> Either a bLeft ($) :: (a -> b) -> a -> b$
      "Interface file is of wrong version: " (++) :: [a] -> [a] -> [a]++ filename :: FilePathfilename
      | otherwise :: Boolotherwise -> do

      dict  <- get_dictionary :: BinHandle -> m Dictionaryget_dictionary bh0 :: BinHandlebh0
      bh1   <- init_handle_user_data :: BinHandle -> Dictionary -> m BinHandleinit_handle_user_data bh0 :: BinHandlebh0 dict :: Dictionarydict

      theNC <- get_name_cache :: m NameCacheget_name_cache
      (nc', symtab) <- get_symbol_table ::
  BinHandle -> NameCache -> m (NameCache, Array Int Name)get_symbol_table bh1 :: BinHandlebh1 theNC :: NameCachetheNC
      set_name_cache :: NameCache -> m ()set_name_cache nc' :: NameCachenc'

      -- set the symbol table
      let ud' = getUserData :: BinHandle -> UserDatagetUserData bh1 :: BinHandlebh1
      bh2 <- return :: Monad m => forall a. a -> m areturn ($!) :: (a -> b) -> a -> b$! setUserData :: BinHandle -> UserData -> BinHandlesetUserData bh1 :: BinHandlebh1 ud' :: UserDataud'{ud_symtab = symtab :: Array Int Namesymtab}

      -- load the actual data
      iface <- liftIO :: MonadIO m => forall a. IO a -> m aliftIO ($) :: (a -> b) -> a -> b$ get :: Binary a => BinHandle -> IO aget bh2 :: BinHandlebh2
      return :: Monad m => forall a. a -> m areturn (Right :: b -> Either a bRight iface :: InstalledInterfaceiface)
 where
   get_dictionary bin_handle = liftIO :: MonadIO m => forall a. IO a -> m aliftIO ($) :: (a -> b) -> a -> b$ do
      dict_p <- get :: Binary a => BinHandle -> IO aget bin_handle :: BinHandlebin_handle
      data_p <- tellBin :: BinHandle -> IO (Bin a)tellBin bin_handle :: BinHandlebin_handle
      seekBin :: BinHandle -> Bin a -> IO ()seekBin bin_handle :: BinHandlebin_handle dict_p :: Bin Anydict_p
      dict <- getDictionary :: BinHandle -> IO DictionarygetDictionary bin_handle :: BinHandlebin_handle
      seekBin :: BinHandle -> Bin a -> IO ()seekBin bin_handle :: BinHandlebin_handle data_p :: Bin Anydata_p
      return :: Monad m => forall a. a -> m areturn dict :: Dictionarydict

   init_handle_user_data bin_handle dict = liftIO :: MonadIO m => forall a. IO a -> m aliftIO ($) :: (a -> b) -> a -> b$ do
      ud <- newReadState :: Dictionary -> IO UserDatanewReadState dict :: Dictionarydict
      return :: Monad m => forall a. a -> m areturn (setUserData :: BinHandle -> UserData -> BinHandlesetUserData bin_handle :: BinHandlebin_handle ud :: UserDataud)

   get_symbol_table bh1 theNC = liftIO :: MonadIO m => forall a. IO a -> m aliftIO ($) :: (a -> b) -> a -> b$ do
      symtab_p <- get :: Binary a => BinHandle -> IO aget bh1 :: BinHandlebh1
      data_p'  <- tellBin :: BinHandle -> IO (Bin a)tellBin bh1 :: BinHandlebh1
      seekBin :: BinHandle -> Bin a -> IO ()seekBin bh1 :: BinHandlebh1 symtab_p :: Bin Anysymtab_p
      (nc', symtab) <- getSymbolTable ::
  BinHandle -> NameCache -> IO (NameCache, Array Int Name)getSymbolTable bh1 :: BinHandlebh1 theNC :: NameCachetheNC
      seekBin :: BinHandle -> Bin a -> IO ()seekBin bh1 :: BinHandlebh1 data_p' :: Bin Anydata_p'
      return :: Monad m => forall a. a -> m areturn (nc' :: NameCachenc', symtab :: Array Int Namesymtab)


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


putName :: BinSymbolTable -> BinHandle -> Name -> IO ()
putName BinSymbolTable{
            bin_symtab_map = symtab_map_ref,
            bin_symtab_next = symtab_next }    bh name
  = do
    symtab_map <- readIORef :: IORef a -> IO areadIORef symtab_map_ref :: IORef (UniqFM (Int, Name))symtab_map_ref
    case lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe eltlookupUFM symtab_map :: IORef (UniqFM (Int, Name))symtab_map name :: Namename of
      Just (off,_) -> put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh (fromIntegral :: (Integral a, Num b) => a -> bfromIntegral off :: Intoff :: Word32)
      Nothing -> do
         off <- readFastMutInt :: FastMutInt -> IO IntreadFastMutInt symtab_next :: FastMutIntsymtab_next
         writeFastMutInt :: FastMutInt -> Int -> IO ()writeFastMutInt symtab_next :: FastMutIntsymtab_next (off :: Intoff(+) :: Num a => a -> a -> a+1)
         writeIORef :: IORef a -> a -> IO ()writeIORef symtab_map_ref :: IORef (UniqFM (Int, Name))symtab_map_ref
             ($!) :: (a -> b) -> a -> b$! addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM eltaddToUFM symtab_map :: IORef (UniqFM (Int, Name))symtab_map name :: Namename (off :: Intoff,name :: Namename)
         put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh (fromIntegral :: (Integral a, Num b) => a -> bfromIntegral off :: Intoff :: Word32)


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


putFastString :: BinDictionary -> BinHandle -> FastString -> IO ()
putFastString BinDictionary { bin_dict_next = j_r,
                              bin_dict_map  = out_r}  bh f
  = do
    out <- readIORef :: IORef a -> IO areadIORef out_r :: IORef (UniqFM (Int, FastString))out_r
    let unique = getUnique :: Uniquable a => a -> UniquegetUnique f :: FastStringf
    case lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe eltlookupUFM out :: UniqFM (Int, FastString)out unique :: Uniqueunique of
        Just (j, _)  -> put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh (fromIntegral :: (Integral a, Num b) => a -> bfromIntegral j :: Intj :: Word32)
        Nothing -> do
           j <- readFastMutInt :: FastMutInt -> IO IntreadFastMutInt j_r :: FastMutIntj_r
           put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh (fromIntegral :: (Integral a, Num b) => a -> bfromIntegral j :: Intj :: Word32)
           writeFastMutInt :: FastMutInt -> Int -> IO ()writeFastMutInt j_r :: FastMutIntj_r (j :: Intj (+) :: Num a => a -> a -> a+ 1)
           writeIORef :: IORef a -> a -> IO ()writeIORef out_r :: IORef (UniqFM (Int, FastString))out_r ($!) :: (a -> b) -> a -> b$! addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM eltaddToUFM out :: UniqFM (Int, FastString)out unique :: Uniqueunique (j :: Intj, f :: FastStringf)


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


putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
putSymbolTable bh next_off symtab = do
  put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh next_off :: Intnext_off
  let names = elems :: Ix i => Array i e -> [e]elems (array :: Ix i => (i, i) -> [(i, e)] -> Array i earray (0,next_off :: Intnext_off(-) :: Num a => a -> a -> a-1) (eltsUFM :: UniqFM elt -> [elt]eltsUFM symtab :: Array Int Namesymtab))
  mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ (\n -> serialiseName :: BinHandle -> Name -> UniqFM (Int, Name) -> IO ()serialiseName bh :: BinHandlebh n :: Namen symtab :: Array Int Namesymtab) names :: [Name]names


getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)
getSymbolTable bh namecache = do
  sz <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
  od_names <- sequence :: Monad m => [m a] -> m [a]sequence (replicate :: Int -> a -> [a]replicate sz :: Intsz (get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh))
  let
        arr = listArray :: Ix i => (i, i) -> [e] -> Array i elistArray (0,sz :: Intsz(-) :: Num a => a -> a -> a-1) names :: [Name]names
        (namecache', names) =
                mapAccumR :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])mapAccumR (fromOnDiskName ::
  Array Int Name -> NameCache -> OnDiskName -> (NameCache, Name)fromOnDiskName arr :: Array Int Namearr) namecache :: NameCachenamecache od_names :: [OnDiskName]od_names
  --
  return :: Monad m => forall a. a -> m areturn (namecache' :: NameCachenamecache', arr :: Array Int Namearr)


type OnDiskName = (PackageId, ModuleName, OccName)


fromOnDiskName
   :: Array Int Name
   -> NameCache
   -> OnDiskName
   -> (NameCache, Name)
fromOnDiskName _ nc (pid, mod_name, occ) =
  let
        modu  = mkModule :: PackageId -> ModuleName -> ModulemkModule pid :: PackageIdpid mod_name :: ModuleNamemod_name
        cache = nsNames :: NameCache -> OrigNameCachensNames nc :: NameCachenc
  in
  case lookupOrigNameCache ::
  OrigNameCache -> Module -> OccName -> Maybe NamelookupOrigNameCache cache :: OrigNameCachecache modu :: Modulemodu occ :: OccNameocc of
     Just name -> (nc :: NameCachenc, name :: Namename)
     Nothing   ->
        let
                us        = nsUniqs :: NameCache -> UniqSupplynsUniqs nc :: NameCachenc
                u         = uniqFromSupply :: UniqSupply -> UniqueuniqFromSupply us :: UniqSupplyus
                name      = mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> NamemkExternalName u :: UniqSupplyu modu :: Modulemodu occ :: OccNameocc noSrcSpan :: SrcSpannoSrcSpan
                new_cache = extendNameCache ::
  OrigNameCache -> Module -> OccName -> Name -> OrigNameCacheextendNameCache cache :: OrigNameCachecache modu :: Modulemodu occ :: OccNameocc name :: Namename
        in
        case splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply)splitUniqSupply us :: UniqSupplyus of { (us',_) ->
        ( nc :: NameCachenc{ nsUniqs = us' :: UniqSupplyus', nsNames = new_cache :: OrigNameCachenew_cache }, name :: Namename )
        }


serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
serialiseName bh name _ = do
  let modu = nameModule :: Name -> ModulenameModule name :: Namename
  put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh (modulePackageId :: Module -> PackageIdmodulePackageId modu :: Modulemodu, moduleName :: Module -> ModuleNamemoduleName modu :: Modulemodu, nameOccName :: Name -> OccNamenameOccName name :: Namename)


-------------------------------------------------------------------------------
-- * GhcBinary instances
-------------------------------------------------------------------------------


instance D:Binary ::
  (BinHandle -> a -> IO ())
  -> (BinHandle -> a -> IO (Bin a))
  -> (BinHandle -> IO a)
  -> T:Binary a(Ord k, Binary k, Binary v) => Binary (Map k v) where
  put_ bh m = put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh (toList :: Map k a -> [(k, a)]Map.toList m :: Map k vm)
  get bh = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap fromList :: Ord k => [(k, a)] -> Map k a(fromList :: Ord k => [(k, a)] -> Map k aMap.fromList) (get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh)


instance D:Binary ::
  (BinHandle -> a -> IO ())
  -> (BinHandle -> a -> IO (Bin a))
  -> (BinHandle -> IO a)
  -> T:Binary aBinary InterfaceFile where
  put_ bh (InterfaceFile env ifaces) = do
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh env :: LinkEnvenv
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh ifaces :: [InstalledInterface]ifaces

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


instance D:Binary ::
  (BinHandle -> a -> IO ())
  -> (BinHandle -> a -> IO (Bin a))
  -> (BinHandle -> IO a)
  -> T:Binary aBinary InstalledInterface where
  put_ bh (InstalledInterface modu info docMap exps visExps opts subMap) = do
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh modu :: Modulemodu
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh info :: HaddockModInfo Nameinfo
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh docMap :: Map Name (DocForDecl Name)docMap
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh exps :: [Name]exps
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh visExps :: [Name]visExps
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh opts :: [DocOption]opts
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh subMap :: Map Name [Name]subMap

  get bh = do
    modu    <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
    info    <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
    docMap  <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
    exps    <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
    visExps <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
    opts    <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
    subMap  <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh

    return :: Monad m => forall a. a -> m areturn (InstalledInterface ::
  Module
  -> HaddockModInfo Name
  -> Map Name (DocForDecl Name)
  -> [Name]
  -> [Name]
  -> [DocOption]
  -> Map Name [Name]
  -> InstalledInterfaceInstalledInterface modu :: Modulemodu info :: HaddockModInfo Nameinfo docMap :: Map Name (DocForDecl Name)docMap
            exps :: [Name]exps visExps :: [Name]visExps opts :: [DocOption]opts subMap :: Map Name [Name]subMap)


instance D:Binary ::
  (BinHandle -> a -> IO ())
  -> (BinHandle -> a -> IO (Bin a))
  -> (BinHandle -> IO a)
  -> T:Binary aBinary DocOption where
    put_ bh OptHide = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 0
    put_ bh OptPrune = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 1
    put_ bh OptIgnoreExports = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 2
    put_ bh OptNotHome = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 3
    get bh = do
            h <- getByte :: BinHandle -> IO Word8getByte bh :: BinHandlebh
            case h :: Word8h of
              0 -> do
                    return :: Monad m => forall a. a -> m areturn OptHide :: DocOptionOptHide
              1 -> do
                    return :: Monad m => forall a. a -> m areturn OptPrune :: DocOptionOptPrune
              2 -> do
                    return :: Monad m => forall a. a -> m areturn OptIgnoreExports :: DocOptionOptIgnoreExports
              3 -> do
                    return :: Monad m => forall a. a -> m areturn OptNotHome :: DocOptionOptNotHome
              _ -> fail :: Monad m => forall a. String -> m afail "invalid binary data found"


instance D:Binary ::
  (BinHandle -> a -> IO ())
  -> (BinHandle -> a -> IO (Bin a))
  -> (BinHandle -> IO a)
  -> T:Binary aBinary Example where
    put_ bh (Example expression result) = do
        put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh expression :: Stringexpression
        put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh result :: [String]result
    get bh = do
        expression <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
        result <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
        return :: Monad m => forall a. a -> m areturn (Example :: String -> [String] -> ExampleExample expression :: Stringexpression result :: [String]result)


{-* Generated by DrIFT : Look, but Don't Touch. *-}
instance D:Binary ::
  (BinHandle -> a -> IO ())
  -> (BinHandle -> a -> IO (Bin a))
  -> (BinHandle -> IO a)
  -> T:Binary a(Binary id) => Binary (Doc id) where
    put_ bh DocEmpty = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 0
    put_ bh (DocAppend aa ab) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 1
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh aa :: Doc idaa
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh ab :: Doc idab
    put_ bh (DocString ac) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 2
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh ac :: Stringac
    put_ bh (DocParagraph ad) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 3
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh ad :: Doc idad
    put_ bh (DocIdentifier ae) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 4
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh ae :: [id]ae
    put_ bh (DocModule af) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 5
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh af :: Stringaf
    put_ bh (DocEmphasis ag) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 6
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh ag :: Doc idag
    put_ bh (DocMonospaced ah) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 7
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh ah :: Doc idah
    put_ bh (DocUnorderedList ai) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 8
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh ai :: [Doc id]ai
    put_ bh (DocOrderedList aj) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 9
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh aj :: [Doc id]aj
    put_ bh (DocDefList ak) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 10
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh ak :: [(Doc id, Doc id)]ak
    put_ bh (DocCodeBlock al) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 11
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh al :: Doc idal
    put_ bh (DocURL am) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 12
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh am :: Stringam
    put_ bh (DocPic x) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 13
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh x :: Stringx
    put_ bh (DocAName an) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 14
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh an :: Stringan
    put_ bh (DocExamples ao) = do
            putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 15
            put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh ao :: [Example]ao
    get bh = do
            h <- getByte :: BinHandle -> IO Word8getByte bh :: BinHandlebh
            case h :: Word8h of
              0 -> do
                    return :: Monad m => forall a. a -> m areturn DocEmpty :: Doc idDocEmpty
              1 -> do
                    aa <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    ab <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocAppend :: Doc id -> Doc id -> Doc idDocAppend aa :: Doc idaa ab :: Doc idab)
              2 -> do
                    ac <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocString :: String -> Doc idDocString ac :: Stringac)
              3 -> do
                    ad <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocParagraph :: Doc id -> Doc idDocParagraph ad :: Doc idad)
              4 -> do
                    ae <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocIdentifier :: [id] -> Doc idDocIdentifier ae :: [id]ae)
              5 -> do
                    af <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocModule :: String -> Doc idDocModule af :: Stringaf)
              6 -> do
                    ag <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocEmphasis :: Doc id -> Doc idDocEmphasis ag :: Doc idag)
              7 -> do
                    ah <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocMonospaced :: Doc id -> Doc idDocMonospaced ah :: Doc idah)
              8 -> do
                    ai <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocUnorderedList :: [Doc id] -> Doc idDocUnorderedList ai :: [Doc id]ai)
              9 -> do
                    aj <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocOrderedList :: [Doc id] -> Doc idDocOrderedList aj :: [Doc id]aj)
              10 -> do
                    ak <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocDefList :: [(Doc id, Doc id)] -> Doc idDocDefList ak :: [(Doc id, Doc id)]ak)
              11 -> do
                    al <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocCodeBlock :: Doc id -> Doc idDocCodeBlock al :: Doc idal)
              12 -> do
                    am <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocURL :: String -> Doc idDocURL am :: Stringam)
              13 -> do
                    x <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocPic :: String -> Doc idDocPic x :: Stringx)
              14 -> do
                    an <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocAName :: String -> Doc idDocAName an :: Stringan)
              15 -> do
                    ao <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
                    return :: Monad m => forall a. a -> m areturn (DocExamples :: [Example] -> Doc idDocExamples ao :: [Example]ao)
              _ -> fail :: Monad m => forall a. String -> m afail "invalid binary data found"


instance D:Binary ::
  (BinHandle -> a -> IO ())
  -> (BinHandle -> a -> IO (Bin a))
  -> (BinHandle -> IO a)
  -> T:Binary aBinary name => Binary (HaddockModInfo name) where
  put_ bh hmi = do
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh (hmi_description :: HaddockModInfo name -> Maybe (Doc name)hmi_description hmi :: HaddockModInfo namehmi)
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh (hmi_portability :: HaddockModInfo name -> Maybe Stringhmi_portability hmi :: HaddockModInfo namehmi)
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh (hmi_stability :: HaddockModInfo name -> Maybe Stringhmi_stability   hmi :: HaddockModInfo namehmi)
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh (hmi_maintainer :: HaddockModInfo name -> Maybe Stringhmi_maintainer  hmi :: HaddockModInfo namehmi)

  get bh = do
    descr <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
    porta <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
    stabi <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
    maint <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
    return :: Monad m => forall a. a -> m areturn (HaddockModInfo ::
  Maybe (Doc name)
  -> Maybe String
  -> Maybe String
  -> Maybe String
  -> HaddockModInfo nameHaddockModInfo descr :: Maybe (Doc name)descr porta :: Maybe Stringporta stabi :: Maybe Stringstabi maint :: Maybe Stringmaint)


instance D:Binary ::
  (BinHandle -> a -> IO ())
  -> (BinHandle -> a -> IO (Bin a))
  -> (BinHandle -> IO a)
  -> T:Binary aBinary DocName where
  put_ bh (Documented name modu) = do
    putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 0
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh name :: Namename
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh modu :: Modulemodu
  put_ bh (Undocumented name) = do
    putByte :: BinHandle -> Word8 -> IO ()putByte bh :: BinHandlebh 1
    put_ :: Binary a => BinHandle -> a -> IO ()put_ bh :: BinHandlebh name :: Namename

  get bh = do
    h <- getByte :: BinHandle -> IO Word8getByte bh :: BinHandlebh
    case h :: Word8h of
      0 -> do
        name <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
        modu <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
        return :: Monad m => forall a. a -> m areturn (Documented :: Name -> Module -> DocNameDocumented name :: Namename modu :: Modulemodu)
      1 -> do
        name <- get :: Binary a => BinHandle -> IO aget bh :: BinHandlebh
        return :: Monad m => forall a. a -> m areturn (Undocumented :: Name -> DocNameUndocumented name :: Namename)
      _ -> error :: [Char] -> aerror "get DocName: Bad h"