    module GHC.Iface.Ext.Fields
       ( ExtensibleFields (..)
       , FieldName
       , emptyExtensibleFields
       -- * Reading
       , readField
       , readFieldWith
       -- * Writing
       , writeField
       , writeFieldWith
       -- * Deletion
       , deleteField
       )
    where

    import GHC.Prelude
    import GHC.Utils.Binary

    import Control.Monad
    import Data.Map         ( Map )
    import qualified Data.Map as Map
    import Control.DeepSeq

    type FieldName = String

    newtype ExtensibleFields = ExtensibleFields { ExtensibleFields -> Map FieldName BinData
    getExtensibleFields :: (Map FieldName BinData) }

    instance Binary ExtensibleFields where
      put_ :: BinHandle -> ExtensibleFields -> IO ()
    put_ BinHandle
    bh (ExtensibleFields Map FieldName BinData
    fs) = do
        forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (forall k a. Map k a -> Int
    Map.size Map FieldName BinData
    fs :: Int)

        -- Put the names of each field, and reserve a space
        -- for a payload pointer after each name:
        [(Bin (Bin Any), BinData)]
    header_entries <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM (forall k a. Map k a -> [(k, a)]
    Map.toList Map FieldName BinData
    fs) forall a b. (a -> b) -> a -> b
    $ \(FieldName
    name, BinData
    dat) -> do
          forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh FieldName
    name
          Bin (Bin Any)
    field_p_p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
          forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Bin (Bin Any)
    field_p_p
          forall (m :: * -> *) a. Monad m => a -> m a
    return (Bin (Bin Any)
    field_p_p, BinData
    dat)

        -- Now put the payloads and use the reserved space
        -- to point to the start of each payload:
        forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Bin (Bin Any), BinData)]
    header_entries forall a b. (a -> b) -> a -> b
    $ \(Bin (Bin Any)
    field_p_p, BinData
    dat) -> do
          Bin Any
    field_p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
          forall a. Binary a => BinHandle -> Bin a -> a -> IO ()
    putAt BinHandle
    bh Bin (Bin Any)
    field_p_p Bin Any
    field_p
          forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    field_p
          forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh BinData
    dat

      get :: BinHandle -> IO ExtensibleFields
    get BinHandle
    bh = do
        Int
    n <- forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh :: IO Int

        -- Get the names and field pointers:
        [(FieldName, Bin Any)]
    header_entries <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    n forall a b. (a -> b) -> a -> b
    $
          (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh

        -- Seek to and get each field's payload:
        [(FieldName, BinData)]
    fields <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(FieldName, Bin Any)]
    header_entries forall a b. (a -> b) -> a -> b
    $ \(FieldName
    name, Bin Any
    field_p) -> do
          forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin Any
    field_p
          BinData
    dat <- forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
          forall (m :: * -> *) a. Monad m => a -> m a
    return (FieldName
    name, BinData
    dat)

        forall (m :: * -> *) a. Monad m => a -> m a
    return forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map FieldName BinData -> ExtensibleFields
    ExtensibleFields forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList forall a b. (a -> b) -> a -> b
    $ [(FieldName, BinData)]
    fields

    instance NFData ExtensibleFields where
      rnf :: ExtensibleFields -> ()
    rnf (ExtensibleFields Map FieldName BinData
    fs) = forall a. NFData a => a -> ()
    rnf Map FieldName BinData
    fs

    emptyExtensibleFields :: ExtensibleFields
    emptyExtensibleFields :: ExtensibleFields
    emptyExtensibleFields = Map FieldName BinData -> ExtensibleFields
    ExtensibleFields forall k a. Map k a
    Map.empty

    --------------------------------------------------------------------------------
    -- | Reading

    readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a)
    readField :: forall a. Binary a => FieldName -> ExtensibleFields -> IO (Maybe a)
    readField FieldName
    name = forall a.
    FieldName
    -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
    readFieldWith FieldName
    name forall a. Binary a => BinHandle -> IO a
    get

    readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
    readFieldWith :: forall a.
    FieldName
    -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
    readFieldWith FieldName
    name BinHandle -> IO a
    read ExtensibleFields
    fields = forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence forall a b. (a -> b) -> a -> b
    $ ((BinHandle -> IO a
    read forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BinData -> IO BinHandle
    dataHandle) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
      forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup FieldName
    name (ExtensibleFields -> Map FieldName BinData
    getExtensibleFields ExtensibleFields
    fields)

    --------------------------------------------------------------------------------
    -- | Writing

    writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields
    writeField :: forall a.
    Binary a =>
    FieldName -> a -> ExtensibleFields -> IO ExtensibleFields
    writeField FieldName
    name a
    x = FieldName
    -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields
    writeFieldWith FieldName
    name (forall a. Binary a => BinHandle -> a -> IO ()
    `put_` a
    x)

    writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields
    writeFieldWith :: FieldName
    -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields
    writeFieldWith FieldName
    name BinHandle -> IO ()
    write ExtensibleFields
    fields = do
      BinHandle
    bh <- Int -> IO BinHandle
    openBinMem (Int
    1024 forall a. Num a => a -> a -> a
    * Int
    1024)
      BinHandle -> IO ()
    write BinHandle
    bh
      --
      BinData
    bd <- BinHandle -> IO BinData
    handleData BinHandle
    bh
      forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ Map FieldName BinData -> ExtensibleFields
    ExtensibleFields (forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert FieldName
    name BinData
    bd forall a b. (a -> b) -> a -> b
    $ ExtensibleFields -> Map FieldName BinData
    getExtensibleFields ExtensibleFields
    fields)

    deleteField :: FieldName -> ExtensibleFields -> ExtensibleFields
    deleteField :: FieldName -> ExtensibleFields -> ExtensibleFields
    deleteField FieldName
    name (ExtensibleFields Map FieldName BinData
    fs) = Map FieldName BinData -> ExtensibleFields
    ExtensibleFields forall a b. (a -> b) -> a -> b
    $ forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete FieldName
    name Map FieldName BinData
    fs