{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}

#if __GLASGOW_HASKELL__ >= 908
{-# OPTIONS_GHC -Wno-x-partial #-}
#endif

-- REVIEW: There is a `BlockTree` in `Test.Utils.TestBlock`. It relies on
-- different mechanisms but maybe we should rely on that instead to avoid
-- duplication.

module Test.Consensus.BlockTree (
    BlockTree (..)
  , BlockTreeBranch (..)
  , PathAnchoredAtSource (..)
  , addBranch
  , addBranch'
  , allFragments
  , findFragment
  , findPath
  , mkTrunk
  , prettyBlockTree
  ) where

import           Cardano.Slotting.Slot (SlotNo (unSlotNo))
import           Data.Foldable (asum)
import           Data.Function ((&))
import           Data.Functor ((<&>))
import           Data.Maybe (fromJust, fromMaybe)
import qualified Data.Vector as Vector
import           Ouroboros.Consensus.Block.Abstract (blockNo, blockSlot,
                     fromWithOrigin, unBlockNo)
import qualified Ouroboros.Network.AnchoredFragment as AF
import           Text.Printf (printf)

-- | Represent a branch of a block tree by a prefix and a suffix. The full
-- fragment (the prefix and suffix catenated) and the trunk suffix (the rest of
-- the trunk after the branch forks off) are provided for practicality.
--
-- INVARIANT: the head of @btbPrefix@ is the anchor of @btbSuffix@.
--
-- INVARIANT: @btbFull == fromJust $ AF.join btbPrefix btbSuffix@.
data BlockTreeBranch blk = BlockTreeBranch {
    forall blk. BlockTreeBranch blk -> AnchoredFragment blk
btbPrefix      :: AF.AnchoredFragment blk,
    forall blk. BlockTreeBranch blk -> AnchoredFragment blk
btbSuffix      :: AF.AnchoredFragment blk,
    forall blk. BlockTreeBranch blk -> AnchoredFragment blk
btbTrunkSuffix :: AF.AnchoredFragment blk,
    forall blk. BlockTreeBranch blk -> AnchoredFragment blk
btbFull        :: AF.AnchoredFragment blk
  }
  deriving (Int -> BlockTreeBranch blk -> ShowS
[BlockTreeBranch blk] -> ShowS
BlockTreeBranch blk -> String
(Int -> BlockTreeBranch blk -> ShowS)
-> (BlockTreeBranch blk -> String)
-> ([BlockTreeBranch blk] -> ShowS)
-> Show (BlockTreeBranch blk)
forall blk.
(StandardHash blk, Show blk) =>
Int -> BlockTreeBranch blk -> ShowS
forall blk.
(StandardHash blk, Show blk) =>
[BlockTreeBranch blk] -> ShowS
forall blk.
(StandardHash blk, Show blk) =>
BlockTreeBranch blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall blk.
(StandardHash blk, Show blk) =>
Int -> BlockTreeBranch blk -> ShowS
showsPrec :: Int -> BlockTreeBranch blk -> ShowS
$cshow :: forall blk.
(StandardHash blk, Show blk) =>
BlockTreeBranch blk -> String
show :: BlockTreeBranch blk -> String
$cshowList :: forall blk.
(StandardHash blk, Show blk) =>
[BlockTreeBranch blk] -> ShowS
showList :: [BlockTreeBranch blk] -> ShowS
Show)

-- | Represent a block tree with a main trunk and branches leaving from the
-- trunk in question. All the branches are represented by their prefix to and
-- suffix from the intersection point.
--
-- INVARIANT: The branches' prefixes share the same anchor as the trunk and are
-- fully contained in the trunk.
--
-- INVARIANT: The branches' suffixes are anchored in the trunk and do not
-- contain any blocks in common with the trunk.
--
-- INVARIANT: The branches' suffixes do not contain any block in common with one
-- another.
--
-- INVARIANT: for all @BlockTreeBranch{..}@ in the tree, @btTrunk == fromJust $
-- AF.join btbPrefix btbTrunkSuffix@.
--
-- REVIEW: Find another name so as not to clash with 'BlockTree' from
-- `unstable-consensus-testlib/Test/Util/TestBlock.hs`.
data BlockTree blk = BlockTree {
    forall blk. BlockTree blk -> AnchoredFragment blk
btTrunk    :: AF.AnchoredFragment blk,
    forall blk. BlockTree blk -> [BlockTreeBranch blk]
btBranches :: [BlockTreeBranch blk]
  }
  deriving (Int -> BlockTree blk -> ShowS
[BlockTree blk] -> ShowS
BlockTree blk -> String
(Int -> BlockTree blk -> ShowS)
-> (BlockTree blk -> String)
-> ([BlockTree blk] -> ShowS)
-> Show (BlockTree blk)
forall blk.
(StandardHash blk, Show blk) =>
Int -> BlockTree blk -> ShowS
forall blk.
(StandardHash blk, Show blk) =>
[BlockTree blk] -> ShowS
forall blk. (StandardHash blk, Show blk) => BlockTree blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall blk.
(StandardHash blk, Show blk) =>
Int -> BlockTree blk -> ShowS
showsPrec :: Int -> BlockTree blk -> ShowS
$cshow :: forall blk. (StandardHash blk, Show blk) => BlockTree blk -> String
show :: BlockTree blk -> String
$cshowList :: forall blk.
(StandardHash blk, Show blk) =>
[BlockTree blk] -> ShowS
showList :: [BlockTree blk] -> ShowS
Show)

-- | Make a block tree made of only a trunk.
mkTrunk :: AF.AnchoredFragment blk -> BlockTree blk
mkTrunk :: forall blk. AnchoredFragment blk -> BlockTree blk
mkTrunk AnchoredFragment blk
btTrunk = BlockTree { AnchoredFragment blk
btTrunk :: AnchoredFragment blk
btTrunk :: AnchoredFragment blk
btTrunk, btBranches :: [BlockTreeBranch blk]
btBranches = [] }

-- | Add a branch to an existing block tree.
--
-- Yields @Nothing@ if the given fragment does not intersect with the trunk or its anchor.
--
-- FIXME: we should enforce that the branch's prefix shares the same anchor as
-- the trunk.
--
-- FIXME: we should enforce that the new branch' suffix does not contain any
-- block in common with an existing branch.
addBranch :: AF.HasHeader blk => AF.AnchoredFragment blk -> BlockTree blk -> Maybe (BlockTree blk)
addBranch :: forall blk.
HasHeader blk =>
AnchoredFragment blk -> BlockTree blk -> Maybe (BlockTree blk)
addBranch AnchoredFragment blk
branch BlockTree blk
bt = do
  (AnchoredFragment blk
btbPrefix, AnchoredFragment blk
_, AnchoredFragment blk
btbTrunkSuffix, AnchoredFragment blk
btbSuffix) <- AnchoredFragment blk
-> AnchoredFragment blk
-> Maybe
     (AnchoredFragment blk, AnchoredFragment blk, AnchoredFragment blk,
      AnchoredFragment blk)
forall block1 block2.
(HasHeader block1, HasHeader block2,
 HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> AnchoredFragment block2
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
AF.intersect (BlockTree blk -> AnchoredFragment blk
forall blk. BlockTree blk -> AnchoredFragment blk
btTrunk BlockTree blk
bt) AnchoredFragment blk
branch
  -- NOTE: We could use the monadic bind for @Maybe@ here but we would rather
  -- catch bugs quicker.
  let btbFull :: AnchoredFragment blk
btbFull = Maybe (AnchoredFragment blk) -> AnchoredFragment blk
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (AnchoredFragment blk) -> AnchoredFragment blk)
-> Maybe (AnchoredFragment blk) -> AnchoredFragment blk
forall a b. (a -> b) -> a -> b
$ AnchoredFragment blk
-> AnchoredFragment blk -> Maybe (AnchoredFragment blk)
forall block.
HasHeader block =>
AnchoredFragment block
-> AnchoredFragment block -> Maybe (AnchoredFragment block)
AF.join AnchoredFragment blk
btbPrefix AnchoredFragment blk
btbSuffix
  BlockTree blk -> Maybe (BlockTree blk)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BlockTree blk -> Maybe (BlockTree blk))
