{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

module Cardano.Ledger.Binary.Group (
  CBORGroup (..),
  groupRecord,
  EncCBORGroup (..),
  listLenInt,
  DecCBORGroup (..),
)
where

import Cardano.Ledger.Binary.Decoding
import Cardano.Ledger.Binary.Encoding
import Data.Proxy
import Data.Typeable

--------------------------------------------------------------------------------
-- CBORGroup
--------------------------------------------------------------------------------

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

instance (DecCBORGroup a, EncCBORGroup a) => DecCBOR (CBORGroup a) where
  decCBOR :: forall s. Decoder s (CBORGroup a)
decCBOR = forall a. a -> CBORGroup a
CBORGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. (EncCBORGroup a, DecCBORGroup a) => Decoder s a
groupRecord

instance EncCBORGroup a => EncCBOR (CBORGroup a) where
  encCBOR :: CBORGroup a -> Encoding
encCBOR (CBORGroup a
x) = Word -> Encoding
encodeListLen (forall a. EncCBORGroup a => a -> Word
listLen a
x) forall a. Semigroup a => a -> a -> a
<> forall a. EncCBORGroup a => a -> Encoding
encCBORGroup a
x
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (CBORGroup a) -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy (CBORGroup a)
proxy =
    forall a. Num a => Integer -> a
fromInteger (forall s a. (Integral s, Integral a) => s -> a
withWordSize (forall a. EncCBORGroup a => Proxy a -> Word
listLenBound Proxy a
proxy'))
      forall a. Num a => a -> a -> a
+ forall a.
EncCBORGroup a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedGroupSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy a
proxy'
    where
      proxy' :: Proxy a
proxy' = forall a. CBORGroup a -> a
unCBORGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (CBORGroup a)
proxy

groupRecord :: forall a s. (EncCBORGroup a, DecCBORGroup a) => Decoder s a
groupRecord :: forall a s. (EncCBORGroup a, DecCBORGroup a) => Decoder s a
groupRecord = forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"CBORGroup" (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBORGroup a => a -> Word
listLen) forall a s. DecCBORGroup a => Decoder s a
decCBORGroup

--------------------------------------------------------------------------------
-- EncCBORGroup
--------------------------------------------------------------------------------

class Typeable a => EncCBORGroup a where
  encCBORGroup :: a -> Encoding
  encodedGroupSizeExpr ::
    (forall x. EncCBOR x => Proxy x -> Size) ->
    Proxy a ->
    Size

  listLen :: a -> Word

  -- | an upper bound for 'listLen', used in 'Size' expressions.
  listLenBound :: Proxy a -> Word

listLenInt :: EncCBORGroup a => a -> Int
listLenInt :: forall a. EncCBORGroup a => a -> Int
listLenInt a
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. EncCBORGroup a => a -> Word
listLen a
x)

--------------------------------------------------------------------------------
-- DecCBORGroup
--------------------------------------------------------------------------------

class Typeable a => DecCBORGroup a where
  decCBORGroup :: Decoder s a