{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

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

import Cardano.Base.Proxy
import Cardano.Ledger.Binary.Decoding
import Cardano.Ledger.Binary.Encoding
import Data.Typeable (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 (Proxy a -> Word
forall a. EncCBORGroup a => Proxy a -> Word
listLen (Proxy a -> Word) -> Proxy a -> Word
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) 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" (Proxy a -> Int
forall (proxy :: * -> *) a. EncCBORGroup a => proxy a -> Int
listLenInt (Proxy a -> Int) -> (a -> Proxy a) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Proxy a
forall a. a -> Proxy a
asProxy) 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 :: Proxy a -> Word

listLenInt :: forall proxy a. EncCBORGroup a => proxy a -> Int
listLenInt :: forall (proxy :: * -> *) a. EncCBORGroup a => proxy a -> Int
listLenInt proxy a
_ = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Proxy a -> Word
forall a. EncCBORGroup a => Proxy a -> Word
listLen (Proxy a -> Word) -> Proxy a -> Word
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a

--------------------------------------------------------------------------------
-- 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 :: Proxy (a, a) -> Word
listLen Proxy (a, a)
_ = Word
2

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