-> BlockTree blk -> Maybe (BlockTree blk)
forall a b. (a -> b) -> a -> b
$ BlockTree blk
bt { btBranches = BlockTreeBranch { .. } : btBranches bt }

-- | Same as @addBranch@ but calls to 'error' if the former yields 'Nothing'.
addBranch' :: AF.HasHeader blk => AF.AnchoredFragment blk -> BlockTree blk -> BlockTree blk
addBranch' :: forall blk.
HasHeader blk =>
AnchoredFragment blk -> BlockTree blk -> BlockTree blk
addBranch' AnchoredFragment blk
branch BlockTree blk
blockTree =
  BlockTree blk -> Maybe (BlockTree blk) -> BlockTree blk
forall a. a -> Maybe a -> a
fromMaybe (String -> BlockTree blk
forall a. HasCallStack => String -> a
error String
"addBranch': precondition does not hold") (Maybe (BlockTree blk) -> BlockTree blk)
-> Maybe (BlockTree blk) -> BlockTree blk
forall a b. (a -> b) -> a -> b
$ AnchoredFragment blk -> BlockTree blk -> Maybe (BlockTree blk)
forall blk.
HasHeader blk =>
AnchoredFragment blk -> BlockTree blk -> Maybe (BlockTree blk)
addBranch AnchoredFragment blk
branch BlockTree blk
blockTree

