    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
        BinHandle -> Int -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    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 (Bin (ZonkAny 1)), BinData))
    -> IO [(Bin (Bin (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 (Bin (ZonkAny 1)), BinData))
     -> IO [(Bin (Bin (ZonkAny 1)), BinData)])
    -> ((FieldName, BinData) -> IO (Bin (Bin (ZonkAny 1)), BinData))
    -> IO [(Bin (Bin (ZonkAny 1)), BinData)]
    forall a b. (a -> b) -> a -> b
    $ \(FieldName
    name, BinData
    dat) -> do
          BinHandle -> FieldName -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh FieldName
    name
          field_p_p <- BinHandle -> IO (Bin (Bin (ZonkAny 1)))
    forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    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 (Bin (ZonkAny 1))
    field_p_p, BinData
    dat) -> do
          field_p <- BinHandle -> IO (Bin (ZonkAny 1))
    forall {k} (a :: k). BinHandle -> IO (Bin a)
    tellBin BinHandle
    bh
          putAt bh field_p_p field_p
          seekBin bh field_p
          put_ bh dat

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

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

        -- Seek to and get each field's payload:
        fields <- forM header_entries $ \(FieldName
    name, Bin (ZonkAny 3)
    field_p) -> do
          BinHandle -> Bin (ZonkAny 3) -> IO ()
    forall {k} (a :: k). BinHandle -> Bin a -> IO ()
    seekBin BinHandle
    bh Bin (ZonkAny 3)
    field_p
          dat <- BinHandle -> IO BinData
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    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
    -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
    forall a.
    FieldName
    -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
    readFieldWith FieldName
    name BinHandle -> IO a
    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 = 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
    $ ((BinHandle -> IO a
    read (BinHandle -> IO a) -> IO BinHandle -> IO a
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (IO BinHandle -> IO a)
    -> (BinData -> IO BinHandle) -> BinData -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BinData -> IO BinHandle
    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
    -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields
    writeFieldWith FieldName
    name (BinHandle -> a -> IO ()
    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
      bh <- Int -> IO BinHandle
    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