{-# LANGUAGE BangPatterns           #-}
{-# LANGUAGE DeriveAnyClass         #-}
{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE PatternSynonyms        #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE StandaloneDeriving     #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE UndecidableInstances   #-}
{-# LANGUAGE ViewPatterns           #-}
module Ouroboros.Network.AnchoredSeq
  ( -- * 'AnchoredSeq' type
    AnchoredSeq (Empty, (:>), (:<))
    -- * 'Anchorable'
  , Anchorable (..)
    -- * Basic operations
  , anchor
  , head
  , headAnchor
  , last
  , toNewestFirst
  , toOldestFirst
  , fromNewestFirst
  , fromOldestFirst
  , splitAt
  , splitAtMeasure
  , dropNewest
  , takeOldest
  , dropWhileNewest
  , takeWhileOldest
  , length
  , null
  , contains
  , withinBounds
  , map
  , bimap
  , mapPreservingMeasure
  , bimapPreservingMeasure
    -- * Special operations
  , rollback
  , isPrefixOf
  , isPrefixOfByMeasure
  , lookupByMeasure
  , splitAfterMeasure
  , splitBeforeMeasure
  , join
  , anchorNewest
  , selectOffsets
  , filter
  , filterWithStop
    -- * Helper functions
  , prettyPrint
    -- * Reference implementations for testing
  , filterWithStopSpec
  ) where

import Prelude hiding (filter, foldr, head, last, length, map, null, splitAt)

import Data.Coerce (coerce)
import Data.FingerTree.Strict (Measured (measure), StrictFingerTree)
import Data.FingerTree.Strict qualified as FT
import Data.Foldable qualified as Foldable
import Data.List qualified as L
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (..))
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Prelude hiding (filter, foldr, head, last, length, map, null, splitAt)
import Prelude qualified as Prelude

{-------------------------------------------------------------------------------
  AnchoredSeq
-------------------------------------------------------------------------------}

-- | Generalisation of a @Sequence@ with elements of type @b@ with a custom
-- measure @v@ and an anchor @a@.
--
-- This type is strict in the elements, but not strict in the spine.
--
-- For example, an 'AnchoredSeq' can represent a fragment of a chain containing
-- blocks that is anchored at a certain point. It can also represent a history
-- of ledger states with the anchor being the \"immutable\" ledger state.
--
-- NOTE: there might be multiple elements with the same measure, e.g., multiple
-- blocks with the same @WithOrigin SlotNo@. That is why functions operating on
-- an 'AnchoredSeq' often take a predicate in addition to a measure. At most one
-- element should satisfy that predicate, e.g., the block must have a certain
-- hash. The behaviour is undefined when multiple elements satisfy the
-- predicate.
data AnchoredSeq v a b = AnchoredSeq {
      forall v a b. AnchoredSeq v a b -> a
anchor      :: !a
    , forall v a b.
AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
unanchorSeq :: !(StrictFingerTree (Measure v) (MeasuredWith v a b))
    }
  deriving (Int -> AnchoredSeq v a b -> ShowS
[AnchoredSeq v a b] -> ShowS
AnchoredSeq v a b -> String
(Int -> AnchoredSeq v a b -> ShowS)
-> (AnchoredSeq v a b -> String)
-> ([AnchoredSeq v a b] -> ShowS)
-> Show (AnchoredSeq v a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v a b. (Show a, Show b) => Int -> AnchoredSeq v a b -> ShowS
forall v a b. (Show a, Show b) => [AnchoredSeq v a b] -> ShowS
forall v a b. (Show a, Show b) => AnchoredSeq v a b -> String
$cshowsPrec :: forall v a b. (Show a, Show b) => Int -> AnchoredSeq v a b -> ShowS
showsPrec :: Int -> AnchoredSeq v a b -> ShowS
$cshow :: forall v a b. (Show a, Show b) => AnchoredSeq v a b -> String
show :: AnchoredSeq v a b -> String
$cshowList :: forall v a b. (Show a, Show b) => [AnchoredSeq v a b] -> ShowS
showList :: [AnchoredSeq v a b] -> ShowS
Show, AnchoredSeq v a b -> AnchoredSeq v a b -> Bool
(AnchoredSeq v a b -> AnchoredSeq v a b -> Bool)
-> (AnchoredSeq v a b -> AnchoredSeq v a b -> Bool)
-> Eq (AnchoredSeq v a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v a b.
(Eq a, Eq b) =>
AnchoredSeq v a b -> AnchoredSeq v a b -> Bool
$c== :: forall v a b.
(Eq a, Eq b) =>
AnchoredSeq v a b -> AnchoredSeq v a b -> Bool
== :: AnchoredSeq v a b -> AnchoredSeq v a b -> Bool
$c/= :: forall v a b.
(Eq a, Eq b) =>
AnchoredSeq v a b -> AnchoredSeq v a b -> Bool
/= :: AnchoredSeq v a b -> AnchoredSeq v a b -> Bool
Eq, (forall x. AnchoredSeq v a b -> Rep (AnchoredSeq v a b) x)
-> (forall x. Rep (AnchoredSeq v a b) x -> AnchoredSeq v a b)
-> Generic (AnchoredSeq v a b)
forall x. Rep (AnchoredSeq v a b) x -> AnchoredSeq v a b
forall x. AnchoredSeq v a b -> Rep (AnchoredSeq v a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v a b x. Rep (AnchoredSeq v a b) x -> AnchoredSeq v a b
forall v a b x. AnchoredSeq v a b -> Rep (AnchoredSeq v a b) x
$cfrom :: forall v a b x. AnchoredSeq v a b -> Rep (AnchoredSeq v a b) x
from :: forall x. AnchoredSeq v a b -> Rep (AnchoredSeq v a b) x
$cto :: forall v a b x. Rep (AnchoredSeq v a b) x -> AnchoredSeq v a b
to :: forall x. Rep (AnchoredSeq v a b) x -> AnchoredSeq v a b
Generic, Context -> AnchoredSeq v a b -> IO (Maybe ThunkInfo)
Proxy (AnchoredSeq v a b) -> String
(Context -> AnchoredSeq v a b -> IO (Maybe ThunkInfo))
-> (Context -> AnchoredSeq v a b -> IO (Maybe ThunkInfo))
-> (Proxy (AnchoredSeq v a b) -> String)
-> NoThunks (AnchoredSeq v a b)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall v a b.
(NoThunks a, NoThunks b) =>
Context -> AnchoredSeq v a b -> IO (Maybe ThunkInfo)
forall v a b.
(NoThunks a, NoThunks b) =>
Proxy (AnchoredSeq v a b) -> String
$cnoThunks :: forall v a b.
(NoThunks a, NoThunks b) =>
Context -> AnchoredSeq v a b -> IO (Maybe ThunkInfo)
noThunks :: Context -> AnchoredSeq v a b -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall v a b.
(NoThunks a, NoThunks b) =>
Context -> AnchoredSeq v a b -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> AnchoredSeq v a b -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall v a b.
(NoThunks a, NoThunks b) =>
Proxy (AnchoredSeq v a b) -> String
showTypeOf :: Proxy (AnchoredSeq v a b) -> String
NoThunks)

-- | Constaint needed to use an @AnchoredSeq@.
class (Ord v, Bounded v) => Anchorable v a b | a -> v where
  -- | @b@ as anchor
  asAnchor :: b -> a

  -- | Return the measure of an anchor
  --
  -- The advantage of this method over a @'Measured' k a@ super-class constraint
  -- is that it doesn't inherit the @'Monoid' k@ constraint, which is unused and
  -- often undesired.
  getAnchorMeasure :: Proxy b -> a -> v

-- | Helper for getting the measure of a @v@.
getElementMeasure :: forall v a b. Anchorable v a b => MeasuredWith v a b -> v
getElementMeasure :: forall v a b. Anchorable v a b => MeasuredWith v a b -> v
getElementMeasure (MeasuredWith b
x) =
    forall v a b. Anchorable v a b => Proxy b -> a -> v
getAnchorMeasure @v @a (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) (a -> v) -> a -> v
forall a b. (a -> b) -> a -> b
$ b -> a
forall v a b. Anchorable v a b => b -> a
asAnchor b
x

{-------------------------------------------------------------------------------
  Internals
-------------------------------------------------------------------------------}

-- | Internal: measure used by the fingertree in 'AnchoredSeq'.
--
-- @v@ is a custom measure. E.g., for blocks this could be the slot number. This
-- custom measure is augmented by a measure based on the size, used to
-- efficiently look up things by their position.
data Measure v = Measure {
       forall v. Measure v -> v
measureMin  :: !v
     , forall v. Measure v -> v
measureMax  :: !v
     , forall v. Measure v -> Int
measureSize :: !Int
     }
  deriving (Int -> Measure v -> ShowS
[Measure v] -> ShowS
Measure v -> String
(Int -> Measure v -> ShowS)
-> (Measure v -> String)
-> ([Measure v] -> ShowS)
-> Show (Measure v)
forall v. Show v => Int -> Measure v -> ShowS
forall v. Show v => [Measure v] -> ShowS
forall v. Show v => Measure v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Measure v -> ShowS
showsPrec :: Int -> Measure v -> ShowS
$cshow :: forall v. Show v => Measure v -> String
show :: Measure v -> String
$cshowList :: forall v. Show v => [Measure v] -> ShowS
showList :: [Measure v] -> ShowS
Show)

-- | Internal: newtype so that we don't impose a 'Measured' constraint on @b@,
-- which would require each instantiation to provide a 'Measured' instance.
-- Also, this fixes the functional dependency of 'Measured' internally, it
-- doesn't leak to all @b@s.
newtype MeasuredWith v a b = MeasuredWith {
      forall v a b. MeasuredWith v a b -> b
unMeasuredWith :: b
    }
  deriving (Int -> MeasuredWith v a b -> ShowS
[MeasuredWith v a b] -> ShowS
MeasuredWith v a b -> String
(Int -> MeasuredWith v a b -> ShowS)
-> (MeasuredWith v a b -> String)
-> ([MeasuredWith v a b] -> ShowS)
-> Show (MeasuredWith v a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v a b. Show b => Int -> MeasuredWith v a b -> ShowS
forall v a b. Show b => [MeasuredWith v a b] -> ShowS
forall v a b. Show b => MeasuredWith v a b -> String
$cshowsPrec :: forall v a b. Show b => Int -> MeasuredWith v a b -> ShowS
showsPrec :: Int -> MeasuredWith v a b -> ShowS
$cshow :: forall v a b. Show b => MeasuredWith v a b -> String
show :: MeasuredWith v a b -> String
$cshowList :: forall v a b. Show b => [MeasuredWith v a b] -> ShowS
showList :: [MeasuredWith v a b] -> ShowS
Show, MeasuredWith v a b -> MeasuredWith v a b -> Bool
(MeasuredWith v a b -> MeasuredWith v a b -> Bool)
-> (MeasuredWith v a b -> MeasuredWith v a b -> Bool)
-> Eq (MeasuredWith v a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v a b.
Eq b =>
MeasuredWith v a b -> MeasuredWith v a b -> Bool
$c== :: forall v a b.
Eq b =>
MeasuredWith v a b -> MeasuredWith v a b -> Bool
== :: MeasuredWith v a b -> MeasuredWith v a b -> Bool
$c/= :: forall v a b.
Eq b =>
MeasuredWith v a b -> MeasuredWith v a b -> Bool
/= :: MeasuredWith v a b -> MeasuredWith v a b -> Bool
Eq, (forall x. MeasuredWith v a b -> Rep (MeasuredWith v a b) x)
-> (forall x. Rep (MeasuredWith v a b) x -> MeasuredWith v a b)
-> Generic (MeasuredWith v a b)
forall x. Rep (MeasuredWith v a b) x -> MeasuredWith v a b
forall x. MeasuredWith v a b -> Rep (MeasuredWith v a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v a b x. Rep (MeasuredWith v a b) x -> MeasuredWith v a b
forall v a b x. MeasuredWith v a b -> Rep (MeasuredWith v a b) x
$cfrom :: forall v a b x. MeasuredWith v a b -> Rep (MeasuredWith v a b) x
from :: forall x. MeasuredWith v a b -> Rep (MeasuredWith v a b) x
$cto :: forall v a b x. Rep (MeasuredWith v a b) x -> MeasuredWith v a b
to :: forall x. Rep (MeasuredWith v a b) x -> MeasuredWith v a b
Generic, Context -> MeasuredWith v a b -> IO (Maybe ThunkInfo)
Proxy (MeasuredWith v a b) -> String
(Context -> MeasuredWith v a b -> IO (Maybe ThunkInfo))
-> (Context -> MeasuredWith v a b -> IO (Maybe ThunkInfo))
-> (Proxy (MeasuredWith v a b) -> String)
-> NoThunks (MeasuredWith v a b)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall v a b.
NoThunks b =>
Context -> MeasuredWith v a b -> IO (Maybe ThunkInfo)
forall v a b. NoThunks b => Proxy (MeasuredWith v a b) -> String
$cnoThunks :: forall v a b.
NoThunks b =>
Context -> MeasuredWith v a b -> IO (Maybe ThunkInfo)
noThunks :: Context -> MeasuredWith v a b -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall v a b.
NoThunks b =>
Context -> MeasuredWith v a b -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> MeasuredWith v a b -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall v a b. NoThunks b => Proxy (MeasuredWith v a b) -> String
showTypeOf :: Proxy (MeasuredWith v a b) -> String
NoThunks)

instance Anchorable v a b => Measured (Measure v) (MeasuredWith v a b) where
  measure :: MeasuredWith v a b -> Measure v
measure MeasuredWith v a b
x = Measure {
        measureMin :: v
measureMin  = v
m
      , measureMax :: v
measureMax  = v
m
      , measureSize :: Int
measureSize = Int
1
      }
    where
      m :: v
      m :: v
m = MeasuredWith v a b -> v
forall v a b. Anchorable v a b => MeasuredWith v a b -> v
getElementMeasure MeasuredWith v a b
x

instance Ord v => Semigroup (Measure v) where
  Measure v
v1 <> :: Measure v -> Measure v -> Measure v
<> Measure v
v2 = Measure {
      measureMin :: v
measureMin  = Measure v -> v
forall v. Measure v -> v
measureMin  Measure v
v1 v -> v -> v
forall a. Ord a => a -> a -> a
`min` Measure v -> v
forall v. Measure v -> v
measureMin  Measure v
v2
    , measureMax :: v
measureMax  = Measure v -> v
forall v. Measure v -> v
measureMax  Measure v
v1 v -> v -> v
forall a. Ord a => a -> a -> a
`max` Measure v -> v
forall v. Measure v -> v
measureMax  Measure v
v2
    , measureSize :: Int
measureSize = Measure v -> Int
forall v. Measure v -> Int
measureSize Measure v
v1   Int -> Int -> Int
forall a. Num a => a -> a -> a
+   Measure v -> Int
forall v. Measure v -> Int
measureSize Measure v
v2
    }

instance (Ord v, Bounded v) => Monoid (Measure v) where
  mempty :: Measure v
mempty  = v -> v -> Int -> Measure v
forall v. v -> v -> Int -> Measure v
Measure v
forall a. Bounded a => a
maxBound v
forall a. Bounded a => a
minBound Int
0
  mappend :: Measure v -> Measure v -> Measure v
mappend = Measure v -> Measure v -> Measure v
forall a. Semigroup a => a -> a -> a
(<>)

{-------------------------------------------------------------------------------
  Pattern synonyms
-------------------------------------------------------------------------------}

-- | \( O(1) \). Pattern for matching on or creating an empty 'AnchoredSeq'. An
-- empty sequence has/needs an anchor.
pattern Empty :: Anchorable v a b => a -> AnchoredSeq v a b
pattern $bEmpty :: forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
$mEmpty :: forall {r} {v} {a} {b}.
Anchorable v a b =>
AnchoredSeq v a b -> (a -> r) -> ((# #) -> r) -> r
Empty a <- (viewRight -> EmptyR a)
  where
    Empty a
a = a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a. Measured v a => StrictFingerTree v a
FT.empty

-- | Auxiliary data type to define the pattern synonym
data ViewRight v a b
    = EmptyR a
    | ConsR  (AnchoredSeq v a b) b

viewRight :: Anchorable v a b => AnchoredSeq v a b -> ViewRight v a b
viewRight :: forall v a b.
Anchorable v a b =>
AnchoredSeq v a b -> ViewRight v a b
viewRight (AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft) = case StrictFingerTree (Measure v) (MeasuredWith v a b)
-> ViewR (StrictFingerTree (Measure v)) (MeasuredWith v a b)
forall v a.
Measured v a =>
StrictFingerTree v a -> ViewR (StrictFingerTree v) a
FT.viewr StrictFingerTree (Measure v) (MeasuredWith v a b)
ft of
    ViewR (StrictFingerTree (Measure v)) (MeasuredWith v a b)
FT.EmptyR                -> a -> ViewRight v a b
forall v a b. a -> ViewRight v a b
EmptyR a
a
    StrictFingerTree (Measure v) (MeasuredWith v a b)
ft' FT.:> MeasuredWith b
b -> AnchoredSeq v a b -> b -> ViewRight v a b
forall v a b. AnchoredSeq v a b -> b -> ViewRight v a b
ConsR (a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft') b
b

-- | \( O(1) \). Add an element to the right of the anchored sequence.
pattern (:>) :: Anchorable v a b => AnchoredSeq v a b -> b -> AnchoredSeq v a b
pattern s' $b:> :: forall v a b.
Anchorable v a b =>
AnchoredSeq v a b -> b -> AnchoredSeq v a b
$m:> :: forall {r} {v} {a} {b}.
Anchorable v a b =>
AnchoredSeq v a b
-> (AnchoredSeq v a b -> b -> r) -> ((# #) -> r) -> r
:> b <- (viewRight -> ConsR s' b)
  where
    AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft :> b
b = a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a (StrictFingerTree (Measure v) (MeasuredWith v a b)
ft StrictFingerTree (Measure v) (MeasuredWith v a b)
-> MeasuredWith v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a.
Measured v a =>
StrictFingerTree v a -> a -> StrictFingerTree v a
FT.|> b -> MeasuredWith v a b
forall v a b. b -> MeasuredWith v a b
MeasuredWith b
b)

-- | Auxiliary data type to define the pattern synonym
data ViewLeft v a b
    = EmptyL a
    | ConsL b (AnchoredSeq v a b)

viewLeft ::
     forall v a b. Anchorable v a b
  => AnchoredSeq v a b
  -> ViewLeft v a b
viewLeft :: forall v a b.
Anchorable v a b =>
AnchoredSeq v a b -> ViewLeft v a b
viewLeft (AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft) = case StrictFingerTree (Measure v) (MeasuredWith v a b)
-> ViewL (StrictFingerTree (Measure v)) (MeasuredWith v a b)
forall v a.
Measured v a =>
StrictFingerTree v a -> ViewL (StrictFingerTree v) a
FT.viewl StrictFingerTree (Measure v) (MeasuredWith v a b)
ft of
    ViewL (StrictFingerTree (Measure v)) (MeasuredWith v a b)
FT.EmptyL ->
      a -> ViewLeft v a b
forall v a b. a -> ViewLeft v a b
EmptyL a
a
    MeasuredWith b
b FT.:< StrictFingerTree (Measure v) (MeasuredWith v a b)
ft' ->
      b -> AnchoredSeq v a b -> ViewLeft v a b
forall v a b. b -> AnchoredSeq v a b -> ViewLeft v a b
ConsL b
b (a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq (b -> a
forall v a b. Anchorable v a b => b -> a
asAnchor b
b) StrictFingerTree (Measure v) (MeasuredWith v a b)
ft')

-- | \( O(1) \). View the first, leftmost block of the anchored sequence.
--
-- Note that the anchor shifts, i.e., the anchor of the second argument will
-- correspond to the first argument.
--
-- This is only a view, not a constructor, as adding a block to the left would
-- change the anchor of the sequence, but we have no information about the
-- predecessor of the block we'd be prepending.
pattern (:<) :: Anchorable v a b => b -> AnchoredSeq v a b -> AnchoredSeq v a b
pattern b $m:< :: forall {r} {v} {a} {b}.
Anchorable v a b =>
AnchoredSeq v a b
-> (b -> AnchoredSeq v a b -> r) -> ((# #) -> r) -> r
:< s' <- (viewLeft -> ConsL b s')

infixl 5 :>, :<

{-# COMPLETE Empty, (:>) #-}
{-# COMPLETE Empty, (:<) #-}

{-------------------------------------------------------------------------------
  Operations
-------------------------------------------------------------------------------}

prettyPrint ::
     String
  -> (a -> String)
  -> (b -> String)
  -> AnchoredSeq v a b
  -> String
prettyPrint :: forall a b v.
String
-> (a -> String) -> (b -> String) -> AnchoredSeq v a b -> String
prettyPrint String
nl a -> String
ppA b -> String
ppB (AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft) =
    (String -> MeasuredWith v a b -> String)
-> String
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> String
forall b a.
(b -> a -> b) -> b -> StrictFingerTree (Measure v) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
      (\String
s (MeasuredWith b
b) -> String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"    " String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
ppB b
b)
      (String
"AnchoredSeq (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
ppA a
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"):")
      StrictFingerTree (Measure v) (MeasuredWith v a b)
ft

-- | \( O(1) \). Return the measure of the anchor.
anchorMeasure :: forall v a b. Anchorable v a b => AnchoredSeq v a b -> v
anchorMeasure :: forall v a b. Anchorable v a b => AnchoredSeq v a b -> v
anchorMeasure = Proxy b -> a -> v
forall v a b. Anchorable v a b => Proxy b -> a -> v
getAnchorMeasure (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) (a -> v) -> (AnchoredSeq v a b -> a) -> AnchoredSeq v a b -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq v a b -> a
forall v a b. AnchoredSeq v a b -> a
anchor

-- | \( O(1) \). When the sequence is empty, return the anchor,
-- otherwise the most recently added element.
head :: Anchorable v a b => AnchoredSeq v a b -> Either a b
head :: forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
head (AnchoredSeq v a b
_ :>  b
b) = b -> Either a b
forall a b. b -> Either a b
Right b
b
head (Empty a
a) = a -> Either a b
forall a b. a -> Either a b
Left a
a

-- | \( O(1) \). The anchor corresponding to the most recently added element
-- (i.e., the anchor that would be needed for a sequence starting /after/ this).
-- When the anchored sequence is empty, the anchor is returned.
headAnchor :: forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
headAnchor :: forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
headAnchor = (a -> a) -> (b -> a) -> Either a b -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id b -> a
forall v a b. Anchorable v a b => b -> a
asAnchor (Either a b -> a)
-> (AnchoredSeq v a b -> Either a b) -> AnchoredSeq v a b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq v a b -> Either a b
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
head

-- | \( O(1) \). When the sequence is empty, return the anchor, otherwise the
-- leftmost element.
last :: Anchorable v a b => AnchoredSeq v a b -> Either a b
last :: forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
last (b
b :< AnchoredSeq v a b
_)  = b -> Either a b
forall a b. b -> Either a b
Right b
b
last (Empty a
a) = a -> Either a b
forall a b. a -> Either a b
Left a
a

-- | \( O(n) \). Return the elements in the 'AnchoredSeq' in newest-to-oldest
-- order.
toNewestFirst :: AnchoredSeq v a b -> [b]
toNewestFirst :: forall v a b. AnchoredSeq v a b -> [b]
toNewestFirst = [MeasuredWith v a b] -> [b]
forall a b. Coercible a b => a -> b
coerce ([MeasuredWith v a b] -> [b])
-> (AnchoredSeq v a b -> [MeasuredWith v a b])
-> AnchoredSeq v a b
-> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MeasuredWith v a b]
 -> MeasuredWith v a b -> [MeasuredWith v a b])
-> [MeasuredWith v a b]
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> [MeasuredWith v a b]
forall b a.
(b -> a -> b) -> b -> StrictFingerTree (Measure v) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' ((MeasuredWith v a b
 -> [MeasuredWith v a b] -> [MeasuredWith v a b])
-> [MeasuredWith v a b]
-> MeasuredWith v a b
-> [MeasuredWith v a b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] (StrictFingerTree (Measure v) (MeasuredWith v a b)
 -> [MeasuredWith v a b])
-> (AnchoredSeq v a b
    -> StrictFingerTree (Measure v) (MeasuredWith v a b))
-> AnchoredSeq v a b
-> [MeasuredWith v a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a b.
AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
unanchorSeq

-- | \( O(n) \). Return the elements in the 'AnchoredSeq' in oldest-to-newest
-- order.
toOldestFirst :: AnchoredSeq v a b -> [b]
toOldestFirst :: forall v a b. AnchoredSeq v a b -> [b]
toOldestFirst = [MeasuredWith v a b] -> [b]
forall a b. Coercible a b => a -> b
coerce ([MeasuredWith v a b] -> [b])
-> (AnchoredSeq v a b -> [MeasuredWith v a b])
-> AnchoredSeq v a b
-> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictFingerTree (Measure v) (MeasuredWith v a b)
-> [MeasuredWith v a b]
forall a. StrictFingerTree (Measure v) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (StrictFingerTree (Measure v) (MeasuredWith v a b)
 -> [MeasuredWith v a b])
-> (AnchoredSeq v a b
    -> StrictFingerTree (Measure v) (MeasuredWith v a b))
-> AnchoredSeq v a b
-> [MeasuredWith v a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a b.
AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
unanchorSeq

-- | \( O(n) \). Make an 'AnchoredSeq' from a list of elements in
-- newest-to-oldest order. The last element in the list will be the one after
-- the given anchor.
fromNewestFirst :: Anchorable v a b => a -> [b] -> AnchoredSeq v a b
fromNewestFirst :: forall v a b. Anchorable v a b => a -> [b] -> AnchoredSeq v a b
fromNewestFirst a
a = (b -> AnchoredSeq v a b -> AnchoredSeq v a b)
-> AnchoredSeq v a b -> [b] -> AnchoredSeq v a b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr ((AnchoredSeq v a b -> b -> AnchoredSeq v a b)
-> b -> AnchoredSeq v a b -> AnchoredSeq v a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnchoredSeq v a b -> b -> AnchoredSeq v a b
forall v a b.
Anchorable v a b =>
AnchoredSeq v a b -> b -> AnchoredSeq v a b
(:>)) (a -> AnchoredSeq v a b
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
Empty a
a)

-- | \( O(n) \). Make an 'AnchoredSeq' from a list of elements in
-- oldest-to-newest order. The first element in the list will be the one after
-- the given anchor.
fromOldestFirst :: Anchorable v a b => a -> [b] -> AnchoredSeq v a b
fromOldestFirst :: forall v a b. Anchorable v a b => a -> [b] -> AnchoredSeq v a b
fromOldestFirst a
a = a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a (StrictFingerTree (Measure v) (MeasuredWith v a b)
 -> AnchoredSeq v a b)
-> ([b] -> StrictFingerTree (Measure v) (MeasuredWith v a b))
-> [b]
-> AnchoredSeq v a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MeasuredWith v a b]
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a. Measured v a => [a] -> StrictFingerTree v a
FT.fromList ([MeasuredWith v a b]
 -> StrictFingerTree (Measure v) (MeasuredWith v a b))
-> ([b] -> [MeasuredWith v a b])
-> [b]
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> [MeasuredWith v a b]
forall a b. Coercible a b => a -> b
coerce

-- | \( O(\log(\min(i,n-i)) \). Split the 'AnchoredSeq' at a given
--  position.
--
-- POSTCONDITION: @(before, after) = splitAt i s@, then:
--
-- > anchor      before == anchor s
-- > headAnchor  before == anchor after
-- > headAnchor  after  == headAnchor s
-- > join before after  == Just s
splitAt ::
      Anchorable v a b
   => Int
   -> AnchoredSeq v a b
   -> (AnchoredSeq v a b, AnchoredSeq v a b)
splitAt :: forall v a b.
Anchorable v a b =>
Int -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
splitAt Int
i (AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft) = case (Measure v -> Bool)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> (StrictFingerTree (Measure v) (MeasuredWith v a b),
    StrictFingerTree (Measure v) (MeasuredWith v a b))
forall v a.
Measured v a =>
(v -> Bool)
-> StrictFingerTree v a
-> (StrictFingerTree v a, StrictFingerTree v a)
FT.split (\Measure v
v -> Measure v -> Int
forall v. Measure v -> Int
measureSize Measure v
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i) StrictFingerTree (Measure v) (MeasuredWith v a b)
ft of
   (StrictFingerTree (Measure v) (MeasuredWith v a b)
before, StrictFingerTree (Measure v) (MeasuredWith v a b)
after) ->
     let before' :: AnchoredSeq v a b
before' = a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
before
     in (AnchoredSeq v a b
before', a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq (AnchoredSeq v a b -> a
forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
headAnchor AnchoredSeq v a b
before') StrictFingerTree (Measure v) (MeasuredWith v a b)
after)

-- | \( O(\log(\min(i,n-i)) \). Split the 'AnchoredSeq' at a given
--  measure.
--
-- POSTCONDITION: @(before, after) = splitAtMeasure v s@, then:
--
-- > anchor      before == anchor s
-- > headAnchor  before == anchor after
-- > headAnchor  after  == headAnchor s
-- > toOldestFirst before ==
-- >   filter ((< v) . getAnchorMeasure @v @a (Proxy @b) . asAnchor) (toOldestFirst s)
-- > toOldestFirst after ==
-- >   filter ((v <=) . getAnchorMeasure @v @a (Proxy @b) . asAnchor) (toOldestFirst s)
splitAtMeasure ::
      Anchorable v a b
   => v
   -> AnchoredSeq v a b
   -> (AnchoredSeq v a b, AnchoredSeq v a b)
splitAtMeasure :: forall v a b.
Anchorable v a b =>
v -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
splitAtMeasure v
v (AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft) = case (Measure v -> Bool)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> (StrictFingerTree (Measure v) (MeasuredWith v a b),
    StrictFingerTree (Measure v) (MeasuredWith v a b))
forall v a.
Measured v a =>
(v -> Bool)
-> StrictFingerTree v a
-> (StrictFingerTree v a, StrictFingerTree v a)
FT.split ((v
v v -> v -> Bool
forall a. Ord a => a -> a -> Bool
<=) (v -> Bool) -> (Measure v -> v) -> Measure v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measure v -> v
forall v. Measure v -> v
measureMax) StrictFingerTree (Measure v) (MeasuredWith v a b)
ft of
   (StrictFingerTree (Measure v) (MeasuredWith v a b)
before, StrictFingerTree (Measure v) (MeasuredWith v a b)
after) ->
     let before' :: AnchoredSeq v a b
before' = a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
before
     in (AnchoredSeq v a b
before', a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq (AnchoredSeq v a b -> a
forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
headAnchor AnchoredSeq v a b
before') StrictFingerTree (Measure v) (MeasuredWith v a b)
after)

-- | \( O(\log(\min(i,n-i)) \). Drop the newest @n@ elements from the
-- 'AnchoredSeq'. The anchor does not change.
dropNewest :: Anchorable v a b => Int -> AnchoredSeq v a b -> AnchoredSeq v a b
dropNewest :: forall v a b.
Anchorable v a b =>
Int -> AnchoredSeq v a b -> AnchoredSeq v a b
dropNewest Int
n s :: AnchoredSeq v a b
s@(AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft)
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    = AnchoredSeq v a b
s
    | Bool
otherwise
    = a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a (StrictFingerTree (Measure v) (MeasuredWith v a b)
 -> AnchoredSeq v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall a b. (a -> b) -> a -> b
$ (Measure v -> Bool)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a.
Measured v a =>
(v -> Bool) -> StrictFingerTree v a -> StrictFingerTree v a
FT.takeUntil (\Measure v
v -> Measure v -> Int
forall v. Measure v -> Int
measureSize Measure v
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
remainingLength) StrictFingerTree (Measure v) (MeasuredWith v a b)
ft
  where
    remainingLength :: Int
remainingLength = AnchoredSeq v a b -> Int
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Int
length AnchoredSeq v a b
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n

-- | \( O(\log(\min(i,n-i)) \). Take the oldest @n@ elements from the
-- 'AnchoredSeq'. The anchor does not change.
takeOldest :: Anchorable v a b => Int -> AnchoredSeq v a b -> AnchoredSeq v a b
takeOldest :: forall v a b.
Anchorable v a b =>
Int -> AnchoredSeq v a b -> AnchoredSeq v a b
takeOldest Int
n s :: AnchoredSeq v a b
s@(AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft)
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredSeq v a b -> Int
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Int
length AnchoredSeq v a b
s
    = AnchoredSeq v a b
s
    | Bool
otherwise
    = a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a (StrictFingerTree (Measure v) (MeasuredWith v a b)
 -> AnchoredSeq v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall a b. (a -> b) -> a -> b
$ (Measure v -> Bool)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a.
Measured v a =>
(v -> Bool) -> StrictFingerTree v a -> StrictFingerTree v a
FT.takeUntil (\Measure v
v -> Measure v -> Int
forall v. Measure v -> Int
measureSize Measure v
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n) StrictFingerTree (Measure v) (MeasuredWith v a b)
ft

-- | \( O(n) \). Drop the newest elements that satisfy the predicate, keeping
-- the remainder. The anchor does not change.
dropWhileNewest ::
     Anchorable v a b
  => (b -> Bool)
  -> AnchoredSeq v a b
  -> AnchoredSeq v a b
dropWhileNewest :: forall v a b.
Anchorable v a b =>
(b -> Bool) -> AnchoredSeq v a b -> AnchoredSeq v a b
dropWhileNewest b -> Bool
_ (Empty a
a) = a -> AnchoredSeq v a b
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
Empty a
a
dropWhileNewest b -> Bool
p s :: AnchoredSeq v a b
s@(AnchoredSeq v a b
s' :> b
b)
    | b -> Bool
p b
b       = (b -> Bool) -> AnchoredSeq v a b -> AnchoredSeq v a b
forall v a b.
Anchorable v a b =>
(b -> Bool) -> AnchoredSeq v a b -> AnchoredSeq v a b
dropWhileNewest b -> Bool
p AnchoredSeq v a b
s'
    | Bool
otherwise = AnchoredSeq v a b
s

-- | \( O(n) \). Take the oldest elements that satisfy the predicate. The anchor
-- does not change.
takeWhileOldest ::
     Anchorable v a b
  => (b -> Bool)
  -> AnchoredSeq v a b
  -> AnchoredSeq v a b
takeWhileOldest :: forall v a b.
Anchorable v a b =>
(b -> Bool) -> AnchoredSeq v a b -> AnchoredSeq v a b
takeWhileOldest b -> Bool
p = \(AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft) -> a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a (StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall {v} {a} {v} {a}.
(Anchorable v a b, Anchorable v a b) =>
StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
go StrictFingerTree (Measure v) (MeasuredWith v a b)
ft)
  where
    go :: StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
go StrictFingerTree (Measure v) (MeasuredWith v a b)
ft = case StrictFingerTree (Measure v) (MeasuredWith v a b)
-> ViewL (StrictFingerTree (Measure v)) (MeasuredWith v a b)
forall v a.
Measured v a =>
StrictFingerTree v a -> ViewL (StrictFingerTree v) a
FT.viewl StrictFingerTree (Measure v) (MeasuredWith v a b)
ft of
        ViewL (StrictFingerTree (Measure v)) (MeasuredWith v a b)
FT.EmptyL
          -> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a. Measured v a => StrictFingerTree v a
FT.empty
        MeasuredWith b
b FT.:< StrictFingerTree (Measure v) (MeasuredWith v a b)
ft'
          | b -> Bool
p b
b
          -> b -> MeasuredWith v a b
forall v a b. b -> MeasuredWith v a b
MeasuredWith b
b MeasuredWith v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a.
Measured v a =>
a -> StrictFingerTree v a -> StrictFingerTree v a
FT.<| StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
go StrictFingerTree (Measure v) (MeasuredWith v a b)
ft'
          | Bool
otherwise
          -> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a. Measured v a => StrictFingerTree v a
FT.empty

-- | \( O(1) \). Return the number of elements. The anchor is not counted.
length :: Anchorable v a b => AnchoredSeq v a b -> Int
length :: forall v a b. Anchorable v a b => AnchoredSeq v a b -> Int
length = Measure v -> Int
forall v. Measure v -> Int
measureSize (Measure v -> Int)
-> (AnchoredSeq v a b -> Measure v) -> AnchoredSeq v a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictFingerTree (Measure v) (MeasuredWith v a b) -> Measure v
forall v a. Measured v a => a -> v
FT.measure (StrictFingerTree (Measure v) (MeasuredWith v a b) -> Measure v)
-> (AnchoredSeq v a b
    -> StrictFingerTree (Measure v) (MeasuredWith v a b))
-> AnchoredSeq v a b
-> Measure v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a b.
AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
unanchorSeq

-- | \( O(1) \). The anchor is not counted.
null :: AnchoredSeq v a b -> Bool
null :: forall v a b. AnchoredSeq v a b -> Bool
null = StrictFingerTree (Measure v) (MeasuredWith v a b) -> Bool
forall v a. StrictFingerTree v a -> Bool
FT.null (StrictFingerTree (Measure v) (MeasuredWith v a b) -> Bool)
-> (AnchoredSeq v a b
    -> StrictFingerTree (Measure v) (MeasuredWith v a b))
-> AnchoredSeq v a b
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a b.
AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
unanchorSeq

-- | \( O(\log(\min(i,n-i)) \). Roll back the anchored sequence such that its
-- new head has the same measure as the given one and satisfies the predicate.
-- When there is no such element or anchor, return 'Nothing'.
rollback ::
     Anchorable v a b
  => v
  -> (Either a b -> Bool)
  -> AnchoredSeq v a b
  -> Maybe (AnchoredSeq v a b)
rollback :: forall v a b.
Anchorable v a b =>
v
-> (Either a b -> Bool)
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b)
rollback v
k Either a b -> Bool
p AnchoredSeq v a b
s
    | AnchoredSeq v a b -> v
forall v a b. Anchorable v a b => AnchoredSeq v a b -> v
anchorMeasure AnchoredSeq v a b
s v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
k, Either a b -> Bool
p (a -> Either a b
forall a b. a -> Either a b
Left (AnchoredSeq v a b -> a
forall v a b. AnchoredSeq v a b -> a
anchor AnchoredSeq v a b
s))
    = AnchoredSeq v a b -> Maybe (AnchoredSeq v a b)
forall a. a -> Maybe a
Just (a -> AnchoredSeq v a b
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
Empty (AnchoredSeq v a b -> a
forall v a b. AnchoredSeq v a b -> a
anchor AnchoredSeq v a b
s))
    | Bool
otherwise
    = (AnchoredSeq v a b, AnchoredSeq v a b) -> AnchoredSeq v a b
forall a b. (a, b) -> a
fst ((AnchoredSeq v a b, AnchoredSeq v a b) -> AnchoredSeq v a b)
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
-> Maybe (AnchoredSeq v a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v
-> (Either a b -> Bool)
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
forall v a b.
Anchorable v a b =>
v
-> (Either a b -> Bool)
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
splitAfterMeasure v
k Either a b -> Bool
p AnchoredSeq v a b
s

-- | \( O(\log(\min(i,n-i)) \). Internal variant of 'lookupByMeasure' that
-- returns a 'FT.SearchResult'.
lookupByMeasureFT ::
     Anchorable v a b
  => v
  -> AnchoredSeq v a b
  -> FT.SearchResult (Measure v) (MeasuredWith v a b)
lookupByMeasureFT :: forall v a b.
Anchorable v a b =>
v
-> AnchoredSeq v a b
-> SearchResult (Measure v) (MeasuredWith v a b)
lookupByMeasureFT v
k (AnchoredSeq a
_ StrictFingerTree (Measure v) (MeasuredWith v a b)
ft) =
    (Measure v -> Measure v -> Bool)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> SearchResult (Measure v) (MeasuredWith v a b)
forall v a.
Measured v a =>
(v -> v -> Bool) -> StrictFingerTree v a -> SearchResult v a
FT.search (\Measure v
ml Measure v
mr -> Measure v -> v
forall v. Measure v -> v
measureMax Measure v
ml v -> v -> Bool
forall a. Ord a => a -> a -> Bool
>= v
k Bool -> Bool -> Bool
&& Measure v -> v
forall v. Measure v -> v
measureMin Measure v
mr v -> v -> Bool
forall a. Ord a => a -> a -> Bool
> v
k) StrictFingerTree (Measure v) (MeasuredWith v a b)
ft

-- | \( O(\log(\min(i,n-i) + s) \) where /s/ is the number of elements with the
-- same measure. Return all elements in the anchored sequence with a measure
-- (@k@) equal to the given one. The elements will be ordered from oldest to
-- newest. Does not look at the anchor.
lookupByMeasure ::
     Anchorable v a b
  => v
  -> AnchoredSeq v a b
  -> [b]
lookupByMeasure :: forall v a b. Anchorable v a b => v -> AnchoredSeq v a b -> [b]
lookupByMeasure v
k AnchoredSeq v a b
s = case v
-> AnchoredSeq v a b
-> SearchResult (Measure v) (MeasuredWith v a b)
forall v a b.
Anchorable v a b =>
v
-> AnchoredSeq v a b
-> SearchResult (Measure v) (MeasuredWith v a b)
lookupByMeasureFT v
k AnchoredSeq v a b
s of
    FT.Position StrictFingerTree (Measure v) (MeasuredWith v a b)
before MeasuredWith v a b
b StrictFingerTree (Measure v) (MeasuredWith v a b)
_after
      | MeasuredWith v a b -> v
forall v a b. Anchorable v a b => MeasuredWith v a b -> v
getElementMeasure MeasuredWith v a b
b v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
k
        -- We have found the rightmost element with the given measure, we still
        -- have to look at the elemens before it with the same measure.
      -> StrictFingerTree (Measure v) (MeasuredWith v a b) -> [b] -> [b]
forall {a} {a}.
Anchorable v a a =>
StrictFingerTree (Measure v) (MeasuredWith v a a) -> [a] -> [a]
elementsBefore StrictFingerTree (Measure v) (MeasuredWith v a b)
before [MeasuredWith v a b -> b
forall v a b. MeasuredWith v a b -> b
unMeasuredWith MeasuredWith v a b
b]
    SearchResult (Measure v) (MeasuredWith v a b)
_ -> []
  where
    -- Look to the left of the element we found for more elements with the same
    -- measure.
    elementsBefore :: StrictFingerTree (Measure v) (MeasuredWith v a a) -> [a] -> [a]
elementsBefore StrictFingerTree (Measure v) (MeasuredWith v a a)
before [a]
acc = case StrictFingerTree (Measure v) (MeasuredWith v a a)
-> ViewR (StrictFingerTree (Measure v)) (MeasuredWith v a a)
forall v a.
Measured v a =>
StrictFingerTree v a -> ViewR (StrictFingerTree v) a
FT.viewr StrictFingerTree (Measure v) (MeasuredWith v a a)
before of
      StrictFingerTree (Measure v) (MeasuredWith v a a)
before' FT.:> MeasuredWith v a a
b
        | MeasuredWith v a a -> v
forall v a b. Anchorable v a b => MeasuredWith v a b -> v
getElementMeasure MeasuredWith v a a
b v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
k
        -> StrictFingerTree (Measure v) (MeasuredWith v a a) -> [a] -> [a]
elementsBefore StrictFingerTree (Measure v) (MeasuredWith v a a)
before' (MeasuredWith v a a -> a
forall v a b. MeasuredWith v a b -> b
unMeasuredWith MeasuredWith v a a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)
           -- Note that we're prepending an older element each time, so the
           -- final list of elements will be ordered from oldest to newest. No
           -- need to reverse the accumulator.
      ViewR (StrictFingerTree (Measure v)) (MeasuredWith v a a)
_ -> [a]
acc

-- | \( O(\log(\min(i,n-i)) \). Does the anchored sequence contain an element
-- with the given measure that satisfies the predicate? The anchor is ignored.
contains :: Anchorable v a b => v -> (b -> Bool) -> AnchoredSeq v a b -> Bool
contains :: forall v a b.
Anchorable v a b =>
v -> (b -> Bool) -> AnchoredSeq v a b -> Bool
contains v
k b -> Bool
p AnchoredSeq v a b
s = (b -> Bool) -> [b] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any b -> Bool
p ([b] -> Bool) -> [b] -> Bool
forall a b. (a -> b) -> a -> b
$ v -> AnchoredSeq v a b -> [b]
forall v a b. Anchorable v a b => v -> AnchoredSeq v a b -> [b]
lookupByMeasure v
k AnchoredSeq v a b
s

-- | \( O(\log(\min(i,n-i)) \). Does the anchored sequence contain an element
-- with the given measure that satisfies the predicate? The anchor is /not/
-- ignored.
withinBounds ::
     Anchorable v a b
  => v
  -> (Either a b -> Bool)
  -> AnchoredSeq v a b
  -> Bool
withinBounds :: forall v a b.
Anchorable v a b =>
v -> (Either a b -> Bool) -> AnchoredSeq v a b -> Bool
withinBounds v
k Either a b -> Bool
p AnchoredSeq v a b
s =
       (v
k v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredSeq v a b -> v
forall v a b. Anchorable v a b => AnchoredSeq v a b -> v
anchorMeasure AnchoredSeq v a b
s Bool -> Bool -> Bool
&& Either a b -> Bool
p (a -> Either a b
forall a b. a -> Either a b
Left (AnchoredSeq v a b -> a
forall v a b. AnchoredSeq v a b -> a
anchor AnchoredSeq v a b
s)))
    Bool -> Bool -> Bool
|| v -> (b -> Bool) -> AnchoredSeq v a b -> Bool
forall v a b.
Anchorable v a b =>
v -> (b -> Bool) -> AnchoredSeq v a b -> Bool
contains v
k (Either a b -> Bool
p (Either a b -> Bool) -> (b -> Either a b) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right) AnchoredSeq v a b
s

-- | \( O(n) \). Maps over the elements and the elements.
map ::
     Anchorable v2 a b2
  => (b1 -> b2)
  -> AnchoredSeq v1 a b1
  -> AnchoredSeq v2 a b2
map :: forall v2 a b2 b1 v1.
Anchorable v2 a b2 =>
(b1 -> b2) -> AnchoredSeq v1 a b1 -> AnchoredSeq v2 a b2
map = (a -> a)
-> (b1 -> b2) -> AnchoredSeq v1 a b1 -> AnchoredSeq v2 a b2
forall v2 a2 b2 a1 b1 v1.
Anchorable v2 a2 b2 =>
(a1 -> a2)
-> (b1 -> b2) -> AnchoredSeq v1 a1 b1 -> AnchoredSeq v2 a2 b2
bimap a -> a
forall a. a -> a
id

-- | \( O(n) \). Maps over the elements.
bimap ::
     Anchorable v2 a2 b2
  => (a1 -> a2)
  -> (b1 -> b2)
  -> AnchoredSeq v1 a1 b1
  -> AnchoredSeq v2 a2 b2
bimap :: forall v2 a2 b2 a1 b1 v1.
Anchorable v2 a2 b2 =>
(a1 -> a2)
-> (b1 -> b2) -> AnchoredSeq v1 a1 b1 -> AnchoredSeq v2 a2 b2
bimap a1 -> a2
f b1 -> b2
g AnchoredSeq v1 a1 b1
s =
    -- 'FT.fmap'' has an unnecessary @Measured v1 a1@ constraint. We don't want
    -- an @Anchorable v1 a1 b1@ constraint here, so we go through an
    -- intermediary list instead. This has the same time complexity and the lazy
    -- traversal and mapping should give the same space complexity.
    a2 -> [b2] -> AnchoredSeq v2 a2 b2
forall v a b. Anchorable v a b => a -> [b] -> AnchoredSeq v a b
fromOldestFirst (a1 -> a2
f (AnchoredSeq v1 a1 b1 -> a1
forall v a b. AnchoredSeq v a b -> a
anchor AnchoredSeq v1 a1 b1
s)) (b1 -> b2
g (b1 -> b2) -> [b1] -> [b2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnchoredSeq v1 a1 b1 -> [b1]
forall v a b. AnchoredSeq v a b -> [b]
toOldestFirst AnchoredSeq v1 a1 b1
s)

-- | \( O(n) \). Maps over the elements.
--
-- NOTE: the functions must preserve the measure.
--
-- More efficient than 'map'
mapPreservingMeasure ::
     (b1 -> b2)
  -> AnchoredSeq v a b1
  -> AnchoredSeq v a b2
mapPreservingMeasure :: forall b1 b2 v a.
(b1 -> b2) -> AnchoredSeq v a b1 -> AnchoredSeq v a b2
mapPreservingMeasure = (a -> a) -> (b1 -> b2) -> AnchoredSeq v a b1 -> AnchoredSeq v a b2
forall a1 a2 b1 b2 v.
(a1 -> a2)
-> (b1 -> b2) -> AnchoredSeq v a1 b1 -> AnchoredSeq v a2 b2
bimapPreservingMeasure a -> a
forall a. a -> a
id

-- | \( O(n) \). Maps over the anchor and the elements.
--
-- NOTE: the functions must preserve the measure.
--
-- More efficient than 'bimap'
bimapPreservingMeasure ::
     (a1 -> a2)
  -> (b1 -> b2)
  -> AnchoredSeq v a1 b1
  -> AnchoredSeq v a2 b2
bimapPreservingMeasure :: forall a1 a2 b1 b2 v.
(a1 -> a2)
-> (b1 -> b2) -> AnchoredSeq v a1 b1 -> AnchoredSeq v a2 b2
bimapPreservingMeasure a1 -> a2
f b1 -> b2
g (AnchoredSeq a1
a StrictFingerTree (Measure v) (MeasuredWith v a1 b1)
ft) =
    a2
-> StrictFingerTree (Measure v) (MeasuredWith v a2 b2)
-> AnchoredSeq v a2 b2
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq (a1 -> a2
f a1
a) ((MeasuredWith v a1 b1 -> MeasuredWith v a2 b2)
-> StrictFingerTree (Measure v) (MeasuredWith v a1 b1)
-> StrictFingerTree (Measure v) (MeasuredWith v a2 b2)
forall a b v.
(a -> b) -> StrictFingerTree v a -> StrictFingerTree v b
FT.unsafeFmap ((b1 -> b2) -> MeasuredWith v a1 b1 -> MeasuredWith v a2 b2
forall a b. Coercible a b => a -> b
coerce b1 -> b2
g) StrictFingerTree (Measure v) (MeasuredWith v a1 b1)
ft)

-- | Take the @n@ newest elements from the anchored sequence.
--
-- WARNING: this may change the anchor
--
-- When the anchored sequence contains fewer than @n@ elements, the anchored
-- sequence will be returned unmodified.
anchorNewest ::
     forall v a b. Anchorable v a b
  => Word64  -- ^ @n@
  -> AnchoredSeq v a b
  -> AnchoredSeq v a b
anchorNewest :: forall v a b.
Anchorable v a b =>
Word64 -> AnchoredSeq v a b -> AnchoredSeq v a b
anchorNewest Word64
n AnchoredSeq v a b
c
    | Int
toDrop Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
    = AnchoredSeq v a b
c
    | Int
toDrop Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5
      -- Hybrid approach: microbenchmarks have shown that a linear drop is
      -- faster when the number of elements is small. For a larger number of
      -- elements, the asymptotic complexity of 'splitAt' wins.
    = Int -> AnchoredSeq v a b -> AnchoredSeq v a b
linearDrop Int
toDrop AnchoredSeq v a b
c
    | Bool
otherwise
    = (AnchoredSeq v a b, AnchoredSeq v a b) -> AnchoredSeq v a b
forall a b. (a, b) -> b
snd ((AnchoredSeq v a b, AnchoredSeq v a b) -> AnchoredSeq v a b)
-> (AnchoredSeq v a b, AnchoredSeq v a b) -> AnchoredSeq v a b
forall a b. (a -> b) -> a -> b
$ Int -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
forall v a b.
Anchorable v a b =>
Int -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
splitAt Int
toDrop AnchoredSeq v a b
c
  where
    len, toDrop :: Int
    len :: Int
len    = AnchoredSeq v a b -> Int
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Int
length AnchoredSeq v a b
c
    toDrop :: Int
toDrop = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n

    linearDrop :: Int -> AnchoredSeq v a b -> AnchoredSeq v a b
    linearDrop :: Int -> AnchoredSeq v a b -> AnchoredSeq v a b
linearDrop !Int
_ (Empty a
a) = a -> AnchoredSeq v a b
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
Empty a
a
    linearDrop !Int
0 AnchoredSeq v a b
c'        = AnchoredSeq v a b
c'
    linearDrop !Int
m (b
_ :< AnchoredSeq v a b
c') = Int -> AnchoredSeq v a b -> AnchoredSeq v a b
linearDrop (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) AnchoredSeq v a b
c'

-- | \( O(\max(n_1, n_2)) \). Check whether the first anchored sequence is a
-- prefix of the second. Comparisons are done based on the 'Eq' instances.
--
-- The two 'AnchoredSeq's must have the same anchor, otherwise the first cannot
-- be a prefix of the second.
isPrefixOf ::
     forall v a b. (Eq a, Eq b)
  => AnchoredSeq v a b
  -> AnchoredSeq v a b
  -> Bool
AnchoredSeq v a b
s1 isPrefixOf :: forall v a b.
(Eq a, Eq b) =>
AnchoredSeq v a b -> AnchoredSeq v a b -> Bool
`isPrefixOf` AnchoredSeq v a b
s2 =
       AnchoredSeq v a b -> a
forall v a b. AnchoredSeq v a b -> a
anchor AnchoredSeq v a b
s1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredSeq v a b -> a
forall v a b. AnchoredSeq v a b -> a
anchor AnchoredSeq v a b
s2
    Bool -> Bool -> Bool
&& AnchoredSeq v a b -> [b]
toElements AnchoredSeq v a b
s1 [b] -> [b] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` AnchoredSeq v a b -> [b]
toElements AnchoredSeq v a b
s2
  where
    toElements :: AnchoredSeq v a b -> [b]
    toElements :: AnchoredSeq v a b -> [b]
toElements = (MeasuredWith v a b -> b) -> [MeasuredWith v a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
L.map MeasuredWith v a b -> b
forall v a b. MeasuredWith v a b -> b
unMeasuredWith ([MeasuredWith v a b] -> [b])
-> (AnchoredSeq v a b -> [MeasuredWith v a b])
-> AnchoredSeq v a b
-> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictFingerTree (Measure v) (MeasuredWith v a b)
-> [MeasuredWith v a b]
forall a. StrictFingerTree (Measure v) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (StrictFingerTree (Measure v) (MeasuredWith v a b)
 -> [MeasuredWith v a b])
-> (AnchoredSeq v a b
    -> StrictFingerTree (Measure v) (MeasuredWith v a b))
-> AnchoredSeq v a b
-> [MeasuredWith v a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a b.
AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
unanchorSeq

-- | \( O(\max(n_1, n_2)) \). Check whether the first anchored sequence is a
-- prefix of the second. Comparisons are done based on the measure.
--
-- The two 'AnchoredSeq's must have the same anchor, otherwise the first cannot
-- be a prefix of the second.
isPrefixOfByMeasure ::
     forall v a b. Anchorable v a b
  => AnchoredSeq v a b
  -> AnchoredSeq v a b
  -> Bool
AnchoredSeq v a b
s1 isPrefixOfByMeasure :: forall v a b.
Anchorable v a b =>
AnchoredSeq v a b -> AnchoredSeq v a b -> Bool
`isPrefixOfByMeasure` AnchoredSeq v a b
s2 =
       AnchoredSeq v a b -> v
forall v a b. Anchorable v a b => AnchoredSeq v a b -> v
anchorMeasure AnchoredSeq v a b
s1 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredSeq v a b -> v
forall v a b. Anchorable v a b => AnchoredSeq v a b -> v
anchorMeasure AnchoredSeq v a b
s2
    Bool -> Bool -> Bool
&& AnchoredSeq v a b -> [v]
toMeasures AnchoredSeq v a b
s1 [v] -> [v] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` AnchoredSeq v a b -> [v]
toMeasures AnchoredSeq v a b
s2
  where
    toMeasures :: AnchoredSeq v a b -> [v]
    toMeasures :: AnchoredSeq v a b -> [v]
toMeasures = (MeasuredWith v a b -> v) -> [MeasuredWith v a b] -> [v]
forall a b. (a -> b) -> [a] -> [b]
L.map MeasuredWith v a b -> v
forall v a b. Anchorable v a b => MeasuredWith v a b -> v
getElementMeasure ([MeasuredWith v a b] -> [v])
-> (AnchoredSeq v a b -> [MeasuredWith v a b])
-> AnchoredSeq v a b
-> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictFingerTree (Measure v) (MeasuredWith v a b)
-> [MeasuredWith v a b]
forall a. StrictFingerTree (Measure v) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (StrictFingerTree (Measure v) (MeasuredWith v a b)
 -> [MeasuredWith v a b])
-> (AnchoredSeq v a b
    -> StrictFingerTree (Measure v) (MeasuredWith v a b))
-> AnchoredSeq v a b
-> [MeasuredWith v a b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a b.
AnchoredSeq v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
unanchorSeq

-- | \( O(\log(\min(i,n-i)) \). Split the 'AnchoredSeq' after an element or
-- anchor with the given measure that satisfies the predicate. Return 'Nothing'
-- if there is no element or anchor with the given measure that satisfies the
-- predicate.
--
-- If the given measure corresponds to the anchor and it satisfies the
-- predicate, an empty sequence with the given anchor, and the original sequence
-- are returned.
--
-- PRECONDITION: there can be multiple elements with the same measure, but there
-- should be at most one element (or anchor) with the given measure satisfying
-- the predicate.
--
-- POSTCONDITION: when @Just (before, after) = splitAfterMeasure k f s@, then:
--
-- > anchor before       == anchor s
-- > headMeasure before  == pt
-- > anchorMeasure after == pt
-- > headAnchor after    == headAnchor s
-- > join before after   == Just s
splitAfterMeasure ::
     Anchorable v a b
  => v
  -> (Either a b -> Bool)
  -> AnchoredSeq v a b
  -> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
splitAfterMeasure :: forall v a b.
Anchorable v a b =>
v
-> (Either a b -> Bool)
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
splitAfterMeasure v
k Either a b -> Bool
p s :: AnchoredSeq v a b
s@(AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft)
    | AnchoredSeq v a b -> v
forall v a b. Anchorable v a b => AnchoredSeq v a b -> v
anchorMeasure AnchoredSeq v a b
s v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
k, Either a b -> Bool
p (a -> Either a b
forall a b. a -> Either a b
Left a
a)
    = (AnchoredSeq v a b, AnchoredSeq v a b)
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
forall a. a -> Maybe a
Just (a -> AnchoredSeq v a b
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
Empty a
a, AnchoredSeq v a b
s)
    | (StrictFingerTree (Measure v) (MeasuredWith v a b)
l, StrictFingerTree (Measure v) (MeasuredWith v a b)
r) <- (Measure v -> Bool)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> (StrictFingerTree (Measure v) (MeasuredWith v a b),
    StrictFingerTree (Measure v) (MeasuredWith v a b))
forall v a.
Measured v a =>
(v -> Bool)
-> StrictFingerTree v a
-> (StrictFingerTree v a, StrictFingerTree v a)
FT.split (\Measure v
v -> Measure v -> v
forall v. Measure v -> v
measureMax Measure v
v v -> v -> Bool
forall a. Ord a => a -> a -> Bool
> v
k) StrictFingerTree (Measure v) (MeasuredWith v a b)
ft
      -- @l@ contains elements with a measure <= the given mesaure. There could
      -- be multiple with the given measure, so try them one by one.
    = StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
go StrictFingerTree (Measure v) (MeasuredWith v a b)
l StrictFingerTree (Measure v) (MeasuredWith v a b)
r
  where
    go :: StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
go StrictFingerTree (Measure v) (MeasuredWith v a b)
l StrictFingerTree (Measure v) (MeasuredWith v a b)
r = case StrictFingerTree (Measure v) (MeasuredWith v a b)
-> ViewR (StrictFingerTree (Measure v)) (MeasuredWith v a b)
forall v a.
Measured v a =>
StrictFingerTree v a -> ViewR (StrictFingerTree v) a
FT.viewr StrictFingerTree (Measure v) (MeasuredWith v a b)
l of
      StrictFingerTree (Measure v) (MeasuredWith v a b)
l' FT.:> m :: MeasuredWith v a b
m@(MeasuredWith b
b)
        | MeasuredWith v a b -> v
forall v a b. Anchorable v a b => MeasuredWith v a b -> v
getElementMeasure MeasuredWith v a b
m v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
k, Either a b -> Bool
p (b -> Either a b
forall a b. b -> Either a b
Right b
b)
        , let al :: AnchoredSeq v a b
al = a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
l
        -> (AnchoredSeq v a b, AnchoredSeq v a b)
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
forall a. a -> Maybe a
Just (AnchoredSeq v a b
al, a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq (AnchoredSeq v a b -> a
forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
headAnchor AnchoredSeq v a b
al) StrictFingerTree (Measure v) (MeasuredWith v a b)
r)
        | MeasuredWith v a b -> v
forall v a b. Anchorable v a b => MeasuredWith v a b -> v
getElementMeasure MeasuredWith v a b
m v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
k
        -> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
go StrictFingerTree (Measure v) (MeasuredWith v a b)
l' (MeasuredWith v a b
m MeasuredWith v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a.
Measured v a =>
a -> StrictFingerTree v a -> StrictFingerTree v a
FT.<| StrictFingerTree (Measure v) (MeasuredWith v a b)
r)
      -- Empty tree or the measure doesn't match anymore
      ViewR (StrictFingerTree (Measure v)) (MeasuredWith v a b)
_ -> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
forall a. Maybe a
Nothing

-- | \( O(\log(\min(i,n-i)) \). Split the 'AnchoredSeq' before an element with
-- the given measure that satisfies the predicate. Return 'Nothing' if the
-- anchored sequence does not contain an element with the given measure that
-- satisfies the predicate.
--
-- Unlike 'splitAfterMeasure' we can't split before the anchor.
--
-- PRECONDITION: there can be multiple elements with the same measure, but there
-- should be at most one element (or anchor) with the given measure satisfying
-- the predicate.
--
-- POSTCONDITION: joining ('join') the two anchored sequences gives back the
-- original anchored sequence.
--
-- POSTCONDITION: the last element (oldest) in the second sequence has the given
-- measure and satisfies the predicate.
splitBeforeMeasure ::
      Anchorable v a b
   => v
   -> (b -> Bool)
   -> AnchoredSeq v a b
   -> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
splitBeforeMeasure :: forall v a b.
Anchorable v a b =>
v
-> (b -> Bool)
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
splitBeforeMeasure v
k b -> Bool
p (AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
ft)
    | (StrictFingerTree (Measure v) (MeasuredWith v a b)
l, StrictFingerTree (Measure v) (MeasuredWith v a b)
r) <- (Measure v -> Bool)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> (StrictFingerTree (Measure v) (MeasuredWith v a b),
    StrictFingerTree (Measure v) (MeasuredWith v a b))
forall v a.
Measured v a =>
(v -> Bool)
-> StrictFingerTree v a
-> (StrictFingerTree v a, StrictFingerTree v a)
FT.split (\Measure v
v -> Measure v -> v
forall v. Measure v -> v
measureMax Measure v
v v -> v -> Bool
forall a. Ord a => a -> a -> Bool
>= v
k) StrictFingerTree (Measure v) (MeasuredWith v a b)
ft
      -- @r@ contains elements with a measure >= the given mesaure. There could
      -- be multiple with the given measure, so try them one by one.
    = StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
go StrictFingerTree (Measure v) (MeasuredWith v a b)
l StrictFingerTree (Measure v) (MeasuredWith v a b)
r
  where
    go :: StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
go StrictFingerTree (Measure v) (MeasuredWith v a b)
l StrictFingerTree (Measure v) (MeasuredWith v a b)
r = case StrictFingerTree (Measure v) (MeasuredWith v a b)
-> ViewL (StrictFingerTree (Measure v)) (MeasuredWith v a b)
forall v a.
Measured v a =>
StrictFingerTree v a -> ViewL (StrictFingerTree v) a
FT.viewl StrictFingerTree (Measure v) (MeasuredWith v a b)
r of
      m :: MeasuredWith v a b
m@(MeasuredWith b
b) FT.:< StrictFingerTree (Measure v) (MeasuredWith v a b)
r'
        | MeasuredWith v a b -> v
forall v a b. Anchorable v a b => MeasuredWith v a b -> v
getElementMeasure MeasuredWith v a b
m v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
k, b -> Bool
p b
b
        , let al :: AnchoredSeq v a b
al = a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a StrictFingerTree (Measure v) (MeasuredWith v a b)
l
        -> (AnchoredSeq v a b, AnchoredSeq v a b)
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
forall a. a -> Maybe a
Just (AnchoredSeq v a b
al, a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq (AnchoredSeq v a b -> a
forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
headAnchor AnchoredSeq v a b
al) StrictFingerTree (Measure v) (MeasuredWith v a b)
r)
        | MeasuredWith v a b -> v
forall v a b. Anchorable v a b => MeasuredWith v a b -> v
getElementMeasure MeasuredWith v a b
m v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
k
        -> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
go (StrictFingerTree (Measure v) (MeasuredWith v a b)
l StrictFingerTree (Measure v) (MeasuredWith v a b)
-> MeasuredWith v a b
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a.
Measured v a =>
StrictFingerTree v a -> a -> StrictFingerTree v a
FT.|> MeasuredWith v a b
m) StrictFingerTree (Measure v) (MeasuredWith v a b)
r'
      -- Empty tree or the measure doesn't match anymore
      ViewL (StrictFingerTree (Measure v)) (MeasuredWith v a b)
_ -> Maybe (AnchoredSeq v a b, AnchoredSeq v a b)
forall a. Maybe a
Nothing

-- | \( O(\log(\min(n_1, n_2))) \). Join two anchored sequences if the given
-- function returns 'True' for the head (newest element or anchor when empty) of
-- the first sequence and the anchor of the second sequence, e.g., when they
-- match.
--
-- The returned sequence will have the same anchor as the first sequence.
join ::
     forall v a b. Anchorable v a b
  => (Either a b -> a -> Bool)
  -> AnchoredSeq v a b
  -> AnchoredSeq v a b
  -> Maybe (AnchoredSeq v a b)
join :: forall v a b.
Anchorable v a b =>
(Either a b -> a -> Bool)
-> AnchoredSeq v a b
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b)
join Either a b -> a -> Bool
f s1 :: AnchoredSeq v a b
s1@(AnchoredSeq a
a1 StrictFingerTree (Measure v) (MeasuredWith v a b)
ft1) (AnchoredSeq a
a2 StrictFingerTree (Measure v) (MeasuredWith v a b)
ft2)
    | Either a b -> a -> Bool
f (AnchoredSeq v a b -> Either a b
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
head AnchoredSeq v a b
s1) a
a2
    = AnchoredSeq v a b -> Maybe (AnchoredSeq v a b)
forall a. a -> Maybe a
Just (AnchoredSeq v a b -> Maybe (AnchoredSeq v a b))
-> AnchoredSeq v a b -> Maybe (AnchoredSeq v a b)
forall a b. (a -> b) -> a -> b
$ a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
forall v a b.
a
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> AnchoredSeq v a b
AnchoredSeq a
a1 (StrictFingerTree (Measure v) (MeasuredWith v a b)
ft1 StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
-> StrictFingerTree (Measure v) (MeasuredWith v a b)
forall v a.
Measured v a =>
StrictFingerTree v a
-> StrictFingerTree v a -> StrictFingerTree v a
FT.>< StrictFingerTree (Measure v) (MeasuredWith v a b)
ft2)
    | Bool
otherwise
    = Maybe (AnchoredSeq v a b)
forall a. Maybe a
Nothing

-- | \( O(o \log(\min(i,n-i))) \). Select the elements and optionally the anchor
-- based on the given offsets, starting from the head of the 'AnchoredSeq'.
--
-- The list of offsets must be increasing monotonically (/strictly increasing is
-- not required).
--
-- __Note__: offset @n@, where @n@ equals the length of the 'AnchoredSeq',
-- corresponds to the anchor. When the sequence is empty, offset 0 will thus
-- correspond to the anchor.
selectOffsets ::
     forall v a b. Anchorable v a b
  => [Int]
  -> AnchoredSeq v a b
  -> [Either a b]
selectOffsets :: forall v a b.
Anchorable v a b =>
[Int] -> AnchoredSeq v a b -> [Either a b]
selectOffsets [Int]
offsets = [Int] -> AnchoredSeq v a b -> [Either a b]
go [Int]
relativeOffsets
  where
    relativeOffsets :: [Int]
relativeOffsets = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Int]
offsets (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
offsets)

    go :: [Int] -> AnchoredSeq v a b -> [Either a b]
    go :: [Int] -> AnchoredSeq v a b -> [Either a b]
go [] AnchoredSeq v a b
_
      = []
    go (Int
off:[Int]
offs) AnchoredSeq v a b
s
      | let i :: Int
i = AnchoredSeq v a b -> Int
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Int
length AnchoredSeq v a b
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off
      , Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
      , (AnchoredSeq v a b
s', AnchoredSeq v a b
_) <- Int -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
forall v a b.
Anchorable v a b =>
Int -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
splitAt Int
i AnchoredSeq v a b
s
      = AnchoredSeq v a b -> Either a b
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
head AnchoredSeq v a b
s' Either a b -> [Either a b] -> [Either a b]
forall a. a -> [a] -> [a]
: [Int] -> AnchoredSeq v a b -> [Either a b]
go [Int]
offs AnchoredSeq v a b
s'
      | Bool
otherwise
      = []

-- | \( O(n) \). Variation on 'filterWithStop' without a stop condition.
filter ::
     forall v a b. Anchorable v a b
  => (b -> Bool)  -- ^ Filtering predicate
  -> AnchoredSeq v a b
  -> [AnchoredSeq v a b]
filter :: forall v a b.
Anchorable v a b =>
(b -> Bool) -> AnchoredSeq v a b -> [AnchoredSeq v a b]
filter b -> Bool
p = (b -> Bool)
-> (b -> Bool) -> AnchoredSeq v a b -> [AnchoredSeq v a b]
forall v a b.
Anchorable v a b =>
(b -> Bool)
-> (b -> Bool) -> AnchoredSeq v a b -> [AnchoredSeq v a b]
filterWithStop b -> Bool
p (Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
False)

-- | \( O(n + r * \log(\min(i,n-i)) \) where /r/ is the number of consecutive
-- ranges of elements to be included in the result.
--
-- Filter out elements that don't match the predicate.
--
-- As filtering removes elements the result is a sequence of disconnected
-- sequences. The sequences are in the original order and are of maximum size.
--
-- As soon as the stop condition is true, the filtering stops and the remaining
-- sequence (starting with the first element for which the stop condition is
-- true) is the final sequence in the returned list.
--
-- The stop condition wins from the filtering predicate: if the stop condition
-- is true for an element, but the filter predicate not, then the element still
-- ends up in final sequence.
--
-- For example, given the sequence containing @[0: 1, 2, 3, 4, 5, 6]@ where the
-- anchor is separated from the elements by @:@:
--
-- > filter         odd        -> [[0: 1], [2: 3], [4: 5]]
-- > filterWithStop odd (>= 4) -> [[0: 1], [2: 3], [3: 4, 5, 6]]
filterWithStop ::
     forall v a b. Anchorable v a b
  => (b -> Bool)  -- ^ Filtering predicate
  -> (b -> Bool)  -- ^ Stop condition
  -> AnchoredSeq v a b
  -> [AnchoredSeq v a b]
filterWithStop :: forall v a b.
Anchorable v a b =>
(b -> Bool)
-> (b -> Bool) -> AnchoredSeq v a b -> [AnchoredSeq v a b]
filterWithStop b -> Bool
p b -> Bool
stop AnchoredSeq v a b
c =
    AnchoredSeq v a b -> FilterRange -> AnchoredSeq v a b
forall v a b.
Anchorable v a b =>
AnchoredSeq v a b -> FilterRange -> AnchoredSeq v a b
applyFilterRange AnchoredSeq v a b
c (FilterRange -> AnchoredSeq v a b)
-> [FilterRange] -> [AnchoredSeq v a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, b)] -> [FilterRange]
startRange ([Int] -> [b] -> [(Int, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (AnchoredSeq v a b -> [b]
forall v a b. AnchoredSeq v a b -> [b]
toOldestFirst AnchoredSeq v a b
c))
  where
    startRange :: [(Int, b)] -> [FilterRange]
    startRange :: [(Int, b)] -> [FilterRange]
startRange [] = []
    startRange ((Int
i, b
b):[(Int, b)]
bs)
        | b -> Bool
stop b
b
         -- We can stop filtering, the last range is from @b@ to the end of the
         -- sequence.
        = [Int -> Int -> FilterRange
FilterRange Int
i (AnchoredSeq v a b -> Int
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Int
length AnchoredSeq v a b
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]

        | b -> Bool
p b
b
          -- We can use @b@ to start a range, try extending it with the next
          -- element
        = Int -> Int -> [(Int, b)] -> [FilterRange]
extendRange Int
i Int
i [(Int, b)]
bs

        | Bool
otherwise
          -- Not part of a range, try the next element
        = [(Int, b)] -> [FilterRange]
startRange [(Int, b)]
bs

    extendRange :: Int -> Int -> [(Int, b)] -> [FilterRange]
    extendRange :: Int -> Int -> [(Int, b)] -> [FilterRange]
extendRange !Int
start !Int
end [] = [Int -> Int -> FilterRange
FilterRange Int
start Int
end]
    extendRange !Int
start !Int
end ((Int
i, b
b):[(Int, b)]
bs)
        | b -> Bool
stop b
b
          -- We can stop filtering, the last range is from @start@ to the end of the
          -- sequence.
        = [Int -> Int -> FilterRange
FilterRange Int
start (AnchoredSeq v a b -> Int
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Int
length AnchoredSeq v a b
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]

        | b -> Bool
p b
b
          -- Extend the open range with @b@
        = Int -> Int -> [(Int, b)] -> [FilterRange]
extendRange Int
start Int
i [(Int, b)]
bs

        | Bool
otherwise
          -- End the open range and try starting another one
        = Int -> Int -> FilterRange
FilterRange Int
start Int
end FilterRange -> [FilterRange] -> [FilterRange]
forall a. a -> [a] -> [a]
: [(Int, b)] -> [FilterRange]
startRange [(Int, b)]
bs

-- | Range with /inclusive/ bounds, i.e., indices, that should be included in
-- the result of a filtering operation.
--
-- INVARIANT: the first lower bound <= the upper bound
--
-- When used in combination with an anchored sequence, both indices should be in
-- the [0, size of sequence) range.
data FilterRange = FilterRange !Int !Int
  deriving (Int -> FilterRange -> ShowS
[FilterRange] -> ShowS
FilterRange -> String
(Int -> FilterRange -> ShowS)
-> (FilterRange -> String)
-> ([FilterRange] -> ShowS)
-> Show FilterRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FilterRange -> ShowS
showsPrec :: Int -> FilterRange -> ShowS
$cshow :: FilterRange -> String
show :: FilterRange -> String
$cshowList :: [FilterRange] -> ShowS
showList :: [FilterRange] -> ShowS
Show)

-- | \( O(\log(\min(i,n-i)) \). Apply a 'FilterRange' to an anchored sequence,
-- returning the sequence matching the range.
--
-- For example, @FilterRange 0 0@ correspond to the first element of the
-- sequence. @FilterRange 0 1@ corresponds to the first two elements of the
-- sequence.
--
-- Since both bounds are inclusive, the sequence is never empty.
--
-- PRECONDITION: both indices are in the @[0, size of sequence)@ range.
applyFilterRange ::
     forall v a b. Anchorable v a b
  => AnchoredSeq v a b
  -> FilterRange
  -> AnchoredSeq v a b
applyFilterRange :: forall v a b.
Anchorable v a b =>
AnchoredSeq v a b -> FilterRange -> AnchoredSeq v a b
applyFilterRange AnchoredSeq v a b
c (FilterRange Int
start Int
stop) = AnchoredSeq v a b
inRange
  where
    (AnchoredSeq v a b
_before, AnchoredSeq v a b
fromStart) = Int -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
forall v a b.
Anchorable v a b =>
Int -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
splitAt Int
start AnchoredSeq v a b
c
    (AnchoredSeq v a b
inRange, AnchoredSeq v a b
_after)    = Int -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
forall v a b.
Anchorable v a b =>
Int -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
splitAt (Int
stop Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) AnchoredSeq v a b
fromStart

-- | \( O(n) \). Naive reference implementation of 'filterWithStop'.
--
-- While the asymptotic complexity of this function is better than that of
-- 'filterWithStop', the allocation cost is high. This function deconstructs and
-- reconstructs the anchored sequence (until the stop condition is reached),
-- even when no elements are removed.
filterWithStopSpec ::
     forall v a b. Anchorable v a b
  => (b -> Bool)  -- ^ Filtering predicate
  -> (b -> Bool)  -- ^ Stop condition
  -> AnchoredSeq v a b
  -> [AnchoredSeq v a b]
filterWithStopSpec :: forall v a b.
Anchorable v a b =>
(b -> Bool)
-> (b -> Bool) -> AnchoredSeq v a b -> [AnchoredSeq v a b]
filterWithStopSpec b -> Bool
p b -> Bool
stop = [AnchoredSeq v a b] -> AnchoredSeq v a b -> [AnchoredSeq v a b]
goNext []
  where
    goNext :: [AnchoredSeq v a b]  -- Previously constructed sequences
           -> AnchoredSeq v a b    -- Sequences still to process
           -> [AnchoredSeq v a b]
    goNext :: [AnchoredSeq v a b] -> AnchoredSeq v a b -> [AnchoredSeq v a b]
goNext [AnchoredSeq v a b]
cs AnchoredSeq v a b
af = [AnchoredSeq v a b]
-> AnchoredSeq v a b -> AnchoredSeq v a b -> [AnchoredSeq v a b]
go [AnchoredSeq v a b]
cs (a -> AnchoredSeq v a b
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
Empty (AnchoredSeq v a b -> a
forall v a b. AnchoredSeq v a b -> a
anchor AnchoredSeq v a b
af)) AnchoredSeq v a b
af

    go :: [AnchoredSeq v a b]  -- Previously constructed sequences
       -> AnchoredSeq v a b    -- Currently accumulating sequence
       -> AnchoredSeq v a b    -- Sequences still to process
       -> [AnchoredSeq v a b]
    go :: [AnchoredSeq v a b]
-> AnchoredSeq v a b -> AnchoredSeq v a b -> [AnchoredSeq v a b]
go [AnchoredSeq v a b]
cs AnchoredSeq v a b
c' af :: AnchoredSeq v a b
af@(b
b :< AnchoredSeq v a b
c) | b -> Bool
stop b
b = [AnchoredSeq v a b] -> [AnchoredSeq v a b]
forall a. [a] -> [a]
reverse (AnchoredSeq v a b -> [AnchoredSeq v a b] -> [AnchoredSeq v a b]
addToAcc (AnchoredSeq v a b -> AnchoredSeq v a b -> AnchoredSeq v a b
join' AnchoredSeq v a b
c' AnchoredSeq v a b
af) [AnchoredSeq v a b]
cs)
                         | b -> Bool
p    b
b = [AnchoredSeq v a b]
-> AnchoredSeq v a b -> AnchoredSeq v a b -> [AnchoredSeq v a b]
go [AnchoredSeq v a b]
cs (AnchoredSeq v a b
c' AnchoredSeq v a b -> b -> AnchoredSeq v a b
forall v a b.
Anchorable v a b =>
AnchoredSeq v a b -> b -> AnchoredSeq v a b
:> b
b) AnchoredSeq v a b
c
    go [AnchoredSeq v a b]
cs AnchoredSeq v a b
c' (b
_ :< AnchoredSeq v a b
c)             = [AnchoredSeq v a b] -> AnchoredSeq v a b -> [AnchoredSeq v a b]
goNext (AnchoredSeq v a b -> [AnchoredSeq v a b] -> [AnchoredSeq v a b]
addToAcc AnchoredSeq v a b
c' [AnchoredSeq v a b]
cs) AnchoredSeq v a b
c
    go [AnchoredSeq v a b]
cs AnchoredSeq v a b
c' (Empty a
_)            = [AnchoredSeq v a b] -> [AnchoredSeq v a b]
forall a. [a] -> [a]
reverse (AnchoredSeq v a b -> [AnchoredSeq v a b] -> [AnchoredSeq v a b]
addToAcc AnchoredSeq v a b
c' [AnchoredSeq v a b]
cs)

    addToAcc :: AnchoredSeq v a b
             -> [AnchoredSeq v a b]
             -> [AnchoredSeq v a b]
    addToAcc :: AnchoredSeq v a b -> [AnchoredSeq v a b] -> [AnchoredSeq v a b]
addToAcc (Empty a
_) [AnchoredSeq v a b]
acc =    [AnchoredSeq v a b]
acc
    addToAcc AnchoredSeq v a b
c'        [AnchoredSeq v a b]
acc = AnchoredSeq v a b
c'AnchoredSeq v a b -> [AnchoredSeq v a b] -> [AnchoredSeq v a b]
forall a. a -> [a] -> [a]
:[AnchoredSeq v a b]
acc

    -- This is called with @c'@ and @(b : < c)@. @c'@ is the sequence containing
    -- the elements before @b@, so they must be joinable.
    join' :: AnchoredSeq v a b
          -> AnchoredSeq v a b
          -> AnchoredSeq v a b
    join' :: AnchoredSeq v a b -> AnchoredSeq v a b -> AnchoredSeq v a b
join' AnchoredSeq v a b
a AnchoredSeq v a b
b =
        AnchoredSeq v a b -> Maybe (AnchoredSeq v a b) -> AnchoredSeq v a b
forall a. a -> Maybe a -> a
fromMaybe (String -> AnchoredSeq v a b
forall a. HasCallStack => String -> a
error String
"could not join sequences") (Maybe (AnchoredSeq v a b) -> AnchoredSeq v a b)
-> Maybe (AnchoredSeq v a b) -> AnchoredSeq v a b
forall a b. (a -> b) -> a -> b
$
        (Either a b -> a -> Bool)
-> AnchoredSeq v a b
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b)
forall v a b.
Anchorable v a b =>
(Either a b -> a -> Bool)
-> AnchoredSeq v a b
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b)
join (\Either a b
_ a
_ -> Bool
True) AnchoredSeq v a b
a AnchoredSeq v a b
b