-- | Return all the full fragments from the root of the tree.
allFragments :: BlockTree blk -> [AF.AnchoredFragment blk]
allFragments :: forall blk. BlockTree blk -> [AnchoredFragment blk]
allFragments BlockTree blk
bt = BlockTree blk -> AnchoredFragment blk
forall blk. BlockTree blk -> AnchoredFragment blk
btTrunk BlockTree blk
bt AnchoredFragment blk
-> [AnchoredFragment blk] -> [AnchoredFragment blk]
forall a. a -> [a] -> [a]
: (BlockTreeBranch blk -> AnchoredFragment blk)
-> [BlockTreeBranch blk] -> [AnchoredFragment blk]
forall a b. (a -> b) -> [a] -> [b]
map BlockTreeBranch blk -> AnchoredFragment blk
forall blk. BlockTreeBranch blk -> AnchoredFragment blk
btbFull (BlockTree blk -> [BlockTreeBranch blk]
forall blk. BlockTree blk -> [BlockTreeBranch blk]
btBranches BlockTree blk
bt)

-- | Look for a point in the block tree and return a fragment going from the
-- root of the tree to the point in question.
findFragment :: AF.HasHeader blk => AF.Point blk -> BlockTree blk -> Maybe (AF.AnchoredFragment blk)
findFragment :: forall blk.
HasHeader blk =>
Point blk -> BlockTree blk -> Maybe (AnchoredFragment blk)
findFragment Point blk
point BlockTree blk
blockTree =
  BlockTree blk -> [AnchoredFragment blk]
forall blk. BlockTree blk -> [AnchoredFragment blk]
allFragments BlockTree blk
blockTree
    [AnchoredFragment blk]
-> ([AnchoredFragment blk]
    -> [Maybe (AnchoredFragment blk, AnchoredFragment blk)])
-> [Maybe (AnchoredFragment blk, AnchoredFragment blk)]
forall a b. a -> (a -> b) -> b
& (AnchoredFragment blk
 -> Maybe (AnchoredFragment blk, AnchoredFragment blk))
