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

import Data.MessagePack (Object)
import Data.Sequence ((|>))

import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode (toMsgpack))

newtype Acc =
  Acc { Acc -> Seq Object
unAcc :: Seq Object }
  deriving stock (Acc -> Acc -> Bool
(Acc -> Acc -> Bool) -> (Acc -> Acc -> Bool) -> Eq Acc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Acc -> Acc -> Bool
$c/= :: Acc -> Acc -> Bool
== :: Acc -> Acc -> Bool
$c== :: Acc -> Acc -> Bool
Eq, Int -> Acc -> ShowS
[Acc] -> ShowS
Acc -> String
(Int -> Acc -> ShowS)
-> (Acc -> String) -> ([Acc] -> ShowS) -> Show Acc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Acc] -> ShowS
$cshowList :: [Acc] -> ShowS
show :: Acc -> String
$cshow :: Acc -> String
showsPrec :: Int -> Acc -> ShowS
$cshowsPrec :: Int -> Acc -> ShowS
Show)

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

instance MsgpackArray (Acc -> [Object]) where
  msgpackArray :: Acc -> [Object]
msgpackArray =
    Seq Object -> [Object]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Object -> [Object]) -> (Acc -> Seq Object) -> Acc -> [Object]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acc -> Seq Object
unAcc

instance MsgpackArray (Acc -> Object) where
  msgpackArray :: Acc -> Object
msgpackArray =
    Seq Object -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Seq Object -> Object) -> (Acc -> Seq Object) -> Acc -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acc -> Seq Object
unAcc

instance MsgpackArray (a -> a) where
  msgpackArray :: a -> a
msgpackArray =
    a -> a
forall a. a -> a
id

instance (
    MsgpackEncode a,
    MsgpackArray (Acc -> b)
  ) => MsgpackArray (Acc -> a -> b) where
  msgpackArray :: Acc -> a -> b
msgpackArray (Acc Seq Object
m) a
a =
    forall a. MsgpackArray a => a
msgpackArray @(Acc -> b) (Seq Object -> Acc
Acc (Seq Object
m Seq Object -> Object -> Seq Object
forall a. Seq a -> a -> Seq a
|> a -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack a
a))

instance {-# overlappable #-} (
    MsgpackEncode a,
    MsgpackArray (Acc -> b)
  ) => MsgpackArray (a -> b) where
  msgpackArray :: a -> b
msgpackArray a
a =
    forall a. MsgpackArray a => a
msgpackArray @(Acc -> b) (Seq Object -> Acc
Acc [a -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack a
a])