{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

module Cardano.Chain.Common.BlockCount
  ( BlockCount (..),
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Cardano.Prelude
import Formatting.Buildable (Buildable)
import NoThunks.Class (NoThunks (..))

newtype BlockCount = BlockCount
  { BlockCount -> Word64
unBlockCount :: Word64
  }
  deriving (BlockCount -> BlockCount -> Bool
(BlockCount -> BlockCount -> Bool)
-> (BlockCount -> BlockCount -> Bool) -> Eq BlockCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockCount -> BlockCount -> Bool
$c/= :: BlockCount -> BlockCount -> Bool
== :: BlockCount -> BlockCount -> Bool
$c== :: BlockCount -> BlockCount -> Bool
Eq, Eq BlockCount
Eq BlockCount
-> (BlockCount -> BlockCount -> Ordering)
-> (BlockCount -> BlockCount -> Bool)
-> (BlockCount -> BlockCount -> Bool)
-> (BlockCount -> BlockCount -> Bool)
-> (BlockCount -> BlockCount -> Bool)
-> (BlockCount -> BlockCount -> BlockCount)
-> (BlockCount -> BlockCount -> BlockCount)
-> Ord BlockCount
BlockCount -> BlockCount -> Bool
BlockCount -> BlockCount -> Ordering
BlockCount -> BlockCount -> BlockCount
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlockCount -> BlockCount -> BlockCount
$cmin :: BlockCount -> BlockCount -> BlockCount
max :: BlockCount -> BlockCount -> BlockCount
$cmax :: BlockCount -> BlockCount -> BlockCount
>= :: BlockCount -> BlockCount -> Bool
$c>= :: BlockCount -> BlockCount -> Bool
> :: BlockCount -> BlockCount -> Bool
$c> :: BlockCount -> BlockCount -> Bool
<= :: BlockCount -> BlockCount -> Bool
$c<= :: BlockCount -> BlockCount -> Bool
< :: BlockCount -> BlockCount -> Bool
$c< :: BlockCount -> BlockCount -> Bool
compare :: BlockCount -> BlockCount -> Ordering
$ccompare :: BlockCount -> BlockCount -> Ordering
$cp1Ord :: Eq BlockCount
Ord, Int -> BlockCount
BlockCount -> Int
BlockCount -> [BlockCount]
BlockCount -> BlockCount
BlockCount -> BlockCount -> [BlockCount]
BlockCount -> BlockCount -> BlockCount -> [BlockCount]
(BlockCount -> BlockCount)
-> (BlockCount -> BlockCount)
-> (Int -> BlockCount)
-> (BlockCount -> Int)
-> (BlockCount -> [BlockCount])
-> (BlockCount -> BlockCount -> [BlockCount])
-> (BlockCount -> BlockCount -> [BlockCount])
-> (BlockCount -> BlockCount -> BlockCount -> [BlockCount])
-> Enum BlockCount
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BlockCount -> BlockCount -> BlockCount -> [BlockCount]
$cenumFromThenTo :: BlockCount -> BlockCount -> BlockCount -> [BlockCount]
enumFromTo :: BlockCount -> BlockCount -> [BlockCount]
$cenumFromTo :: BlockCount -> BlockCount -> [BlockCount]
enumFromThen :: BlockCount -> BlockCount -> [BlockCount]
$cenumFromThen :: BlockCount -> BlockCount -> [BlockCount]
enumFrom :: BlockCount -> [BlockCount]
$cenumFrom :: BlockCount -> [BlockCount]
fromEnum :: BlockCount -> Int
$cfromEnum :: BlockCount -> Int
toEnum :: Int -> BlockCount
$ctoEnum :: Int -> BlockCount
pred :: BlockCount -> BlockCount
$cpred :: BlockCount -> BlockCount
succ :: BlockCount -> BlockCount
$csucc :: BlockCount -> BlockCount
Enum, ReadPrec [BlockCount]
ReadPrec BlockCount
Int -> ReadS BlockCount
ReadS [BlockCount]
(Int -> ReadS BlockCount)
-> ReadS [BlockCount]
-> ReadPrec BlockCount
-> ReadPrec [BlockCount]
-> Read BlockCount
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BlockCount]
$creadListPrec :: ReadPrec [BlockCount]
readPrec :: ReadPrec BlockCount
$creadPrec :: ReadPrec BlockCount
readList :: ReadS [BlockCount]
$creadList :: ReadS [BlockCount]
readsPrec :: Int -> ReadS BlockCount
$creadsPrec :: Int -> ReadS BlockCount
Read, Int -> BlockCount -> ShowS
[BlockCount] -> ShowS
BlockCount -> String
(Int -> BlockCount -> ShowS)
-> (BlockCount -> String)
-> ([BlockCount] -> ShowS)
-> Show BlockCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockCount] -> ShowS
$cshowList :: [BlockCount] -> ShowS
show :: BlockCount -> String
$cshow :: BlockCount -> String
showsPrec :: Int -> BlockCount -> ShowS
$cshowsPrec :: Int -> BlockCount -> ShowS
Show, BlockCount -> Builder
(BlockCount -> Builder) -> Buildable BlockCount
forall p. (p -> Builder) -> Buildable p
build :: BlockCount -> Builder
$cbuild :: BlockCount -> Builder
Buildable, (forall x. BlockCount -> Rep BlockCount x)
-> (forall x. Rep BlockCount x -> BlockCount) -> Generic BlockCount
forall x. Rep BlockCount x -> BlockCount
forall x. BlockCount -> Rep BlockCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockCount x -> BlockCount
$cfrom :: forall x. BlockCount -> Rep BlockCount x
Generic, BlockCount -> ()
(BlockCount -> ()) -> NFData BlockCount
forall a. (a -> ()) -> NFData a
rnf :: BlockCount -> ()
$crnf :: BlockCount -> ()
NFData, Context -> BlockCount -> IO (Maybe ThunkInfo)
Proxy BlockCount -> String
(Context -> BlockCount -> IO (Maybe ThunkInfo))
-> (Context -> BlockCount -> IO (Maybe ThunkInfo))
-> (Proxy BlockCount -> String)
-> NoThunks BlockCount
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy BlockCount -> String
$cshowTypeOf :: Proxy BlockCount -> String
wNoThunks :: Context -> BlockCount -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BlockCount -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockCount -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> BlockCount -> IO (Maybe ThunkInfo)
NoThunks)

instance ToCBOR BlockCount where
  toCBOR :: BlockCount -> Encoding
toCBOR = Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word64 -> Encoding)
-> (BlockCount -> Word64) -> BlockCount -> Encoding
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockCount -> Word64
unBlockCount
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy BlockCount -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy BlockCount
pxy = Proxy Word64 -> Size
forall t. ToCBOR t => Proxy t -> Size
size (BlockCount -> Word64
unBlockCount (BlockCount -> Word64) -> Proxy BlockCount -> Proxy Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy BlockCount
pxy)

instance FromCBOR BlockCount where
  fromCBOR :: Decoder s BlockCount
fromCBOR = Word64 -> BlockCount
BlockCount (Word64 -> BlockCount) -> Decoder s Word64 -> Decoder s BlockCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR