{-# 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

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 EncCBORGroup a where
  encCBORGroup :: a -> Encoding

  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
  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)