module Hasql.Connection.Config.ConnectionString.Params where

import Data.Map.Strict qualified as Map
import Hasql.Prelude

type Params = Map.Map ByteString ByteString

class Updates a where
  update :: a -> Params -> Params

nil :: Params
nil :: Params
nil = Params
forall k a. Map k a
Map.empty

fromUpdates :: (Updates a) => [a] -> Params
fromUpdates :: forall a. Updates a => [a] -> Params
fromUpdates = (Params -> a -> Params) -> Params -> [a] -> Params
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> Params -> Params) -> Params -> a -> Params
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Params -> Params
forall a. Updates a => a -> Params -> Params
update) Params
nil

setKeyValue :: ByteString -> ByteString -> Params -> Params
setKeyValue :: ByteString -> ByteString -> Params -> Params
setKeyValue ByteString
key ByteString
value = ByteString -> ByteString -> Params -> Params
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
key ByteString
value