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