{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | Sequences of diffs for ledger tables.
--
--   These diff sequences are an instantiation of a strict finger tree with root
--   measures. The tree/sequence itself contains diffs and slot information, while
--   the root measure is the total sum of all diffs in the sequence. The internal
--   measure is used to keep track of sequence length and maximum slot numbers.
--
--   The diff datatype that we use forms a cancellative monoid, which allows for
--   relatively efficient splitting of finger trees with respect to recomputing
--   measures by means of subtracting diffs using the 'stripPrefix' and
--   'stripSuffix' functions that cancellative monoids provide. Namely, if either
--   the left or right part of the split is small in comparison with the input
--   sequence, then we can subtract the diffs in the smaller part from the root
--   measure of the input to (quickly) compute the root measure of the /other/
--   part of the split. This is much faster than computing the root measures from
--   scratch by doing a linear-time pass over the elements of the split parts, or
--   a logarithmic-time pass over intermediate sums of diffs in case we store
--   cumulative diffs in the nodes of the finger tree.
--
--   === Example of fast splits
--
--   As an analogy, consider this example: we have a sequence of consecutive
--   integer numbers @xs = [1..n]@ where @n@ is large, and we define the root
--   measure of the sequence to be the total sum of these numbers, @rmxs = sum
--   [1..n]@ (we assume @rmxs@ is fully evaluated). Say we split this sequence of
--   integer numbers at the index @2@, then we get /left/ and /right/ parts of the
--   split @ys@ and @zs@ respectively.
--
--   > splitAt 2 xs = (ys, zs) = ([1..2], [3..n])
--
--   How should we compute we the root measure @rmys@ of @ys@? Since @ys@ is
--   small, we can just compute @rmys = sum [1..2]@. How should we compute the
--   root measure @rmzs@ of @zs@? We should not compute @rmzs = sum [3..n]@ in
--   this case, since @n@ is large. Instead, we compute @rmzs = rmxs - rmys@,
--   which evaluates to its result in time that is linear in the length of @ys@,
--   in this case @O(1)@.
--
--   === Why not store sums of diffs in the internal measure instead of the root
--       measure?
--
--   We could also have used the interal measure of the strict finger tree to
--   store intermediate sums of diffs for all subtrees of the node. The subtree
--   rooted at the root of the tree would then store the total sum of diffs.
--   However, we would have now to recompute a possibly logarithmic number of sums
--   of diffs when we split or extend the sequence. Given that in @consensus@ we
--   use the total sum of diffs nearly as often as we split or extend the diff
--   sequence, this proved to be too costly. The single-instance root measure
--   reduces the overhead of this "caching" of intermediate sums of diffs by only
--   using a single total sum of diffs, though augmented with 'stripPrefix' and
--   'stripSuffix' operations to facilitate computing updated root measures.
--
--   === Root measures in practice
--
--   In consensus, we have the following access pattern. We perform @A@ then @B@ a
--   total of @n@ times, and then we perform @C(n)@ once. Repeat.
--
--   > A    = retrieve the total sum of diffs
--   > B    = snoc a diff to the sequence
--   > C(n) = split n diffs from the left of the sequence
--
--   In Cardano, @n == 100@ by default. That means we split roughly @2^7@ diffs
--   from a sequence of length roughly @2^11@. At first glance, it seems
--   counterintuitive that using a root measured finger tree would be quicker than
--   using a "normal" finger tree, because the former has a split function with a
--   linear cost. It needs to recompute the sum of @2^7@ diffs, instead of @7@
--   diffs if we were to use the normal finger tree split, which has logarithmic
--   complexity.
--
--   We wrote a benchmark that exercises the root measured finger tree and the
--   normal finger tree according to the described access pattern. It turned out
--   that the root measured fingertree was faster. If we look at the complexity of
--   these operations, then for a normal fingertree:
--
--   > A      = O(1)       amortised
--   > B      = O(1)       amortised
--   > C(100) = O(log 100) amortised
--
--   For a root measured fingertree:
--
--   > A      = O(1)   worst-case
--   > B      = O(1)   worst-case
--   > C(100) = O(100) worst-case
--
--   Complexity wise, the root measured finger tree looks worse, but in practice it
--   performs a bit better than the normal finger tree. It might mean there are
--   higher constants at play for the computational complexity of the normal finger
--   tree operations.
--
--   TODO: I wonder if is worth it to keep using the root measured finger tree. The
--   root measured finger tree sacrifices computational complexity for an algorithm
--   that works well in pratice for @n=100@; given that the flush frequency is
--   configurable, using a value other than @100@ might lead to worse performance
--   than if we were to use a normal finger tree.
module Ouroboros.Consensus.Storage.LedgerDB.V1.DiffSeq
  ( -- * Sequences of diffs
    DiffSeq (..)
  , Element (..)
  , InternalMeasure (..)
  , Length (..)
  , RootMeasure (..)
  , SlotNoLB (..)
  , SlotNoUB (..)

    -- * Short-hands for type-class constraints
  , SM

    -- * Queries
  , cumulativeDiff
  , length
  , numDeletes
  , numInserts

    -- * Construction
  , append
  , empty
  , extend

    -- * Slots
  , maxSlot
  , minSlot

    -- * Splitting
  , split
  , splitAt
  , splitAtFromEnd
  , splitAtSlot

    -- * Conversion
  , fromAntiDiff
  , toAntiDiff
  ) where

import qualified Cardano.Slotting.Slot as Slot
import qualified Control.Exception as Exn
import Data.Bifunctor (Bifunctor (bimap))
import Data.FingerTree.RootMeasured.Strict hiding (split)
import qualified Data.FingerTree.RootMeasured.Strict as RMFT (splitSized)
import qualified Data.Map.Diff.Strict.Internal as Anti
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict
import Data.Monoid (Sum (..))
import Data.Semigroup (Max (..), Min (..))
import Data.Semigroup.Cancellative
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import NoThunks.Class (NoThunks)
import qualified Ouroboros.Consensus.Ledger.Tables.Diff as Diff
import Ouroboros.Consensus.Util.Orphans ()
import Prelude hiding (length, splitAt)

{-------------------------------------------------------------------------------
  Sequences of diffs
-------------------------------------------------------------------------------}

-- | A sequence of key-value store differences.
--
-- INVARIANT: The slot numbers of consecutive elements should be strictly
-- increasing. Manipulating the underlying @'StrictFingerTree'@ directly may
-- break this invariant.
newtype DiffSeq k v
  = UnsafeDiffSeq
      ( StrictFingerTree
          (RootMeasure k v)
          (InternalMeasure k v)
          (Element k v)
      )
  deriving stock ((forall x. DiffSeq k v -> Rep (DiffSeq k v) x)
-> (forall x. Rep (DiffSeq k v) x -> DiffSeq k v)
-> Generic (DiffSeq k v)
forall x. Rep (DiffSeq k v) x -> DiffSeq k v
forall x. DiffSeq k v -> Rep (DiffSeq k v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k v x. Rep (DiffSeq k v) x -> DiffSeq k v
forall k v x. DiffSeq k v -> Rep (DiffSeq k v) x
$cfrom :: forall k v x. DiffSeq k v -> Rep (DiffSeq k v) x
from :: forall x. DiffSeq k v -> Rep (DiffSeq k v) x
$cto :: forall k v x. Rep (DiffSeq k v) x -> DiffSeq k v
to :: forall x. Rep (DiffSeq k v) x -> DiffSeq k v
Generic, Int -> DiffSeq k v -> ShowS
[DiffSeq k v] -> ShowS
DiffSeq k v -> String
(Int -> DiffSeq k v -> ShowS)
-> (DiffSeq k v -> String)
-> ([DiffSeq k v] -> ShowS)
-> Show (DiffSeq k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> DiffSeq k v -> ShowS
forall k v. (Show k, Show v) => [DiffSeq k v] -> ShowS
forall k v. (Show k, Show v) => DiffSeq k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> DiffSeq k v -> ShowS
showsPrec :: Int -> DiffSeq k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => DiffSeq k v -> String
show :: DiffSeq k v -> String
$cshowList :: forall k v. (Show k, Show v) => [DiffSeq k v] -> ShowS
showList :: [DiffSeq k v] -> ShowS
Show, DiffSeq k v -> DiffSeq k v -> Bool
(DiffSeq k v -> DiffSeq k v -> Bool)
-> (DiffSeq k v -> DiffSeq k v -> Bool) -> Eq (DiffSeq k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => DiffSeq k v -> DiffSeq k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => DiffSeq k v -> DiffSeq k v -> Bool
== :: DiffSeq k v -> DiffSeq k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => DiffSeq k v -> DiffSeq k v -> Bool
/= :: DiffSeq k v -> DiffSeq k v -> Bool
Eq)
  deriving anyclass Context -> DiffSeq k v -> IO (Maybe ThunkInfo)
Proxy (DiffSeq k v) -> String
(Context -> DiffSeq k v -> IO (Maybe ThunkInfo))
-> (Context -> DiffSeq k v -> IO (Maybe ThunkInfo))
-> (Proxy (DiffSeq k v) -> String)
-> NoThunks (DiffSeq k v)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall k v.
(NoThunks k, NoThunks v) =>
Context -> DiffSeq k v -> IO (Maybe ThunkInfo)
forall k v.
(NoThunks k, NoThunks v) =>
Proxy (DiffSeq k v) -> String
$cnoThunks :: forall k v.
(NoThunks k, NoThunks v) =>
Context -> DiffSeq k v -> IO (Maybe ThunkInfo)
noThunks :: Context -> DiffSeq k v -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall k v.
(NoThunks k, NoThunks v) =>
Context -> DiffSeq k v -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> DiffSeq k v -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall k v.
(NoThunks k, NoThunks v) =>
Proxy (DiffSeq k v) -> String
showTypeOf :: Proxy (DiffSeq k v) -> String
NoThunks

-- The @'SlotNo'@ is not included in the root measure, since it is not a
-- cancellative monoid.
data RootMeasure k v = RootMeasure
  { forall k v. RootMeasure k v -> Length
rmLength :: {-# UNPACK #-} !Length
  -- ^ Cumulative length
  , forall k v. RootMeasure k v -> Diff k v
rmDiff :: !(Anti.Diff k v)
  -- ^ Cumulative diff
  , forall k v. RootMeasure k v -> Sum Int
rmNumInserts :: !(Sum Int)
  -- ^ Cumulative number of inserts
  , forall k v. RootMeasure k v -> Sum Int
rmNumDeletes :: !(Sum Int)
  -- ^ Cumulative number of deletes
  }
  deriving stock ((forall x. RootMeasure k v -> Rep (RootMeasure k v) x)
-> (forall x. Rep (RootMeasure k v) x -> RootMeasure k v)
-> Generic (RootMeasure k v)
forall x. Rep (RootMeasure k v) x -> RootMeasure k v
forall x. RootMeasure k v -> Rep (RootMeasure k v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k v x. Rep (RootMeasure k v) x -> RootMeasure k v
forall k v x. RootMeasure k v -> Rep (RootMeasure k v) x
$cfrom :: forall k v x. RootMeasure k v -> Rep (RootMeasure k v) x
from :: forall x. RootMeasure k v -> Rep (RootMeasure k v) x
$cto :: forall k v x. Rep (RootMeasure k v) x -> RootMeasure k v
to :: forall x. Rep (RootMeasure k v) x -> RootMeasure k v
Generic, Int -> RootMeasure k v -> ShowS
[RootMeasure k v] -> ShowS
RootMeasure k v -> String
(Int -> RootMeasure k v -> ShowS)
-> (RootMeasure k v -> String)
-> ([RootMeasure k v] -> ShowS)
-> Show (RootMeasure k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> RootMeasure k v -> ShowS
forall k v. (Show k, Show v) => [RootMeasure k v] -> ShowS
forall k v. (Show k, Show v) => RootMeasure k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> RootMeasure k v -> ShowS
showsPrec :: Int -> RootMeasure k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => RootMeasure k v -> String
show :: RootMeasure k v -> String
$cshowList :: forall k v. (Show k, Show v) => [RootMeasure k v] -> ShowS
showList :: [RootMeasure k v] -> ShowS
Show, RootMeasure k v -> RootMeasure k v -> Bool
(RootMeasure k v -> RootMeasure k v -> Bool)
-> (RootMeasure k v -> RootMeasure k v -> Bool)
-> Eq (RootMeasure k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v.
(Eq k, Eq v) =>
RootMeasure k v -> RootMeasure k v -> Bool
$c== :: forall k v.
(Eq k, Eq v) =>
RootMeasure k v -> RootMeasure k v -> Bool
== :: RootMeasure k v -> RootMeasure k v -> Bool
$c/= :: forall k v.
(Eq k, Eq v) =>
RootMeasure k v -> RootMeasure k v -> Bool
/= :: RootMeasure k v -> RootMeasure k v -> Bool
Eq, (forall a b. (a -> b) -> RootMeasure k a -> RootMeasure k b)
-> (forall a b. a -> RootMeasure k b -> RootMeasure k a)
-> Functor (RootMeasure k)
forall a b. a -> RootMeasure k b -> RootMeasure k a
forall a b. (a -> b) -> RootMeasure k a -> RootMeasure k b
forall k a b. a -> RootMeasure k b -> RootMeasure k a
forall k a b. (a -> b) -> RootMeasure k a -> RootMeasure k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k a b. (a -> b) -> RootMeasure k a -> RootMeasure k b
fmap :: forall a b. (a -> b) -> RootMeasure k a -> RootMeasure k b
$c<$ :: forall k a b. a -> RootMeasure k b -> RootMeasure k a
<$ :: forall a b. a -> RootMeasure k b -> RootMeasure k a
Functor)
  deriving anyclass Context -> RootMeasure k v -> IO (Maybe ThunkInfo)
Proxy (RootMeasure k v) -> String
(Context -> RootMeasure k v -> IO (Maybe ThunkInfo))
-> (Context -> RootMeasure k v -> IO (Maybe ThunkInfo))
-> (Proxy (RootMeasure k v) -> String)
-> NoThunks (RootMeasure k v)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall k v.
(NoThunks k, NoThunks v) =>
Context -> RootMeasure k v -> IO (Maybe ThunkInfo)
forall k v.
(NoThunks k, NoThunks v) =>
Proxy (RootMeasure k v) -> String
$cnoThunks :: forall k v.
(NoThunks k, NoThunks v) =>
Context -> RootMeasure k v -> IO (Maybe ThunkInfo)
noThunks :: Context -> RootMeasure k v -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall k v.
(NoThunks k, NoThunks v) =>
Context -> RootMeasure k v -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> RootMeasure k v -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall k v.
(NoThunks k, NoThunks v) =>
Proxy (RootMeasure k v) -> String
showTypeOf :: Proxy (RootMeasure k v) -> String
NoThunks

data InternalMeasure k v = InternalMeasure
  { forall k v. InternalMeasure k v -> Length
imLength :: {-# UNPACK #-} !Length
  -- ^ Cumulative length
  , forall k v. InternalMeasure k v -> StrictMaybe SlotNoLB
imSlotNoL :: !(StrictMaybe SlotNoLB)
  -- ^ Leftmost slot number (or lower bound)
  --
  -- Empty diff sequences have no rightmost slot number, so in that case
  -- @imSlotNo == Nothing@.
  , forall k v. InternalMeasure k v -> StrictMaybe SlotNoUB
imSlotNoR :: !(StrictMaybe SlotNoUB)
  -- ^ Rightmost slot number (or upper bound)
  --
  -- Empty diff sequences have no leftmost slot number, so in that case
  -- @imSlotNo == Nothing@.
  }
  deriving stock ((forall x. InternalMeasure k v -> Rep (InternalMeasure k v) x)
-> (forall x. Rep (InternalMeasure k v) x -> InternalMeasure k v)
-> Generic (InternalMeasure k v)
forall x. Rep (InternalMeasure k v) x -> InternalMeasure k v
forall x. InternalMeasure k v -> Rep (InternalMeasure k v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k v x. Rep (InternalMeasure k v) x -> InternalMeasure k v
forall k v x. InternalMeasure k v -> Rep (InternalMeasure k v) x
$cfrom :: forall k v x. InternalMeasure k v -> Rep (InternalMeasure k v) x
from :: forall x. InternalMeasure k v -> Rep (InternalMeasure k v) x
$cto :: forall k v x. Rep (InternalMeasure k v) x -> InternalMeasure k v
to :: forall x. Rep (InternalMeasure k v) x -> InternalMeasure k v
Generic, Int -> InternalMeasure k v -> ShowS
[InternalMeasure k v] -> ShowS
InternalMeasure k v -> String
(Int -> InternalMeasure k v -> ShowS)
-> (InternalMeasure k v -> String)
-> ([InternalMeasure k v] -> ShowS)
-> Show (InternalMeasure k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. Int -> InternalMeasure k v -> ShowS
forall k v. [InternalMeasure k v] -> ShowS
forall k v. InternalMeasure k v -> String
$cshowsPrec :: forall k v. Int -> InternalMeasure k v -> ShowS
showsPrec :: Int -> InternalMeasure k v -> ShowS
$cshow :: forall k v. InternalMeasure k v -> String
show :: InternalMeasure k v -> String
$cshowList :: forall k v. [InternalMeasure k v] -> ShowS
showList :: [InternalMeasure k v] -> ShowS
Show, InternalMeasure k v -> InternalMeasure k v -> Bool
(InternalMeasure k v -> InternalMeasure k v -> Bool)
-> (InternalMeasure k v -> InternalMeasure k v -> Bool)
-> Eq (InternalMeasure k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. InternalMeasure k v -> InternalMeasure k v -> Bool
$c== :: forall k v. InternalMeasure k v -> InternalMeasure k v -> Bool
== :: InternalMeasure k v -> InternalMeasure k v -> Bool
$c/= :: forall k v. InternalMeasure k v -> InternalMeasure k v -> Bool
/= :: InternalMeasure k v -> InternalMeasure k v -> Bool
Eq, (forall a b.
 (a -> b) -> InternalMeasure k a -> InternalMeasure k b)
-> (forall a b. a -> InternalMeasure k b -> InternalMeasure k a)
-> Functor (InternalMeasure k)
forall a b. a -> InternalMeasure k b -> InternalMeasure k a
forall a b. (a -> b) -> InternalMeasure k a -> InternalMeasure k b
forall k a b. a -> InternalMeasure k b -> InternalMeasure k a
forall k a b.
(a -> b) -> InternalMeasure k a -> InternalMeasure k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k a b.
(a -> b) -> InternalMeasure k a -> InternalMeasure k b
fmap :: forall a b. (a -> b) -> InternalMeasure k a -> InternalMeasure k b
$c<$ :: forall k a b. a -> InternalMeasure k b -> InternalMeasure k a
<$ :: forall a b. a -> InternalMeasure k b -> InternalMeasure k a
Functor)
  deriving anyclass Context -> InternalMeasure k v -> IO (Maybe ThunkInfo)
Proxy (InternalMeasure k v) -> String
(Context -> InternalMeasure k v -> IO (Maybe ThunkInfo))
-> (Context -> InternalMeasure k v -> IO (Maybe ThunkInfo))
-> (Proxy (InternalMeasure k v) -> String)
-> NoThunks (InternalMeasure k v)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall k v. Context -> InternalMeasure k v -> IO (Maybe ThunkInfo)
forall k v. Proxy (InternalMeasure k v) -> String
$cnoThunks :: forall k v. Context -> InternalMeasure k v -> IO (Maybe ThunkInfo)
noThunks :: Context -> InternalMeasure k v -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall k v. Context -> InternalMeasure k v -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> InternalMeasure k v -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall k v. Proxy (InternalMeasure k v) -> String
showTypeOf :: Proxy (InternalMeasure k v) -> String
NoThunks

data Element k v = Element
  { forall k v. Element k v -> SlotNo
elSlotNo :: {-# UNPACK #-} !Slot.SlotNo
  , forall k v. Element k v -> Diff k v
elDiff :: !(Anti.Diff k v)
  }
  deriving stock ((forall x. Element k v -> Rep (Element k v) x)
-> (forall x. Rep (Element k v) x -> Element k v)
-> Generic (Element k v)
forall x. Rep (Element k v) x -> Element k v
forall x. Element k v -> Rep (Element k v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k v x. Rep (Element k v) x -> Element k v
forall k v x. Element k v -> Rep (Element k v) x
$cfrom :: forall k v x. Element k v -> Rep (Element k v) x
from :: forall x. Element k v -> Rep (Element k v) x
$cto :: forall k v x. Rep (Element k v) x -> Element k v
to :: forall x. Rep (Element k v) x -> Element k v
Generic, Int -> Element k v -> ShowS
[Element k v] -> ShowS
Element k v -> String
(Int -> Element k v -> ShowS)
-> (Element k v -> String)
-> ([Element k v] -> ShowS)
-> Show (Element k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> Element k v -> ShowS
forall k v. (Show k, Show v) => [Element k v] -> ShowS
forall k v. (Show k, Show v) => Element k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> Element k v -> ShowS
showsPrec :: Int -> Element k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => Element k v -> String
show :: Element k v -> String
$cshowList :: forall k v. (Show k, Show v) => [Element k v] -> ShowS
showList :: [Element k v] -> ShowS
Show, Element k v -> Element k v -> Bool
(Element k v -> Element k v -> Bool)
-> (Element k v -> Element k v -> Bool) -> Eq (Element k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => Element k v -> Element k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => Element k v -> Element k v -> Bool
== :: Element k v -> Element k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => Element k v -> Element k v -> Bool
/= :: Element k v -> Element k v -> Bool
Eq, (forall a b. (a -> b) -> Element k a -> Element k b)
-> (forall a b. a -> Element k b -> Element k a)
-> Functor (Element k)
forall a b. a -> Element k b -> Element k a
forall a b. (a -> b) -> Element k a -> Element k b
forall k a b. a -> Element k b -> Element k a
forall k a b. (a -> b) -> Element k a -> Element k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k a b. (a -> b) -> Element k a -> Element k b
fmap :: forall a b. (a -> b) -> Element k a -> Element k b
$c<$ :: forall k a b. a -> Element k b -> Element k a
<$ :: forall a b. a -> Element k b -> Element k a
Functor)
  deriving anyclass Context -> Element k v -> IO (Maybe ThunkInfo)
Proxy (Element k v) -> String
(Context -> Element k v -> IO (Maybe ThunkInfo))
-> (Context -> Element k v -> IO (Maybe ThunkInfo))
-> (Proxy (Element k v) -> String)
-> NoThunks (Element k v)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall k v.
(NoThunks k, NoThunks v) =>
Context -> Element k v -> IO (Maybe ThunkInfo)
forall k v.
(NoThunks k, NoThunks v) =>
Proxy (Element k v) -> String
$cnoThunks :: forall k v.
(NoThunks k, NoThunks v) =>
Context -> Element k v -> IO (Maybe ThunkInfo)
noThunks :: Context -> Element k v -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall k v.
(NoThunks k, NoThunks v) =>
Context -> Element k v -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Element k v -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall k v.
(NoThunks k, NoThunks v) =>
Proxy (Element k v) -> String
showTypeOf :: Proxy (Element k v) -> String
NoThunks

-- | Length of a sequence of differences.
newtype Length = Length {Length -> Int
unLength :: Int}
  deriving stock ((forall x. Length -> Rep Length x)
-> (forall x. Rep Length x -> Length) -> Generic Length
forall x. Rep Length x -> Length
forall x. Length -> Rep Length x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Length -> Rep Length x
from :: forall x. Length -> Rep Length x
$cto :: forall x. Rep Length x -> Length
to :: forall x. Rep Length x -> Length
Generic, Int -> Length -> ShowS
[Length] -> ShowS
Length -> String
(Int -> Length -> ShowS)
-> (Length -> String) -> ([Length] -> ShowS) -> Show Length
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Length -> ShowS
showsPrec :: Int -> Length -> ShowS
$cshow :: Length -> String
show :: Length -> String
$cshowList :: [Length] -> ShowS
showList :: [Length] -> ShowS
Show, Length -> Length -> Bool
(Length -> Length -> Bool)
-> (Length -> Length -> Bool) -> Eq Length
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Length -> Length -> Bool
== :: Length -> Length -> Bool
$c/= :: Length -> Length -> Bool
/= :: Length -> Length -> Bool
Eq, Eq Length
Eq Length =>
(Length -> Length -> Ordering)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Length)
-> (Length -> Length -> Length)
-> Ord Length
Length -> Length -> Bool
Length -> Length -> Ordering
Length -> Length -> Length
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
$ccompare :: Length -> Length -> Ordering
compare :: Length -> Length -> Ordering
$c< :: Length -> Length -> Bool
< :: Length -> Length -> Bool
$c<= :: Length -> Length -> Bool
<= :: Length -> Length -> Bool
$c> :: Length -> Length -> Bool
> :: Length -> Length -> Bool
$c>= :: Length -> Length -> Bool
>= :: Length -> Length -> Bool
$cmax :: Length -> Length -> Length
max :: Length -> Length -> Length
$cmin :: Length -> Length -> Length
min :: Length -> Length -> Length
Ord)
  deriving newtype Integer -> Length
Length -> Length
Length -> Length -> Length
(Length -> Length -> Length)
-> (Length -> Length -> Length)
-> (Length -> Length -> Length)
-> (Length -> Length)
-> (Length -> Length)
-> (Length -> Length)
-> (Integer -> Length)
-> Num Length
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Length -> Length -> Length
+ :: Length -> Length -> Length
$c- :: Length -> Length -> Length
- :: Length -> Length -> Length
$c* :: Length -> Length -> Length
* :: Length -> Length -> Length
$cnegate :: Length -> Length
negate :: Length -> Length
$cabs :: Length -> Length
abs :: Length -> Length
$csignum :: Length -> Length
signum :: Length -> Length
$cfromInteger :: Integer -> Length
fromInteger :: Integer -> Length
Num
  deriving anyclass Context -> Length -> IO (Maybe ThunkInfo)
Proxy Length -> String
(Context -> Length -> IO (Maybe ThunkInfo))
-> (Context -> Length -> IO (Maybe ThunkInfo))
-> (Proxy Length -> String)
-> NoThunks Length
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Length -> IO (Maybe ThunkInfo)
noThunks :: Context -> Length -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Length -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Length -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Length -> String
showTypeOf :: Proxy Length -> String
NoThunks
  deriving NonEmpty Length -> Length
Length -> Length -> Length
(Length -> Length -> Length)
-> (NonEmpty Length -> Length)
-> (forall b. Integral b => b -> Length -> Length)
-> Semigroup Length
forall b. Integral b => b -> Length -> Length
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Length -> Length -> Length
<> :: Length -> Length -> Length
$csconcat :: NonEmpty Length -> Length
sconcat :: NonEmpty Length -> Length
$cstimes :: forall b. Integral b => b -> Length -> Length
stimes :: forall b. Integral b => b -> Length -> Length
Semigroup via Sum Int
  deriving Semigroup Length
Length
Semigroup Length =>
Length
-> (Length -> Length -> Length)
-> ([Length] -> Length)
-> Monoid Length
[Length] -> Length
Length -> Length -> Length
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Length
mempty :: Length
$cmappend :: Length -> Length -> Length
mappend :: Length -> Length -> Length
$cmconcat :: [Length] -> Length
mconcat :: [Length] -> Length
Monoid via Sum Int
  deriving (Semigroup Length
Semigroup Length =>
(Length -> Length -> Bool)
-> (Length -> Length -> Maybe Length) -> LeftReductive Length
Length -> Length -> Bool
Length -> Length -> Maybe Length
forall m.
Semigroup m =>
(m -> m -> Bool) -> (m -> m -> Maybe m) -> LeftReductive m
$cisPrefixOf :: Length -> Length -> Bool
isPrefixOf :: Length -> Length -> Bool
$cstripPrefix :: Length -> Length -> Maybe Length
stripPrefix :: Length -> Length -> Maybe Length
LeftReductive, Semigroup Length
Semigroup Length =>
(Length -> Length -> Bool)
-> (Length -> Length -> Maybe Length) -> RightReductive Length
Length -> Length -> Bool
Length -> Length -> Maybe Length
forall m.
Semigroup m =>
(m -> m -> Bool) -> (m -> m -> Maybe m) -> RightReductive m
$cisSuffixOf :: Length -> Length -> Bool
isSuffixOf :: Length -> Length -> Bool
$cstripSuffix :: Length -> Length -> Maybe Length
stripSuffix :: Length -> Length -> Maybe Length
RightReductive) via Sum Int
  deriving (LeftReductive Length
LeftReductive Length => LeftCancellative Length
forall m. LeftReductive m => LeftCancellative m
LeftCancellative, RightReductive Length
RightReductive Length => RightCancellative Length
forall m. RightReductive m => RightCancellative m
RightCancellative) via Sum Int

-- | An upper bound on slot numbers.
newtype SlotNoUB = SlotNoUB {SlotNoUB -> SlotNo
unSlotNoUB :: Slot.SlotNo}
  deriving stock ((forall x. SlotNoUB -> Rep SlotNoUB x)
-> (forall x. Rep SlotNoUB x -> SlotNoUB) -> Generic SlotNoUB
forall x. Rep SlotNoUB x -> SlotNoUB
forall x. SlotNoUB -> Rep SlotNoUB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SlotNoUB -> Rep SlotNoUB x
from :: forall x. SlotNoUB -> Rep SlotNoUB x
$cto :: forall x. Rep SlotNoUB x -> SlotNoUB
to :: forall x. Rep SlotNoUB x -> SlotNoUB
Generic, Int -> SlotNoUB -> ShowS
[SlotNoUB] -> ShowS
SlotNoUB -> String
(Int -> SlotNoUB -> ShowS)
-> (SlotNoUB -> String) -> ([SlotNoUB] -> ShowS) -> Show SlotNoUB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlotNoUB -> ShowS
showsPrec :: Int -> SlotNoUB -> ShowS
$cshow :: SlotNoUB -> String
show :: SlotNoUB -> String
$cshowList :: [SlotNoUB] -> ShowS
showList :: [SlotNoUB] -> ShowS
Show, SlotNoUB -> SlotNoUB -> Bool
(SlotNoUB -> SlotNoUB -> Bool)
-> (SlotNoUB -> SlotNoUB -> Bool) -> Eq SlotNoUB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SlotNoUB -> SlotNoUB -> Bool
== :: SlotNoUB -> SlotNoUB -> Bool
$c/= :: SlotNoUB -> SlotNoUB -> Bool
/= :: SlotNoUB -> SlotNoUB -> Bool
Eq, Eq SlotNoUB
Eq SlotNoUB =>
(SlotNoUB -> SlotNoUB -> Ordering)
-> (SlotNoUB -> SlotNoUB -> Bool)
-> (SlotNoUB -> SlotNoUB -> Bool)
-> (SlotNoUB -> SlotNoUB -> Bool)
-> (SlotNoUB -> SlotNoUB -> Bool)
-> (SlotNoUB -> SlotNoUB -> SlotNoUB)
-> (SlotNoUB -> SlotNoUB -> SlotNoUB)
-> Ord SlotNoUB
SlotNoUB -> SlotNoUB -> Bool
SlotNoUB -> SlotNoUB -> Ordering
SlotNoUB -> SlotNoUB -> SlotNoUB
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
$ccompare :: SlotNoUB -> SlotNoUB -> Ordering
compare :: SlotNoUB -> SlotNoUB -> Ordering
$c< :: SlotNoUB -> SlotNoUB -> Bool
< :: SlotNoUB -> SlotNoUB -> Bool
$c<= :: SlotNoUB -> SlotNoUB -> Bool
<= :: SlotNoUB -> SlotNoUB -> Bool
$c> :: SlotNoUB -> SlotNoUB -> Bool
> :: SlotNoUB -> SlotNoUB -> Bool
$c>= :: SlotNoUB -> SlotNoUB -> Bool
>= :: SlotNoUB -> SlotNoUB -> Bool
$cmax :: SlotNoUB -> SlotNoUB -> SlotNoUB
max :: SlotNoUB -> SlotNoUB -> SlotNoUB
$cmin :: SlotNoUB -> SlotNoUB -> SlotNoUB
min :: SlotNoUB -> SlotNoUB -> SlotNoUB
Ord)
  deriving newtype Integer -> SlotNoUB
SlotNoUB -> SlotNoUB
SlotNoUB -> SlotNoUB -> SlotNoUB
(SlotNoUB -> SlotNoUB -> SlotNoUB)
-> (SlotNoUB -> SlotNoUB -> SlotNoUB)
-> (SlotNoUB -> SlotNoUB -> SlotNoUB)
-> (SlotNoUB -> SlotNoUB)
-> (SlotNoUB -> SlotNoUB)
-> (SlotNoUB -> SlotNoUB)
-> (Integer -> SlotNoUB)
-> Num SlotNoUB
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: SlotNoUB -> SlotNoUB -> SlotNoUB
+ :: SlotNoUB -> SlotNoUB -> SlotNoUB
$c- :: SlotNoUB -> SlotNoUB -> SlotNoUB
- :: SlotNoUB -> SlotNoUB -> SlotNoUB
$c* :: SlotNoUB -> SlotNoUB -> SlotNoUB
* :: SlotNoUB -> SlotNoUB -> SlotNoUB
$cnegate :: SlotNoUB -> SlotNoUB
negate :: SlotNoUB -> SlotNoUB
$cabs :: SlotNoUB -> SlotNoUB
abs :: SlotNoUB -> SlotNoUB
$csignum :: SlotNoUB -> SlotNoUB
signum :: SlotNoUB -> SlotNoUB
$cfromInteger :: Integer -> SlotNoUB
fromInteger :: Integer -> SlotNoUB
Num
  deriving anyclass Context -> SlotNoUB -> IO (Maybe ThunkInfo)
Proxy SlotNoUB -> String
(Context -> SlotNoUB -> IO (Maybe ThunkInfo))
-> (Context -> SlotNoUB -> IO (Maybe ThunkInfo))
-> (Proxy SlotNoUB -> String)
-> NoThunks SlotNoUB
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SlotNoUB -> IO (Maybe ThunkInfo)
noThunks :: Context -> SlotNoUB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SlotNoUB -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SlotNoUB -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SlotNoUB -> String
showTypeOf :: Proxy SlotNoUB -> String
NoThunks
  deriving NonEmpty SlotNoUB -> SlotNoUB
SlotNoUB -> SlotNoUB -> SlotNoUB
(SlotNoUB -> SlotNoUB -> SlotNoUB)
-> (NonEmpty SlotNoUB -> SlotNoUB)
-> (forall b. Integral b => b -> SlotNoUB -> SlotNoUB)
-> Semigroup SlotNoUB
forall b. Integral b => b -> SlotNoUB -> SlotNoUB
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SlotNoUB -> SlotNoUB -> SlotNoUB
<> :: SlotNoUB -> SlotNoUB -> SlotNoUB
$csconcat :: NonEmpty SlotNoUB -> SlotNoUB
sconcat :: NonEmpty SlotNoUB -> SlotNoUB
$cstimes :: forall b. Integral b => b -> SlotNoUB -> SlotNoUB
stimes :: forall b. Integral b => b -> SlotNoUB -> SlotNoUB
Semigroup via Max Slot.SlotNo
  deriving Semigroup SlotNoUB
SlotNoUB
Semigroup SlotNoUB =>
SlotNoUB
-> (SlotNoUB -> SlotNoUB -> SlotNoUB)
-> ([SlotNoUB] -> SlotNoUB)
-> Monoid SlotNoUB
[SlotNoUB] -> SlotNoUB
SlotNoUB -> SlotNoUB -> SlotNoUB
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SlotNoUB
mempty :: SlotNoUB
$cmappend :: SlotNoUB -> SlotNoUB -> SlotNoUB
mappend :: SlotNoUB -> SlotNoUB -> SlotNoUB
$cmconcat :: [SlotNoUB] -> SlotNoUB
mconcat :: [SlotNoUB] -> SlotNoUB
Monoid via Max Slot.SlotNo

-- | A lower bound on slot numbers.
newtype SlotNoLB = SlotNoLB {SlotNoLB -> SlotNo
unSlotNoLB :: Slot.SlotNo}
  deriving stock ((forall x. SlotNoLB -> Rep SlotNoLB x)
-> (forall x. Rep SlotNoLB x -> SlotNoLB) -> Generic SlotNoLB
forall x. Rep SlotNoLB x -> SlotNoLB
forall x. SlotNoLB -> Rep SlotNoLB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SlotNoLB -> Rep SlotNoLB x
from :: forall x. SlotNoLB -> Rep SlotNoLB x
$cto :: forall x. Rep SlotNoLB x -> SlotNoLB
to :: forall x. Rep SlotNoLB x -> SlotNoLB
Generic, Int -> SlotNoLB -> ShowS
[SlotNoLB] -> ShowS
SlotNoLB -> String
(Int -> SlotNoLB -> ShowS)
-> (SlotNoLB -> String) -> ([SlotNoLB] -> ShowS) -> Show SlotNoLB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlotNoLB -> ShowS
showsPrec :: Int -> SlotNoLB -> ShowS
$cshow :: SlotNoLB -> String
show :: SlotNoLB -> String
$cshowList :: [SlotNoLB] -> ShowS
showList :: [SlotNoLB] -> ShowS
Show, SlotNoLB -> SlotNoLB -> Bool
(SlotNoLB -> SlotNoLB -> Bool)
-> (SlotNoLB -> SlotNoLB -> Bool) -> Eq SlotNoLB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SlotNoLB -> SlotNoLB -> Bool
== :: SlotNoLB -> SlotNoLB -> Bool
$c/= :: SlotNoLB -> SlotNoLB -> Bool
/= :: SlotNoLB -> SlotNoLB -> Bool
Eq, Eq SlotNoLB
Eq SlotNoLB =>
(SlotNoLB -> SlotNoLB -> Ordering)
-> (SlotNoLB -> SlotNoLB -> Bool)
-> (SlotNoLB -> SlotNoLB -> Bool)
-> (SlotNoLB -> SlotNoLB -> Bool)
-> (SlotNoLB -> SlotNoLB -> Bool)
-> (SlotNoLB -> SlotNoLB -> SlotNoLB)
-> (SlotNoLB -> SlotNoLB -> SlotNoLB)
-> Ord SlotNoLB
SlotNoLB -> SlotNoLB -> Bool
SlotNoLB -> SlotNoLB -> Ordering
SlotNoLB -> SlotNoLB -> SlotNoLB
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
$ccompare :: SlotNoLB -> SlotNoLB -> Ordering
compare :: SlotNoLB -> SlotNoLB -> Ordering
$c< :: SlotNoLB -> SlotNoLB -> Bool
< :: SlotNoLB -> SlotNoLB -> Bool
$c<= :: SlotNoLB -> SlotNoLB -> Bool
<= :: SlotNoLB -> SlotNoLB -> Bool
$c> :: SlotNoLB -> SlotNoLB -> Bool
> :: SlotNoLB -> SlotNoLB -> Bool
$c>= :: SlotNoLB -> SlotNoLB -> Bool
>= :: SlotNoLB -> SlotNoLB -> Bool
$cmax :: SlotNoLB -> SlotNoLB -> SlotNoLB
max :: SlotNoLB -> SlotNoLB -> SlotNoLB
$cmin :: SlotNoLB -> SlotNoLB -> SlotNoLB
min :: SlotNoLB -> SlotNoLB -> SlotNoLB
Ord)
  deriving newtype Integer -> SlotNoLB
SlotNoLB -> SlotNoLB
SlotNoLB -> SlotNoLB -> SlotNoLB
(SlotNoLB -> SlotNoLB -> SlotNoLB)
-> (SlotNoLB -> SlotNoLB -> SlotNoLB)
-> (SlotNoLB -> SlotNoLB -> SlotNoLB)
-> (SlotNoLB -> SlotNoLB)
-> (SlotNoLB -> SlotNoLB)
-> (SlotNoLB -> SlotNoLB)
-> (Integer -> SlotNoLB)
-> Num SlotNoLB
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: SlotNoLB -> SlotNoLB -> SlotNoLB
+ :: SlotNoLB -> SlotNoLB -> SlotNoLB
$c- :: SlotNoLB -> SlotNoLB -> SlotNoLB
- :: SlotNoLB -> SlotNoLB -> SlotNoLB
$c* :: SlotNoLB -> SlotNoLB -> SlotNoLB
* :: SlotNoLB -> SlotNoLB -> SlotNoLB
$cnegate :: SlotNoLB -> SlotNoLB
negate :: SlotNoLB -> SlotNoLB
$cabs :: SlotNoLB -> SlotNoLB
abs :: SlotNoLB -> SlotNoLB
$csignum :: SlotNoLB -> SlotNoLB
signum :: SlotNoLB -> SlotNoLB
$cfromInteger :: Integer -> SlotNoLB
fromInteger :: Integer -> SlotNoLB
Num
  deriving anyclass Context -> SlotNoLB -> IO (Maybe ThunkInfo)
Proxy SlotNoLB -> String
(Context -> SlotNoLB -> IO (Maybe ThunkInfo))
-> (Context -> SlotNoLB -> IO (Maybe ThunkInfo))
-> (Proxy SlotNoLB -> String)
-> NoThunks SlotNoLB
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SlotNoLB -> IO (Maybe ThunkInfo)
noThunks :: Context -> SlotNoLB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SlotNoLB -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SlotNoLB -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SlotNoLB -> String
showTypeOf :: Proxy SlotNoLB -> String
NoThunks
  deriving NonEmpty SlotNoLB -> SlotNoLB
SlotNoLB -> SlotNoLB -> SlotNoLB
(SlotNoLB -> SlotNoLB -> SlotNoLB)
-> (NonEmpty SlotNoLB -> SlotNoLB)
-> (forall b. Integral b => b -> SlotNoLB -> SlotNoLB)
-> Semigroup SlotNoLB
forall b. Integral b => b -> SlotNoLB -> SlotNoLB
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SlotNoLB -> SlotNoLB -> SlotNoLB
<> :: SlotNoLB -> SlotNoLB -> SlotNoLB
$csconcat :: NonEmpty SlotNoLB -> SlotNoLB
sconcat :: NonEmpty SlotNoLB -> SlotNoLB
$cstimes :: forall b. Integral b => b -> SlotNoLB -> SlotNoLB
stimes :: forall b. Integral b => b -> SlotNoLB -> SlotNoLB
Semigroup via Min Slot.SlotNo
  deriving Semigroup SlotNoLB
SlotNoLB
Semigroup SlotNoLB =>
SlotNoLB
-> (SlotNoLB -> SlotNoLB -> SlotNoLB)
-> ([SlotNoLB] -> SlotNoLB)
-> Monoid SlotNoLB
[SlotNoLB] -> SlotNoLB
SlotNoLB -> SlotNoLB -> SlotNoLB
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: SlotNoLB
mempty :: SlotNoLB
$cmappend :: SlotNoLB -> SlotNoLB -> SlotNoLB
mappend :: SlotNoLB -> SlotNoLB -> SlotNoLB
$cmconcat :: [SlotNoLB] -> SlotNoLB
mconcat :: [SlotNoLB] -> SlotNoLB
Monoid via Min Slot.SlotNo

-- TODO: once EBBs are removed, this can be a strict inequality.
noSlotBoundsIntersect :: SlotNoUB -> SlotNoLB -> Bool
noSlotBoundsIntersect :: SlotNoUB -> SlotNoLB -> Bool
noSlotBoundsIntersect (SlotNoUB SlotNo
sl1) (SlotNoLB SlotNo
sl2) = SlotNo
sl1 SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
sl2

{-------------------------------------------------------------------------------
  Root measuring
-------------------------------------------------------------------------------}

instance (Ord k, Eq v) => RootMeasured (RootMeasure k v) (Element k v) where
  measureRoot :: Element k v -> RootMeasure k v
measureRoot (Element SlotNo
_ Diff k v
d) =
    Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v
forall k v.
Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v
RootMeasure Length
1 Diff k v
d (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> Int -> Sum Int
forall a b. (a -> b) -> a -> b
$ Diff k v -> Int
forall k v. Diff k v -> Int
Anti.numInserts Diff k v
d) (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> Int -> Sum Int
forall a b. (a -> b) -> a -> b
$ Diff k v -> Int
forall k v. Diff k v -> Int
Anti.numDeletes Diff k v
d)

instance (Ord k, Eq v) => Semigroup (RootMeasure k v) where
  RootMeasure Length
len1 Diff k v
d1 Sum Int
n1 Sum Int
m1 <> :: RootMeasure k v -> RootMeasure k v -> RootMeasure k v
<> RootMeasure Length
len2 Diff k v
d2 Sum Int
n2 Sum Int
m2 =
    Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v
forall k v.
Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v
RootMeasure (Length
len1 Length -> Length -> Length
forall a. Semigroup a => a -> a -> a
<> Length
len2) (Diff k v
d1 Diff k v -> Diff k v -> Diff k v
forall a. Semigroup a => a -> a -> a
<> Diff k v
d2) (Sum Int
n1 Sum Int -> Sum Int -> Sum Int
forall a. Semigroup a => a -> a -> a
<> Sum Int
n2) (Sum Int
m1 Sum Int -> Sum Int -> Sum Int
forall a. Semigroup a => a -> a -> a
<> Sum Int
m2)

instance (Ord k, Eq v) => Monoid (RootMeasure k v) where
  mempty :: RootMeasure k v
mempty = Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v
forall k v.
Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v
RootMeasure Length
forall a. Monoid a => a
mempty Diff k v
forall a. Monoid a => a
mempty Sum Int
forall a. Monoid a => a
mempty Sum Int
forall a. Monoid a => a
mempty

instance (Ord k, Eq v) => LeftReductive (RootMeasure k v) where
  stripPrefix :: RootMeasure k v -> RootMeasure k v -> Maybe (RootMeasure k v)
stripPrefix (RootMeasure Length
len1 Diff k v
d1 Sum Int
n1 Sum Int
m1) (RootMeasure Length
len2 Diff k v
d2 Sum Int
n2 Sum Int
m2) =
    Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v
forall k v.
Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v
RootMeasure
      (Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v)
-> Maybe Length
-> Maybe (Diff k v -> Sum Int -> Sum Int -> RootMeasure k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Length -> Length -> Maybe Length
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix Length
len1 Length
len2
      Maybe (Diff k v -> Sum Int -> Sum Int -> RootMeasure k v)
-> Maybe (Diff k v)
-> Maybe (Sum Int -> Sum Int -> RootMeasure k v)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Diff k v -> Diff k v -> Maybe (Diff k v)
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix Diff k v
d1 Diff k v
d2
      Maybe (Sum Int -> Sum Int -> RootMeasure k v)
-> Maybe (Sum Int) -> Maybe (Sum Int -> RootMeasure k v)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sum Int -> Sum Int -> Maybe (Sum Int)
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix Sum Int
n1 Sum Int
n2
      Maybe (Sum Int -> RootMeasure k v)
-> Maybe (Sum Int) -> Maybe (RootMeasure k v)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sum Int -> Sum Int -> Maybe (Sum Int)
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix Sum Int
m1 Sum Int
m2

instance (Ord k, Eq v) => RightReductive (RootMeasure k v) where
  stripSuffix :: RootMeasure k v -> RootMeasure k v -> Maybe (RootMeasure k v)
stripSuffix (RootMeasure Length
len1 Diff k v
d1 Sum Int
n1 Sum Int
m1) (RootMeasure Length
len2 Diff k v
d2 Sum Int
n2 Sum Int
m2) =
    Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v
forall k v.
Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v
RootMeasure
      (Length -> Diff k v -> Sum Int -> Sum Int -> RootMeasure k v)
-> Maybe Length
-> Maybe (Diff k v -> Sum Int -> Sum Int -> RootMeasure k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Length -> Length -> Maybe Length
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix Length
len1 Length
len2
      Maybe (Diff k v -> Sum Int -> Sum Int -> RootMeasure k v)
-> Maybe (Diff k v)
-> Maybe (Sum Int -> Sum Int -> RootMeasure k v)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Diff k v -> Diff k v -> Maybe (Diff k v)
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix Diff k v
d1 Diff k v
d2
      Maybe (Sum Int -> Sum Int -> RootMeasure k v)
-> Maybe (Sum Int) -> Maybe (Sum Int -> RootMeasure k v)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sum Int -> Sum Int -> Maybe (Sum Int)
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix Sum Int
n1 Sum Int
n2
      Maybe (Sum Int -> RootMeasure k v)
-> Maybe (Sum Int) -> Maybe (RootMeasure k v)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sum Int -> Sum Int -> Maybe (Sum Int)
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix Sum Int
m1 Sum Int
m2

instance (Ord k, Eq v) => LeftCancellative (RootMeasure k v)
instance (Ord k, Eq v) => RightCancellative (RootMeasure k v)

{-------------------------------------------------------------------------------
  Internal measuring
-------------------------------------------------------------------------------}

instance Measured (InternalMeasure k v) (Element k v) where
  measure :: Element k v -> InternalMeasure k v
measure (Element SlotNo
sl Diff k v
_d) =
    InternalMeasure
      { imLength :: Length
imLength = Length
1
      , imSlotNoL :: StrictMaybe SlotNoLB
imSlotNoL = SlotNoLB -> StrictMaybe SlotNoLB
forall a. a -> StrictMaybe a
SJust (SlotNoLB -> StrictMaybe SlotNoLB)
-> SlotNoLB -> StrictMaybe SlotNoLB
forall a b. (a -> b) -> a -> b
$ SlotNo -> SlotNoLB
SlotNoLB SlotNo
sl
      , imSlotNoR :: StrictMaybe SlotNoUB
imSlotNoR = SlotNoUB -> StrictMaybe SlotNoUB
forall a. a -> StrictMaybe a
SJust (SlotNoUB -> StrictMaybe SlotNoUB)
-> SlotNoUB -> StrictMaybe SlotNoUB
forall a b. (a -> b) -> a -> b
$ SlotNo -> SlotNoUB
SlotNoUB SlotNo
sl
      }

instance Semigroup (InternalMeasure k v) where
  InternalMeasure Length
len1 StrictMaybe SlotNoLB
sl1L StrictMaybe SlotNoUB
sl1R <> :: InternalMeasure k v -> InternalMeasure k v -> InternalMeasure k v
<> InternalMeasure Length
len2 StrictMaybe SlotNoLB
sl2L StrictMaybe SlotNoUB
sl2R =
    Length
-> StrictMaybe SlotNoLB
-> StrictMaybe SlotNoUB
-> InternalMeasure k v
forall k v.
Length
-> StrictMaybe SlotNoLB
-> StrictMaybe SlotNoUB
-> InternalMeasure k v
InternalMeasure (Length
len1 Length -> Length -> Length
forall a. Semigroup a => a -> a -> a
<> Length
len2) (StrictMaybe SlotNoLB
sl1L StrictMaybe SlotNoLB
-> StrictMaybe SlotNoLB -> StrictMaybe SlotNoLB
forall a. Semigroup a => a -> a -> a
<> StrictMaybe SlotNoLB
sl2L) (StrictMaybe SlotNoUB
sl1R StrictMaybe SlotNoUB
-> StrictMaybe SlotNoUB -> StrictMaybe SlotNoUB
forall a. Semigroup a => a -> a -> a
<> StrictMaybe SlotNoUB
sl2R)

instance Monoid (InternalMeasure k v) where
  mempty :: InternalMeasure k v
mempty = Length
-> StrictMaybe SlotNoLB
-> StrictMaybe SlotNoUB
-> InternalMeasure k v
forall k v.
Length
-> StrictMaybe SlotNoLB
-> StrictMaybe SlotNoUB
-> InternalMeasure k v
InternalMeasure Length
forall a. Monoid a => a
mempty StrictMaybe SlotNoLB
forall a. Monoid a => a
mempty StrictMaybe SlotNoUB
forall a. Monoid a => a
mempty

{-------------------------------------------------------------------------------
  Short-hands types and constraints
-------------------------------------------------------------------------------}

-- | Short-hand for @'SuperMeasured'@.
type SM k v =
  SuperMeasured (RootMeasure k v) (InternalMeasure k v) (Element k v)

{-------------------------------------------------------------------------------
  Queries
-------------------------------------------------------------------------------}

cumulativeDiff ::
  SM k v =>
  DiffSeq k v ->
  Anti.Diff k v
cumulativeDiff :: forall k v. SM k v => DiffSeq k v -> Diff k v
cumulativeDiff (UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft) = RootMeasure k v -> Diff k v
forall k v. RootMeasure k v -> Diff k v
rmDiff (RootMeasure k v -> Diff k v) -> RootMeasure k v -> Diff k v
forall a b. (a -> b) -> a -> b
$ StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> RootMeasure k v
forall v a. RootMeasured v a => a -> v
measureRoot StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft

length ::
  SM k v =>
  DiffSeq k v -> Int
length :: forall k v. SM k v => DiffSeq k v -> Int
length (UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft) = Length -> Int
unLength (Length -> Int)
-> (RootMeasure k v -> Length) -> RootMeasure k v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RootMeasure k v -> Length
forall k v. RootMeasure k v -> Length
rmLength (RootMeasure k v -> Int) -> RootMeasure k v -> Int
forall a b. (a -> b) -> a -> b
$ StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> RootMeasure k v
forall v a. RootMeasured v a => a -> v
measureRoot StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft

numInserts ::
  SM k v =>
  DiffSeq k v -> Sum Int
numInserts :: forall k v. SM k v => DiffSeq k v -> Sum Int
numInserts (UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft) = RootMeasure k v -> Sum Int
forall k v. RootMeasure k v -> Sum Int
rmNumInserts (RootMeasure k v -> Sum Int) -> RootMeasure k v -> Sum Int
forall a b. (a -> b) -> a -> b
$ StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> RootMeasure k v
forall v a. RootMeasured v a => a -> v
measureRoot StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft

numDeletes ::
  SM k v =>
  DiffSeq k v -> Sum Int
numDeletes :: forall k v. SM k v => DiffSeq k v -> Sum Int
numDeletes (UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft) = RootMeasure k v -> Sum Int
forall k v. RootMeasure k v -> Sum Int
rmNumDeletes (RootMeasure k v -> Sum Int) -> RootMeasure k v -> Sum Int
forall a b. (a -> b) -> a -> b
$ StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> RootMeasure k v
forall v a. RootMeasured v a => a -> v
measureRoot StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

extend ::
  SM k v =>
  DiffSeq k v ->
  Slot.SlotNo ->
  Anti.Diff k v ->
  DiffSeq k v
extend :: forall k v.
SM k v =>
DiffSeq k v -> SlotNo -> Diff k v -> DiffSeq k v
extend (UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft) SlotNo
sl Diff k v
d =
  Bool -> DiffSeq k v -> DiffSeq k v
forall a. (?callStack::CallStack) => Bool -> a -> a
Exn.assert Bool
invariant (DiffSeq k v -> DiffSeq k v) -> DiffSeq k v -> DiffSeq k v
forall a b. (a -> b) -> a -> b
$ StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> DiffSeq k v
forall k v.
StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> DiffSeq k v
UnsafeDiffSeq (StrictFingerTree
   (RootMeasure k v) (InternalMeasure k v) (Element k v)
 -> DiffSeq k v)
-> StrictFingerTree
     (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> DiffSeq k v
forall a b. (a -> b) -> a -> b
$ StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> Element k v
-> StrictFingerTree
     (RootMeasure k v) (InternalMeasure k v) (Element k v)
forall vr vi a.
SuperMeasured vr vi a =>
StrictFingerTree vr vi a -> a -> StrictFingerTree vr vi a
|> SlotNo -> Diff k v -> Element k v
forall k v. SlotNo -> Diff k v -> Element k v
Element SlotNo
sl Diff k v
d
 where
  invariant :: Bool
invariant = case InternalMeasure k v -> StrictMaybe SlotNoUB
forall k v. InternalMeasure k v -> StrictMaybe SlotNoUB
imSlotNoR (InternalMeasure k v -> StrictMaybe SlotNoUB)
-> InternalMeasure k v -> StrictMaybe SlotNoUB
forall a b. (a -> b) -> a -> b
$ StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> InternalMeasure k v
forall v a. Measured v a => a -> v
measure StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft of
    StrictMaybe SlotNoUB
SNothing -> Bool
True
    SJust SlotNoUB
slR -> SlotNoUB -> SlotNoLB -> Bool
noSlotBoundsIntersect SlotNoUB
slR (SlotNo -> SlotNoLB
SlotNoLB SlotNo
sl)

append ::
  (Ord k, Eq v) =>
  DiffSeq k v ->
  DiffSeq k v ->
  DiffSeq k v
append :: forall k v.
(Ord k, Eq v) =>
DiffSeq k v -> DiffSeq k v -> DiffSeq k v
append (UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft1) (UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft2) =
  Bool -> DiffSeq k v -> DiffSeq k v
forall a. (?callStack::CallStack) => Bool -> a -> a
Exn.assert Bool
invariant (DiffSeq k v -> DiffSeq k v) -> DiffSeq k v -> DiffSeq k v
forall a b. (a -> b) -> a -> b
$ StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> DiffSeq k v
forall k v.
StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> DiffSeq k v
UnsafeDiffSeq (StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft1 StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> StrictFingerTree
     (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> StrictFingerTree
     (RootMeasure k v) (InternalMeasure k v) (Element k v)
forall a. Semigroup a => a -> a -> a
<> StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft2)
 where
  sl1R :: StrictMaybe SlotNoUB
sl1R = InternalMeasure k v -> StrictMaybe SlotNoUB
forall k v. InternalMeasure k v -> StrictMaybe SlotNoUB
imSlotNoR (InternalMeasure k v -> StrictMaybe SlotNoUB)
-> InternalMeasure k v -> StrictMaybe SlotNoUB
forall a b. (a -> b) -> a -> b
$ StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> InternalMeasure k v
forall v a. Measured v a => a -> v
measure StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft1
  sl2L :: StrictMaybe SlotNoLB
sl2L = InternalMeasure k v -> StrictMaybe SlotNoLB
forall k v. InternalMeasure k v -> StrictMaybe SlotNoLB
imSlotNoL (InternalMeasure k v -> StrictMaybe SlotNoLB)
-> InternalMeasure k v -> StrictMaybe SlotNoLB
forall a b. (a -> b) -> a -> b
$ StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> InternalMeasure k v
forall v a. Measured v a => a -> v
measure StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft2
  invariant :: Bool
invariant = case SlotNoUB -> SlotNoLB -> Bool
noSlotBoundsIntersect (SlotNoUB -> SlotNoLB -> Bool)
-> StrictMaybe SlotNoUB -> StrictMaybe (SlotNoLB -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe SlotNoUB
sl1R StrictMaybe (SlotNoLB -> Bool)
-> StrictMaybe SlotNoLB -> StrictMaybe Bool
forall a b. StrictMaybe (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictMaybe SlotNoLB
sl2L of
    StrictMaybe Bool
SNothing -> Bool
True
    SJust Bool
v -> Bool
v

empty ::
  (Ord k, Eq v) =>
  DiffSeq k v
empty :: forall k v. (Ord k, Eq v) => DiffSeq k v
empty = StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> DiffSeq k v
forall k v.
StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> DiffSeq k v
UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
forall a. Monoid a => a
mempty

{-------------------------------------------------------------------------------
  Slots
-------------------------------------------------------------------------------}

maxSlot ::
  SM k v =>
  DiffSeq k v ->
  StrictMaybe Slot.SlotNo
maxSlot :: forall k v. SM k v => DiffSeq k v -> StrictMaybe SlotNo
maxSlot (UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft) = SlotNoUB -> SlotNo
unSlotNoUB (SlotNoUB -> SlotNo) -> StrictMaybe SlotNoUB -> StrictMaybe SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InternalMeasure k v -> StrictMaybe SlotNoUB
forall k v. InternalMeasure k v -> StrictMaybe SlotNoUB
imSlotNoR (StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> InternalMeasure k v
forall v a. Measured v a => a -> v
measure StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft)

minSlot ::
  SM k v =>
  DiffSeq k v ->
  StrictMaybe Slot.SlotNo
minSlot :: forall k v. SM k v => DiffSeq k v -> StrictMaybe SlotNo
minSlot (UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft) = SlotNoLB -> SlotNo
unSlotNoLB (SlotNoLB -> SlotNo) -> StrictMaybe SlotNoLB -> StrictMaybe SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InternalMeasure k v -> StrictMaybe SlotNoLB
forall k v. InternalMeasure k v -> StrictMaybe SlotNoLB
imSlotNoL (StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> InternalMeasure k v
forall v a. Measured v a => a -> v
measure StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft)

{-------------------------------------------------------------------------------
  Splitting
-------------------------------------------------------------------------------}

instance Sized (InternalMeasure k v) where
  size :: InternalMeasure k v -> Int
size = Length -> Int
unLength (Length -> Int)
-> (InternalMeasure k v -> Length) -> InternalMeasure k v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalMeasure k v -> Length
forall k v. InternalMeasure k v -> Length
imLength

splitAtSlot ::
  SM k v =>
  Slot.SlotNo ->
  DiffSeq k v ->
  (DiffSeq k v, DiffSeq k v)
splitAtSlot :: forall k v.
SM k v =>
SlotNo -> DiffSeq k v -> (DiffSeq k v, DiffSeq k v)
splitAtSlot SlotNo
slot =
  (InternalMeasure k v -> Bool)
-> DiffSeq k v -> (DiffSeq k v, DiffSeq k v)
forall k v.
SM k v =>
(InternalMeasure k v -> Bool)
-> DiffSeq k v -> (DiffSeq k v, DiffSeq k v)
split (Bool -> (SlotNo -> Bool) -> StrictMaybe SlotNo -> Bool
forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe Bool
False (SlotNo
slot SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<=) (StrictMaybe SlotNo -> Bool)
-> (InternalMeasure k v -> StrictMaybe SlotNo)
-> InternalMeasure k v
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlotNoUB -> SlotNo) -> StrictMaybe SlotNoUB -> StrictMaybe SlotNo
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SlotNoUB -> SlotNo
unSlotNoUB (StrictMaybe SlotNoUB -> StrictMaybe SlotNo)
-> (InternalMeasure k v -> StrictMaybe SlotNoUB)
-> InternalMeasure k v
-> StrictMaybe SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalMeasure k v -> StrictMaybe SlotNoUB
forall k v. InternalMeasure k v -> StrictMaybe SlotNoUB
imSlotNoR)

split ::
  SM k v =>
  (InternalMeasure k v -> Bool) ->
  DiffSeq k v ->
  (DiffSeq k v, DiffSeq k v)
split :: forall k v.
SM k v =>
(InternalMeasure k v -> Bool)
-> DiffSeq k v -> (DiffSeq k v, DiffSeq k v)
split InternalMeasure k v -> Bool
p (UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft) =
  (StrictFingerTree
   (RootMeasure k v) (InternalMeasure k v) (Element k v)
 -> DiffSeq k v)
-> (StrictFingerTree
      (RootMeasure k v) (InternalMeasure k v) (Element k v)
    -> DiffSeq k v)
-> (StrictFingerTree
      (RootMeasure k v) (InternalMeasure k v) (Element k v),
    StrictFingerTree
      (RootMeasure k v) (InternalMeasure k v) (Element k v))
-> (DiffSeq k v, DiffSeq k v)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> DiffSeq k v
forall k v.
StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> DiffSeq k v
UnsafeDiffSeq StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> DiffSeq k v
forall k v.
StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> DiffSeq k v
UnsafeDiffSeq ((StrictFingerTree
    (RootMeasure k v) (InternalMeasure k v) (Element k v),
  StrictFingerTree
    (RootMeasure k v) (InternalMeasure k v) (Element k v))
 -> (DiffSeq k v, DiffSeq k v))
-> (StrictFingerTree
      (RootMeasure k v) (InternalMeasure k v) (Element k v),
    StrictFingerTree
      (RootMeasure k v) (InternalMeasure k v) (Element k v))
-> (DiffSeq k v, DiffSeq k v)
forall a b. (a -> b) -> a -> b
$
    (InternalMeasure k v -> Bool)
-> StrictFingerTree
     (RootMeasure k v) (InternalMeasure k v) (Element k v)
-> (StrictFingerTree
      (RootMeasure k v) (InternalMeasure k v) (Element k v),
    StrictFingerTree
      (RootMeasure k v) (InternalMeasure k v) (Element k v))
forall vr vi a.
(SuperMeasured vr vi a, Sized vi) =>
(vi -> Bool)
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
RMFT.splitSized InternalMeasure k v -> Bool
p StrictFingerTree
  (RootMeasure k v) (InternalMeasure k v) (Element k v)
ft

splitAt ::
  SM k v =>
  Int ->
  DiffSeq k v ->
  (DiffSeq k v, DiffSeq k v)
splitAt :: forall k v.
SM k v =>
Int -> DiffSeq k v -> (DiffSeq k v, DiffSeq k v)
splitAt Int
n = (InternalMeasure k v -> Bool)
-> DiffSeq k v -> (DiffSeq k v, DiffSeq k v)
forall k v.
SM k v =>
(InternalMeasure k v -> Bool)
-> DiffSeq k v -> (DiffSeq k v, DiffSeq k v)
split ((Int -> Length
Length Int
n Length -> Length -> Bool
forall a. Ord a => a -> a -> Bool
<) (Length -> Bool)
-> (InternalMeasure k v -> Length) -> InternalMeasure k v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalMeasure k v -> Length
forall k v. InternalMeasure k v -> Length
imLength)

splitAtFromEnd ::
  (SM k v, HasCallStack) =>
  Int ->
  DiffSeq k v ->
  (DiffSeq k v, DiffSeq k v)
splitAtFromEnd :: forall k v.
(SM k v, ?callStack::CallStack) =>
Int -> DiffSeq k v -> (DiffSeq k v, DiffSeq k v)
splitAtFromEnd Int
n DiffSeq k v
dseq =
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len
    then Int -> DiffSeq k v -> (DiffSeq k v, DiffSeq k v)
forall k v.
SM k v =>
Int -> DiffSeq k v -> (DiffSeq k v, DiffSeq k v)
splitAt (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) DiffSeq k v
dseq
    else String -> (DiffSeq k v, DiffSeq k v)
forall a. (?callStack::CallStack) => String -> a
error (String -> (DiffSeq k v, DiffSeq k v))
-> String -> (DiffSeq k v, DiffSeq k v)
forall a b. (a -> b) -> a -> b
$ String
"Can't split a seq of length " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" from end at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
 where
  len :: Int
len = DiffSeq k v -> Int
forall k v. SM k v => DiffSeq k v -> Int
length DiffSeq k v
dseq

{-------------------------------------------------------------------------------
  From-to diffs
-------------------------------------------------------------------------------}

fromAntiDiff :: Anti.Diff k v -> Diff.Diff k v
fromAntiDiff :: forall k v. Diff k v -> Diff k v
fromAntiDiff (Anti.Diff Map k (DeltaHistory v)
d) = Map k (Delta v) -> Diff k v
forall k v. Map k (Delta v) -> Diff k v
Diff.Diff ((DeltaHistory v -> Delta v)
-> Map k (DeltaHistory v) -> Map k (Delta v)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Delta v -> Delta v
forall {v}. Delta v -> Delta v
f (Delta v -> Delta v)
-> (DeltaHistory v -> Delta v) -> DeltaHistory v -> Delta v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeltaHistory v -> Delta v
forall v. DeltaHistory v -> Delta v
Anti.last) Map k (DeltaHistory v)
d)
 where
  f :: Delta v -> Delta v
f (Anti.Insert v
v) = v -> Delta v
forall v. v -> Delta v
Diff.Insert v
v
  f Anti.Delete{} = Delta v
forall v. Delta v
Diff.Delete

toAntiDiff :: Diff.Diff k v -> Anti.Diff k v
toAntiDiff :: forall k v. Diff k v -> Diff k v
toAntiDiff (Diff.Diff Map k (Delta v)
d) = Map k (DeltaHistory v) -> Diff k v
forall k v. Map k (DeltaHistory v) -> Diff k v
Anti.Diff ((Delta v -> DeltaHistory v)
-> Map k (Delta v) -> Map k (DeltaHistory v)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Delta v -> DeltaHistory v
forall {v}. Delta v -> DeltaHistory v
f Map k (Delta v)
d)
 where
  f :: Delta v -> DeltaHistory v
f (Diff.Insert v
v) = v -> DeltaHistory v
forall v. v -> DeltaHistory v
Anti.singletonInsert v
v
  f Delta v
Diff.Delete = DeltaHistory v
forall v. DeltaHistory v
Anti.singletonDelete