module Cereal.UnorderedContainers.Put where

import qualified Cereal.UnorderedContainers.Extras.StrictHashMap as StrictHashMap
import Cereal.UnorderedContainers.Prelude

strictHashMap :: Putter Int -> Putter key -> Putter value -> Putter (StrictHashMap.HashMap key value)
strictHashMap :: forall key value.
Putter Int
-> Putter key -> Putter value -> Putter (HashMap key value)
strictHashMap Putter Int
int Putter key
key Putter value
value HashMap key value
x = PutM ()
size forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutM ()
associations
  where
    size :: PutM ()
size = Putter Int
int (forall k v. HashMap k v -> Int
StrictHashMap.size HashMap key value
x)
    associations :: PutM ()
associations = forall (m :: * -> *) k v.
Applicative m =>
(k -> v -> m ()) -> HashMap k v -> m ()
StrictHashMap.traverse_ key -> Putter value
association HashMap key value
x
    association :: key -> Putter value
association key
keyValue value
valueValue = Putter key
key key
keyValue forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Putter value
value value
valueValue