-> [AnchoredFragment blk]
-> [Maybe (AnchoredFragment blk, AnchoredFragment blk)]
forall a b. (a -> b) -> [a] -> [b]
map (\AnchoredFragment blk
fragment -> AnchoredFragment blk
-> Point blk -> Maybe (AnchoredFragment blk, AnchoredFragment blk)
forall block1 block2.
(HasHeader block1, HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> Point block2
-> Maybe (AnchoredFragment block1, AnchoredFragment block1)
AF.splitAfterPoint AnchoredFragment blk
fragment Point blk
point)
    [Maybe (AnchoredFragment blk, AnchoredFragment blk)]
-> ([Maybe (AnchoredFragment blk, AnchoredFragment blk)]
    -> Maybe (AnchoredFragment blk, AnchoredFragment blk))
-> Maybe (AnchoredFragment blk, AnchoredFragment blk)
forall a b. a -> (a -> b) -> b
& [Maybe (AnchoredFragment blk, AnchoredFragment blk)]
-> Maybe (AnchoredFragment blk, AnchoredFragment blk)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    Maybe (AnchoredFragment blk, AnchoredFragment blk)
-> ((AnchoredFragment blk, AnchoredFragment blk)
    -> AnchoredFragment blk)
-> Maybe (AnchoredFragment blk)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (AnchoredFragment blk, AnchoredFragment blk)
-> AnchoredFragment blk
forall a b. (a, b) -> a
fst

-- | See 'findPath'.
newtype PathAnchoredAtSource = PathAnchoredAtSource Bool

-- | @findPath source target blockTree@ finds a path from the @source@ point to
-- the @target@ point in the @blockTree@ and returns it as an anchored fragment
-- It returns @Nothing@ when either of @source@ are @target@ are not in the
-- 'BlockTree'. There are two interesting properties on this fragment:
--
--   1. Whether the returned fragment is anchored at the @source@.
--   2. Whether the returned fragment is empty.
--
-- Together, those two properties form four interesting cases:
--
--   a. If the fragment is anchored at the @source@ and is empty, then @source
--      == target@.
--
--   b. If the fragment is anchored at the @source@ and is not empty, then
--      @source@ is an ancestor of @target@ and the fragment contains all the
--      blocks between them, @target@ included.
--
--   c. If the fragment is not anchored at the @source@ and is empty, then
--      @target@ is an ancestor of @source@.
--
--   d. If the fragment is not anchored at the @source@ and is not empty, then
--      it is anchored at the youngest common ancestor of both @source@ and
--      @target@ and contains all the blocks between that ancestor and @target@.
findPath ::
  AF.HasHeader blk =>
  AF.Point blk ->
  AF.Point blk ->
  BlockTree blk ->
  Maybe (PathAnchoredAtSource, AF.AnchoredFragment blk)
findPath :: forall blk.
HasHeader blk =>
Point blk
-> Point blk
-> BlockTree blk
-> Maybe (PathAnchoredAtSource, AnchoredFragment blk)
findPath Point blk
source Point blk
target BlockTree blk
blockTree = do
  AnchoredFragment blk
sourceFragment <- Point blk -> BlockTree blk -> Maybe (AnchoredFragment blk)
forall blk.
HasHeader blk =>
Point blk -> BlockTree blk -> Maybe (AnchoredFragment blk)
findFragment Point blk
source BlockTree blk
blockTree
  AnchoredFragment blk
targetFragment <- Point blk -> BlockTree blk -> Maybe (AnchoredFragment blk)
forall blk.
HasHeader blk =>
Point blk -> BlockTree blk -> Maybe (AnchoredFragment blk)
findFragment Point blk
target BlockTree blk
blockTree
  (AnchoredFragment blk
_, AnchoredFragment blk
_, AnchoredFragment blk
_, AnchoredFragment blk
targetSuffix) <- AnchoredFragment blk
-> AnchoredFragment blk
-> Maybe
     (AnchoredFragment blk, AnchoredFragment blk, AnchoredFragment blk,
      AnchoredFragment blk)
forall block1 block2.
(HasHeader block1, HasHeader block2,
 HeaderHash block1 ~ HeaderHash block2) =>
AnchoredFragment block1
-> AnchoredFragment block2
-> Maybe
     (AnchoredFragment block1, AnchoredFragment block2,
      AnchoredFragment block1, AnchoredFragment block2)
AF.intersect AnchoredFragment blk
sourceFragment AnchoredFragment blk
targetFragment
  (PathAnchoredAtSource, AnchoredFragment blk)
-> Maybe (PathAnchoredAtSource, AnchoredFragment blk)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (
    Bool -> PathAnchoredAtSource
PathAnchoredAtSource (AnchoredFragment blk -> Point blk
forall block. AnchoredFragment block -> Point block
AF.anchorPoint AnchoredFragment blk
targetSuffix Point blk -> Point blk -> Bool
forall a. Eq a => a -> a -> Bool
== Point blk
source),
    AnchoredFragment blk
targetSuffix
    )

-- | Pretty prints a block tree for human readability. For instance:
--
--     slots:  0  1  2  3  4  5  6  7  8  9
--     trunk:  0─────1──2──3──4─────5──6──7
--                      ╰─────3──4─────5
--
-- Returns a list of strings intended to be catenated with a newline.
prettyBlockTree :: AF.HasHeader blk => BlockTree blk -> [String]
prettyBlockTree :: forall blk. HasHeader blk => BlockTree blk -> [String]
prettyBlockTree BlockTree blk
blockTree =
  [String
"slots:   " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((SlotNo -> String) -> [SlotNo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Word64 -> String
forall r. PrintfType r => String -> r
printf String
"%2d" (Word64 -> String) -> (SlotNo -> Word64) -> SlotNo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> Word64
unSlotNo) [SlotNo
veryFirstSlot .. SlotNo
veryLastSlot])]
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [AnchoredFragment blk -> String
forall blk. HasHeader blk => AnchoredFragment blk -> String
printTrunk AnchoredFragment blk
honestFragment]
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((AnchoredFragment blk -> String)
-> [AnchoredFragment blk] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map AnchoredFragment blk -> String
forall blk. HasHeader blk => AnchoredFragment blk -> String
printBranch [AnchoredFragment blk]
adversarialFragments)

  where
    honestFragment :: AnchoredFragment blk
honestFragment = BlockTree blk -> AnchoredFragment blk
forall blk. BlockTree blk -> AnchoredFragment blk
btTrunk BlockTree blk
blockTree
    adversarialFragments :: [AnchoredFragment blk]
adversarialFragments = (BlockTreeBranch blk -> AnchoredFragment blk)
-> [BlockTreeBranch blk] -> [AnchoredFragment blk]
forall a b. (a -> b) -> [a] -> [b]
map BlockTreeBranch blk -> AnchoredFragment blk
forall blk. BlockTreeBranch blk -> AnchoredFragment blk
btbSuffix (BlockTree blk -> [BlockTreeBranch blk]
forall blk. BlockTree blk -> [BlockTreeBranch blk]
btBranches BlockTree blk
blockTree)

    veryFirstSlot :: SlotNo
veryFirstSlot = AnchoredFragment blk -> SlotNo
forall blk. AnchoredFragment blk -> SlotNo
firstNo (AnchoredFragment blk -> SlotNo) -> AnchoredFragment blk -> SlotNo
forall a b. (a -> b) -> a -> b
$ AnchoredFragment blk
honestFragment

    veryLastSlot :: SlotNo
veryLastSlot =
      (SlotNo -> SlotNo -> SlotNo) -> SlotNo -> [SlotNo] -> SlotNo
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl SlotNo -> SlotNo -> SlotNo
forall a. Ord a => a -> a -> a
max SlotNo
0 ([SlotNo] -> SlotNo) -> [SlotNo] -> SlotNo
forall a b. (a -> b) -> a -> b
$
        (AnchoredFragment blk -> SlotNo)
-> [AnchoredFragment blk] -> [SlotNo]
forall a b. (a -> b) -> [a] -> [b]
map
          AnchoredFragment blk -> SlotNo
forall blk. HasHeader blk => AnchoredFragment blk -> SlotNo
lastNo
          (AnchoredFragment blk
honestFragment AnchoredFragment blk
-> [AnchoredFragment blk] -> [AnchoredFragment blk]
forall a. a -> [a] -> [a]
: [AnchoredFragment blk]
adversarialFragments)

    printTrunk :: AF.HasHeader blk => AF.AnchoredFragment blk -> String
    printTrunk :: forall blk. HasHeader blk => AnchoredFragment blk -> String
printTrunk = (SlotNo -> String) -> AnchoredFragment blk -> String
forall blk.
HasHeader blk =>
(SlotNo -> String) -> AnchoredFragment blk -> String
printLine (\SlotNo
_ -> String
"trunk:  ─")

    printBranch :: AF.HasHeader blk => AF.AnchoredFragment blk -> String
    printBranch :: forall blk. HasHeader blk => AnchoredFragment blk -> String
printBranch = (SlotNo -> String) -> AnchoredFragment blk -> String
forall blk.
HasHeader blk =>
(SlotNo -> String) -> AnchoredFragment blk -> String
printLine ((SlotNo -> String) -> AnchoredFragment blk -> String)
-> (SlotNo -> String) -> AnchoredFragment blk -> String
forall a b. (a -> b) -> a -> b
$ \SlotNo
firstSlot ->
      String
"      " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SlotNo -> Word64
unSlotNo (SlotNo
firstSlot SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
- SlotNo
veryFirstSlot))) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ╰─"

    printLine :: AF.HasHeader blk => (SlotNo -> String) -> AF.AnchoredFragment blk -> String
    printLine :: forall blk.
