{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}

-- |
-- This is an internal module. You probably don't need to import this. Use
-- "Data.Seqn.MSeq" instead.
--
-- = WARNING
--
-- Definitions in this module allow violating invariants that would otherwise be
-- guaranteed by "Data.Seqn.MSeq". Use at your own risk!
--
module Data.Seqn.Internal.MSeq
  (
    -- * MSeq
    MSeq(..)

    -- * Construct
  , empty
  , singleton
  , fromList
  , fromRevList
  , replicate
  , replicateA
  , generate
  , generateA
  , unfoldr
  , unfoldl
  , unfoldrM
  , unfoldlM
  , concatMap
  , mfix

    -- * Convert
  , toRevList

    -- * Index
  , lookup
  , index
  , (!?)
  , (!)
  , update
  , adjust
  , insertAt
  , deleteAt

    -- * Slice
  , cons
  , snoc
  , uncons
  , unsnoc
  , take
  , drop
  , slice
  , splitAt
  , takeEnd
  , dropEnd
  , splitAtEnd

    -- * Filter
  , filter
  , mapMaybe
  , mapEither
  , filterA
  , mapMaybeA
  , mapEitherA
  , takeWhile
  , dropWhile
  , span
  , break
  , takeWhileEnd
  , dropWhileEnd
  , spanEnd
  , breakEnd

    -- * Transform
  , map
  , liftA2
  , traverse
  , imap
  , itraverse
  , reverse
  , intersperse
  , scanl
  , scanr
  , sort
  , sortBy

    -- * Search and test
  , findEnd
  , findIndex
  , findIndexEnd
  , infixIndices
  , binarySearchFind
  , isPrefixOf
  , isSuffixOf
  , isInfixOf
  , isSubsequenceOf

    -- * Zip and unzip
  , zipWith
  , zipWith3
  , zipWithM
  , zipWith3M
  , unzipWith
  , unzipWith3

    -- * Measured queries
  , summaryMay
  , summary
  , sliceSummaryMay
  , sliceSummary
  , foldlSliceSummaryComponents
  , binarySearchPrefix
  , binarySearchSuffix

    -- * Force
  , liftRnf2

    -- * Internal
  , fromMTree

    -- * Testing
  , valid
  , debugShowsPrec
  ) where

import Prelude hiding (break, concatMap, drop, dropWhile, filter, liftA2, lookup, map, replicate, reverse, scanl, scanr, span, splitAt, take, takeWhile, traverse, unzip, unzip3, zip, zip3, zipWith, zipWith3)
import qualified Control.Applicative as Ap
import Control.Applicative.Backwards (Backwards(..))
import Control.DeepSeq (NFData(..))
import Data.Bifunctor (Bifunctor(..))
import Data.Coerce (coerce)
import qualified Data.Foldable as F
import qualified Data.Foldable.WithIndex as IFo
import Data.Functor.Classes (Eq1(..), Ord1(..), Show1(..))
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (fromMaybe)
import qualified Data.Monoid as Monoid
import qualified Data.Primitive.Array as A
import Data.Semigroup (Semigroup(..))
import qualified Data.SamSort as Sam
import qualified GHC.Exts as X
import Text.Read (Read(..))
import qualified Text.Read as Read

import Data.Seqn.Internal.MTree (Measured(..), MTree(..))
import qualified Data.Seqn.Internal.MTree as T
import qualified Data.Seqn.Internal.Util as U
import qualified Data.Seqn.Internal.Stream as Stream
import Data.Seqn.Internal.Stream (Step(..), Stream(..))
import qualified Data.Seqn.Internal.KMP as KMP

--------
-- Seq
--------

-- | A sequence with elements of type @a@. An instance of @'Measured' a@ is
-- required for most operations.
data MSeq a
  = MTree !a !(MTree a)
  | MEmpty
-- See Note [Seq structure] in Data.Seqn.Internal.Seq

--------------
-- Instances
--------------

instance Eq a => Eq (MSeq a) where
  MSeq a
