{-# LANGUAGE FlexibleInstances #-}
{-# 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
(CBORGroup a -> CBORGroup a -> Bool)
-> (CBORGroup a -> CBORGroup a -> Bool) -> Eq (CBORGroup a)
forall a. Eq a => CBORGroup a -> CBORGroup a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: CBORGroup a -> CBORGroup a -> Bool
Eq, Int -> CBORGroup a -> ShowS
[CBORGroup a] -> ShowS
CBORGroup a -> String
(Int -> CBORGroup a -> ShowS)
-> (CBORGroup a -> String)
-> ([CBORGroup a] -> ShowS)
-> Show (CBORGroup a)
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
$cshowsPrec :: forall a. Show a => Int -> CBORGroup a -> ShowS
showsPrec :: Int -> CBORGroup a -> ShowS
$cshow :: forall a. Show a => CBORGroup a -> String
show :: CBORGroup a -> String
$cshowList :: forall a. Show a => [CBORGroup a] -> ShowS
showList :: [CBORGroup a] -> ShowS
Show)

instance (DecCBORGroup a, EncCBORGroup a) => DecCBOR (CBORGroup a) where
  decCBOR :: forall s. Decoder s (CBORGroup a)
decCBOR = a -> CBORGroup a
forall a. a -> CBORGroup a
CBORGroup (a -> CBORGroup a) -> Decoder s a -> Decoder s (CBORGroup a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
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 (a -> Word
forall a. EncCBORGroup a => a -> Word
listLen a
x) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
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 =
    Integer -> Size
forall a. Num a => Integer -> a
fromInteger (Word -> Integer
forall s a. (Integral s, Integral a) => s -> a
withWordSize (Proxy a -> Word
forall a. EncCBORGroup a => Proxy a -> Word
listLenBound Proxy a
proxy'))
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
forall a.
EncCBORGroup a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedGroupSizeExpr Proxy x -> Size
forall t. EncCBOR t => Proxy t -> Size
size Proxy a
proxy'
    where
      proxy' :: Proxy a
proxy' = CBORGroup a -> a
forall a. CBORGroup a -> a
unCBORGroup (CBORGroup a -> a) -> Proxy (CBORGroup a) -> Proxy a
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 = Text -> (a -> Int) -> Decoder s a -> Decoder s a
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"CBORGroup" (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> (a -> Integer) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Integer) -> (a -> Word) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word
forall a. EncCBORGroup a => a -> Word
listLen) Decoder s a
forall s. Decoder s a
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 = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word
forall a. EncCBORGroup a => a -> Word
listLen a
x)

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

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

instance EncCBOR a => EncCBORGroup (a, a) where
  encCBORGroup :: (a, a) -> Encoding
encCBORGroup (a
x, a
y) =
    a -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR a
x Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR a
y
  encodedGroupSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy (a, a) -> Size
encodedGroupSizeExpr forall t. EncCBOR t => Proxy t -> Size
size_ Proxy (a, a)
proxy =
    (forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size_ ((a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> Proxy (a, a) -> Proxy a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (a, a)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size_ ((a, a) -> a
forall a b. (a, b) -> b
snd ((a, a) -> a) -> Proxy (a, a) -> Proxy a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (a, a)
proxy)
  listLen :: (a, a) -> Word
listLen (a, a)
_ = Word
2
  listLenBound :: Proxy (a, a) -> Word
listLenBound Proxy (a, a)
_ = Word
2

instance DecCBOR a => DecCBORGroup (a, a) where
  decCBORGroup :: forall s. Decoder s (a, a)
decCBORGroup = do
    a
x <- Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR
    a
y <- Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR
    (a, a) -> Decoder s (a, a)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, a
y)