-- |Helper for encoding values to a heterogeneous MessagePack map.
module Ribosome.Host.Class.Msgpack.Map where

import Data.MessagePack (Object)
import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode (toMsgpack))

-- |Utility class for 'MsgpackMap'.
class MsgpackMapElem a where
  msgpackMapElem :: a -> Map Text Object

instance {-# overlappable #-} (
    MsgpackEncode a,
    t ~ Text
  ) => MsgpackMapElem (t, a) where
    msgpackMapElem :: (t, a) -> Map Text Object
msgpackMapElem (t
k, a
v) =
      [(t
k, a -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack a
v)]

instance (
    MsgpackEncode a,
    t ~ Text
  ) => MsgpackMapElem (t, Maybe a) where
    msgpackMapElem :: (t, Maybe a) -> Map Text Object
msgpackMapElem = \case
      (t
k, Just a
v) ->
        [(t
k, a -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack a
v)]
      (t
_, Maybe a
Nothing) ->
        Map Text Object
forall a. Monoid a => a
mempty

-- |This class provides a variadic method for encoding MessagePack maps.
class MsgpackMap a where
  -- |Encode an arbitrary number of heterogeneously typed values to a single MessagePack map.
  -- This function is variadic, meaning that it takes an arbitrary number of arguments:
  --
  -- >>> msgpackMap ("number", 5 :: Int) ("status", "error" :: Text) ("intensity", 3.14 :: Double) :: Object
  -- ObjectMap (Map.fromList [(ObjectString "number", ObjectInt 5), (ObjectString "status", ObjectString "error"), (ObjectString "intensity", ObjectFloat 3.14)])
  --
  -- This avoids the need to call 'Ribosome.toMsgpack' once for each element and then once more for the map.
  msgpackMap :: a

instance MsgpackMap (Map Text Object -> Object) where
  msgpackMap :: Map Text Object -> Object
msgpackMap =
    Map Text Object -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack

instance MsgpackMap (a -> a) where
  msgpackMap :: a -> a
msgpackMap =
    a -> a
forall a. a -> a
id

instance (
    MsgpackMapElem (t, a),
    MsgpackMap (Map Text Object -> b)
  ) => MsgpackMap (Map Text Object -> (t, a) -> b) where
  msgpackMap :: Map Text Object -> (t, a) -> b
msgpackMap Map Text Object
m (t, a)
a =
    Map Text Object -> b
forall a. MsgpackMap a => a
msgpackMap (Map Text Object
m Map Text Object -> Map Text Object -> Map Text Object
forall a. Semigroup a => a -> a -> a
<> (t, a) -> Map Text Object
forall a. MsgpackMapElem a => a -> Map Text Object
msgpackMapElem (t, a)
a)

instance (
    MsgpackMapElem (t, a),
    MsgpackMap (Map Text Object -> b)
  ) => MsgpackMap ((t, a) -> b) where
  msgpackMap :: (t, a) -> b
msgpackMap (t, a)
a =
    Map Text Object -> b
forall a. MsgpackMap a => a
msgpackMap ((t, a) -> Map Text Object
forall a. MsgpackMapElem a => a -> Map Text Object
msgpackMapElem (t, a)
a)