t1 == :: MSeq a -> MSeq a -> Bool
== MSeq a
t2 = MSeq a -> MSeq a -> Ordering
forall a b. MSeq a -> MSeq b -> Ordering
compareLength MSeq a
t1 MSeq a
t2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ Bool -> Bool -> Bool
&& MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream MSeq a
t1 Stream a -> Stream a -> Bool
forall a. Eq a => a -> a -> Bool
== MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream MSeq a
t2
  {-# INLINABLE (==) #-}

-- | Lexicographical ordering
instance Ord a => Ord (MSeq a) where
  compare :: MSeq a -> MSeq a -> Ordering
compare MSeq a
t1 MSeq a
t2 = Stream a -> Stream a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream MSeq a
t1) (MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream MSeq a
t2)
  {-# INLINABLE compare #-}

instance Show a => Show (MSeq a) where
  showsPrec :: Int -> MSeq a -> ShowS
showsPrec Int
_ MSeq a
t = [a] -> ShowS
forall a. Show a => a -> ShowS
shows (MSeq a -> [a]
forall a. MSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList MSeq a
t)
  {-# INLINABLE showsPrec #-}

instance (Measured a, Read a) => Read (MSeq a) where
  readPrec :: ReadPrec (MSeq a)
readPrec = ([a] -> MSeq a) -> ReadPrec [a] -> ReadPrec (MSeq a)
forall a b. (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> MSeq a
forall a. Measured a => [a] -> MSeq a
fromList ReadPrec [a]
forall a. Read a => ReadPrec [a]
readListPrec
  {-# INLINABLE readPrec #-}

  readListPrec :: ReadPrec [MSeq a]
readListPrec = ReadPrec [MSeq a]
forall a. Read a => ReadPrec [a]
Read.readListPrecDefault
  {-# INLINABLE readListPrec #-}

instance Eq1 MSeq where
  liftEq :: forall a b. (a -> b -> Bool) -> MSeq a -> MSeq b -> Bool
liftEq a -> b -> Bool
f MSeq a
t1 MSeq b
t2 = MSeq a -> MSeq b -> Ordering
forall a b. MSeq a -> MSeq b -> Ordering
compareLength MSeq a
t1 MSeq b
t2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ Bool -> Bool -> Bool
&& (a -> b -> Bool) -> Stream a -> Stream b -> Bool
forall a b. (a -> b -> Bool) -> Stream a -> Stream b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f (MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream MSeq a
t1) (MSeq b -> Stream b
forall a. MSeq a -> Stream a
stream MSeq b
t2)
  {-# INLINE liftEq #-}

instance Ord1 MSeq where
  liftCompare :: forall a b. (a -> b -> Ordering) -> MSeq a -> MSeq b -> Ordering
liftCompare a -> b -> Ordering
f MSeq a
t1 MSeq b
t2 = (a -> b -> Ordering) -> Stream a -> Stream b -> Ordering
forall a b.
(a -> b -> Ordering) -> Stream a -> Stream b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f (MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream MSeq a
t1) (MSeq b -> Stream b
forall a. MSeq a -> Stream a
stream MSeq b
t2)
  {-# INLINE liftCompare #-}

instance Show1 MSeq where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> MSeq a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
sl Int
_ MSeq a
t = [a] -> ShowS
sl (MSeq a -> [a]
forall a. MSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList MSeq a
t)
  {-# INLINE liftShowsPrec #-}

-- |
-- [@length@]: \(O(1)\).
--
-- Folds are \(O(n)\).
instance Foldable MSeq where
  fold :: forall m. Monoid m => MSeq m -> m
fold = (m -> m) -> MSeq m -> m
forall m a. Monoid m => (a -> m) -> MSeq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap m -> m
forall a. a -> a
id
  {-# INLINABLE fold #-}

  foldMap :: forall m a. Monoid m => (a -> m) -> MSeq a -> m
foldMap a -> m
f = \case
    MTree a
x MTree a
xs -> a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> MTree a -> m
forall a m. Monoid m => (a -> m) -> MTree a -> m
T.foldMap a -> m
f MTree a
xs
    MSeq a
MEmpty -> m
forall a. Monoid a => a
mempty
  {-# INLINE foldMap #-}

  foldMap' :: forall m a. Monoid m => (a -> m) -> MSeq a -> m
foldMap' a -> m
f = (m -> a -> m) -> m -> MSeq a -> m
forall b a. (b -> a -> b) -> b -> MSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\m
z a
x -> m
z m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
x) m
forall a. Monoid a => a
mempty
  {-# INLINE foldMap' #-}

  foldr :: forall a b. (a -> b -> b) -> b -> MSeq a -> b
foldr a -> b -> b
f b
z = (a -> b -> b) -> b -> Stream a -> b
forall a b. (a -> b -> b) -> b -> Stream a -> b
Stream.foldr a -> b -> b
f b
z (Stream a -> b) -> (MSeq a -> Stream a) -> MSeq a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream
  {-# INLINE foldr #-}

  foldl :: forall b a. (b -> a -> b) -> b -> MSeq a -> b
foldl b -> a -> b
f b
z = (a -> b -> b) -> b -> Stream a -> b
forall a b. (a -> b -> b) -> b -> Stream a -> b
Stream.foldr ((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
f) b
z (Stream a -> b) -> (MSeq a -> Stream a) -> MSeq a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSeq a -> Stream a
forall a. MSeq a -> Stream a
streamEnd
  {-# INLINE foldl #-}

  foldl' :: forall b a. (b -> a -> b) -> b -> MSeq a -> b
foldl' b -> a -> b
f !b
z = \case
    MTree a
x MTree a
xs -> (b -> a -> b) -> b -> MTree a -> b
forall b a. (b -> a -> b) -> b -> MTree a -> b
T.foldl' b -> a -> b
f (b -> a -> b
f b
z a
x) MTree a
xs
    MSeq a
MEmpty -> b
z
  {-# INLINE foldl' #-}

  foldr' :: forall a b. (a -> b -> b) -> b -> MSeq a -> b
foldr' a -> b -> b
f !b
z = \case
    MTree a
x MTree a
xs -> a -> b -> b
f a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! (a -> b -> b) -> b -> MTree a -> b
forall a b. (a -> b -> b) -> b -> MTree a -> b
T.foldr' a -> b -> b
f b
z MTree a
xs
    MSeq a
MEmpty -> b
z
  {-# INLINE foldr' #-}

  null :: forall a. MSeq a -> Bool
null = \case
    MTree a
_ MTree a
_ -> Bool
False
    MSeq a
MEmpty -> Bool
True

  length :: forall a. MSeq a -> Int
length = \case
    MTree a
_ MTree a
xs -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs
    MSeq a
MEmpty -> Int
0

instance Measured a => X.IsList (MSeq a) where
  type Item (MSeq a) = a
  fromList :: [Item (MSeq a)] -> MSeq a
fromList = [a] -> MSeq a
[Item (MSeq a)] -> MSeq a
forall a. Measured a => [a] -> MSeq a
fromList
  {-# INLINE fromList #-}

  toList :: MSeq a -> [Item (MSeq a)]
toList = MSeq a -> [a]
MSeq a -> [Item (MSeq a)]
forall a. MSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
  {-# INLINE toList #-}

instance IFo.FoldableWithIndex Int MSeq where
  ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> MSeq a -> m
ifoldMap Int -> a -> m
f = \case
    MTree a
x MTree a
xs -> Int -> a -> m
f Int
0 a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (Int -> a -> m) -> Int -> MTree a -> m
forall m a. Monoid m => (Int -> a -> m) -> Int -> MTree a -> m
T.ifoldMap Int -> a -> m
f Int
1 MTree a
xs
    MSeq a
MEmpty -> m
forall a. Monoid a => a
mempty
  {-# INLINE ifoldMap #-}

  ifoldr :: forall a b. (Int -> a -> b -> b) -> b -> MSeq a -> b
ifoldr Int -> a -> b -> b
f b
z = (Int -> a -> b -> b) -> b -> Int -> (Int -> Int) -> Stream a -> b
forall a b.
(Int -> a -> b -> b) -> b -> Int -> (Int -> Int) -> Stream a -> b
Stream.ifoldr Int -> a -> b -> b
f b
z Int
0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Stream a -> b) -> (MSeq a -> Stream a) -> MSeq a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream
  {-# INLINE ifoldr #-}

  ifoldl :: forall b a. (Int -> b -> a -> b) -> b -> MSeq a -> b
ifoldl Int -> b -> a -> b
f b
z = \MSeq a
t ->
    (Int -> a -> b -> b) -> b -> Int -> (Int -> Int) -> Stream a -> b
forall a b.
(Int -> a -> b -> b) -> b -> Int -> (Int -> Int) -> Stream a -> b
Stream.ifoldr ((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> a -> b) -> a -> b -> b)
-> (Int -> b -> a -> b) -> Int -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> a -> b
f) b
z (MSeq a -> Int
forall a. MSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MSeq a
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) (MSeq a -> Stream a
forall a. MSeq a -> Stream a
streamEnd MSeq a
t)
  {-# INLINE ifoldl #-}

  ifoldr' :: forall a b. (Int -> a -> b -> b) -> b -> MSeq a -> b
ifoldr' Int -> a -> b -> b
f !b
z = \case
    MTree a
x MTree a
xs -> Int -> a -> b -> b
f Int
0 a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! (Int -> a -> b -> b) -> b -> Int -> MTree a -> b
forall a b. (Int -> a -> b -> b) -> b -> Int -> MTree a -> b
T.ifoldr' Int -> a -> b -> b
f b
z (MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs) MTree a
xs
    MSeq a
MEmpty -> b
z
  {-# INLINE ifoldr' #-}

  ifoldl' :: forall b a. (Int -> b -> a -> b) -> b -> MSeq a -> b
ifoldl' Int -> b -> a -> b
f !b
z = \case
    MTree a
x MTree a
xs -> (Int -> b -> a -> b) -> b -> Int -> MTree a -> b
forall b a. (Int -> b -> a -> b) -> b -> Int -> MTree a -> b
T.ifoldl' Int -> b -> a -> b
f (Int -> b -> a -> b
f Int
0 b
z a
x) Int
1 MTree a
xs
    MSeq a
MEmpty -> b
z
  {-# INLINE ifoldl' #-}

-- |
-- [@(<>)@]: \(O(\left| \log n_1 - \log n_2 \right|)\). Concatenates two
-- sequences.
--
-- [@stimes@]: \(O(\log c)\). @stimes c xs@ is @xs@ repeating @c@ times. If
-- @c < 0@, 'empty' is returned.
instance Measured a => Semigroup (MSeq a) where
  MTree a
x MTree a
xs <> :: MSeq a -> MSeq a -> MSeq a
<> MTree a
y MTree a
ys = a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
T.link a
y MTree a
xs MTree a
ys)
  MSeq a
l <> MSeq a
MEmpty = MSeq a
l
  MSeq a
MEmpty <> MSeq a
r = MSeq a
r
  {-# INLINABLE (<>) #-}

  stimes :: forall b. Integral b => b -> MSeq a -> MSeq a
stimes !b
c = \case
    t :: MSeq a
t@(MTree a
x MTree a
xs)
      | b
c b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 -> MSeq a
forall a. MSeq a
MEmpty
      | b -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
toi (MSeq a -> Int
forall a. MSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MSeq a
t) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
toi (Int
forall a. Bounded a => a
maxBound :: Int) ->
          String -> MSeq a
forall a. HasCallStack => String -> a
error String
"MSeq.stimes: result size too large"
      | Bool
otherwise -> a -> Int -> MTree a -> MTree a -> MSeq a
forall a. Measured a => a -> Int -> MTree a -> MTree a -> MSeq a
stimesGo a
x (Int
c'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
xs MTree a
xs
      where
        c' :: Int
c' = b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
c :: Int
        toi :: Int -> Integer
        toi :: Int -> Integer
toi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    MSeq a
MEmpty -> MSeq a
forall a. MSeq a
MEmpty
  {-# INLINABLE stimes #-}
  -- See Note [Complexity of stimes] in Data.Seqn.Internal.Seq

  sconcat :: NonEmpty (MSeq a) -> MSeq a
sconcat (MSeq a
x:|[MSeq a]
xs) = [MSeq a] -> MSeq a
forall a. Monoid a => [a] -> a
mconcat (MSeq a
xMSeq a -> [MSeq a] -> [MSeq a]
forall a. a -> [a] -> [a]
:[MSeq a]
xs)
  {-# INLINABLE sconcat #-}

stimesGo :: Measured a => a -> Int -> MTree a -> MTree a -> MSeq a
stimesGo :: forall a. Measured a => a -> Int -> MTree a -> MTree a -> MSeq a
stimesGo !a
x = Int -> MTree a -> MTree a -> MSeq a
go
  where
    go :: Int -> MTree a -> MTree a -> MSeq a
go Int
c !MTree a
xs !MTree a
acc
      | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x MTree a
acc
      | Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> MTree a -> MTree a -> MSeq a
go (Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
T.bin a
x MTree a
xs MTree a
xs) MTree a
acc
      | Bool
otherwise = Int -> MTree a -> MTree a -> MSeq a
go (Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
T.bin a
x MTree a
xs MTree a
xs) (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
T.link a
x MTree a
xs MTree a
acc)
{-# INLINE stimesGo #-}

-- |
-- [@mempty@]: The empty sequence.
instance Measured a => Monoid (MSeq a) where
  mempty :: MSeq a
mempty = MSeq a
forall a. MSeq a
MEmpty

  mconcat :: [MSeq a] -> MSeq a
mconcat = (MSeq a -> MSeq a) -> [MSeq a] -> MSeq a
forall b (f :: * -> *) a.
(Measured b, Foldable f) =>
(a -> MSeq b) -> f a -> MSeq b
concatMap MSeq a -> MSeq a
forall a. a -> a
id
  {-# INLINE mconcat #-} -- Inline for fusion

instance (NFData (Measure a), NFData a) => NFData (MSeq a) where
  rnf :: MSeq a -> ()
rnf = \case
    MTree a
x MTree a
xs -> a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> () -> ()
forall a b. a -> b -> b
`seq` MTree a -> ()
forall a. NFData a => a -> ()
rnf MTree a
xs
    MSeq a
MEmpty -> ()
  {-# INLINABLE rnf #-}

--------------
-- Construct
--------------

-- | The empty sequence.
empty :: MSeq a
empty :: forall a. MSeq a
empty = MSeq a
forall a. MSeq a
MEmpty

-- | A singleton sequence.
singleton :: a -> MSeq a
singleton :: forall a. a -> MSeq a
singleton a
x = a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x MTree a
forall a. MTree a
T.MTip

-- | \(O(n)\). Create an @MSeq@ from a list.
fromList :: Measured a => [a] -> MSeq a
fromList :: forall a. Measured a => [a] -> MSeq a
fromList = Stack a -> MSeq a
forall a. Measured a => Stack a -> MSeq a
ltrFinish (Stack a -> MSeq a) -> ([a] -> Stack a) -> [a] -> MSeq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> a -> Stack a) -> Stack a -> [a] -> Stack a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Stack a -> a -> Stack a
forall a. Measured a => Stack a -> a -> Stack a
ltrPush Stack a
forall a. Stack a
Nil
{-# INLINE fromList #-}
-- See Note [fromList implementation]

-- | \(O(n)\). Create an @MSeq@ from a reversed list.
fromRevList :: Measured a => [a] -> MSeq a
fromRevList :: forall a. Measured a => [a] -> MSeq a
fromRevList = Stack a -> MSeq a
forall a. Measured a => Stack a -> MSeq a
rtlFinish (Stack a -> MSeq a) -> ([a] -> Stack a) -> [a] -> MSeq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> a -> Stack a) -> Stack a -> [a] -> Stack a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ((a -> Stack a -> Stack a) -> Stack a -> a -> Stack a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Stack a -> Stack a
forall a. Measured a => a -> Stack a -> Stack a
rtlPush) Stack a
forall a. Stack a
Nil
{-# INLINE fromRevList #-}
-- See Note [fromList implementation]

-- | \(O(\log n)\). A sequence with a repeated element.
-- If the length is negative, 'empty' is returned.
replicate :: Measured a => Int -> a -> MSeq a
replicate :: forall a. Measured a => Int -> a -> MSeq a
replicate Int
n !a
x
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = MSeq a
forall a. MSeq a
MEmpty
  | Bool
otherwise = a -> Int -> MTree a -> MTree a -> MSeq a
forall a. Measured a => a -> Int -> MTree a -> MTree a -> MSeq a
stimesGo a
x (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip
{-# INLINABLE replicate #-}

-- | \(O(n)\). Generate a sequence from a length and an applicative action.
-- If the length is negative, 'empty' is returned.
replicateA :: (Measured a, Applicative f) => Int -> f a -> f (MSeq a)
replicateA :: forall a (f :: * -> *).
(Measured a, Applicative f) =>
Int -> f a -> f (MSeq a)
replicateA !Int
n f a
m = Int -> (Int -> f a) -> f (MSeq a)
forall a (f :: * -> *).
(Measured a, Applicative f) =>
Int -> (Int -> f a) -> f (MSeq a)
generateA Int
n (f a -> Int -> f a
forall a b. a -> b -> a
const f a
m)
{-# INLINABLE replicateA #-}

-- | \(O(n)\). Generate a sequence from a length and a generator.
-- If the length is negative, 'empty' is returned.
generate :: Measured a => Int -> (Int -> a) -> MSeq a
generate :: forall a. Measured a => Int -> (Int -> a) -> MSeq a
generate =
  ((Int -> (Int -> Identity a) -> Identity (MSeq a))
-> Int -> (Int -> a) -> MSeq a
forall {a}.
(Int -> (Int -> Identity a) -> Identity (MSeq a))
-> Int -> (Int -> a) -> MSeq a
forall a b. Coercible a b => a -> b
coerce :: (Int -> (Int -> Identity a) -> Identity (MSeq a))
          -> Int -> (Int -> a) -> MSeq a)
  Int -> (Int -> Identity a) -> Identity (MSeq a)
forall a (f :: * -> *).
(Measured a, Applicative f) =>
Int -> (Int -> f a) -> f (MSeq a)
generateA
{-# INLINE generate #-}

-- | \(O(n)\). Generate a sequence from a length and an applicative generator.
-- If the length is negative, 'empty' is returned.
generateA
  :: (Measured a, Applicative f) => Int -> (Int -> f a) -> f (MSeq a)
generateA :: forall a (f :: * -> *).
(Measured a, Applicative f) =>
Int -> (Int -> f a) -> f (MSeq a)
generateA Int
n Int -> f a
f
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = MSeq a -> f (MSeq a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MSeq a
forall a. MSeq a
MEmpty
  | Bool
otherwise = (a -> MTree a -> MSeq a) -> f a -> f (MTree a) -> f (MSeq a)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree (Int -> f a
f Int
0) ((Int -> f a) -> Int -> Int -> f (MTree a)
forall a (f :: * -> *).
(Measured a, Applicative f) =>
(Int -> f a) -> Int -> Int -> f (MTree a)
T.generateA Int -> f a
f Int
1 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
{-# INLINE generateA #-}

-- | \(O(n)\). Unfold a sequence from left to right.
unfoldr :: Measured a => (b -> Maybe (a, b)) -> b -> MSeq a
unfoldr :: forall a b. Measured a => (b -> Maybe (a, b)) -> b -> MSeq a
unfoldr =
  (((b -> Identity (Maybe (a, b))) -> b -> Identity (MSeq a))
-> (b -> Maybe (a, b)) -> b -> MSeq a
forall {b} {a}.
((b -> Identity (Maybe (a, b))) -> b -> Identity (MSeq a))
-> (b -> Maybe (a, b)) -> b -> MSeq a
forall a b. Coercible a b => a -> b
coerce :: ((b -> Identity (Maybe (a, b))) -> b -> Identity (MSeq a))
          -> (b -> Maybe (a, b)) -> b -> MSeq a)
  (b -> Identity (Maybe (a, b))) -> b -> Identity (MSeq a)
forall a (m :: * -> *) b.
(Measured a, Monad m) =>
(b -> m (Maybe (a, b))) -> b -> m (MSeq a)
unfoldrM
{-# INLINE unfoldr #-}

-- | \(O(n)\). Unfold a sequence monadically from left to right.
unfoldrM :: (Measured a, Monad m) => (b -> m (Maybe (a, b))) -> b -> m (MSeq a)
unfoldrM :: forall a (m :: * -> *) b.
(Measured a, Monad m) =>
(b -> m (Maybe (a, b))) -> b -> m (MSeq a)
unfoldrM b -> m (Maybe (a, b))
f = Stack a -> b -> m (MSeq a)
go Stack a
forall a. Stack a
Nil
  where
    go :: Stack a -> b -> m (MSeq a)
go !Stack a
b b
z = b -> m (Maybe (a, b))
f b
z m (Maybe (a, b)) -> (Maybe (a, b) -> m (MSeq a)) -> m (MSeq a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (a, b)
Nothing -> MSeq a -> m (MSeq a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MSeq a -> m (MSeq a)) -> MSeq a -> m (MSeq a)
forall a b. (a -> b) -> a -> b
$! Stack a -> MSeq a
forall a. Measured a => Stack a -> MSeq a
ltrFinish Stack a
b
      Just (a
x, b
z') -> Stack a -> b -> m (MSeq a)
go (Stack a -> a -> Stack a
forall a. Measured a => Stack a -> a -> Stack a
ltrPush Stack a
b a
x) b
z'
{-# INLINE unfoldrM #-}

-- | \(O(n)\). Unfold a sequence from right to left.
unfoldl :: Measured a => (b -> Maybe (b, a)) -> b -> MSeq a
unfoldl :: forall a b. Measured a => (b -> Maybe (b, a)) -> b -> MSeq a
unfoldl =
  (((b -> Identity (Maybe (b, a))) -> b -> Identity (MSeq a))
-> (b -> Maybe (b, a)) -> b -> MSeq a
forall {b} {a}.
((b -> Identity (Maybe (b, a))) -> b -> Identity (MSeq a))
-> (b -> Maybe (b, a)) -> b -> MSeq a
forall a b. Coercible a b => a -> b
coerce :: ((b -> Identity (Maybe (b, a))) -> b -> Identity (MSeq a))
          -> (b -> Maybe (b, a)) -> b -> MSeq a)
  (b -> Identity (Maybe (b, a))) -> b -> Identity (MSeq a)
forall a (m :: * -> *) b.
(Measured a, Monad m) =>
(b -> m (Maybe (b, a))) -> b -> m (MSeq a)
unfoldlM
{-# INLINE unfoldl #-}

-- | \(O(n)\). Unfold a sequence monadically from right to left.
unfoldlM :: (Measured a, Monad m) => (b -> m (Maybe (b, a))) -> b -> m (MSeq a)
unfoldlM :: forall a (m :: * -> *) b.
(Measured a, Monad m) =>
(b -> m (Maybe (b, a))) -> b -> m (MSeq a)
unfoldlM b -> m (Maybe (b, a))
f = Stack a -> b -> m (MSeq a)
go Stack a
forall a. Stack a
Nil
  where
    go :: Stack a -> b -> m (MSeq a)
go !Stack a
b b
z = b -> m (Maybe (b, a))
f b
z m (Maybe (b, a)) -> (Maybe (b, a) -> m (MSeq a)) -> m (MSeq a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (b, a)
Nothing -> MSeq a -> m (MSeq a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MSeq a -> m (MSeq a)) -> MSeq a -> m (MSeq a)
forall a b. (a -> b) -> a -> b
$! Stack a -> MSeq a
forall a. Measured a => Stack a -> MSeq a
rtlFinish Stack a
b
      Just (b
z', a
x) -> Stack a -> b -> m (MSeq a)
go (a -> Stack a -> Stack a
forall a. Measured a => a -> Stack a -> Stack a
rtlPush a
x Stack a
b) b
z'
{-# INLINE unfoldlM #-}

-- | \(O \left(\sum_i \log n_i \right)\).
-- Map over a @Foldable@ and concatenate the results.
concatMap :: (Measured b, Foldable f) => (a -> MSeq b) -> f a -> MSeq b
concatMap :: forall b (f :: * -> *) a.
(Measured b, Foldable f) =>
(a -> MSeq b) -> f a -> MSeq b
concatMap a -> MSeq b
f = Stack b -> MSeq b
forall a. Measured a => Stack a -> MSeq a
ltrFinish (Stack b -> MSeq b) -> (f a -> Stack b) -> f a -> MSeq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack b -> a -> Stack b) -> Stack b -> f a -> Stack b
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Stack b -> a -> Stack b
g Stack b
forall a. Stack a
Nil
  where
    g :: Stack b -> a -> Stack b
g Stack b
b a
x = case a -> MSeq b
f a
x of
      MSeq b
MEmpty -> Stack b
b
      MTree b
y MTree b
ys -> Stack b -> b -> MTree b -> Stack b
forall a. Measured a => Stack a -> a -> MTree a -> Stack a
ltrPushMany Stack b
b b
y MTree b
ys
    {-# INLINE g #-}
{-# INLINE concatMap #-}
-- See Note [concatMap implementation]

-- | Monadic fixed point. See "Control.Monad.Fix".
mfix :: Measured a => (a -> MSeq a) -> MSeq a
mfix :: forall a. Measured a => (a -> MSeq a) -> MSeq a
mfix a -> MSeq a
f =
  (Int -> a -> a) -> MSeq a -> MSeq a
forall b a. Measured b => (Int -> a -> b) -> MSeq a -> MSeq b
imap
    (\Int
i a
_ -> let x :: a
x = Int -> MSeq a -> a
forall a. Int -> MSeq a -> a
index Int
i (a -> MSeq a
f a
x) in a
x)
    (a -> MSeq a
f (String -> a
forall a. HasCallStack => String -> a
error String
"MSeq.mfix: f must be lazy"))
{-# INLINE mfix #-}

------------
-- Convert
------------

-- | \(O(n)\). Convert to a list in reverse.
--
-- To convert to a list without reversing, use
-- @Data.Foldable.'Data.Foldable.toList'@.
toRevList :: MSeq a -> [a]
toRevList :: forall a. MSeq a -> [a]
toRevList MSeq a
t = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
X.build ((forall b. (a -> b -> b) -> b -> b) -> [a])
-> (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a b. (a -> b) -> a -> b
$ \a -> b -> b
lcons b
lnil -> (b -> a -> b) -> b -> MSeq a -> b
forall b a. (b -> a -> b) -> b -> MSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl ((a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
lcons) b
lnil MSeq a
t
{-# INLINE toRevList #-}

----------
-- Index
----------

-- | \(O(\log n)\). Look up the element at an index.
lookup :: Int -> MSeq a -> Maybe a
lookup :: forall a. Int -> MSeq a -> Maybe a
lookup !Int
i (MTree a
x MTree a
xs)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = Maybe a
forall a. Maybe a
Nothing
  | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
x
  | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$! Int -> MTree a -> a
forall a. Int -> MTree a -> a
T.index (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
xs
lookup Int
_ MSeq a
MEmpty = Maybe a
forall a. Maybe a
Nothing
{-# INLINE lookup #-}

-- | \(O(\log n)\). Look up the element at an index. Calls @error@ if the index
-- is out of bounds.
index :: Int -> MSeq a -> a
index :: forall a. Int -> MSeq a -> a
index !Int
i = \case
  MTree a
x MTree a
xs
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> a
x
    | Bool
otherwise -> Int -> MTree a -> a
forall a. Int -> MTree a -> a
T.index (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
xs
  MSeq a
MEmpty -> String -> a
forall a. HasCallStack => String -> a
error String
"MSeq.index: out of bounds"

-- | \(O(\log n)\). Infix version of 'lookup'.
(!?) :: MSeq a -> Int -> Maybe a
!? :: forall a. MSeq a -> Int -> Maybe a
(!?) = (Int -> MSeq a -> Maybe a) -> MSeq a -> Int -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> MSeq a -> Maybe a
forall a. Int -> MSeq a -> Maybe a
lookup
{-# INLINE (!?) #-}

-- | \(O(\log n)\). Infix version of 'index'. Calls @error@ if the index is out
-- of bounds.
(!) :: MSeq a -> Int -> a
! :: forall a. MSeq a -> Int -> a
(!) = (Int -> MSeq a -> a) -> MSeq a -> Int -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> MSeq a -> a
forall a. Int -> MSeq a -> a
index

-- | \(O(\log n)\). Update an element at an index. If the index is out of
-- bounds, the sequence is returned unchanged.
update :: Measured a => Int -> a -> MSeq a -> MSeq a
update :: forall a. Measured a => Int -> a -> MSeq a -> MSeq a
update Int
i a
x MSeq a
t = (a -> a) -> Int -> MSeq a -> MSeq a
forall a. Measured a => (a -> a) -> Int -> MSeq a -> MSeq a
adjust (a -> a -> a
forall a b. a -> b -> a
const a
x) Int
i MSeq a
t
{-# INLINABLE update #-}

-- | \(O(\log n)\). Adjust the element at an index. If the index is out of
-- bounds, the sequence is returned unchanged.
adjust :: Measured a => (a -> a) -> Int -> MSeq a -> MSeq a
adjust :: forall a. Measured a => (a -> a) -> Int -> MSeq a -> MSeq a
adjust a -> a
f !Int
i MSeq a
t = case MSeq a
t of
  MTree a
x MTree a
xs
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i -> MSeq a
t
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree (a -> a
f a
x) MTree a
xs
    | Bool
otherwise -> a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x (Identity (MTree a) -> MTree a
forall a. Identity a -> a
runIdentity ((a -> Identity a) -> Int -> MTree a -> Identity (MTree a)
forall a (f :: * -> *).
(Measured a, Functor f) =>
(a -> f a) -> Int -> MTree a -> f (MTree a)
T.adjustF (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> (a -> a) -> a -> Identity a
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
U.#. a -> a
f) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
xs))
  MSeq a
MEmpty -> MSeq a
forall a. MSeq a
MEmpty
{-# INLINE adjust #-}

-- | \(O(\log n)\). Insert an element at an index. If the index is out of
-- bounds, the element is added to the closest end of the sequence.
insertAt :: Measured a => Int -> a -> MSeq a -> MSeq a
insertAt :: forall a. Measured a => Int -> a -> MSeq a -> MSeq a
insertAt !Int
i a
y MSeq a
t = case MSeq a
t of
  MTree a
x MTree a
xs
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> a -> MSeq a -> MSeq a
forall a. Measured a => a -> MSeq a -> MSeq a
cons a
y MSeq a
t
    | Bool
otherwise -> a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x (Int -> a -> MTree a -> MTree a
forall a. Measured a => Int -> a -> MTree a -> MTree a
T.insertAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
y MTree a
xs)
  MSeq a
MEmpty -> a -> MSeq a
forall a. a -> MSeq a
singleton a
y
{-# INLINABLE insertAt #-}

-- | \(O(\log n)\). Delete an element at an index. If the index is out of
-- bounds, the sequence is returned unchanged.
deleteAt :: Measured a => Int -> MSeq a -> MSeq a
deleteAt :: forall a. Measured a => Int -> MSeq a -> MSeq a
deleteAt !Int
i MSeq a
t = case MSeq a
t of
  MTree a
x MTree a
xs
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i -> MSeq a
t
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> MTree a -> MSeq a
forall a. Measured a => MTree a -> MSeq a
fromMTree MTree a
xs
    | Bool
otherwise -> a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x (Int -> MTree a -> MTree a
forall a. Measured a => Int -> MTree a -> MTree a
T.deleteAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
xs)
  MSeq a
MEmpty -> MSeq a
forall a. MSeq a
MEmpty
{-# INLINABLE deleteAt #-}

----------
-- Slice
----------

-- | \(O(\log n)\). Append a value to the beginning of a sequence.
cons :: Measured a => a -> MSeq a -> MSeq a
cons :: forall a. Measured a => a -> MSeq a -> MSeq a
cons a
x (MTree a
y MTree a
ys) = a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x (a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a
T.cons a
y MTree a
ys)
cons a
x MSeq a
MEmpty = a -> MSeq a
forall a. a -> MSeq a
singleton a
x
{-# INLINABLE cons #-}

-- | \(O(\log n)\). Append a value to the end of a sequence.
snoc :: Measured a => MSeq a -> a -> MSeq a
snoc :: forall a. Measured a => MSeq a -> a -> MSeq a
snoc (MTree a
y MTree a
ys) a
x = a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
y (MTree a -> a -> MTree a
forall a. Measured a => MTree a -> a -> MTree a
T.snoc MTree a
ys a
x)
snoc MSeq a
MEmpty a
x = a -> MSeq a
forall a. a -> MSeq a
singleton a
x
{-# INLINABLE snoc #-}

-- | \(O(\log n)\). The head and tail of a sequence.
uncons :: Measured a => MSeq a -> Maybe (a, MSeq a)
uncons :: forall a. Measured a => MSeq a -> Maybe (a, MSeq a)
uncons (MTree a
x MTree a
xs) = (a, MSeq a) -> Maybe (a, MSeq a)
forall a. a -> Maybe a
Just ((a, MSeq a) -> Maybe (a, MSeq a))
-> (MSeq a -> (a, MSeq a)) -> MSeq a -> Maybe (a, MSeq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
x (MSeq a -> Maybe (a, MSeq a)) -> MSeq a -> Maybe (a, MSeq a)
forall a b. (a -> b) -> a -> b
$! MTree a -> MSeq a
forall a. Measured a => MTree a -> MSeq a
fromMTree MTree a
xs
uncons MSeq a
MEmpty = Maybe (a, MSeq a)
forall a. Maybe a
Nothing
{-# INLINE uncons #-}

-- | \(O(\log n)\). The init and last of a sequence.
unsnoc :: Measured a => MSeq a -> Maybe (MSeq a, a)
unsnoc :: forall a. Measured a => MSeq a -> Maybe (MSeq a, a)
unsnoc (MTree a
x MTree a
xs) = case MTree a -> SMaybe (S2 (MTree a) a)
forall a. Measured a => MTree a -> SMaybe (S2 (MTree a) a)
T.unsnoc MTree a
xs of
  SMaybe (S2 (MTree a) a)
U.SNothing -> (MSeq a, a) -> Maybe (MSeq a, a)
forall a. a -> Maybe a
Just (MSeq a
forall a. MSeq a
MEmpty, a
x)
  U.SJust (U.S2 MTree a
ys a
y) -> (MSeq a, a) -> Maybe (MSeq a, a)
forall a. a -> Maybe a
Just (a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x MTree a
ys, a
y)
unsnoc MSeq a
MEmpty = Maybe (MSeq a, a)
forall a. Maybe a
Nothing
{-# INLINE unsnoc #-}

-- | \(O(\log n)\). Take a number of elements from the beginning of a sequence.
take :: Measured a => Int -> MSeq a -> MSeq a
take :: forall a. Measured a => Int -> MSeq a -> MSeq a
take !Int
i t :: MSeq a
t@(MTree a
x MTree a
xs)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = MSeq a
forall a. MSeq a
MEmpty
  | MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = MSeq a
t
  | Bool
otherwise = a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x (Const (MTree a) (S2 a (MTree a)) -> MTree a
forall {k} a (b :: k). Const a b -> a
getConst (Int -> MTree a -> Const (MTree a) (S2 a (MTree a))
forall a (f :: * -> * -> *).
(Measured a, Biapplicative f) =>
Int -> MTree a -> f (MTree a) (S2 a (MTree a))
T.splitAtF (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
xs))
take Int
_ MSeq a
MEmpty = MSeq a
forall a. MSeq a
MEmpty
{-# INLINABLE take #-}

-- | \(O(\log n)\). Drop a number of elements from the beginning of a sequence.
drop :: Measured a => Int -> MSeq a -> MSeq a
drop :: forall a. Measured a => Int -> MSeq a -> MSeq a
drop !Int
i t :: MSeq a
t@(MTree a
_ MTree a
xs)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = MSeq a
t
  | MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = MSeq a
forall a. MSeq a
MEmpty
  | Bool
otherwise = case Tagged (MTree a) (S2 a (MTree a)) -> S2 a (MTree a)
forall a b. Tagged a b -> b
U.unTagged (Int -> MTree a -> Tagged (MTree a) (S2 a (MTree a))
forall a (f :: * -> * -> *).
(Measured a, Biapplicative f) =>
Int -> MTree a -> f (MTree a) (S2 a (MTree a))
T.splitAtF (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
xs) of
      U.S2 a
x' MTree a
xs' -> a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x' MTree a
xs'
drop Int
_ MSeq a
MEmpty = MSeq a
forall a. MSeq a
MEmpty
{-# INLINABLE drop #-}

-- | \(O(\log n)\). The slice of a sequence between two indices (inclusive).
slice :: Measured a => (Int, Int) -> MSeq a -> MSeq a
slice :: forall a. Measured a => (Int, Int) -> MSeq a -> MSeq a
slice (Int
i,Int
j) = Int -> MSeq a -> MSeq a
forall a. Measured a => Int -> MSeq a -> MSeq a
drop Int
i (MSeq a -> MSeq a) -> (MSeq a -> MSeq a) -> MSeq a -> MSeq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MSeq a -> MSeq a
forall a. Measured a => Int -> MSeq a -> MSeq a
take (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINABLE slice #-}

-- | \(O(\log n)\). Take a number of elements from the end of a sequence.
takeEnd :: Measured a => Int -> MSeq a -> MSeq a
takeEnd :: forall a. Measured a => Int -> MSeq a -> MSeq a
takeEnd Int
n MSeq a
t = Int -> MSeq a -> MSeq a
forall a. Measured a => Int -> MSeq a -> MSeq a
drop (MSeq a -> Int
forall a. MSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MSeq a
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) MSeq a
t
{-# INLINABLE takeEnd #-}

-- | \(O(\log n)\). Drop a number of elements from the end of a sequence.
dropEnd :: Measured a => Int -> MSeq a -> MSeq a
dropEnd :: forall a. Measured a => Int -> MSeq a -> MSeq a
dropEnd Int
n MSeq a
t = Int -> MSeq a -> MSeq a
forall a. Measured a => Int -> MSeq a -> MSeq a
take (MSeq a -> Int
forall a. MSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MSeq a
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) MSeq a
t
{-# INLINABLE dropEnd #-}

-- | \(O(\log n)\). Split a sequence at a given index.
--
-- @splitAt n xs == ('take' n xs, 'drop' n xs)@
splitAt :: Measured a => Int -> MSeq a -> (MSeq a, MSeq a)
splitAt :: forall a. Measured a => Int -> MSeq a -> (MSeq a, MSeq a)
splitAt !Int
i t :: MSeq a
t@(MTree a
x MTree a
xs)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (MSeq a
forall a. MSeq a
MEmpty, MSeq a
t)
  | MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = (MSeq a
t, MSeq a
forall a. MSeq a
MEmpty)
  | Bool
otherwise = case Int -> MTree a -> S2 (MTree a) (S2 a (MTree a))
forall a (f :: * -> * -> *).
(Measured a, Biapplicative f) =>
Int -> MTree a -> f (MTree a) (S2 a (MTree a))
T.splitAtF (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
xs of
      U.S2 MTree a
xs1 (U.S2 a
x' MTree a
xs2) -> (a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x MTree a
xs1, a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x' MTree a
xs2)
splitAt Int
_ MSeq a
MEmpty = (MSeq a
forall a. MSeq a
MEmpty, MSeq a
forall a. MSeq a
MEmpty)
{-# INLINABLE splitAt #-}

-- | \(O(\log n)\). Split a sequence at a given index from the end.
--
-- @splitAtEnd n xs == ('dropEnd' n xs, 'takeEnd' n xs)@
splitAtEnd :: Measured a => Int -> MSeq a -> (MSeq a, MSeq a)
splitAtEnd :: forall a. Measured a => Int -> MSeq a -> (MSeq a, MSeq a)
splitAtEnd Int
i MSeq a
s = Int -> MSeq a -> (MSeq a, MSeq a)
forall a. Measured a => Int -> MSeq a -> (MSeq a, MSeq a)
splitAt (MSeq a -> Int
forall a. MSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MSeq a
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) MSeq a
s
{-# INLINABLE splitAtEnd #-}

-----------
-- Filter
-----------

-- | \(O(n)\). Keep elements that satisfy a predicate.
filter :: Measured a => (a -> Bool) -> MSeq a -> MSeq a
filter :: forall a. Measured a => (a -> Bool) -> MSeq a -> MSeq a
filter =
  (((a -> Identity Bool) -> MSeq a -> Identity (MSeq a))
-> (a -> Bool) -> MSeq a -> MSeq a
forall {a}.
((a -> Identity Bool) -> MSeq a -> Identity (MSeq a))
-> (a -> Bool) -> MSeq a -> MSeq a
forall a b. Coercible a b => a -> b
coerce :: ((a -> Identity Bool) -> MSeq a -> Identity (MSeq a))
          -> (a -> Bool) -> MSeq a -> MSeq a)
  (a -> Identity Bool) -> MSeq a -> Identity (MSeq a)
forall a (f :: * -> *).
(Measured a, Applicative f) =>
(a -> f Bool) -> MSeq a -> f (MSeq a)
filterA
{-# INLINE filter #-}

-- | \(O(n)\). Map over elements and collect the @Just@s.
mapMaybe :: Measured b => (a -> Maybe b) -> MSeq a -> MSeq b
mapMaybe :: forall b a. Measured b => (a -> Maybe b) -> MSeq a -> MSeq b
mapMaybe =
  (((a -> Identity (Maybe b)) -> MSeq a -> Identity (MSeq b))
-> (a -> Maybe b) -> MSeq a -> MSeq b
forall {a} {b}.
((a -> Identity (Maybe b)) -> MSeq a -> Identity (MSeq b))
-> (a -> Maybe b) -> MSeq a -> MSeq b
forall a b. Coercible a b => a -> b
coerce :: ((a -> Identity (Maybe b)) -> MSeq a -> Identity (MSeq b))
          -> (a -> Maybe b) -> MSeq a -> MSeq b)
  (a -> Identity (Maybe b)) -> MSeq a -> Identity (MSeq b)
forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(a -> f (Maybe b)) -> MSeq a -> f (MSeq b)
mapMaybeA
{-# INLINE mapMaybe #-}

-- | \(O(n)\). Map over elements and split the @Left@s and @Right@s.
mapEither
  :: (Measured b, Measured c) => (a -> Either b c) -> MSeq a -> (MSeq b, MSeq c)
mapEither :: forall b c a.
(Measured b, Measured c) =>
(a -> Either b c) -> MSeq a -> (MSeq b, MSeq c)
mapEither =
  (((a -> Identity (Either b c))
 -> MSeq a -> Identity (MSeq b, MSeq c))
-> (a -> Either b c) -> MSeq a -> (MSeq b, MSeq c)
forall {a} {b} {c}.
((a -> Identity (Either b c))
 -> MSeq a -> Identity (MSeq b, MSeq c))
-> (a -> Either b c) -> MSeq a -> (MSeq b, MSeq c)
forall a b. Coercible a b => a -> b
coerce :: ((a -> Identity (Either b c)) -> MSeq a -> Identity (MSeq b, MSeq c))
          -> (a -> Either b c) -> MSeq a -> (MSeq b, MSeq c))
  (a -> Identity (Either b c)) -> MSeq a -> Identity (MSeq b, MSeq c)
forall b c (f :: * -> *) a.
(Measured b, Measured c, Applicative f) =>
(a -> f (Either b c)) -> MSeq a -> f (MSeq b, MSeq c)
mapEitherA
{-# INLINE mapEither #-}

-- | \(O(n)\). Keep elements that satisfy an applicative predicate.
filterA :: (Measured a, Applicative f) => (a -> f Bool) -> MSeq a -> f (MSeq a)
filterA :: forall a (f :: * -> *).
(Measured a, Applicative f) =>
(a -> f Bool) -> MSeq a -> f (MSeq a)
filterA a -> f Bool
f = (a -> f (Maybe a)) -> MSeq a -> f (MSeq a)
forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(a -> f (Maybe b)) -> MSeq a -> f (MSeq b)
mapMaybeA (\a
x -> (Bool -> Maybe a) -> f Bool -> f (Maybe a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
b -> if Bool
b then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing) (a -> f Bool
f a
x))
{-# INLINE filterA #-}

-- | \(O(n)\). Traverse over elements and collect the @Just@s.
mapMaybeA
  :: (Measured b, Applicative f) => (a -> f (Maybe b)) -> MSeq a -> f (MSeq b)
mapMaybeA :: forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(a -> f (Maybe b)) -> MSeq a -> f (MSeq b)
mapMaybeA a -> f (Maybe b)
f = \case
  MTree a
x MTree a
xs -> (Maybe b -> MTree b -> MSeq b)
-> f (Maybe b) -> f (MTree b) -> f (MSeq b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 ((MTree b -> MSeq b)
-> (b -> MTree b -> MSeq b) -> Maybe b -> MTree b -> MSeq b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MTree b -> MSeq b
forall a. Measured a => MTree a -> MSeq a
fromMTree b -> MTree b -> MSeq b
forall a. a -> MTree a -> MSeq a
MTree) (a -> f (Maybe b)
f a
x) ((a -> f (Maybe b)) -> MTree a -> f (MTree b)
forall (f :: * -> *) b a.
(Applicative f, Measured b) =>
(a -> f (Maybe b)) -> MTree a -> f (MTree b)
T.mapMaybeA a -> f (Maybe b)
f MTree a
xs)
  MSeq a
MEmpty -> MSeq b -> f (MSeq b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MSeq b
forall a. MSeq a
MEmpty
{-# INLINE mapMaybeA #-}

-- | \(O(n)\). Traverse over elements and split the @Left@s and @Right@s.
mapEitherA
  :: (Measured b, Measured c, Applicative f)
  => (a -> f (Either b c)) -> MSeq a -> f (MSeq b, MSeq c)
mapEitherA :: forall b c (f :: * -> *) a.
(Measured b, Measured c, Applicative f) =>
(a -> f (Either b c)) -> MSeq a -> f (MSeq b, MSeq c)
mapEitherA a -> f (Either b c)
f = \case
  MTree a
x MTree a
xs -> (\Either b c -> S2 (MTree b) (MTree c) -> (MSeq b, MSeq c)
g -> (Either b c -> S2 (MTree b) (MTree c) -> (MSeq b, MSeq c))
-> f (Either b c)
-> f (S2 (MTree b) (MTree c))
-> f (MSeq b, MSeq c)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 Either b c -> S2 (MTree b) (MTree c) -> (MSeq b, MSeq c)
g (a -> f (Either b c)
f a
x) ((a -> f (Either b c)) -> MTree a -> f (S2 (MTree b) (MTree c))
forall (f :: * -> *) b c a.
(Applicative f, Measured b, Measured c) =>
(a -> f (Either b c)) -> MTree a -> f (S2 (MTree b) (MTree c))
T.mapEitherA a -> f (Either b c)
f MTree a
xs)) ((Either b c -> S2 (MTree b) (MTree c) -> (MSeq b, MSeq c))
 -> f (MSeq b, MSeq c))
-> (Either b c -> S2 (MTree b) (MTree c) -> (MSeq b, MSeq c))
-> f (MSeq b, MSeq c)
forall a b. (a -> b) -> a -> b
$ \Either b c
mx S2 (MTree b) (MTree c)
xs' ->
    case Either b c
mx of
      Left b
x' -> S2 (MSeq b) (MSeq c) -> (MSeq b, MSeq c)
forall {a} {b}. S2 a b -> (a, b)
unS2 (S2 (MSeq b) (MSeq c) -> (MSeq b, MSeq c))
-> S2 (MSeq b) (MSeq c) -> (MSeq b, MSeq c)
forall a b. (a -> b) -> a -> b
$ (MTree b -> MSeq b)
-> (MTree c -> MSeq c)
-> S2 (MTree b) (MTree c)
-> S2 (MSeq b) (MSeq c)
forall a b c d. (a -> b) -> (c -> d) -> S2 a c -> S2 b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (b -> MTree b -> MSeq b
forall a. a -> MTree a -> MSeq a
MTree b
x') MTree c -> MSeq c
forall a. Measured a => MTree a -> MSeq a
fromMTree S2 (MTree b) (MTree c)
xs'
      Right c
x' -> S2 (MSeq b) (MSeq c) -> (MSeq b, MSeq c)
forall {a} {b}. S2 a b -> (a, b)
unS2 (S2 (MSeq b) (MSeq c) -> (MSeq b, MSeq c))
-> S2 (MSeq b) (MSeq c) -> (MSeq b, MSeq c)
forall a b. (a -> b) -> a -> b
$ (MTree b -> MSeq b)
-> (MTree c -> MSeq c)
-> S2 (MTree b) (MTree c)
-> S2 (MSeq b) (MSeq c)
forall a b c d. (a -> b) -> (c -> d) -> S2 a c -> S2 b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap MTree b -> MSeq b
forall a. Measured a => MTree a -> MSeq a
fromMTree (c -> MTree c -> MSeq c
forall a. a -> MTree a -> MSeq a
MTree c
x') S2 (MTree b) (MTree c)
xs'
  MSeq a
MEmpty -> (MSeq b, MSeq c) -> f (MSeq b, MSeq c)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MSeq b
forall a. MSeq a
MEmpty, MSeq c
forall a. MSeq a
MEmpty)
  where
    unS2 :: S2 a b -> (a, b)
unS2 (U.S2 a
x b
y) = (a
x, b
y)
{-# INLINE mapEitherA #-}

-- | \(O(i + \log n)\). The longest prefix of elements that satisfy a predicate.
-- \(i\) is the length of the prefix.
takeWhile :: Measured a => (a -> Bool) -> MSeq a -> MSeq a
takeWhile :: forall a. Measured a => (a -> Bool) -> MSeq a -> MSeq a
takeWhile a -> Bool
p MSeq a
t = (Int -> a -> MSeq a -> MSeq a) -> MSeq a -> MSeq a -> MSeq a
forall a b. (Int -> a -> b -> b) -> b -> MSeq a -> b
forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
IFo.ifoldr (\Int
i a
x MSeq a
z -> if a -> Bool
p a
x then MSeq a
z else Int -> MSeq a -> MSeq a
forall a. Measured a => Int -> MSeq a -> MSeq a
take Int
i MSeq a
t) MSeq a
t MSeq a
t
{-# INLINE takeWhile #-}

-- | \(O(i + \log n)\). The remainder after removing the longest prefix of
-- elements that satisfy a predicate.
-- \(i\) is the length of the prefix.
dropWhile :: Measured a => (a -> Bool) -> MSeq a -> MSeq a
dropWhile :: forall a. Measured a => (a -> Bool) -> MSeq a -> MSeq a
dropWhile a -> Bool
p MSeq a
t = (Int -> a -> MSeq a -> MSeq a) -> MSeq a -> MSeq a -> MSeq a
forall a b. (Int -> a -> b -> b) -> b -> MSeq a -> b
forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
IFo.ifoldr (\Int
i a
x MSeq a
z -> if a -> Bool
p a
x then MSeq a
z else Int -> MSeq a -> MSeq a
forall a. Measured a => Int -> MSeq a -> MSeq a
drop Int
i MSeq a
t) MSeq a
forall a. MSeq a
MEmpty MSeq a
t
{-# INLINE dropWhile #-}

-- | \(O(i + \log n)\). The longest prefix of elements that satisfy a predicate,
-- together with the remainder of the sequence.
-- \(i\) is the length of the prefix.
--
-- @span p xs == ('takeWhile' p xs, 'dropWhile' p xs)@
span :: Measured a => (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
span :: forall a. Measured a => (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
span a -> Bool
p MSeq a
t = (Int -> a -> (MSeq a, MSeq a) -> (MSeq a, MSeq a))
-> (MSeq a, MSeq a) -> MSeq a -> (MSeq a, MSeq a)
forall a b. (Int -> a -> b -> b) -> b -> MSeq a -> b
forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
IFo.ifoldr (\Int
i a
x (MSeq a, MSeq a)
z -> if a -> Bool
p a
x then (MSeq a, MSeq a)
z else Int -> MSeq a -> (MSeq a, MSeq a)
forall a. Measured a => Int -> MSeq a -> (MSeq a, MSeq a)
splitAt Int
i MSeq a
t) (MSeq a
t, MSeq a
forall a. MSeq a
MEmpty) MSeq a
t
{-# INLINE span #-}

-- | \(O(i + \log n)\). The longest prefix of elements that /do not/ satisfy a
-- predicate, together with the remainder of the sequence. \(i\) is the length
-- of the prefix.
--
-- @break p == 'span' (not . p)@
break :: Measured a => (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
break :: forall a. Measured a => (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
break a -> Bool
p = (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
forall a. Measured a => (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
span (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)
{-# INLINE break #-}

-- | \(O(i + \log n)\). The longest suffix of elements that satisfy a predicate.
-- \(i\) is the length of the suffix.
takeWhileEnd :: Measured a => (a -> Bool) -> MSeq a -> MSeq a
takeWhileEnd :: forall a. Measured a => (a -> Bool) -> MSeq a -> MSeq a
takeWhileEnd a -> Bool
p MSeq a
t = (Int -> MSeq a -> a -> MSeq a) -> MSeq a -> MSeq a -> MSeq a
forall b a. (Int -> b -> a -> b) -> b -> MSeq a -> b
forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
IFo.ifoldl (\Int
i MSeq a
z a
x -> if a -> Bool
p a
x then MSeq a
z else Int -> MSeq a -> MSeq a
forall a. Measured a => Int -> MSeq a -> MSeq a
drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MSeq a
t) MSeq a
t MSeq a
t
{-# INLINE takeWhileEnd #-}

-- | \(O(i + \log n)\). The remainder after removing the longest suffix of
-- elements that satisfy a predicate.
-- \(i\) is the length of the suffix.
dropWhileEnd :: Measured a => (a -> Bool) -> MSeq a -> MSeq a
dropWhileEnd :: forall a. Measured a => (a -> Bool) -> MSeq a -> MSeq a
dropWhileEnd a -> Bool
p MSeq a
t =
  (Int -> MSeq a -> a -> MSeq a) -> MSeq a -> MSeq a -> MSeq a
forall b a. (Int -> b -> a -> b) -> b -> MSeq a -> b
forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
IFo.ifoldl (\Int
i MSeq a
z a
x -> if a -> Bool
p a
x then MSeq a
z else Int -> MSeq a -> MSeq a
forall a. Measured a => Int -> MSeq a -> MSeq a
take (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MSeq a
t) MSeq a
forall a. MSeq a
MEmpty MSeq a
t
{-# INLINE dropWhileEnd #-}

-- | \(O(i + \log n)\). The longest suffix of elements that satisfy a predicate,
-- together with the remainder of the sequence.
-- \(i\) is the length of the suffix.
--
-- @spanEnd p xs == ('dropWhileEnd' p xs, 'takeWhileEnd' p xs)@
spanEnd :: Measured a => (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
spanEnd :: forall a. Measured a => (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
spanEnd a -> Bool
p MSeq a
t =
  (Int -> (MSeq a, MSeq a) -> a -> (MSeq a, MSeq a))
-> (MSeq a, MSeq a) -> MSeq a -> (MSeq a, MSeq a)
forall b a. (Int -> b -> a -> b) -> b -> MSeq a -> b
forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
IFo.ifoldl (\Int
i (MSeq a, MSeq a)
z a
x -> if a -> Bool
p a
x then (MSeq a, MSeq a)
z else Int -> MSeq a -> (MSeq a, MSeq a)
forall a. Measured a => Int -> MSeq a -> (MSeq a, MSeq a)
splitAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MSeq a
t) (MSeq a
forall a. MSeq a
MEmpty, MSeq a
t) MSeq a
t
{-# INLINE spanEnd #-}

-- | \(O(i + \log n)\). The longest suffix of elements that /do not/ satisfy a
-- predicate, together with the remainder of the sequence.
-- \(i\) is the length of the suffix.
--
-- @breakEnd p == 'spanEnd' (not . p)@
breakEnd :: Measured a => (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
breakEnd :: forall a. Measured a => (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
breakEnd a -> Bool
p = (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
forall a. Measured a => (a -> Bool) -> MSeq a -> (MSeq a, MSeq a)
spanEnd (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)
{-# INLINE breakEnd #-}

--------------
-- Transform
--------------

-- Note [Functor MSeq]
-- ~~~~~~~~~~~~~~~~~~~
-- MSeq cannot be a Functor because of the Measured constraint on the element
-- type. So class methods which require Functor are provided as standalone.

-- | \(O(n)\). Map over a sequence.
map :: Measured b => (a -> b) -> MSeq a -> MSeq b
map :: forall b a. Measured b => (a -> b) -> MSeq a -> MSeq b
map =
  (((a -> Identity b) -> MSeq a -> Identity (MSeq b))
-> (a -> b) -> MSeq a -> MSeq b
forall {a} {b}.
((a -> Identity b) -> MSeq a -> Identity (MSeq b))
-> (a -> b) -> MSeq a -> MSeq b
forall a b. Coercible a b => a -> b
coerce :: ((a -> Identity b) -> MSeq a -> Identity (MSeq b))
          -> (a -> b) -> MSeq a -> MSeq b)
  (a -> Identity b) -> MSeq a -> Identity (MSeq b)
forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(a -> f b) -> MSeq a -> f (MSeq b)
traverse
{-# INLINE map #-}

-- | \(O(n_1 n_2)\). Cartesian product of two sequences.
liftA2 :: Measured c => (a -> b -> c) -> MSeq a -> MSeq b -> MSeq c
liftA2 :: forall c a b.
Measured c =>
(a -> b -> c) -> MSeq a -> MSeq b -> MSeq c
liftA2 a -> b -> c
f MSeq a
t1 MSeq b
t2 = case MSeq b
t2 of
  MSeq b
MEmpty -> MSeq c
forall a. MSeq a
MEmpty
  MTree b
x MTree b
MTip -> (a -> c) -> MSeq a -> MSeq c
forall b a. Measured b => (a -> b) -> MSeq a -> MSeq b
map (a -> b -> c
`f` b
x) MSeq a
t1
  MSeq b
_ -> (a -> MSeq c) -> MSeq a -> MSeq c
forall b (f :: * -> *) a.
(Measured b, Foldable f) =>
(a -> MSeq b) -> f a -> MSeq b
concatMap (\a
x -> (b -> c) -> MSeq b -> MSeq c
forall b a. Measured b => (a -> b) -> MSeq a -> MSeq b
map (a -> b -> c
f a
x) MSeq b
t2) MSeq a
t1
{-# INLINE liftA2 #-}

-- | \(O(n)\). Traverse a sequence.
traverse
  :: (Measured b, Applicative f) => (a -> f b) -> MSeq a -> f (MSeq b)
traverse :: forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(a -> f b) -> MSeq a -> f (MSeq b)
traverse a -> f b
f = \case
  MSeq a
MEmpty -> MSeq b -> f (MSeq b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MSeq b
forall a. MSeq a
MEmpty
  MTree a
x MTree a
xs -> (b -> MTree b -> MSeq b) -> f b -> f (MTree b) -> f (MSeq b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 b -> MTree b -> MSeq b
forall a. a -> MTree a -> MSeq a
MTree (a -> f b
f a
x) ((a -> f b) -> MTree a -> f (MTree b)
forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(a -> f b) -> MTree a -> f (MTree b)
T.traverse a -> f b
f MTree a
xs)
{-# INLINE traverse #-}

-- | \(O(n)\). Map over a sequence with index.
imap :: Measured b => (Int -> a -> b) -> MSeq a -> MSeq b
imap :: forall b a. Measured b => (Int -> a -> b) -> MSeq a -> MSeq b
imap =
  (((Int -> a -> Identity b) -> MSeq a -> Identity (MSeq b))
-> (Int -> a -> b) -> MSeq a -> MSeq b
forall {a} {b}.
((Int -> a -> Identity b) -> MSeq a -> Identity (MSeq b))
-> (Int -> a -> b) -> MSeq a -> MSeq b
forall a b. Coercible a b => a -> b
coerce :: ((Int -> a -> Identity b) -> MSeq a -> Identity (MSeq b))
          -> (Int -> a -> b) -> MSeq a -> MSeq b)
  (Int -> a -> Identity b) -> MSeq a -> Identity (MSeq b)
forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(Int -> a -> f b) -> MSeq a -> f (MSeq b)
itraverse
{-# INLINE imap #-}

-- | \(O(n)\). Traverse a sequence with index.
itraverse
  :: (Measured b, Applicative f) => (Int -> a -> f b) -> MSeq a -> f (MSeq b)
itraverse :: forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(Int -> a -> f b) -> MSeq a -> f (MSeq b)
itraverse Int -> a -> f b
f = \case
  MSeq a
MEmpty -> MSeq b -> f (MSeq b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MSeq b
forall a. MSeq a
MEmpty
  MTree a
x MTree a
xs -> (b -> MTree b -> MSeq b) -> f b -> f (MTree b) -> f (MSeq b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 b -> MTree b -> MSeq b
forall a. a -> MTree a -> MSeq a
MTree (Int -> a -> f b
f Int
0 a
x) ((Int -> a -> f b) -> Int -> MTree a -> f (MTree b)
forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(Int -> a -> f b) -> Int -> MTree a -> f (MTree b)
T.itraverse Int -> a -> f b
f Int
1 MTree a
xs)
{-# INLINE itraverse #-}

-- | \(O(n)\). Reverse a sequence.
reverse :: Measured a => MSeq a -> MSeq a
reverse :: forall a. Measured a => MSeq a -> MSeq a
reverse (MTree a
x MTree a
xs) = case MTree a -> SMaybe (S2 a (MTree a))
forall a. Measured a => MTree a -> SMaybe (S2 a (MTree a))
T.uncons (MTree a -> MTree a
forall {a}. Measured a => MTree a -> MTree a
rev MTree a
xs) of
  SMaybe (S2 a (MTree a))
U.SNothing -> a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x MTree a
forall a. MTree a
MTip
  U.SJust (U.S2 a
x' MTree a
xs') -> a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x' (MTree a -> a -> MTree a
forall a. Measured a => MTree a -> a -> MTree a
T.snoc MTree a
xs' a
x)
  where
    rev :: MTree a -> MTree a
rev MTree a
T.MTip = MTree a
forall a. MTree a
T.MTip
    rev (T.MBin Int
sz Measure a
_ a
y MTree a
l MTree a
r) = Int -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
T.binn Int
sz a
y (MTree a -> MTree a
rev MTree a
r) (MTree a -> MTree a
rev MTree a
l)
reverse MSeq a
MEmpty = MSeq a
forall a. MSeq a
MEmpty
{-# INLINABLE reverse #-}

-- | \(O(n)\). Intersperse an element between the elements of a sequence.
intersperse :: Measured a => a -> MSeq a -> MSeq a
intersperse :: forall a. Measured a => a -> MSeq a -> MSeq a
intersperse a
y (MTree a
x MTree a
xs) = case MTree a -> SMaybe (S2 (MTree a) a)
forall a. Measured a => MTree a -> SMaybe (S2 (MTree a) a)
T.unsnoc (MTree a -> MTree a
go MTree a
xs) of
  SMaybe (S2 (MTree a) a)
U.SNothing -> String -> MSeq a
forall a. HasCallStack => String -> a
error String
"intersperse: impossible"
  U.SJust (U.S2 MTree a
xs' a
_) -> a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x MTree a
xs'
  where
    yt :: MTree a
yt = a -> MTree a
forall a. Measured a => a -> MTree a
T.singleton a
y
    go :: MTree a -> MTree a
go MTree a
T.MTip = MTree a
yt
    go (T.MBin Int
sz Measure a
_ a
z MTree a
l MTree a
r) = Int -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
T.binn (Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
z (MTree a -> MTree a
go MTree a
l) (MTree a -> MTree a
go MTree a
r)
    -- No need to balance, x <= 3y => 2x+1 <= 3(2y+1)
intersperse a
_ MSeq a
MEmpty = MSeq a
forall a. MSeq a
MEmpty
{-# INLINABLE intersperse #-}

-- | \(O(n)\). Like 'Data.Foldable.foldl'' but keeps all intermediate values.
scanl :: Measured b => (b -> a -> b) -> b -> MSeq a -> MSeq b
scanl :: forall b a. Measured b => (b -> a -> b) -> b -> MSeq a -> MSeq b
scanl b -> a -> b
f !b
z0 =
  b -> MSeq b -> MSeq b
forall a. Measured a => a -> MSeq a -> MSeq a
cons b
z0 (MSeq b -> MSeq b) -> (MSeq a -> MSeq b) -> MSeq a -> MSeq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (SState b (MSeq b) -> b -> MSeq b)
-> b -> SState b (MSeq b) -> MSeq b
forall a b c. (a -> b -> c) -> b -> a -> c
flip SState b (MSeq b) -> b -> MSeq b
forall s a. SState s a -> s -> a
U.evalSState b
z0 (SState b (MSeq b) -> MSeq b)
-> (MSeq a -> SState b (MSeq b)) -> MSeq a -> MSeq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> SStateT b Identity b) -> MSeq a -> SState b (MSeq b)
forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(a -> f b) -> MSeq a -> f (MSeq b)
traverse (\a
x -> (b -> S2 b b) -> SStateT b Identity b
forall s a. (s -> S2 s a) -> SState s a
U.sState (\b
z -> let z' :: b
z' = b -> a -> b
f b
z a
x in b -> b -> S2 b b
forall a b. a -> b -> S2 a b
U.S2 b
z' b
z'))
{-# INLINE scanl #-}
-- See Note [SState for scans] in Data.Seqn.Internal.Seq

-- | \(O(n)\). Like 'Data.Foldable.foldr'' but keeps all intermediate values.
scanr :: Measured b => (a -> b -> b) -> b -> MSeq a -> MSeq b
scanr :: forall b a. Measured b => (a -> b -> b) -> b -> MSeq a -> MSeq b
scanr a -> b -> b
f !b
z0 =
  (MSeq b -> b -> MSeq b) -> b -> MSeq b -> MSeq b
forall a b c. (a -> b -> c) -> b -> a -> c
flip MSeq b -> b -> MSeq b
forall a. Measured a => MSeq a -> a -> MSeq a
snoc b
z0 (MSeq b -> MSeq b) -> (MSeq a -> MSeq b) -> MSeq a -> MSeq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (SState b (MSeq b) -> b -> MSeq b)
-> b -> SState b (MSeq b) -> MSeq b
forall a b c. (a -> b -> c) -> b -> a -> c
flip SState b (MSeq b) -> b -> MSeq b
forall s a. SState s a -> s -> a
U.evalSState b
z0 (SState b (MSeq b) -> MSeq b)
-> (MSeq a -> SState b (MSeq b)) -> MSeq a -> MSeq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Backwards (SStateT b Identity) (MSeq b) -> SState b (MSeq b)
forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards (Backwards (SStateT b Identity) (MSeq b) -> SState b (MSeq b))
-> (MSeq a -> Backwards (SStateT b Identity) (MSeq b))
-> MSeq a
-> SState b (MSeq b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> Backwards (SStateT b Identity) b)
-> MSeq a -> Backwards (SStateT b Identity) (MSeq b)
forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(a -> f b) -> MSeq a -> f (MSeq b)
traverse
    (\a
x -> SStateT b Identity b -> Backwards (SStateT b Identity) b
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards ((b -> S2 b b) -> SStateT b Identity b
forall s a. (s -> S2 s a) -> SState s a
U.sState (\b
z -> let z' :: b
z' = a -> b -> b
f a
x b
z in b -> b -> S2 b b
forall a b. a -> b -> S2 a b
U.S2 b
z' b
z')))
{-# INLINE scanr #-}

-- | \(O(n \log n)\). Sort a sequence.
sort :: (Ord a, Measured a) => MSeq a -> MSeq a
sort :: forall a. (Ord a, Measured a) => MSeq a -> MSeq a
sort = (a -> a -> Ordering) -> MSeq a -> MSeq a
forall a. Measured a => (a -> a -> Ordering) -> MSeq a -> MSeq a
sortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINABLE sort #-}

-- | \(O(n \log n)\). Sort a sequence using a comparison function.
sortBy :: Measured a => (a -> a -> Ordering) -> MSeq a -> MSeq a
sortBy :: forall a. Measured a => (a -> a -> Ordering) -> MSeq a -> MSeq a
sortBy a -> a -> Ordering
cmp MSeq a
xs = (Int -> a -> a) -> MSeq a -> MSeq a
forall b a. Measured b => (Int -> a -> b) -> MSeq a -> MSeq b
imap (\Int
i a
_ -> Array a -> Int -> a
forall a. Array a -> Int -> a
A.indexArray Array a
xa Int
i) MSeq a
xs
  where
    n :: Int
n = MSeq a -> Int
forall a. MSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MSeq a
xs
    xa :: Array a
xa = Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
A.createArray Int
n a
forall a. a
errorElement ((forall s. MutableArray s a -> ST s ()) -> Array a)
-> (forall s. MutableArray s a -> ST s ()) -> Array a
forall a b. (a -> b) -> a -> b
$ \ma :: MutableArray s a
ma@(A.MutableArray MutableArray# s a
ma#) -> do
      (Int -> a -> ST s () -> ST s ()) -> ST s () -> MSeq a -> ST s ()
forall a b. (Int -> a -> b -> b) -> b -> MSeq a -> b
forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
IFo.ifoldr (\Int
i a
x ST s ()
z -> MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
A.writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
ma Int
i a
x ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ST s ()
z) (() -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) MSeq a
xs
      (a -> a -> Ordering) -> MutableArray# s a -> Int -> Int -> ST s ()
forall a s.
(a -> a -> Ordering) -> MutableArray# s a -> Int -> Int -> ST s ()
Sam.sortArrayBy a -> a -> Ordering
cmp MutableArray# s a
ma# Int
0 Int
n
{-# INLINABLE sortBy #-}
-- See Note [Inlinable sortBy] in Data.Seqn.Internal.Seq

--------------------
-- Search and test
--------------------

-- | \(O(n)\). The last element satisfying a predicate.
--
-- To get the first element, use @Data.Foldable.'Data.Foldable.find'@.
findEnd :: (a -> Bool) -> MSeq a -> Maybe a
findEnd :: forall a. (a -> Bool) -> MSeq a -> Maybe a
findEnd a -> Bool
f =
  Last a -> Maybe a
forall a. Last a -> Maybe a
Monoid.getLast (Last a -> Maybe a) -> (MSeq a -> Last a) -> MSeq a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Last a) -> MSeq a -> Last a
forall m a. Monoid m => (a -> m) -> MSeq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\a
x -> Maybe a -> Last a
forall a. Maybe a -> Last a
Monoid.Last (if a -> Bool
f a
x then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing))
{-# INLINE findEnd #-}

-- | \(O(n)\). The index of the first element satisfying a predicate.
findIndex :: (a -> Bool) -> MSeq a -> Maybe Int
findIndex :: forall a. (a -> Bool) -> MSeq a -> Maybe Int
findIndex a -> Bool
f =
  First Int -> Maybe Int
forall a. First a -> Maybe a
Monoid.getFirst (First Int -> Maybe Int)
-> (MSeq a -> First Int) -> MSeq a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Int -> a -> First Int) -> MSeq a -> First Int
forall m a. Monoid m => (Int -> a -> m) -> MSeq a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
IFo.ifoldMap (\Int
i a
x -> Maybe Int -> First Int
forall a. Maybe a -> First a
Monoid.First (if a -> Bool
f a
x then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i else Maybe Int
forall a. Maybe a
Nothing))
{-# INLINE findIndex #-}

-- | \(O(n)\). The index of the last element satisfying a predicate.
findIndexEnd :: (a -> Bool) -> MSeq a -> Maybe Int
findIndexEnd :: forall a. (a -> Bool) -> MSeq a -> Maybe Int
findIndexEnd a -> Bool
f =
  Last Int -> Maybe Int
forall a. Last a -> Maybe a
Monoid.getLast (Last Int -> Maybe Int)
-> (MSeq a -> Last Int) -> MSeq a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Int -> a -> Last Int) -> MSeq a -> Last Int
forall m a. Monoid m => (Int -> a -> m) -> MSeq a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
IFo.ifoldMap (\Int
i a
x -> Maybe Int -> Last Int
forall a. Maybe a -> Last a
Monoid.Last (if a -> Bool
f a
x then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i else Maybe Int
forall a. Maybe a
Nothing))
{-# INLINE findIndexEnd #-}

-- | \(O(n_1 + n_2)\). Indices in the second sequence where the first sequence
-- begins as a substring. Includes overlapping occurences.
infixIndices :: Eq a => MSeq a -> MSeq a -> [Int]
infixIndices :: forall a. Eq a => MSeq a -> MSeq a -> [Int]
infixIndices MSeq a
t1 MSeq a
t2
  | MSeq a -> Bool
forall a. MSeq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null MSeq a
t1 = [Int
0 .. MSeq a -> Int
forall a. MSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MSeq a
t2]
  | MSeq a -> MSeq a -> Ordering
forall a b. MSeq a -> MSeq b -> Ordering
compareLength MSeq a
t1 MSeq a
t2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = []
  | Bool
otherwise =
    let n1 :: Int
n1 = MSeq a -> Int
forall a. MSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MSeq a
t1
        t1a :: Array a
t1a = Int -> MSeq a -> Array a
forall a. Int -> MSeq a -> Array a
infixIndicesMkArray Int
n1 MSeq a
t1
        !(!Table a
mt, !State a
m0) = Array a -> (Table a, State a)
forall a. Eq a => Array a -> (Table a, State a)
KMP.build Array a
t1a
    in (forall b. (Int -> b -> b) -> b -> b) -> [Int]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
X.build ((forall b. (Int -> b -> b) -> b -> b) -> [Int])
-> (forall b. (Int -> b -> b) -> b -> b) -> [Int]
forall a b. (a -> b) -> a -> b
$ \Int -> b -> b
lcons b
lnil ->
         let f :: Int -> a -> (State a -> b) -> State a -> b
f !Int
i a
x State a -> b
k !State a
m = case Table a -> State a -> a -> (Bool, State a)
forall a. Eq a => Table a -> State a -> a -> (Bool, State a)
KMP.step Table a
mt State a
m a
x of
               (Bool
b,State a
m') ->
                 if Bool
b
                 then Int -> b -> b
lcons (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (State a -> b
k State a
m')
                 else State a -> b
k State a
m'
         in (Int -> a -> (State a -> b) -> State a -> b)
-> (State a -> b) -> MSeq a -> State a -> b
forall a b. (Int -> a -> b -> b) -> b -> MSeq a -> b
forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
IFo.ifoldr Int -> a -> (State a -> b) -> State a -> b
f (\ !State a
_ -> b
lnil) MSeq a
t2 State a
m0
{-# INLINE infixIndices #-} -- Inline for fusion

infixIndicesMkArray :: Int -> MSeq a -> A.Array a
infixIndicesMkArray :: forall a. Int -> MSeq a -> Array a
infixIndicesMkArray !Int
n !MSeq a
t = Int -> a -> (forall {s}. MutableArray s a -> ST s ()) -> Array a
forall a.
Int -> a -> (forall s. MutableArray s a -> ST s ()) -> Array a
A.createArray Int
n a
forall a. a
errorElement ((forall {s}. MutableArray s a -> ST s ()) -> Array a)
-> (forall {s}. MutableArray s a -> ST s ()) -> Array a
forall a b. (a -> b) -> a -> b
$ \MutableArray s a
ma ->
  (Int -> a -> ST s () -> ST s ()) -> ST s () -> MSeq a -> ST s ()
forall a b. (Int -> a -> b -> b) -> b -> MSeq a -> b
forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
IFo.ifoldr (\Int
i a
x ST s ()
z -> MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
A.writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
ma Int
i a
x ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ST s ()
z) (() -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) MSeq a
t

-- | \(O(\log n)\). Binary search for an element in a sequence.
--
-- Given a function @f@ this function returns an arbitrary element @x@, if it
-- exists, such that @f x = EQ@. @f@ must be monotonic on the sequence—
-- specifically @fmap f@ must result in a sequence which has many (possibly
-- zero) @LT@s, followed by many @EQ@s, followed by many @GT@s.
binarySearchFind :: (a -> Ordering) -> MSeq a -> Maybe a
binarySearchFind :: forall a. (a -> Ordering) -> MSeq a -> Maybe a
binarySearchFind a -> Ordering
f = \case
  MSeq a
MEmpty -> Maybe a
forall a. Maybe a
Nothing
  MTree a
x MTree a
xs -> case a -> Ordering
f a
x of
    Ordering
LT -> MTree a -> Maybe a
go MTree a
xs
    Ordering
EQ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
    Ordering
GT -> Maybe a
forall a. Maybe a
Nothing
  where
    go :: MTree a -> Maybe a
go MTree a
MTip = Maybe a
forall a. Maybe a
Nothing
    go (MBin Int
_ Measure a
_ a
y MTree a
l MTree a
r) = case a -> Ordering
f a
y of
      Ordering
LT -> MTree a -> Maybe a
go MTree a
r
      Ordering
EQ -> a -> Maybe a
forall a. a -> Maybe a
Just a
y
      Ordering
GT -> MTree a -> Maybe a
go MTree a
l
{-# INLINE binarySearchFind #-}

-- | \(O(\min(n_1,n_2))\). Whether the first sequence is a prefix of the second.
isPrefixOf :: Eq a => MSeq a -> MSeq a -> Bool
isPrefixOf :: forall a. Eq a => MSeq a -> MSeq a -> Bool
isPrefixOf MSeq a
t1 MSeq a
t2 =
  MSeq a -> MSeq a -> Ordering
forall a b. MSeq a -> MSeq b -> Ordering
compareLength MSeq a
t1 MSeq a
t2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Stream a -> Stream a -> Bool
forall a. Eq a => Stream a -> Stream a -> Bool
Stream.isPrefixOf (MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream MSeq a
t1) (MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream MSeq a
t2)
{-# INLINABLE isPrefixOf #-}

-- | \(O(\min(n_1,n_2))\). Whether the first sequence is a suffix of the second.
isSuffixOf :: Eq a => MSeq a -> MSeq a -> Bool
isSuffixOf :: forall a. Eq a => MSeq a -> MSeq a -> Bool
isSuffixOf MSeq a
t1 MSeq a
t2 =
  MSeq a -> MSeq a -> Ordering
forall a b. MSeq a -> MSeq b -> Ordering
compareLength MSeq a
t1 MSeq a
t2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Stream a -> Stream a -> Bool
forall a. Eq a => Stream a -> Stream a -> Bool
Stream.isPrefixOf (MSeq a -> Stream a
forall a. MSeq a -> Stream a
streamEnd MSeq a
t1) (MSeq a -> Stream a
forall a. MSeq a -> Stream a
streamEnd MSeq a
t2)
{-# INLINABLE isSuffixOf #-}

-- | \(O(n_1 + n_2)\). Whether the first sequence is a substring of the second.
isInfixOf :: Eq a => MSeq a -> MSeq a -> Bool
isInfixOf :: forall a. Eq a => MSeq a -> MSeq a -> Bool
isInfixOf MSeq a
t1 MSeq a
t2 = (Int -> Bool -> Bool) -> Bool -> [Int] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
_ Bool
_ -> Bool
True) Bool
False (MSeq a -> MSeq a -> [Int]
forall a. Eq a => MSeq a -> MSeq a -> [Int]
infixIndices MSeq a
t1 MSeq a
t2)
{-# INLINABLE isInfixOf #-}

-- | \(O(n_1 + n_2)\). Whether the first sequence is a subsequence of the second.
isSubsequenceOf :: Eq a => MSeq a -> MSeq a -> Bool
isSubsequenceOf :: forall a. Eq a => MSeq a -> MSeq a -> Bool
isSubsequenceOf MSeq a
t1 MSeq a
t2 =
  MSeq a -> MSeq a -> Ordering
forall a b. MSeq a -> MSeq b -> Ordering
compareLength MSeq a
t1 MSeq a
t2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT Bool -> Bool -> Bool
&& Stream a -> Stream a -> Bool
forall a. Eq a => Stream a -> Stream a -> Bool
Stream.isSubsequenceOf (MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream MSeq a
t1) (MSeq a -> Stream a
forall a. MSeq a -> Stream a
stream MSeq a
t2)
{-# INLINABLE isSubsequenceOf #-}

------------------
-- Zip and unzip
------------------

-- | \(O(\min(n_1,n_2))\). Zip two sequences with a function. The result is
-- as long as the shorter sequence.
zipWith :: Measured c => (a -> b -> c) -> MSeq a -> MSeq b -> MSeq c
zipWith :: forall c a b.
Measured c =>
(a -> b -> c) -> MSeq a -> MSeq b -> MSeq c
zipWith =
  (((a -> b -> Identity c) -> MSeq a -> MSeq b -> Identity (MSeq c))
-> (a -> b -> c) -> MSeq a -> MSeq b -> MSeq c
forall {a} {b} {c}.
((a -> b -> Identity c) -> MSeq a -> MSeq b -> Identity (MSeq c))
-> (a -> b -> c) -> MSeq a -> MSeq b -> MSeq c
forall a b. Coercible a b => a -> b
coerce :: ((a -> b -> Identity c) -> MSeq a -> MSeq b -> Identity (MSeq c))
          -> (a -> b -> c) -> MSeq a -> MSeq b -> MSeq c)
  (a -> b -> Identity c) -> MSeq a -> MSeq b -> Identity (MSeq c)
forall c (m :: * -> *) a b.
(Measured c, Monad m) =>
(a -> b -> m c) -> MSeq a -> MSeq b -> m (MSeq c)
zipWithM
{-# INLINE zipWith #-}

-- | \(O(\min(n_1,n_2,n_3))\). Zip three sequences with a function. The result
-- is as long as the shortest sequence.
zipWith3
  :: Measured d => (a -> b -> c -> d) -> MSeq a -> MSeq b -> MSeq c -> MSeq d
zipWith3 :: forall d a b c.
Measured d =>
(a -> b -> c -> d) -> MSeq a -> MSeq b -> MSeq c -> MSeq d
zipWith3 =
  (((a -> b -> c -> Identity d)
 -> MSeq a -> MSeq b -> MSeq c -> Identity (MSeq d))
-> (a -> b -> c -> d) -> MSeq a -> MSeq b -> MSeq c -> MSeq d
forall {a} {b} {c} {d}.
((a -> b -> c -> Identity d)
 -> MSeq a -> MSeq b -> MSeq c -> Identity (MSeq d))
-> (a -> b -> c -> d) -> MSeq a -> MSeq b -> MSeq c -> MSeq d
forall a b. Coercible a b => a -> b
coerce :: ((a -> b -> c -> Identity d) -> MSeq a -> MSeq b -> MSeq c -> Identity (MSeq d))
          -> (a -> b -> c -> d) -> MSeq a -> MSeq b -> MSeq c -> MSeq d)
  (a -> b -> c -> Identity d)
-> MSeq a -> MSeq b -> MSeq c -> Identity (MSeq d)
forall d (m :: * -> *) a b c.
(Measured d, Monad m) =>
(a -> b -> c -> m d) -> MSeq a -> MSeq b -> MSeq c -> m (MSeq d)
zipWith3M
{-# INLINE zipWith3 #-}

-- | \(O(\min(n_1,n_2))\). Zip two sequences with a monadic function.
zipWithM
  :: (Measured c, Monad m) => (a -> b -> m c) -> MSeq a -> MSeq b -> m (MSeq c)
zipWithM :: forall c (m :: * -> *) a b.
(Measured c, Monad m) =>
(a -> b -> m c) -> MSeq a -> MSeq b -> m (MSeq c)
zipWithM a -> b -> m c
f MSeq a
t1 MSeq b
t2 = (a -> b -> m c) -> MSeq a -> Stream b -> m (MSeq c)
forall c (m :: * -> *) a b.
(Measured c, Monad m) =>
(a -> b -> m c) -> MSeq a -> Stream b -> m (MSeq c)
zipWithStreamM a -> b -> m c
f MSeq a
t1 (MSeq b -> Stream b
forall a. MSeq a -> Stream a
stream MSeq b
t2)
{-# INLINE zipWithM #-}

-- | \(O(\min(n_1,n_2,n_3))\). Zip three sequences with a monadic function.
zipWith3M
  :: (Measured d, Monad m)
  => (a -> b -> c -> m d) -> MSeq a -> MSeq b -> MSeq c -> m (MSeq d)
zipWith3M :: forall d (m :: * -> *) a b c.
(Measured d, Monad m) =>
(a -> b -> c -> m d) -> MSeq a -> MSeq b -> MSeq c -> m (MSeq d)
zipWith3M a -> b -> c -> m d
f MSeq a
t1 MSeq b
t2 MSeq c
t3 =
  (a -> S2 b c -> m d) -> MSeq a -> Stream (S2 b c) -> m (MSeq d)
forall c (m :: * -> *) a b.
(Measured c, Monad m) =>
(a -> b -> m c) -> MSeq a -> Stream b -> m (MSeq c)
zipWithStreamM
    (\a
x (U.S2 b
y c
z) -> a -> b -> c -> m d
f a
x b
y c
z)
    MSeq a
t1
    ((b -> c -> S2 b c) -> Stream b -> Stream c -> Stream (S2 b c)
forall a b c. (a -> b -> c) -> Stream a -> Stream b -> Stream c
Stream.zipWith b -> c -> S2 b c
forall a b. a -> b -> S2 a b
U.S2 (MSeq b -> Stream b
forall a. MSeq a -> Stream a
stream MSeq b
t2) (MSeq c -> Stream c
forall a. MSeq a -> Stream a
stream MSeq c
t3))
{-# INLINE zipWith3M #-}

zipWithStreamM
  :: (Measured c, Monad m)
  => (a -> b -> m c) -> MSeq a -> Stream b -> m (MSeq c)
zipWithStreamM :: forall c (m :: * -> *) a b.
(Measured c, Monad m) =>
(a -> b -> m c) -> MSeq a -> Stream b -> m (MSeq c)
zipWithStreamM a -> b -> m c
f MSeq a
t Stream b
strm = case MSeq a
t of
  MSeq a
MEmpty -> MSeq c -> m (MSeq c)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MSeq c
forall a. MSeq a
MEmpty
  MTree a
x MTree a
xs -> case Stream b
strm of
    Stream s -> Step s b
step s
s -> case s -> Step s b
step s
s of
      Step s b
Done -> MSeq c -> m (MSeq c)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MSeq c
forall a. MSeq a
MEmpty
      Yield b
y s
s1 ->
        (c -> MTree c -> MSeq c) -> m c -> m (MTree c) -> m (MSeq c)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 c -> MTree c -> MSeq c
forall a. a -> MTree a -> MSeq a
MTree (a -> b -> m c
f a
x b
y) ((a -> b -> m c) -> MTree a -> Stream b -> m (MTree c)
forall c (m :: * -> *) a b.
(Measured c, Monad m) =>
(a -> b -> m c) -> MTree a -> Stream b -> m (MTree c)
T.zipWithStreamM a -> b -> m c
f MTree a
xs ((s -> Step s b) -> s -> Stream b
forall a s. (s -> Step s a) -> s -> Stream a
Stream s -> Step s b
step s
s1))
{-# INLINE zipWithStreamM #-}

-- | \(O(n)\). Map over a sequence and unzip the result.
unzipWith
  :: (Measured b, Measured c)
  => (a -> (b, c)) -> MSeq a -> (MSeq b, MSeq c)
unzipWith :: forall b c a.
(Measured b, Measured c) =>
(a -> (b, c)) -> MSeq a -> (MSeq b, MSeq c)
unzipWith a -> (b, c)
f MSeq a
t = case MSeq a
t of
  MTree a
x MTree a
xs ->
    case (a -> (b, c)
f a
x, (a -> Identity (b, c))
-> MTree a -> Identity (S2 (MTree b) (MTree c))
forall b c (f :: * -> *) a.
(Measured b, Measured c, Applicative f) =>
(a -> f (b, c)) -> MTree a -> f (S2 (MTree b) (MTree c))
T.unzipWithA ((b, c) -> Identity (b, c)
forall a. a -> Identity a
Identity ((b, c) -> Identity (b, c))
-> (a -> (b, c)) -> a -> Identity (b, c)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
U.#. a -> (b, c)
f) MTree a
xs) of
      ((b
x1,c
x2), Identity (U.S2 MTree b
xs1 MTree c
xs2)) ->
        let !t1 :: MSeq b
t1 = b -> MTree b -> MSeq b
forall a. a -> MTree a -> MSeq a
MTree b
x1 MTree b
xs1
            !t2 :: MSeq c
t2 = c -> MTree c -> MSeq c
forall a. a -> MTree a -> MSeq a
MTree c
x2 MTree c
xs2
        in (MSeq b
t1,MSeq c
t2)
  MSeq a
MEmpty -> (MSeq b
forall a. MSeq a
MEmpty, MSeq c
forall a. MSeq a
MEmpty)
{-# INLINE unzipWith #-}

-- | \(O(n)\). Map over a sequence and unzip the result.
unzipWith3
  :: (Measured b, Measured c, Measured d)
  => (a -> (b, c, d)) -> MSeq a -> (MSeq b, MSeq c, MSeq d)
unzipWith3 :: forall b c d a.
(Measured b, Measured c, Measured d) =>
(a -> (b, c, d)) -> MSeq a -> (MSeq b, MSeq c, MSeq d)
unzipWith3 a -> (b, c, d)
f MSeq a
t = case MSeq a
t of
  MTree a
x MTree a
xs ->
    case (a -> (b, c, d)
f a
x, (a -> Identity (b, c, d))
-> MTree a -> Identity (S3 (MTree b) (MTree c) (MTree d))
forall b c d (f :: * -> *) a.
(Measured b, Measured c, Measured d, Applicative f) =>
(a -> f (b, c, d))
-> MTree a -> f (S3 (MTree b) (MTree c) (MTree d))
T.unzipWith3A ((b, c, d) -> Identity (b, c, d)
forall a. a -> Identity a
Identity ((b, c, d) -> Identity (b, c, d))
-> (a -> (b, c, d)) -> a -> Identity (b, c, d)
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
U.#. a -> (b, c, d)
f) MTree a
xs) of
      ((b
x1,c
x2,d
x3), Identity (U.S3 MTree b
xs1 MTree c
xs2 MTree d
xs3)) ->
        let !t1 :: MSeq b
t1 = b -> MTree b -> MSeq b
forall a. a -> MTree a -> MSeq a
MTree b
x1 MTree b
xs1
            !t2 :: MSeq c
t2 = c -> MTree c -> MSeq c
forall a. a -> MTree a -> MSeq a
MTree c
x2 MTree c
xs2
            !t3 :: MSeq d
t3 = d -> MTree d -> MSeq d
forall a. a -> MTree a -> MSeq a
MTree d
x3 MTree d
xs3
        in (MSeq b
t1,MSeq c
t2,MSeq d
t3)
  MSeq a
MEmpty -> (MSeq b
forall a. MSeq a
MEmpty, MSeq c
forall a. MSeq a
MEmpty, MSeq d
forall a. MSeq a
MEmpty)
{-# INLINE unzipWith3 #-}

---------------------
-- Measured queries
---------------------

-- | \(O(1)\). The summary is the fold of measures of all elements in the
-- sequence. Returns @Nothing@ if the sequence is empty.
--
-- @summaryMay == 'foldMap' (Just . 'measure')@
summaryMay :: Measured a => MSeq a -> Maybe (Measure a)
summaryMay :: forall a. Measured a => MSeq a -> Maybe (Measure a)
summaryMay MSeq a
t = case MSeq a
t of
  MTree a
x MTree a
xs -> Measure a -> Maybe (Measure a)
forall a. a -> Maybe a
Just (Measure a -> Maybe (Measure a)) -> Measure a -> Maybe (Measure a)
forall a b. (a -> b) -> a -> b
$! a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x Measure a -> MTree a -> Measure a
forall a. Measured a => Measure a -> MTree a -> Measure a
T.<<> MTree a
xs
  MSeq a
MEmpty -> Maybe (Measure a)
forall a. Maybe a
Nothing
{-# INLINE summaryMay #-}

-- | \(O(1)\). The summary is the fold of measures of all elements in the
-- sequence.
--
-- @summary == 'foldMap' 'measure'@
summary :: (Measured a, Monoid (Measure a)) => MSeq a -> Measure a
summary :: forall a. (Measured a, Monoid (Measure a)) => MSeq a -> Measure a
summary MSeq a
t = Measure a -> Maybe (Measure a) -> Measure a
forall a. a -> Maybe a -> a
fromMaybe Measure a
forall a. Monoid a => a
mempty (MSeq a -> Maybe (Measure a)
forall a. Measured a => MSeq a -> Maybe (Measure a)
summaryMay MSeq a
t)
{-# INLINABLE summary #-}

-- | \(O(\log n)\). The summary of a slice of the sequence. The slice is
-- indicated by its bounds (inclusive).
--
-- @sliceSummaryMay lu == 'summaryMay' . 'slice' lu@
--
-- @since 0.1.1.0
sliceSummaryMay :: Measured a => (Int, Int) -> MSeq a -> Maybe (Measure a)
sliceSummaryMay :: forall a. Measured a => (Int, Int) -> MSeq a -> Maybe (Measure a)
sliceSummaryMay (!Int
ql, !Int
qu) MSeq a
t = case MSeq a
t of
  MSeq a
MEmpty -> Maybe (Measure a)
forall a. Maybe a
Nothing
  MTree a
x MTree a
xs
    | Int
ql Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
qu Bool -> Bool -> Bool
|| Int
qu Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| MSeq a -> Int
forall a. MSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MSeq a
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ql -> Maybe (Measure a)
forall a. Maybe a
Nothing
    | Bool
otherwise -> Measure a -> Maybe (Measure a)
forall a. a -> Maybe a
Just (Measure a -> Maybe (Measure a)) -> Measure a -> Maybe (Measure a)
forall a b. (a -> b) -> a -> b
$! (Measure a -> Measure a)
-> (Measure a -> Measure a -> Measure a)
-> Int
-> Int
-> a
-> MTree a
-> Measure a
forall a b.
Measured a =>
(Measure a -> b)
-> (b -> Measure a -> b) -> Int -> Int -> a -> MTree a -> b
foldlMap1SliceSummaryComponents Measure a -> Measure a
forall a. a -> a
id Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
(<>) Int
ql Int
qu a
x MTree a
xs
{-# INLINE sliceSummaryMay #-}

-- | \(O(\log n)\). The summary of a slice of the sequence. The slice is
-- indicated by its bounds (inclusive).
--
-- @sliceSummary lu == 'summary' . 'slice' lu@
--
-- @since 0.1.1.0
sliceSummary
  :: (Measured a, Monoid (Measure a)) => (Int, Int) -> MSeq a -> Measure a
sliceSummary :: forall a.
(Measured a, Monoid (Measure a)) =>
(Int, Int) -> MSeq a -> Measure a
sliceSummary (Int, Int)
lu MSeq a
t = Measure a -> Maybe (Measure a) -> Measure a
forall a. a -> Maybe a -> a
fromMaybe Measure a
forall a. Monoid a => a
mempty ((Int, Int) -> MSeq a -> Maybe (Measure a)
forall a. Measured a => (Int, Int) -> MSeq a -> Maybe (Measure a)
sliceSummaryMay (Int, Int)
lu MSeq a
t)
{-# INLINABLE sliceSummary #-}

-- | Strict left fold over measures covering a slice. These measures are
-- summaries of \(O(\log n)\) adjacent slices which form the requested slice
-- when concatenated.
--
-- @foldlSliceSummaryComponents (<>) mempty == 'sliceSummary'@
--
-- This function is useful when
--
-- * Some property of the summary of a slice is desired.
-- * It is expensive to compute the summary, i.e. @(<>)@ for @Measure a@ is
--   expensive.
-- * It is possible, and cheaper, to compute the property given components
--   of the summary of the slice.
--
-- ==== __Examples__
--
-- One use case for this is order statistic queries on a slice, such as counting
-- the number of elements less than some value.
--
-- It requires a @Multiset@ structure as outlined below, which can be
-- implemented using sorted arrays/balanced binary trees.
--
-- @
-- data Multiset a
-- singleton :: Ord a => a -> MultiSet a -- O(1)
-- (<>) :: Ord a => Multiset a -> Multiset a -> Multiset a -- O(n1 + n2)
-- countLessThan :: Ord a => a -> Multiset a -> Int -- O(log n)
-- @
--
-- @
-- import Data.Seqn.MSeq (Measured, MSeq)
-- import qualified Data.Seqn.MSeq as MSeq
--
-- newtype Elem a = Elem a deriving Show
--
-- instance Ord a => Measured (Elem a) where
--   type Measure (Elem a) = Multiset a
--   measure (Elem x) = singleton x
--
-- -- | O(n log n).
-- fromList :: Ord a => [a] -> MSeq (Elem a)
-- fromList = MSeq.fromList . map Elem
--
-- -- | O(log^2 n).
-- countLessThanInSlice :: Ord a => a -> (Int, Int) -> MSeq (Elem a) -> Int
-- countLessThanInSlice k =
--   MSeq.foldlSliceSummaryComponents (\\acc xs -> acc + countLessThan k xs) 0
-- @
--
-- @since 0.1.1.0
foldlSliceSummaryComponents
  :: Measured a => (b -> Measure a -> b) -> b -> (Int, Int) -> MSeq a -> b
foldlSliceSummaryComponents :: forall a b.
Measured a =>
(b -> Measure a -> b) -> b -> (Int, Int) -> MSeq a -> b
foldlSliceSummaryComponents b -> Measure a -> b
f !b
z (!Int
ql, !Int
qu) MSeq a
t = case MSeq a
t of
  MSeq a
MEmpty -> b
z
  MTree a
x MTree a
xs
    | Int
ql Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
qu Bool -> Bool -> Bool
|| Int
qu Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| MSeq a -> Int
forall a. MSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MSeq a
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ql -> b
z
    | Bool
otherwise -> (Measure a -> b)
-> (b -> Measure a -> b) -> Int -> Int -> a -> MTree a -> b
forall a b.
Measured a =>
(Measure a -> b)
-> (b -> Measure a -> b) -> Int -> Int -> a -> MTree a -> b
foldlMap1SliceSummaryComponents (b -> Measure a -> b
f b
z) b -> Measure a -> b
f Int
ql Int
qu a
x MTree a
xs
{-# INLINE foldlSliceSummaryComponents #-}

-- Precondition: slice (ql, qu) (Tree x0 xs0) is non-empty
foldlMap1SliceSummaryComponents
  :: Measured a
  => (Measure a -> b) -> (b -> Measure a -> b)
  -> Int -> Int -> a -> MTree a -> b
foldlMap1SliceSummaryComponents :: forall a b.
Measured a =>
(Measure a -> b)
-> (b -> Measure a -> b) -> Int -> Int -> a -> MTree a -> b
foldlMap1SliceSummaryComponents Measure a -> b
f b -> Measure a -> b
g !Int
ql !Int
qu a
x0 MTree a
xs0
  | Int
ql Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
&& Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
qu = b -> Int -> MTree a -> b
go (Measure a -> b
f (a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x0)) Int
1 MTree a
xs0
  | Bool
otherwise = Int -> MTree a -> b
go1 Int
1 MTree a
xs0
  where
    go1 :: Int -> MTree a -> b
go1 !Int
i (MBin Int
sz Measure a
v a
y MTree a
l MTree a
r)
      | Int
ql Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
qu = Measure a -> b
f Measure a
v
      | Int
ql Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
j Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
qu =
          if Int
ql Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
j Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
qu
          then b -> Int -> MTree a -> b
go (b -> Measure a -> b
g (Int -> MTree a -> b
go1 Int
i MTree a
l) (a -> Measure a
forall a. Measured a => a -> Measure a
measure a
y)) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MTree a
r
          else Int -> MTree a -> b
go1 Int
i MTree a
l
      | Int
ql Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
j Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
qu = b -> Int -> MTree a -> b
go (Measure a -> b
f (a -> Measure a
forall a. Measured a => a -> Measure a
measure a
y)) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MTree a
r
      | Bool
otherwise = Int -> MTree a -> b
go1 (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MTree a
r
      where
        k :: Int
k = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
l
    go1 Int
_ MTree a
MTip = String -> b
forall a. HasCallStack => String -> a
error String
"MSeq.foldlMap1SliceSummaryComponents: impossible"

    go :: b -> Int -> MTree a -> b
go !b
z !Int
i (MBin Int
sz Measure a
v a
x MTree a
l MTree a
r)
      | Int
qu Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i Bool -> Bool -> Bool
|| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ql = b
z
      | Int
ql Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
qu = b -> Measure a -> b
g b
z Measure a
v
      | Int
ql Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
j Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
qu = b -> Int -> MTree a -> b
go (b -> Measure a -> b
g (b -> Int -> MTree a -> b
go b
z Int
i MTree a
l) (a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x)) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MTree a
r
      | Bool
otherwise = b -> Int -> MTree a -> b
go (b -> Int -> MTree a -> b
go b
z Int
i MTree a
l) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MTree a
r
      where
        k :: Int
k = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
l
    go b
z Int
_ MTree a
MTip = b
z
{-# INLINE foldlMap1SliceSummaryComponents #-}

-- | \(O(\log n)\). Perform a binary search on the summaries of the non-empty
-- prefixes of the sequence.
--
-- @binarySearchPrefix p xs@ for a monotonic predicate @p@ returns two adjacent
-- indices @i@ and @j@, @0 <= i < j < length xs@.
--
-- * @i@ is the greatest index such that
--   @p (fromJust (summaryMay (take (i+1) xs)))@
--   is @False@, or @Nothing@ if there is no such index.
-- * @j@ is the least index such that
--   @p (fromJust (summaryMay (take (j+1) xs)))@
--   is @True@, or @Nothing@ if there is no such index.
--
-- ==== __Examples__
--
-- @
-- import "Data.Monoid" (Sum(..))
--
-- newtype Elem = E Int deriving Show
--
-- instance Measured Elem where
--   type Measure Elem = Sum Int
--   measure (E x) = Sum x
-- @
--
-- >>> let xs = fromList [E 1, E 2, E 3, E 4]
--
-- The summaries of the prefixes of @xs@ by index are:
--
-- * @0: measure (E 1) = Sum 1@.
-- * @1: measure (E 1) <> measure (E 2) = Sum 3@.
-- * @2: measure (E 1) <> measure (E 2) <> measure (E 3) = Sum 6@.
-- * @3: measure (E 1) <> measure (E 2) <> measure (E 3) <> measure (E 4) = Sum 10@.
--
-- >>> binarySearchPrefix (> Sum 4) xs
-- (Just 1,Just 2)
--
-- @
--                  ╭──────────┬──────────┬──────────┬──────────╮
-- index:           │        0 │        1 │        2 │        3 │
--                  ├──────────┼──────────┼──────────┼──────────┤
-- prefix summary:  │    Sum 1 │    Sum 3 │    Sum 6 |   Sum 10 │
--                  ├──────────┼──────────┼──────────┼──────────┤
-- (> Sum 4):       │    False │    False │     True │     True │
--                  ╰──────────┴──────────┴──────────┴──────────╯
-- result:                       ( Just 1 ,   Just 2 )
-- @
--
-- >>> binarySearchPrefix (> Sum 20) xs
-- (Just 3,Nothing)
--
-- @
--                  ╭──────────┬──────────┬──────────┬──────────╮
-- index:           │        0 │        1 │        2 │        3 │
--                  ├──────────┼──────────┼──────────┼──────────┤
-- prefix summary:  │    Sum 1 │    Sum 3 │    Sum 6 |   Sum 10 │
--                  ├──────────┼──────────┼──────────┼──────────┤
-- (> Sum 20):      │    False │    False │    False │    False │
--                  ╰──────────┴──────────┴──────────┴──────────╯
-- result:                                             ( Just 3 ,  Nothing )
-- @
--
binarySearchPrefix
  :: Measured a => (Measure a -> Bool) -> MSeq a -> (Maybe Int, Maybe Int)
binarySearchPrefix :: forall a.
Measured a =>
(Measure a -> Bool) -> MSeq a -> (Maybe Int, Maybe Int)
binarySearchPrefix Measure a -> Bool
p = \case
  MTree a
x MTree a
xs
    | Measure a -> Bool
p Measure a
v -> (Maybe Int
forall a. Maybe a
Nothing, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
    | Measure a -> Bool
p (Measure a
v Measure a -> MTree a -> Measure a
forall a. Measured a => Measure a -> MTree a -> Measure a
T.<<> MTree a
xs) -> let !i :: Int
i = Int -> Measure a -> MTree a -> Int
go Int
1 Measure a
v MTree a
xs in (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i)
    | Bool
otherwise -> let !i :: Int
i = MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs in (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i, Maybe Int
forall a. Maybe a
Nothing)
    where
      v :: Measure a
v = a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x
  MSeq a
MEmpty -> (Maybe Int
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing)
  where
    go :: Int -> Measure a -> MTree a -> Int
go !Int
i !Measure a
vup = \case
      MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r
        | Measure a -> Bool
p Measure a
v -> Int -> Measure a -> MTree a -> Int
go Int
i Measure a
vup MTree a
l
        | Measure a -> Bool
p Measure a
v' -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
l
        | Bool
otherwise -> Int -> Measure a -> MTree a -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Measure a
v' MTree a
r
        where
          v :: Measure a
v = Measure a
vup Measure a -> MTree a -> Measure a
forall a. Measured a => Measure a -> MTree a -> Measure a
T.<<> MTree a
l
          v' :: Measure a
v' = Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x
      MTree a
MTip -> String -> Int
forall a. HasCallStack => String -> a
error String
"MSeq.binarySearchPrefix: bad p"
{-# INLINE binarySearchPrefix #-}

-- | \(O(\log n)\). Perform a binary search on the summaries of the non-empty
-- suffixes of the sequence.
--
-- @binarySearchSuffix p xs@ for a monotonic predicate @p@ returns two adjacent
-- indices @i@ and @j@, @0 <= i < j < length xs@.
--
-- * @i@ is the greatest index such that
--   @p (fromJust (summaryMay (drop i xs)))@ is
--   @True@, or @Nothing@ if there is no such index.
-- * @j@ is the least index such that
--   @p (fromJust (summaryMay (drop j xs)))@ is
--   @False@, or @Nothing@ if there is no such index
--
-- ==== __Examples__
--
-- @
-- import "Data.Monoid" (Sum(..))
--
-- newtype Elem = E Int deriving Show
--
-- instance Measured Elem where
--   type Measure Elem = Sum Int
--   measure (E x) = Sum x
-- @
--
-- >>> let xs = fromList [E 1, E 2, E 3, E 4]
--
-- The summaries of the suffixes of @xs@ by index are:
--
-- * @0: measure (E 1) <> measure (E 2) <> measure (E 3) <> measure (E 4) = Sum 10@.
-- * @1: measure (E 2) <> measure (E 3) <> measure (E 4) = Sum 9@.
-- * @2: measure (E 3) <> measure (E 4) = Sum 7@.
-- * @3: measure (E 4) = Sum 4@.
--
-- >>> binarySearchSuffix (> Sum 4) xs
-- (Just 2,Just 3)
--
-- @
--                  ╭──────────┬──────────┬──────────┬──────────╮
-- index:           │        0 │        1 │        2 │        3 │
--                  ├──────────┼──────────┼──────────┼──────────┤
-- suffix summary:  │   Sum 10 │    Sum 9 │    Sum 7 |    Sum 4 │
--                  ├──────────┼──────────┼──────────┼──────────┤
-- (> Sum 4):       │     True │     True │     True │    False │
--                  ╰──────────┴──────────┴──────────┴──────────╯
-- result:                                  ( Just 2 ,   Just 3 )
-- @
--
-- >>> binarySearchSuffix (> Sum 20) xs
-- (Nothing,Just 0)
--
-- @
--                           ╭──────────┬──────────┬──────────┬──────────╮
-- index:                    │        0 │        1 │        2 │        3 │
--                           ├──────────┼──────────┼──────────┼──────────┤
-- suffix summary:           │   Sum 10 │    Sum 9 │    Sum 7 |    Sum 4 │
--                           ├──────────┼──────────┼──────────┼──────────┤
-- (> Sum 20):               │    False │    False │    False │    False │
--                           ╰──────────┴──────────┴──────────┴──────────╯
-- result:         ( Nothing ,   Just 0 )
-- @
--
binarySearchSuffix
  :: Measured a => (Measure a -> Bool) -> MSeq a -> (Maybe Int, Maybe Int)
binarySearchSuffix :: forall a.
Measured a =>
(Measure a -> Bool) -> MSeq a -> (Maybe Int, Maybe Int)
binarySearchSuffix Measure a -> Bool
p = \case
  MTree a
x MTree a
xs -> case MTree a
xs of
    MBin Int
_ Measure a
rv a
rx MTree a
rl MTree a
rr
      | Measure a -> Bool
p Measure a
rv -> let !i :: Int
i = a -> MTree a -> MTree a -> Int
goR a
rx MTree a
rl MTree a
rr
                in if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                   then let !j :: Int
j = MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs in (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
j, Maybe Int
forall a. Maybe a
Nothing)
                   else let !j :: Int
j = MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i in (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
j, Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
      | Measure a -> Bool
p Measure a
v -> (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
      | Bool
otherwise -> (Maybe Int
forall a. Maybe a
Nothing, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
      where
        v :: Measure a
v = a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv
    MTree a
MTip
      | Measure a -> Bool
p (a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x) -> (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0, Maybe Int
forall a. Maybe a
Nothing)
      | Bool
otherwise -> (Maybe Int
forall a. Maybe a
Nothing, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
  MSeq a
MEmpty -> (Maybe Int
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing)
  where
    goR :: a -> MTree a -> MTree a -> Int
goR !a
x !MTree a
l MTree a
r = case MTree a
r of
      MBin Int
rsz Measure a
rv a
rx MTree a
rl MTree a
rr
        | Measure a -> Bool
p Measure a
rv -> a -> MTree a -> MTree a -> Int
goR a
rx MTree a
rl MTree a
rr
        | Measure a -> Bool
p Measure a
v -> Int
rsz
        | Bool
otherwise -> Int -> Measure a -> MTree a -> Int
go (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rsz) Measure a
v MTree a
l
        where
          v :: Measure a
v = a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv
      MTree a
MTip
        | Measure a -> Bool
p Measure a
v -> Int
0
        | Bool
otherwise -> Int -> Measure a -> MTree a -> Int
go Int
1 Measure a
v MTree a
l
        where
          v :: Measure a
v = a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x
    go :: Int -> Measure a -> MTree a -> Int
go !Int
i !Measure a
vup = \case
      MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r
        | Measure a -> Bool
p Measure a
v -> Int -> Measure a -> MTree a -> Int
go Int
i Measure a
vup MTree a
r
        | Measure a -> Bool
p Measure a
v' -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
r
        | Bool
otherwise -> Int -> Measure a -> MTree a -> Int
go (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Measure a
v' MTree a
l
        where
          v :: Measure a
v = MTree a
r MTree a -> Measure a -> Measure a
forall a. Measured a => MTree a -> Measure a -> Measure a
T.<>> Measure a
vup
          v' :: Measure a
v' = a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v
      MTree a
MTip -> String -> Int
forall a. HasCallStack => String -> a
error String
"MSeq.binarySearchSuffix: bad p"
{-# INLINE binarySearchSuffix #-}

----------
-- Force
----------

-- | Reduce a sequence to normal form, given functions to reduce its contents.
liftRnf2 :: (Measure a -> ()) -> (a -> ()) -> MSeq a -> ()
liftRnf2 :: forall a. (Measure a -> ()) -> (a -> ()) -> MSeq a -> ()
liftRnf2 Measure a -> ()
g a -> ()
f = \case
  MTree a
x MTree a
xs -> a -> ()
f a
x () -> () -> ()
forall a b. a -> b -> b
`seq` (Measure a -> ()) -> (a -> ()) -> MTree a -> ()
forall a. (Measure a -> ()) -> (a -> ()) -> MTree a -> ()
T.liftRnf2 Measure a -> ()
g a -> ()
f MTree a
xs
  MSeq a
MEmpty -> ()
{-# INLINE liftRnf2 #-}

--------
-- Util
--------

fromMTree :: Measured a => MTree a -> MSeq a
fromMTree :: forall a. Measured a => MTree a -> MSeq a
fromMTree MTree a
t = case MTree a -> SMaybe (S2 a (MTree a))
forall a. Measured a => MTree a -> SMaybe (S2 a (MTree a))
T.uncons MTree a
t of
  SMaybe (S2 a (MTree a))
U.SNothing -> MSeq a
forall a. MSeq a
MEmpty
  U.SJust (U.S2 a
x MTree a
xs) -> a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x MTree a
xs
{-# INLINE fromMTree #-}

-- See Note [compareLength]
compareLength :: MSeq a -> MSeq b -> Ordering
compareLength :: forall a b. MSeq a -> MSeq b -> Ordering
compareLength MSeq a
l MSeq b
r = case MSeq a
l of
  MTree a
_ MTree a
xs -> case MSeq b
r of
    MTree b
_ MTree b
ys -> MTree a -> MTree b -> Ordering
forall a b. MTree a -> MTree b -> Ordering
compareSize MTree a
xs MTree b
ys
    MSeq b
MEmpty -> Ordering
GT
  MSeq a
MEmpty -> case MSeq b
r of
    MTree b
_ MTree b
_ -> Ordering
LT
    MSeq b
MEmpty -> Ordering
EQ
{-# INLINE compareLength #-}

compareSize :: MTree a -> MTree b -> Ordering
compareSize :: forall a b. MTree a -> MTree b -> Ordering
compareSize MTree a
l MTree b
r = case MTree a
l of
  MBin Int
szl Measure a
_ a
_ MTree a
_ MTree a
_ -> case MTree b
r of
    MBin Int
szr Measure b
_ b
_ MTree b
_ MTree b
_ -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
szl Int
szr
    MTree b
MTip -> Ordering
GT
  MTree a
MTip -> case MTree b
r of
    MBin Int
_ Measure b
_ b
_ MTree b
_ MTree b
_ -> Ordering
LT
    MTree b
MTip -> Ordering
EQ
{-# INLINE compareSize #-}

----------
-- Build
----------

-- WARNING
--
-- The functions below are similar but they should not be mixed together! All of
-- them operate on Stack, but what the Stack means is not the same between
-- functions.
--
-- left-to-right, 1 element at a time: ltrPush, ltrFinish
-- left-to-right, many elements at a time: ltrPushMany, ltrFinish
-- right-to-left, 1 element at a time: rtlPush, rtlFinish

-- See Note [fromList implementation] in Data.Seqn.Internal.Seq
-- See Note [concatMap implementation] in Data.Seqn.Internal.Seq

ltrPush :: Measured a => Stack a -> a -> Stack a
ltrPush :: forall a. Measured a => Stack a -> a -> Stack a
ltrPush Stack a
stk a
y = case Stack a
stk of
  Push a
x MTree a
MTip Stack a
stk' -> Stack a -> a -> Int -> MTree a -> Stack a
forall a. Measured a => Stack a -> a -> Int -> MTree a -> Stack a
ltrPushLoop Stack a
stk' a
x Int
1 (a -> MTree a
forall a. Measured a => a -> MTree a
T.singleton a
y)
  Stack a
_ -> a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
y MTree a
forall a. MTree a
MTip Stack a
stk
{-# INLINABLE ltrPush #-}

ltrPushLoop :: Measured a => Stack a -> a -> Int -> MTree a -> Stack a
ltrPushLoop :: forall a. Measured a => Stack a -> a -> Int -> MTree a -> Stack a
ltrPushLoop Stack a
stk a
y !Int
ysz MTree a
ys = case Stack a
stk of
  Push a
x xs :: MTree a
xs@(MBin Int
xsz Measure a
_ a
_ MTree a
_ MTree a
_) Stack a
stk'
    | Int
xsz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ysz -> Stack a -> a -> Int -> MTree a -> Stack a
forall a. Measured a => Stack a -> a -> Int -> MTree a -> Stack a
ltrPushLoop Stack a
stk' a
x Int
sz (Int -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
T.binn Int
sz a
y MTree a
xs MTree a
ys)
    where
      sz :: Int
sz = Int
xszInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
xszInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
  Stack a
_ -> a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
y MTree a
ys Stack a
stk
{-# INLINABLE ltrPushLoop #-}

rtlPush :: Measured a => a -> Stack a -> Stack a
rtlPush :: forall a. Measured a => a -> Stack a -> Stack a
rtlPush a
x = \case
  Push a
y MTree a
MTip Stack a
stk' -> a -> Int -> MTree a -> Stack a -> Stack a
forall a. Measured a => a -> Int -> MTree a -> Stack a -> Stack a
rtlPushLoop a
x Int
1 (a -> MTree a
forall a. Measured a => a -> MTree a
T.singleton a
y) Stack a
stk'
  Stack a
stk -> a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
x MTree a
forall a. MTree a
MTip Stack a
stk
{-# INLINABLE rtlPush #-}

rtlPushLoop :: Measured a => a -> Int -> MTree a -> Stack a -> Stack a
rtlPushLoop :: forall a. Measured a => a -> Int -> MTree a -> Stack a -> Stack a
rtlPushLoop a
x !Int
xsz MTree a
xs = \case
  Push a
y ys :: MTree a
ys@(MBin Int
ysz Measure a
_ a
_ MTree a
_ MTree a
_) Stack a
stk'
    | Int
xsz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ysz -> a -> Int -> MTree a -> Stack a -> Stack a
forall a. Measured a => a -> Int -> MTree a -> Stack a -> Stack a
rtlPushLoop a
x Int
sz (Int -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
T.binn Int
sz a
y MTree a
xs MTree a
ys) Stack a
stk'
    where
      sz :: Int
sz = Int
xszInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
xszInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
  Stack a
stk -> a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
x MTree a
xs Stack a
stk
{-# INLINABLE rtlPushLoop #-}

ltrPushMany :: Measured a => Stack a -> a -> MTree a -> Stack a
ltrPushMany :: forall a. Measured a => Stack a -> a -> MTree a -> Stack a
ltrPushMany Stack a
stk a
y MTree a
ys = case Stack a
stk of
  Push a
x MTree a
xs Stack a
stk'
    | Int
ysz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
xsz Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 -> Stack a -> a -> Int -> MTree a -> a -> Int -> MTree a -> Stack a
forall a.
Measured a =>
Stack a -> a -> Int -> MTree a -> a -> Int -> MTree a -> Stack a
ltrPushManyLoop Stack a
stk' a
x Int
xsz MTree a
xs a
y Int
ysz MTree a
ys
    | Bool
otherwise -> a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
y MTree a
ys Stack a
stk
    where
      xsz :: Int
xsz = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
xs
      ysz :: Int
ysz = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
T.size MTree a
ys
  Stack a
Nil -> a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
y MTree a
ys Stack a
forall a. Stack a
Nil
{-# INLINABLE ltrPushMany #-}

ltrPushManyLoop
  :: Measured a
  => Stack a -> a -> Int -> MTree a -> a -> Int -> MTree a -> Stack a
ltrPushManyLoop :: forall a.
Measured a =>
Stack a -> a -> Int -> MTree a -> a -> Int -> MTree a -> Stack a
ltrPushManyLoop Stack a
stk a
y !Int
ysz MTree a
ys a
z !Int
zsz MTree a
zs = case Stack a
stk of
  Push a
x xs :: MTree a
xs@(MBin Int
xsz1 Measure a
_ a
_ MTree a
_ MTree a
_) Stack a
stk'
    | Int
xsz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
zsz
    -> Stack a -> a -> Int -> MTree a -> a -> Int -> MTree a -> Stack a
forall a.
Measured a =>
Stack a -> a -> Int -> MTree a -> a -> Int -> MTree a -> Stack a
ltrPushManyLoop Stack a
stk' a
x (Int
xsz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ysz) (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
T.link a
y MTree a
xs MTree a
ys) a
z Int
zsz MTree a
zs
    | Int
yzsz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
xsz Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
    -> Stack a -> a -> Int -> MTree a -> a -> Int -> MTree a -> Stack a
forall a.
Measured a =>
Stack a -> a -> Int -> MTree a -> a -> Int -> MTree a -> Stack a
ltrPushManyLoop Stack a
stk' a
x Int
xsz MTree a
xs a
y Int
yzsz (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
T.link a
z MTree a
ys MTree a
zs)
    | Bool
otherwise
    -> a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
y (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
T.link a
z MTree a
ys MTree a
zs) Stack a
stk
    where
      xsz :: Int
xsz = Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
xsz1
      yzsz :: Int
yzsz = Int
yszInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
zsz
  Stack a
_ -> a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
y (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
T.link a
z MTree a
ys MTree a
zs) Stack a
stk
{-# INLINABLE ltrPushManyLoop #-}

ltrFinish :: Measured a => Stack a -> MSeq a
ltrFinish :: forall a. Measured a => Stack a -> MSeq a
ltrFinish = MSeq a
-> (a -> MTree a -> S2 a (MTree a))
-> (S2 a (MTree a) -> a -> MTree a -> S2 a (MTree a))
-> (S2 a (MTree a) -> MSeq a)
-> Stack a
-> MSeq a
forall c a b.
c
-> (a -> MTree a -> b)
-> (b -> a -> MTree a -> b)
-> (b -> c)
-> Stack a
-> c
wrapUpStack
  MSeq a
forall a. MSeq a
MEmpty
  a -> MTree a -> S2 a (MTree a)
forall a b. a -> b -> S2 a b
U.S2
  (\(U.S2 a
y MTree a
ys) a
x MTree a
xs -> a -> MTree a -> S2 a (MTree a)
forall a b. a -> b -> S2 a b
U.S2 a
x (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
T.link a
y MTree a
xs MTree a
ys))
  (\(U.S2 a
y MTree a
ys) -> a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
y MTree a
ys)
{-# INLINABLE ltrFinish #-}

rtlFinish :: Measured a => Stack a -> MSeq a
rtlFinish :: forall a. Measured a => Stack a -> MSeq a
rtlFinish = MSeq a
-> (a -> MTree a -> S2 a (MTree a))
-> (S2 a (MTree a) -> a -> MTree a -> S2 a (MTree a))
-> (S2 a (MTree a) -> MSeq a)
-> Stack a
-> MSeq a
forall c a b.
c
-> (a -> MTree a -> b)
-> (b -> a -> MTree a -> b)
-> (b -> c)
-> Stack a
-> c
wrapUpStack
  MSeq a
forall a. MSeq a
MEmpty
  a -> MTree a -> S2 a (MTree a)
forall a b. a -> b -> S2 a b
U.S2
  (\(U.S2 a
x MTree a
xs) a
y MTree a
ys -> a -> MTree a -> S2 a (MTree a)
forall a b. a -> b -> S2 a b
U.S2 a
x (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
T.link a
y MTree a
xs MTree a
ys))
  (\(U.S2 a
x MTree a
xs) -> a -> MTree a -> MSeq a
forall a. a -> MTree a -> MSeq a
MTree a
x MTree a
xs)
{-# INLINABLE rtlFinish #-}

-----------
-- Stream
-----------

-- See Note [Streams] in Data.Seqn.Internal.Seq

stream :: MSeq a -> Stream a
stream :: forall a. MSeq a -> Stream a
stream !MSeq a
t = (Stack a -> Step (Stack a) a) -> Stack a -> Stream a
forall a s. (s -> Step s a) -> s -> Stream a
Stream Stack a -> Step (Stack a) a
forall {a}. Stack a -> Step (Stack a) a
step Stack a
s
  where
    s :: Stack a
s = case MSeq a
t of
      MTree a
x MTree a
xs -> a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
x MTree a
xs Stack a
forall a. Stack a
Nil
      MSeq a
MEmpty -> Stack a
forall a. Stack a
Nil
    step :: Stack a -> Step (Stack a) a
step = \case
      Stack a
Nil -> Step (Stack a) a
forall s a. Step s a
Done
      Push a
x MTree a
xs Stack a
stk -> let !stk' :: Stack a
stk' = MTree a -> Stack a -> Stack a
forall a. MTree a -> Stack a -> Stack a
down MTree a
xs Stack a
stk in a -> Stack a -> Step (Stack a) a
forall s a. a -> s -> Step s a
Yield a
x Stack a
stk'
    {-# INLINE [0] step #-}
{-# INLINE stream #-}

streamEnd :: MSeq a -> Stream a
streamEnd :: forall a. MSeq a -> Stream a
streamEnd !MSeq a
t = (Stack a -> Step (Stack a) a) -> Stack a -> Stream a
forall a s. (s -> Step s a) -> s -> Stream a
Stream Stack a -> Step (Stack a) a
forall {a}. Stack a -> Step (Stack a) a
step Stack a
s
  where
    s :: Stack a
s = case MSeq a
t of
      MTree a
x MTree a
xs -> a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
x MTree a
xs Stack a
forall a. Stack a
Nil
      MSeq a
MEmpty -> Stack a
forall a. Stack a
Nil
    step :: Stack a -> Step (Stack a) a
step = \case
      Stack a
Nil -> Step (Stack a) a
forall s a. Step s a
Done
      Push a
x MTree a
xs Stack a
stk -> case a -> MTree a -> Stack a -> S2 a (Stack a)
forall a. a -> MTree a -> Stack a -> S2 a (Stack a)
rDown a
x MTree a
xs Stack a
stk of
        U.S2 a
y Stack a
stk' -> a -> Stack a -> Step (Stack a) a
forall s a. a -> s -> Step s a
Yield a
y Stack a
stk'
    {-# INLINE [0] step #-}
{-# INLINE streamEnd #-}

down :: MTree a -> Stack a -> Stack a
down :: forall a. MTree a -> Stack a -> Stack a
down (MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r) Stack a
stk = MTree a -> Stack a -> Stack a
forall a. MTree a -> Stack a -> Stack a
down MTree a
l (a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
x MTree a
r Stack a
stk)
down MTree a
MTip Stack a
stk = Stack a
stk

rDown :: a -> MTree a -> Stack a -> U.S2 a (Stack a)
rDown :: forall a. a -> MTree a -> Stack a -> S2 a (Stack a)
rDown !a
y (MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r) Stack a
stk = a -> MTree a -> Stack a -> S2 a (Stack a)
forall a. a -> MTree a -> Stack a -> S2 a (Stack a)
rDown a
x MTree a
r (a -> MTree a -> Stack a -> Stack a
forall a. a -> MTree a -> Stack a -> Stack a
Push a
y MTree a
l Stack a
stk)
rDown a
y MTree a
MTip Stack a
stk = a -> Stack a -> S2 a (Stack a)
forall a b. a -> b -> S2 a b
U.S2 a
y Stack a
stk

----------
-- Stack
----------

-- This is used in various places. What it stores depends on the specific use
-- case.
data Stack a
  = Push !a !(MTree a) !(Stack a)
  | Nil

wrapUpStack
  :: c -- empty
  -> (a -> MTree a -> b) -- initial
  -> (b -> a -> MTree a -> b) -- fold fun
  -> (b -> c) -- finish
  -> Stack a
  -> c
wrapUpStack :: forall c a b.
c
-> (a -> MTree a -> b)
-> (b -> a -> MTree a -> b)
-> (b -> c)
-> Stack a
-> c
wrapUpStack c
z0 a -> MTree a -> b
f0 b -> a -> MTree a -> b
f b -> c
fin = Stack a -> c
go
  where
    go :: Stack a -> c
go Stack a
Nil = c
z0
    go (Push a
x MTree a
xs Stack a
stk) = b -> Stack a -> c
go1 (a -> MTree a -> b
f0 a
x MTree a
xs) Stack a
stk
    go1 :: b -> Stack a -> c
go1 !b
z Stack a
Nil = b -> c
fin b
z
    go1 b
z (Push a
x MTree a
xs Stack a
stk) = b -> Stack a -> c
go1 (b -> a -> MTree a -> b
f b
z a
x MTree a
xs) Stack a
stk
{-# INLINE wrapUpStack #-}

------------
-- Testing
------------

valid :: (Measured a, Eq (Measure a)) => MSeq a -> Bool
valid :: forall a. (Measured a, Eq (Measure a)) => MSeq a -> Bool
valid = \case
  MTree a
_ MTree a
xs -> MTree a -> Bool
forall a. (Measured a, Eq (Measure a)) => MTree a -> Bool
T.valid MTree a
xs
  MSeq a
MEmpty -> Bool
True

debugShowsPrec :: (Show a, Show (Measure a)) => Int -> MSeq a -> ShowS
debugShowsPrec :: forall a. (Show a, Show (Measure a)) => Int -> MSeq a -> ShowS
debugShowsPrec Int
p = \case
  MTree a
x MTree a
xs ->
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"MTree " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> MTree a -> ShowS
forall a. (Show a, Show (Measure a)) => Int -> MTree a -> ShowS
T.debugShowsPrec Int
11 MTree a
xs
  MSeq a
MEmpty -> String -> ShowS
showString String
"MEmpty"

----------
-- Error
----------

errorElement :: a
errorElement :: forall a. a
errorElement = String -> a
forall a. HasCallStack => String -> a
error String
"MSeq: errorElement"