Class.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Proto3.Wire.Encode.Class
    ( module Proto3.Wire.Encode.Class
    , module Proto3.Wire.Encode
    , module Proto3.Wire.Types
    )
where

import Data.Aeson.Key (Key)
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Value (..))
import Data.Int (Int32)
import Data.Scientific (toBoundedInteger, toRealFloat)
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Text.Encoding qualified as Text
import Data.Vector qualified as Vector
import Data.Word (Word32)
import Proto3.Wire.Class (ProtoEnum)
import Proto3.Wire.Encode hiding (text)
import Proto3.Wire.Types (FieldNumber)
import Prelude hiding (span)

class Encode a where
    encode :: a -> MessageBuilder

class EncodeField a where
    encodeField :: FieldNumber -> a -> MessageBuilder

instance (Encode a) => EncodeField a where
    encodeField n = embedded n . encode

instance Encode Value where
    encode (String s) = encodeField 1 s
    encode (Bool b) = bool 2 b
    encode (Number n) = maybe (double 4 $ toRealFloat n) (int64 3) $ toBoundedInteger n
    encode (Array a) = embedded 5 . encodeField 1 . Vector.toList $ a
    encode (Object o) = embedded 6 . encodeField 1 . KeyMap.toList $ o
    encode Null = mempty

instance Encode (Key.Key, Value) where
    encode (k, v) =
        mconcat
            [ encodeField 1 k
            , encodeField 2 v
            ]

instance (Bounded a, Enum a) => ProtoEnum a

instance {-# OVERLAPPING #-} EncodeField Word32 where
    encodeField = fixed32

instance {-# OVERLAPPING #-} EncodeField Int32 where
    encodeField = int32

instance {-# OVERLAPPING #-} EncodeField Text where
    encodeField n = byteString n . Text.encodeUtf8

instance {-# OVERLAPPING #-} EncodeField Key where
    encodeField n = encodeField n . Key.toText

instance {-# OVERLAPPING #-} (EncodeField a) => EncodeField [a] where
    encodeField n = foldMap (encodeField n)

instance {-# OVERLAPPING #-} (EncodeField a) => EncodeField (Seq a) where
    encodeField n = foldMap (encodeField n)