HasHeader blk =>
(SlotNo -> String) -> AnchoredFragment blk -> String
printLine SlotNo -> String
printHeader AnchoredFragment blk
fragment =
      let firstSlot :: SlotNo
firstSlot = AnchoredFragment blk -> SlotNo
forall blk. AnchoredFragment blk -> SlotNo
firstNo AnchoredFragment blk
fragment
          lastSlot :: SlotNo
lastSlot = AnchoredFragment blk -> SlotNo
forall blk. HasHeader blk => AnchoredFragment blk -> SlotNo
lastNo AnchoredFragment blk
fragment
      in SlotNo -> String
printHeader SlotNo
firstSlot String -> ShowS
forall a. [a] -> [a] -> [a]
++ SlotNo -> SlotNo -> AnchoredFragment blk -> String
forall blk.
HasHeader blk =>
SlotNo -> SlotNo -> AnchoredFragment blk -> String
printFragment SlotNo
firstSlot SlotNo
lastSlot AnchoredFragment blk
fragment

    printFragment :: AF.HasHeader blk => SlotNo -> SlotNo -> AF.AnchoredFragment blk -> String
    printFragment :: forall blk.
HasHeader blk =>
SlotNo -> SlotNo -> AnchoredFragment blk -> String
printFragment SlotNo
firstSlot SlotNo
lastSlot AnchoredFragment blk
fragment =
      AnchoredFragment blk
