-- | Functions to move to Ouroboros.Network.AnchoredFragment
module Test.Consensus.Network.AnchoredFragment.Extras (
    intersectWith
  , slotLength
  ) where

import           Cardano.Slotting.Slot (SlotNo (unSlotNo), withOrigin)
import           Data.List (find)
import           Data.Maybe (isJust)
import           Ouroboros.Network.AnchoredFragment (AnchoredFragment,
                     HasHeader, Point, anchor, anchorToSlotNo, headAnchor,
                     splitAfterPoint)


-- | Find the first point in the fragment
intersectWith :: HasHeader b => AnchoredFragment b -> [Point b] -> Maybe (Point b)
intersectWith :: forall b.
HasHeader b =>
AnchoredFragment b -> [Point b] -> Maybe (Point b)
intersectWith AnchoredFragment b
fullFrag = (Point b -> Bool) -> [Point b] -> Maybe (Point b)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Maybe (AnchoredFragment b, AnchoredFragment b) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (AnchoredFragment b, AnchoredFragment b) -> Bool)
-> (Point b -> Maybe (AnchoredFragment b, AnchoredFragment b))
-> Point b
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment b
-> Point b -> Maybe (AnchoredFragment b, AnchoredFragment b)
forall block1 block2.
(HasHeader block1, HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> Point block2
-> Maybe (AnchoredFragment block1, AnchoredFragment block1)
splitAfterPoint AnchoredFragment b
fullFrag)

-- | The number of slots the fragment spans. This is different from the
-- 'length' which is the number of blocks in the fragment.
slotLength :: HasHeader blk => AnchoredFragment blk -> Int
slotLength :: forall blk. HasHeader blk => AnchoredFragment blk -> Int
slotLength AnchoredFragment blk
fragment =
  Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo (SlotNo -> Word64) -> SlotNo -> Word64
forall a b. (a -> b) -> a -> b
$
    SlotNo -> (SlotNo -> SlotNo) -> WithOrigin SlotNo -> SlotNo
forall b t. b -> (t -> b) -> WithOrigin t -> b
withOrigin SlotNo
0 SlotNo -> SlotNo
forall a. a -> a
id (Anchor blk -> WithOrigin SlotNo
forall block. Anchor block -> WithOrigin SlotNo
anchorToSlotNo (Anchor blk -> WithOrigin SlotNo)
-> Anchor blk -> WithOrigin SlotNo
forall a b. (a -> b) -> a -> b
$ AnchoredFragment blk -> Anchor blk
forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
headAnchor AnchoredFragment blk
fragment)
    SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
- SlotNo -> (SlotNo -> SlotNo) -> WithOrigin SlotNo -> SlotNo
forall b t. b -> (t -> b) -> WithOrigin t -> b
withOrigin SlotNo
0 SlotNo -> SlotNo
forall a. a -> a
id (Anchor blk -> WithOrigin SlotNo
forall block. Anchor block -> WithOrigin SlotNo
anchorToSlotNo (Anchor blk -> WithOrigin SlotNo)
-> Anchor blk -> WithOrigin SlotNo
forall a b. (a -> b) -> a -> b
$ AnchoredFragment blk -> Anchor blk
forall v a b. AnchoredSeq v a b -> a
anchor AnchoredFragment blk
fragment)