{-# LANGUAGE ScopedTypeVariables #-}

-- | Utility functions on chains
--
-- Intended for qualified import
-- > import qualified Test.Util.MockChain as Chain
module Test.Util.MockChain
  ( commonPrefix
  , dropLastBlocks
  , lastSlot
  ) where

import Data.Foldable as Foldable (foldl')
import Data.Sequence.Strict (StrictSeq (..))
import Ouroboros.Consensus.Block
import Ouroboros.Network.Mock.Chain

{-------------------------------------------------------------------------------
  Utility functions on chains
-------------------------------------------------------------------------------}

lastSlot :: HasHeader b => Chain b -> Maybe SlotNo
lastSlot :: forall b. HasHeader b => Chain b -> Maybe SlotNo
lastSlot Chain b
Genesis = Maybe SlotNo
forall a. Maybe a
Nothing
lastSlot (Chain b
_ :> b
b) = SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just (SlotNo -> Maybe SlotNo) -> SlotNo -> Maybe SlotNo
forall a b. (a -> b) -> a -> b
$ b -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot b
b

commonPrefix :: Eq b => Chain b -> Chain b -> Chain b
commonPrefix :: forall b. Eq b => Chain b -> Chain b -> Chain b
commonPrefix Chain b
c Chain b
d = StrictSeq b -> Chain b
forall b. StrictSeq b -> Chain b
chainFromSeq (StrictSeq b -> Chain b) -> StrictSeq b -> Chain b
forall a b. (a -> b) -> a -> b
$ StrictSeq b -> StrictSeq b -> StrictSeq b
forall b. Eq b => StrictSeq b -> StrictSeq b -> StrictSeq b
go (Chain b -> StrictSeq b
forall b. Chain b -> StrictSeq b
chainToSeq Chain b
c) (Chain b -> StrictSeq b
forall b. Chain b -> StrictSeq b
chainToSeq Chain b
d)
 where
  go :: Eq b => StrictSeq b -> StrictSeq b -> StrictSeq b
  go :: forall b. Eq b => StrictSeq b -> StrictSeq b -> StrictSeq b
go StrictSeq b
Empty StrictSeq b
_ = StrictSeq b
forall a. StrictSeq a
Empty
  go StrictSeq b
_ StrictSeq b
Empty = StrictSeq b
forall a. StrictSeq a
Empty
  go (b
x :<| StrictSeq b
xs) (b
y :<| StrictSeq b
ys)
    | b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
y = b
x b -> StrictSeq b -> StrictSeq b
forall a. a -> StrictSeq a -> StrictSeq a
:<| StrictSeq b -> StrictSeq b -> StrictSeq b
forall b. Eq b => StrictSeq b -> StrictSeq b -> StrictSeq b
go StrictSeq b
xs StrictSeq b
ys
    | Bool
otherwise = StrictSeq b
forall a. StrictSeq a
Empty

dropLastBlocks :: Int -> Chain b -> Chain b
dropLastBlocks :: forall b. Int -> Chain b -> Chain b
dropLastBlocks Int
_ Chain b
Genesis = Chain b
forall block. Chain block
Genesis
dropLastBlocks Int
i bs :: Chain b
bs@(Chain b
cs :> b
_)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Chain b
bs
  | Bool
otherwise = Int -> Chain b -> Chain b
forall b. Int -> Chain b -> Chain b
dropLastBlocks (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Chain b
cs

{-------------------------------------------------------------------------------
  Internal auxiliary
-------------------------------------------------------------------------------}

chainFromSeq :: StrictSeq b -> Chain b
chainFromSeq :: forall b. StrictSeq b -> Chain b
chainFromSeq = (Chain b -> b -> Chain b) -> Chain b -> StrictSeq b -> Chain b
forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Chain b -> b -> Chain b
forall block. Chain block -> block -> Chain block
(:>) Chain b
forall block. Chain block
Genesis

chainToSeq :: Chain b -> StrictSeq b
chainToSeq :: forall b. Chain b -> StrictSeq b
chainToSeq = (StrictSeq b -> b -> StrictSeq b)
-> StrictSeq b -> Chain b -> StrictSeq b
forall a b. (a -> b -> a) -> a -> Chain b -> a
foldChain StrictSeq b -> b -> StrictSeq b
forall a. StrictSeq a -> a -> StrictSeq a
(:|>) StrictSeq b
forall a. StrictSeq a
Empty