fragment
        AnchoredFragment blk -> (AnchoredFragment blk -> [blk]) -> [blk]
forall a b. a -> (a -> b) -> b
& AnchoredFragment blk -> [blk]
forall v a b. AnchoredSeq v a b -> [b]
AF.toOldestFirst
        -- Turn the fragment into a list of (SlotNo, Just BlockNo)
        [blk] -> ([blk] -> [(Int, Maybe Word64)]) -> [(Int, Maybe Word64)]
forall a b. a -> (a -> b) -> b
& (blk -> (Int, Maybe Word64)) -> [blk] -> [(Int, Maybe Word64)]
forall a b. (a -> b) -> [a] -> [b]
map (\blk
block -> (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SlotNo -> Word64
unSlotNo (blk -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot blk
block) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- SlotNo -> Word64
unSlotNo SlotNo
firstSlot), Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (BlockNo -> Word64
unBlockNo (blk -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo blk
block))))
        -- Update only the Vector elements that have blocks in them
        [(Int, Maybe Word64)]
-> ([(Int, Maybe Word64)] -> [Maybe Word64]) -> [Maybe Word64]
forall a b. a -> (a -> b) -> b
& Vector (Maybe Word64) -> [Maybe Word64]
forall a. Vector a -> [a]
Vector.toList (Vector (Maybe Word64) -> [Maybe Word64])
-> ([(Int, Maybe Word64)] -> Vector (Maybe Word64))
-> [(Int, Maybe Word64)]
-> [Maybe Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (Maybe Word64)
forall {a}. Vector (Maybe a)
slotRange Vector (Maybe Word64)
-> [(Int, Maybe Word64)] -> Vector (Maybe Word64)
forall a. Vector a -> [(Int, a)] -> Vector a
Vector.//)
        [Maybe Word64] -> ([Maybe Word64] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& (Maybe Word64 -> String) -> [Maybe Word64] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> (Word64 -> String) -> Maybe Word64 -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"  " (String -> Word64 -> String
forall r. PrintfType r => String -> r
printf String
"%2d"))
        [String] -> ([String] -> String) -> String
forall a b. a -> (a -> b) -> b
& [String] -> String
unwords
        String -> ShowS -> String
forall a b. a -> (a -> b) -> b
& (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' then Char
'─' else Char
c)
      where
        -- Initialize a Vector with the length of the fragment containing only Nothings
        slotRange :: Vector (Maybe a)
slotRange = Int -> Maybe a -> Vector (Maybe a)
forall a. Int -> a -> Vector a
Vector.replicate (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SlotNo -> Word64
unSlotNo SlotNo
lastSlot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- SlotNo -> Word64
unSlotNo SlotNo
firstSlot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)) Maybe a
forall a. Maybe a
Nothing

    lastNo ::  AF.HasHeader blk => AF.AnchoredFragment blk -> SlotNo
    lastNo :: forall blk. HasHeader blk => AnchoredFragment blk -> SlotNo
lastNo = SlotNo -> WithOrigin SlotNo -> SlotNo
forall t. t -> WithOrigin t -> t
fromWithOrigin SlotNo
0 (WithOrigin SlotNo -> SlotNo)
-> (AnchoredFragment blk -> WithOrigin SlotNo)
-> AnchoredFragment blk
-> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment blk -> WithOrigin SlotNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin SlotNo
AF.headSlot

    firstNo :: AF.AnchoredFragment blk -> SlotNo
    firstNo :: forall blk. AnchoredFragment blk -> SlotNo
firstNo AnchoredFragment blk
frag =
      case AnchoredFragment blk -> Anchor blk
forall v a b. AnchoredSeq v a b -> a
AF.anchor AnchoredFragment blk
frag of
        Anchor blk
AF.AnchorGenesis     -> SlotNo
0
        AF.Anchor SlotNo
slotNo HeaderHash blk
_ BlockNo
_ -> SlotNo
slotNo SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ SlotNo
1