-- | A 'Dropper s' is a 'Decoder s ()', that is a decoder that returns nothing
--
--   We use 'Dropper's when we don't care about the result of decoding, for
--   example when we have deprecated some part of the serialised blockchain, but
--   still need to decode old blocks.

module Cardano.Binary.Drop
  ( Dropper
  , dropBytes
  , dropInt32
  , dropList
  , dropMap
  , dropSet
  , dropTuple
  , dropTriple
  , dropWord8
  , dropWord64
  )
where

import Cardano.Prelude

import qualified Codec.CBOR.Decoding as D


type Dropper s = D.Decoder s ()

dropBytes :: Dropper s
dropBytes :: Dropper s
dropBytes = Decoder s ByteString -> Dropper s
forall (f :: * -> *) a. Functor f => f a -> f ()
void Decoder s ByteString
forall s. Decoder s ByteString
D.decodeBytes

dropInt32 :: Dropper s
dropInt32 :: Dropper s
dropInt32 = Decoder s Int32 -> Dropper s
forall (f :: * -> *) a. Functor f => f a -> f ()
void Decoder s Int32
forall s. Decoder s Int32
D.decodeInt32

-- | Drop a list of values using the supplied `Dropper` for each element
dropList :: Dropper s -> Dropper s
dropList :: Dropper s -> Dropper s
dropList Dropper s
dropElems = do
  Dropper s
forall s. Decoder s ()
D.decodeListLenIndef
  (() -> () -> ()) -> () -> (() -> ()) -> Dropper s -> Dropper s
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
D.decodeSequenceLenIndef () -> () -> ()
forall a b. a -> b -> a
const () () -> ()
forall (cat :: * -> * -> *) a. Category cat => cat a a
identity Dropper s
dropElems

dropMap :: Dropper s -> Dropper s -> Dropper s
dropMap :: Dropper s -> Dropper s -> Dropper s
dropMap Dropper s
dropKey Dropper s
dropValue = do
  Int
n <- Decoder s Int
forall s. Decoder s Int
D.decodeMapLen
  Int -> Dropper s -> Dropper s
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (Dropper s -> Dropper s) -> Dropper s -> Dropper s
forall a b. (a -> b) -> a -> b
$ Dropper s
dropKey Dropper s -> Dropper s -> Dropper s
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Dropper s
dropValue

dropSet :: Dropper s -> Dropper s
dropSet :: Dropper s -> Dropper s
dropSet Dropper s
dropElem = do
  Decoder s Word -> Dropper s
forall (f :: * -> *) a. Functor f => f a -> f ()
void Decoder s Word
forall s. Decoder s Word
D.decodeTag
  Int
n <- Decoder s Int
forall s. Decoder s Int
D.decodeListLen
  Int -> Dropper s -> Dropper s
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n Dropper s
dropElem

dropTuple :: Dropper s -> Dropper s -> Dropper s
dropTuple :: Dropper s -> Dropper s -> Dropper s
dropTuple Dropper s
dropA Dropper s
dropB = do
  Int -> Dropper s
forall s. Int -> Decoder s ()
D.decodeListLenOf Int
2
  Dropper s
dropA
  Dropper s
dropB

dropTriple :: Dropper s -> Dropper s -> Dropper s -> Dropper s
dropTriple :: Dropper s -> Dropper s -> Dropper s -> Dropper s
dropTriple Dropper s
dropA Dropper s
dropB Dropper s
dropC = do
  Int -> Dropper s
forall s. Int -> Decoder s ()
D.decodeListLenOf Int
3
  Dropper s
dropA
  Dropper s
dropB
  Dropper s
dropC

dropWord8 :: Dropper s
dropWord8 :: Dropper s
dropWord8 = Decoder s Word8 -> Dropper s
forall (f :: * -> *) a. Functor f => f a -> f ()
void Decoder s Word8
forall s. Decoder s Word8
D.decodeWord8

dropWord64 :: Dropper s
dropWord64 :: Dropper s
dropWord64 = Decoder s Word64 -> Dropper s
forall (f :: * -> *) a. Functor f => f a -> f ()
void Decoder s Word64
forall s. Decoder s Word64
D.decodeWord64