    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_ :: WriteBinHandle -> ExtensibleFields -> IO ()
    put_ WriteBinHandle
    bh (ExtensibleFields Map FieldName BinData
    fs) = do
        WriteBinHandle -> Int -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh (Map FieldName BinData -> Int
    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:
        header_entries <- [(FieldName, BinData)]
    -> ((FieldName, BinData)
        -> IO (Bin (RelBinPtr (ZonkAny 1)), BinData))
    -> IO [(Bin (RelBinPtr (ZonkAny 1)), BinData)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM (Map FieldName BinData -> [(FieldName, BinData)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map FieldName BinData
    fs) (((FieldName, BinData)
      -> IO (Bin (RelBinPtr (ZonkAny 1)), BinData))
     -> IO [(Bin (RelBinPtr (ZonkAny 1)), BinData)])
    -> ((FieldName, BinData)
        -> IO (Bin (RelBinPtr (ZonkAny 1)), BinData))
    -> IO [(Bin (RelBinPtr (ZonkAny 1)), BinData)]
    forall a b. (a -> b) -> a -> b
    $ \(FieldName
    name, BinData
    dat) -> do
          WriteBinHandle -> FieldName -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh FieldName
    name
          field_p_p <- WriteBinHandle -> IO (Bin (RelBinPtr (ZonkAny 1)))
    forall {k} (a :: k). WriteBinHandle -> IO (Bin a)
    tellBinWriter WriteBinHandle
    bh
          put_ bh field_p_p
          return (field_p_p, dat)

        -- Now put the payloads and use the reserved space
        -- to point to the start of each payload:
        forM_ header_entries $ \(Bin (RelBinPtr (ZonkAny 1))
    field_p_p, BinData
    dat) -> do
          field_p <- WriteBinHandle -> IO (Bin (ZonkAny 1))
    forall {k} (a :: k). WriteBinHandle -> IO (Bin a)
    tellBinWriter WriteBinHandle
    bh
          putAtRel bh field_p_p field_p
          seekBinWriter bh field_p
          put_ bh dat

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

        -- Get the names and field pointers:
        header_entries <- replicateM n $
          (,) <$> get bh <*> getRelBin bh

        -- Seek to and get each field's payload:
        fields <- forM header_entries $ \(FieldName
    name, RelBin (ZonkAny 3)
    field_p) -> do
          ReadBinHandle -> RelBin (ZonkAny 3) -> IO ()
    forall {k} (a :: k). ReadBinHandle -> RelBin a -> IO ()
    seekBinReaderRel ReadBinHandle
    bh RelBin (ZonkAny 3)
    field_p
          dat <- ReadBinHandle -> IO BinData
    forall a. Binary a => ReadBinHandle -> IO a
    get ReadBinHandle
    bh
          return (name, dat)

        return . ExtensibleFields . Map.fromList $ fields

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

    emptyExtensibleFields :: ExtensibleFields
    emptyExtensibleFields :: ExtensibleFields
    emptyExtensibleFields = Map FieldName BinData -> ExtensibleFields
    ExtensibleFields Map FieldName BinData
    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 = FieldName
    -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
    forall a.
    FieldName
    -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
    readFieldWith FieldName
    name ReadBinHandle -> IO a
    forall a. Binary a => ReadBinHandle -> IO a
    get

    readFieldWith :: FieldName -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
    readFieldWith :: forall a.
    FieldName
    -> (ReadBinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
    readFieldWith FieldName
    name ReadBinHandle -> IO a
    read ExtensibleFields
    fields = Maybe (IO a) -> IO (Maybe a)
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
    sequence (Maybe (IO a) -> IO (Maybe a)) -> Maybe (IO a) -> IO (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ ((ReadBinHandle -> IO a
    read (ReadBinHandle -> IO a) -> IO ReadBinHandle -> IO a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (IO ReadBinHandle -> IO a)
    -> (BinData -> IO ReadBinHandle) -> BinData -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BinData -> IO ReadBinHandle
    dataHandle) (BinData -> IO a) -> Maybe BinData -> Maybe (IO a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
      FieldName -> Map FieldName BinData -> Maybe BinData
    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
    -> (WriteBinHandle -> IO ())
    -> ExtensibleFields
    -> IO ExtensibleFields
    writeFieldWith FieldName
    name (WriteBinHandle -> a -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    `put_` a
    x)

    writeFieldWith :: FieldName -> (WriteBinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields
    writeFieldWith :: FieldName
    -> (WriteBinHandle -> IO ())
    -> ExtensibleFields
    -> IO ExtensibleFields
    writeFieldWith FieldName
    name WriteBinHandle -> IO ()
    write ExtensibleFields
    fields = do
      bh <- Int -> IO WriteBinHandle
    openBinMem (Int
    1024 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    1024)
      write bh
      --
      bd <- handleData bh
      return $ ExtensibleFields (Map.insert name bd $ getExtensibleFields fields)

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