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

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

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

    -- * Convert
  , toRevList

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

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

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

    -- * Transform
  , reverse
  , intersperse
  , scanl
  , scanr
  , sort
  , sortBy

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

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

    -- * Internal
  , fromTree

    -- * Testing
  , valid
  , debugShowsPrec
  ) where

import Prelude hiding (concatMap, break, drop, dropWhile, filter, lookup, 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(..), NFData1(..))
import Control.Monad (MonadPlus(..))
import Control.Monad.Fix (MonadFix(..))
import Control.Monad.Zip (MonadZip(..))
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(..), Read1(..))
import qualified Data.Functor.Classes as F1
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))
import qualified Data.Functor.WithIndex as IFu
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Monoid as Monoid
import qualified Data.Primitive.Array as A
import qualified Data.SamSort as Sam
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import qualified Data.Traversable as Tr
import qualified Data.Traversable.WithIndex as ITr
import qualified GHC.Exts as X
import Text.Read (Read(..))
import qualified Text.Read as Read

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

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

-- | A sequence with elements of type @a@.
data Seq a
  = Tree !a !(Tree a)
  | Empty

-- Note [Seq structure]
-- ~~~~~~~~~~~~~~~~~~~~
-- A Seq is a weight-balanced binary tree, with a small twist: the first element
-- is kept aside from the tree. It can be viewed as a binary tree with a root
-- and a right child, but a missing left child. The motivation for this change
-- is that it improves the complexity of the append operation, from
-- O(log (n_1 + n_2)) to O(|log n_1 - log n_2|), while not affecting any of the
-- other operations. Is it worth the trouble? I think so.

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

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

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

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

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

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

instance Eq1 Seq where
  liftEq :: forall a b. (a -> b -> Bool) -> Seq a -> Seq b -> Bool
liftEq a -> b -> Bool
f Seq a
t1 Seq b
t2 = Seq a -> Seq b -> Ordering
forall a b. Seq a -> Seq b -> Ordering
compareLength Seq a
t1 Seq 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 (Seq a -> Stream a
forall a. Seq a -> Stream a
stream Seq a
t1) (Seq b -> Stream b
forall a. Seq a -> Stream a
stream Seq b
t2)
  {-# INLINE liftEq #-}

instance Ord1 Seq where
  liftCompare :: forall a b. (a -> b -> Ordering) -> Seq a -> Seq b -> Ordering
liftCompare a -> b -> Ordering
f Seq a
t1 Seq 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 (Seq a -> Stream a
forall a. Seq a -> Stream a
stream Seq a
t1) (Seq b -> Stream b
forall a. Seq a -> Stream a
stream Seq b
t2)
  {-# INLINE liftCompare #-}

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

instance Read1 Seq where
  liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Seq a)
liftReadPrec ReadPrec a
_ = ([a] -> Seq a) -> ReadPrec [a] -> ReadPrec (Seq a)
forall a b. (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Seq a
forall a. [a] -> Seq a
fromList
  liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Seq a]
liftReadListPrec = ReadPrec a -> ReadPrec [a] -> ReadPrec [Seq a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
F1.liftReadListPrecDefault

-- |
-- [@length@]: \(O(1)\).
--
-- Folds are \(O(n)\).
instance Foldable Seq where
  fold :: forall m. Monoid m => Seq m -> m
fold = (m -> m) -> Seq m -> m
forall m a. Monoid m => (a -> m) -> Seq 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) -> Seq a -> m
foldMap a -> m
f = (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
Tr.foldMapDefault a -> m
f
  {-# INLINE foldMap #-}

  foldMap' :: forall m a. Monoid m => (a -> m) -> Seq a -> m
foldMap' a -> m
f = (m -> a -> m) -> m -> Seq a -> m
forall b a. (b -> a -> b) -> b -> Seq 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 -> Seq 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) -> (Seq a -> Stream a) -> Seq a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> Stream a
forall a. Seq a -> Stream a
stream
  {-# INLINE foldr #-}

  foldl :: forall b a. (b -> a -> b) -> b -> Seq 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) -> (Seq a -> Stream a) -> Seq a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> Stream a
forall a. Seq a -> Stream a
streamEnd
  {-# INLINE foldl #-}

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

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

  null :: forall a. Seq a -> Bool
null = \case
    Tree a
_ Tree a
_ -> Bool
False
    Seq a
Empty -> Bool
True

  length :: forall a. Seq a -> Int
length = \case
    Tree a
_ Tree a
xs -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tree a -> Int
forall a. Tree a -> Int
T.size Tree a
xs
    Seq a
Empty -> Int
0

-- |
-- [@fmap@]: \(O(n)\).
--
-- [@(<$)@]: \(O(\log n)\).
instance Functor Seq where
  fmap :: forall a b. (a -> b) -> Seq a -> Seq b
fmap a -> b
f = (a -> b) -> Seq a -> Seq b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
Tr.fmapDefault a -> b
f
  {-# INLINE fmap #-}

  a
x <$ :: forall a b. a -> Seq b -> Seq a
<$ Seq b
xs = Int -> a -> Seq a
forall a. Int -> a -> Seq a
replicate (Seq b -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq b
xs) a
x

instance Traversable Seq where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse a -> f b
f = \case
    Seq a
Empty -> Seq b -> f (Seq b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq b
forall a. Seq a
Empty
    Tree a
x Tree a
xs -> (b -> Tree b -> Seq b) -> f b -> f (Tree b) -> f (Seq 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 -> Tree b -> Seq b
forall a. a -> Tree a -> Seq a
Tree (a -> f b
f a
x) ((a -> f b) -> Tree a -> f (Tree b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree a -> f (Tree b)
T.traverse a -> f b
f Tree a
xs)
  {-# INLINE traverse #-}

-- |
-- [@(<>)@]: \(O(\left| \log n_1 - \log n_2 \right|)\). Concatenates two
-- sequences.
--
-- [@stimes@]: \(O(\log c)\). @stimes c xs@ is @xs@ repeated @c@ times. If
-- @c < 0@, 'empty' is returned.
instance Semigroup (Seq a) where
  Tree a
x Tree a
xs <> :: Seq a -> Seq a -> Seq a
<> Tree a
y Tree a
ys = a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
y Tree a
xs Tree a
ys)
  Seq a
l <> Seq a
Empty = Seq a
l
  Seq a
Empty <> Seq a
r = Seq a
r

  stimes :: forall b. Integral b => b -> Seq a -> Seq a
stimes !b
c = \case
    t :: Seq a
t@(Tree a
x Tree a
xs)
      | b
c b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 -> Seq a
forall a. Seq a
Empty
      | 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 (Seq a -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
t) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
toi (Int
forall a. Bounded a => a
maxBound :: Int) ->
          String -> Seq a
forall a. HasCallStack => String -> a
error String
"Seq.stimes: result size too large"
      | Bool
otherwise -> a -> Int -> Tree a -> Tree a -> Seq a
forall a. a -> Int -> Tree a -> Tree a -> Seq a
stimesGo a
x (Int
c'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Tree a
xs Tree 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
    Seq a
Empty -> Seq a
forall a. Seq a
Empty
  {-# INLINABLE stimes #-}

  sconcat :: NonEmpty (Seq a) -> Seq a
sconcat (Seq a
x:|[Seq a]
xs) = [Seq a] -> Seq a
forall a. Monoid a => [a] -> a
mconcat (Seq a
xSeq a -> [Seq a] -> [Seq a]
forall a. a -> [a] -> [a]
:[Seq a]
xs)

-- Note [Complexity of stimes]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- Let stimesGo be initially called with trees (xs and acc) of size (n-1).
--
-- go is called O(log c) times in total, since c halves on every call.
-- At any iteration, xs is made up of initial tree bin-ed with itself multiple
-- times, and acc is made up of the some of the xs linked together.
-- All operations in go are O(1) except for link, which takes
-- O(log(size xs) - log(size acc)).
--
-- The cost of the ith iteration is O(1) if 2^i is in c.
-- If not, a link is done with some cost depending on xs and acc.
-- For iteration i, the size of xs is 2^i n - 1.
-- The size of acc is (sum of 2^p_j * n) - 1 for the powers of 2 p_j < i in c.
-- Let there be k powers of 2 in c, i.e. c = \sum_{i=1}^k p_i.
-- Then the total cost of the links is
--   O(\sum_{i=2}^k (\log (2^{p_i} n - 1) - \log ((\sum_{j=1}^{i-1} 2^{p_j} n) - 1))))
-- = O(\sum_{i=2}^k (\log (2^{p_i} n)     - \log (\sum_{j=1}^{i-1} 2^{p_j} n)))
-- = O(\sum_{i=2}^k (\log (2^{p_i} n)     - \log (2^{p_{i-1}} n)))
-- = O(\sum_{i=2}^k (p_i + \log n         - p_{i-1} - \log n))
-- = O(\sum_{i=2}^k (p_i - p_{i-1}))
-- = O(p_k - p_1)
-- = O(\log c)

stimesGo :: a -> Int -> Tree a -> Tree a -> Seq a
stimesGo :: forall a. a -> Int -> Tree a -> Tree a -> Seq a
stimesGo !a
x = Int -> Tree a -> Tree a -> Seq a
go
  where
    go :: Int -> Tree a -> Tree a -> Seq a
go Int
c !Tree a
xs !Tree a
acc
      | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree 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 -> Tree a -> Tree a -> Seq a
go (Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.bin a
x Tree a
xs Tree a
xs) Tree a
acc
      | Bool
otherwise = Int -> Tree a -> Tree a -> Seq a
go (Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.bin a
x Tree a
xs Tree a
xs) (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
x Tree a
xs Tree a
acc)
{-# INLINE stimesGo #-}

-- |
-- [@mempty@]: The empty sequence.
instance Monoid (Seq a) where
  mempty :: Seq a
mempty = Seq a
forall a. Seq a
Empty

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

instance NFData a => NFData (Seq a) where
  rnf :: Seq a -> ()
rnf = \case
    Tree a
x Tree a
xs -> a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> () -> ()
forall a b. a -> b -> b
`seq` Tree a -> ()
forall a. NFData a => a -> ()
rnf Tree a
xs
    Seq a
Empty -> ()
  {-# INLINABLE rnf #-}

instance NFData1 Seq where
  liftRnf :: forall a. (a -> ()) -> Seq a -> ()
liftRnf a -> ()
f = \case
    Tree a
x Tree a
xs -> a -> ()
f a
x () -> () -> ()
forall a b. a -> b -> b
`seq` (a -> ()) -> Tree a -> ()
forall a. (a -> ()) -> Tree a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
f Tree a
xs
    Seq a
Empty -> ()
  {-# INLINE liftRnf #-}

-- |
-- [@liftA2@]: \(O(n_1 n_2)\).
--
-- [@(<*)@]: \(O(n_1 \log n_2)\).
--
-- [@(*>)@]: \(O(\log n_1)\).
instance Applicative Seq where
  pure :: forall a. a -> Seq a
pure = a -> Seq a
forall a. a -> Seq a
singleton

  liftA2 :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2 a -> b -> c
f Seq a
t1 Seq b
t2 = case Seq b
t2 of
    Seq b
Empty -> Seq c
forall a. Seq a
Empty
    Tree b
x Tree b
Tip -> (a -> c) -> Seq a -> Seq c
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
`f` b
x) Seq a
t1
    Seq b
_ -> (a -> Seq c) -> Seq a -> Seq c
forall (f :: * -> *) a b.
Foldable f =>
(a -> Seq b) -> f a -> Seq b
concatMap (\a
x -> (b -> c) -> Seq b -> Seq c
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
x) Seq b
t2) Seq a
t1
  {-# INLINE liftA2 #-}

  Seq a
t1 <* :: forall a b. Seq a -> Seq b -> Seq a
<* Seq b
t2 = case Seq b
t2 of
    Seq b
Empty -> Seq a
forall a. Seq a
Empty
    Tree b
_ Tree b
Tip -> Seq a
t1
    Seq b
_ -> (a -> Seq a) -> Seq a -> Seq a
forall (f :: * -> *) a b.
Foldable f =>
(a -> Seq b) -> f a -> Seq b
concatMap (Int -> a -> Seq a
forall a. Int -> a -> Seq a
replicate (Seq b -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq b
t2)) Seq a
t1

  Seq a
s1 *> :: forall a b. Seq a -> Seq b -> Seq b
*> Seq b
s2 = Int -> Seq b -> Seq b
forall b. Integral b => b -> Seq b -> Seq b
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes (Seq a -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
s1) Seq b
s2

instance Ap.Alternative Seq where
  empty :: forall a. Seq a
empty = Seq a
forall a. Seq a
Empty
  <|> :: forall a. Seq a -> Seq a -> Seq a
(<|>) = Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
(<>)

instance Monad Seq where
  Seq a
t >>= :: forall a b. Seq a -> (a -> Seq b) -> Seq b
>>= a -> Seq b
f = (a -> Seq b) -> Seq a -> Seq b
forall (f :: * -> *) a b.
Foldable f =>
(a -> Seq b) -> f a -> Seq b
concatMap a -> Seq b
f Seq a
t
  {-# INLINE (>>=) #-}

instance MonadPlus Seq

instance MonadFail Seq where
  fail :: forall a. String -> Seq a
fail String
_ = Seq a
forall a. Seq a
Empty

instance MonadFix Seq where
  mfix :: forall a. (a -> Seq a) -> Seq a
mfix a -> Seq a
f =
    (Int -> a -> a) -> Seq a -> Seq a
forall a b. (Int -> a -> b) -> Seq a -> Seq b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
IFu.imap
      (\Int
i a
_ -> let x :: a
x = Int -> Seq a -> a
forall a. Int -> Seq a -> a
index Int
i (a -> Seq a
f a
x) in a
x)
      (a -> Seq a
f (String -> a
forall a. HasCallStack => String -> a
error String
"Seq.mfix: f must be lazy"))
  {-# INLINE mfix #-}

instance MonadZip Seq where
  mzip :: forall a b. Seq a -> Seq b -> Seq (a, b)
mzip = Seq a -> Seq b -> Seq (a, b)
forall a b. Seq a -> Seq b -> Seq (a, b)
zip
  mzipWith :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
mzipWith = (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith
  munzip :: forall a b. Seq (a, b) -> (Seq a, Seq b)
munzip = Seq (a, b) -> (Seq a, Seq b)
forall a b. Seq (a, b) -> (Seq a, Seq b)
unzip

instance (a ~ Char) => IsString (Seq a) where
  fromString :: String -> Seq a
fromString = String -> Seq a
String -> Seq Char
forall a. [a] -> Seq a
fromList

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

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

instance IFu.FunctorWithIndex Int Seq where
  imap :: forall a b. (Int -> a -> b) -> Seq a -> Seq b
imap Int -> a -> b
f = (Int -> a -> b) -> Seq a -> Seq b
forall i (f :: * -> *) a b.
TraversableWithIndex i f =>
(i -> a -> b) -> f a -> f b
ITr.imapDefault Int -> a -> b
f
  {-# INLINE imap #-}

instance IFo.FoldableWithIndex Int Seq where
  ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> Seq a -> m
ifoldMap Int -> a -> m
f = (Int -> a -> m) -> Seq a -> m
forall i (f :: * -> *) m a.
(TraversableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ITr.ifoldMapDefault Int -> a -> m
f
  {-# INLINE ifoldMap #-}

  ifoldr :: forall a b. (Int -> a -> b -> b) -> b -> Seq 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) -> (Seq a -> Stream a) -> Seq a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> Stream a
forall a. Seq a -> Stream a
stream
  {-# INLINE ifoldr #-}

  ifoldl :: forall b a. (Int -> b -> a -> b) -> b -> Seq a -> b
ifoldl Int -> b -> a -> b
f b
z = \Seq 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 (Seq a -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq 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) (Seq a -> Stream a
forall a. Seq a -> Stream a
streamEnd Seq a
t)
  {-# INLINE ifoldl #-}

  ifoldr' :: forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
ifoldr' Int -> a -> b -> b
f !b
z = \case
    Tree a
x Tree 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 -> Tree a -> b
forall a b. (Int -> a -> b -> b) -> b -> Int -> Tree a -> b
T.ifoldr' Int -> a -> b -> b
f b
z (Tree a -> Int
forall a. Tree a -> Int
T.size Tree a
xs) Tree a
xs
    Seq a
Empty -> b
z
  {-# INLINE ifoldr' #-}

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

instance ITr.TraversableWithIndex Int Seq where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f (Seq b)
itraverse Int -> a -> f b
f = \case
    Seq a
Empty -> Seq b -> f (Seq b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq b
forall a. Seq a
Empty
    Tree a
x Tree a
xs -> (b -> Tree b -> Seq b) -> f b -> f (Tree b) -> f (Seq 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 -> Tree b -> Seq b
forall a. a -> Tree a -> Seq a
Tree (Int -> a -> f b
f Int
0 a
x) ((Int -> a -> f b) -> Int -> Tree a -> f (Tree b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Int -> Tree a -> f (Tree b)
T.itraverse Int -> a -> f b
f Int
1 Tree a
xs)
  {-# INLINE itraverse #-}

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

-- | The empty sequence.
empty :: Seq a
empty :: forall a. Seq a
empty = Seq a
forall a. Seq a
Empty

-- | A singleton sequence.
singleton :: a -> Seq a
singleton :: forall a. a -> Seq a
singleton a
x = a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
forall a. Tree a
Tip

-- | \(O(n)\). Create a @Seq@ from a list.
--
-- ==== __Examples__
--
-- >>> fromList [8,1,19,11,5,12,12]
-- [8,1,19,11,5,12,12]
fromList :: [a] -> Seq a
fromList :: forall a. [a] -> Seq a
fromList = Stack a -> Seq a
forall a. Stack a -> Seq a
ltrFinish (Stack a -> Seq a) -> ([a] -> Stack a) -> [a] -> Seq 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. Stack a -> a -> Stack a
ltrPush Stack a
forall a. Stack a
Nil
{-# INLINE fromList #-}
-- See Note [fromList implementation]

-- | \(O(n)\). Create a @Seq@ from a reversed list.
--
-- ==== __Examples__
--
-- >>> fromRevList "!olleH"
-- "Hello!"
fromRevList :: [a] -> Seq a
fromRevList :: forall a. [a] -> Seq a
fromRevList = Stack a -> Seq a
forall a. Stack a -> Seq a
rtlFinish (Stack a -> Seq a) -> ([a] -> Stack a) -> [a] -> Seq 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. 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.
--
-- ==== __Examples__
--
-- >>> replicate 3 "ha"
-- ["ha","ha","ha"]
replicate :: Int -> a -> Seq a
replicate :: forall a. Int -> a -> Seq a
replicate Int
n !a
x
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Seq a
forall a. Seq a
Empty
  | Bool
otherwise = a -> Int -> Tree a -> Tree a -> Seq a
forall a. a -> Int -> Tree a -> Tree a -> Seq a
stimesGo a
x (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Tree a
forall a. Tree a
Tip Tree a
forall a. Tree a
Tip

-- | \(O(n)\). Generate a sequence from a length and an applicative action.
-- If the length is negative, 'empty' is returned.
--
-- ==== __Examples__
--
-- >>> import System.Random (randomIO)
-- >>> import Data.Word (Word8)
-- >>> replicateA 5 (randomIO :: IO Word8)
-- [26,134,30,58,221]
replicateA :: Applicative f => Int -> f a -> f (Seq a)
replicateA :: forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA !Int
n f a
m = Int -> (Int -> f a) -> f (Seq a)
forall (f :: * -> *) a.
Applicative f =>
Int -> (Int -> f a) -> f (Seq 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.
--
-- ==== __Examples__
--
-- >>> generate 4 (10*)
-- [0,10,20,30]
generate :: Int -> (Int -> a) -> Seq a
generate :: forall a. Int -> (Int -> a) -> Seq a
generate =
  ((Int -> (Int -> Identity a) -> Identity (Seq a))
-> Int -> (Int -> a) -> Seq a
forall {a}.
(Int -> (Int -> Identity a) -> Identity (Seq a))
-> Int -> (Int -> a) -> Seq a
forall a b. Coercible a b => a -> b
coerce :: (Int -> (Int -> Identity a) -> Identity (Seq a))
          -> Int -> (Int -> a) -> Seq a)
  Int -> (Int -> Identity a) -> Identity (Seq a)
forall (f :: * -> *) a.
Applicative f =>
Int -> (Int -> f a) -> f (Seq 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 :: Applicative f => Int -> (Int -> f a) -> f (Seq a)
generateA :: forall (f :: * -> *) a.
Applicative f =>
Int -> (Int -> f a) -> f (Seq a)
generateA Int
n Int -> f a
f
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Seq a -> f (Seq a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
forall a. Seq a
Empty
  | Bool
otherwise = (a -> Tree a -> Seq a) -> f a -> f (Tree a) -> f (Seq 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 -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree (Int -> f a
f Int
0) ((Int -> f a) -> Int -> Int -> f (Tree a)
forall (f :: * -> *) a.
Applicative f =>
(Int -> f a) -> Int -> Int -> f (Tree 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.
--
-- ==== __Examples__
--
-- >>> let f (i,a,b) = if i >= 10 then Nothing else Just (a, (i+1, b, a+b))
-- >>> unfoldr f (0,0,1)
-- [0,1,1,2,3,5,8,13,21,34]
unfoldr :: (b -> Maybe (a, b)) -> b -> Seq a
unfoldr :: forall b a. (b -> Maybe (a, b)) -> b -> Seq a
unfoldr =
  (((b -> Identity (Maybe (a, b))) -> b -> Identity (Seq a))
-> (b -> Maybe (a, b)) -> b -> Seq a
forall {b} {a}.
((b -> Identity (Maybe (a, b))) -> b -> Identity (Seq a))
-> (b -> Maybe (a, b)) -> b -> Seq a
forall a b. Coercible a b => a -> b
coerce :: ((b -> Identity (Maybe (a, b))) -> b -> Identity (Seq a))
          -> (b -> Maybe (a, b)) -> b -> Seq a)
  (b -> Identity (Maybe (a, b))) -> b -> Identity (Seq a)
forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> b -> m (Seq a)
unfoldrM
{-# INLINE unfoldr #-}

-- | \(O(n)\). Unfold a sequence monadically from left to right.
unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> m (Seq a)
unfoldrM :: forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> b -> m (Seq a)
unfoldrM b -> m (Maybe (a, b))
f = Stack a -> b -> m (Seq a)
go Stack a
forall a. Stack a
Nil
  where
    go :: Stack a -> b -> m (Seq a)
go !Stack a
b b
z = b -> m (Maybe (a, b))
f b
z m (Maybe (a, b)) -> (Maybe (a, b) -> m (Seq a)) -> m (Seq 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 -> Seq a -> m (Seq a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq a -> m (Seq a)) -> Seq a -> m (Seq a)
forall a b. (a -> b) -> a -> b
$! Stack a -> Seq a
forall a. Stack a -> Seq a
ltrFinish Stack a
b
      Just (a
x, b
z') -> Stack a -> b -> m (Seq a)
go (Stack a -> a -> Stack a
forall 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.
--
-- ==== __Examples__
--
-- >>> let f i = if i <= 0 then Nothing else Just (i `div` 2, i)
-- >>> unfoldl f 1024
-- [1,2,4,8,16,32,64,128,256,512,1024]
unfoldl :: (b -> Maybe (b, a)) -> b -> Seq a
unfoldl :: forall b a. (b -> Maybe (b, a)) -> b -> Seq a
unfoldl =
  (((b -> Identity (Maybe (b, a))) -> b -> Identity (Seq a))
-> (b -> Maybe (b, a)) -> b -> Seq a
forall {b} {a}.
((b -> Identity (Maybe (b, a))) -> b -> Identity (Seq a))
-> (b -> Maybe (b, a)) -> b -> Seq a
forall a b. Coercible a b => a -> b
coerce :: ((b -> Identity (Maybe (b, a))) -> b -> Identity (Seq a))
          -> (b -> Maybe (b, a)) -> b -> Seq a)
  (b -> Identity (Maybe (b, a))) -> b -> Identity (Seq a)
forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (b, a))) -> b -> m (Seq a)
unfoldlM
{-# INLINE unfoldl #-}

-- | \(O(n)\). Unfold a sequence monadically from right to left.
unfoldlM :: Monad m => (b -> m (Maybe (b, a))) -> b -> m (Seq a)
unfoldlM :: forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (b, a))) -> b -> m (Seq a)
unfoldlM b -> m (Maybe (b, a))
f = Stack a -> b -> m (Seq a)
go Stack a
forall a. Stack a
Nil
  where
    go :: Stack a -> b -> m (Seq a)
go !Stack a
b b
z = b -> m (Maybe (b, a))
f b
z m (Maybe (b, a)) -> (Maybe (b, a) -> m (Seq a)) -> m (Seq 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 -> Seq a -> m (Seq a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq a -> m (Seq a)) -> Seq a -> m (Seq a)
forall a b. (a -> b) -> a -> b
$! Stack a -> Seq a
forall a. Stack a -> Seq a
rtlFinish Stack a
b
      Just (b
z', a
x) -> Stack a -> b -> m (Seq a)
go (a -> Stack a -> Stack a
forall 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.
--
-- ==== __Examples__
--
-- >>> concatMap (uncurry replicate) [(1,'H'),(1,'e'),(2,'l'),(1,'o')]
-- "Hello"
concatMap :: Foldable f => (a -> Seq b) -> f a -> Seq b
concatMap :: forall (f :: * -> *) a b.
Foldable f =>
(a -> Seq b) -> f a -> Seq b
concatMap a -> Seq b
f = Stack b -> Seq b
forall a. Stack a -> Seq a
ltrFinish (Stack b -> Seq b) -> (f a -> Stack b) -> f a -> Seq 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 -> Seq b
f a
x of
      Seq b
Empty -> Stack b
b
      Tree b
y Tree b
ys -> Stack b -> b -> Tree b -> Stack b
forall a. Stack a -> a -> Tree a -> Stack a
ltrPushMany Stack b
b b
y Tree b
ys
    {-# INLINE g #-}
{-# INLINE concatMap #-}
-- See Note [concatMap implementation]

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

-- | \(O(n)\). Convert to a list in reverse.
--
-- To convert to a list without reversing, use
-- @Data.Foldable.'Data.Foldable.toList'@.
--
-- ==== __Examples__
--
-- >>> toRevList (fromList "!olleH")
-- "Hello!"
toRevList :: Seq a -> [a]
toRevList :: forall a. Seq a -> [a]
toRevList Seq 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 -> Seq a -> b
forall b a. (b -> a -> b) -> b -> Seq 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 Seq a
t
{-# INLINE toRevList #-}

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

-- Precondition: 0 <= i < size xs
indexTree :: Int -> Tree a -> a
indexTree :: forall a. Int -> Tree a -> a
indexTree !Int
i Tree a
xs = Const a (Tree a) -> a
forall {k} a (b :: k). Const a b -> a
getConst ((a -> Const a a) -> Int -> Tree a -> Const a (Tree a)
forall (f :: * -> *) a.
Functor f =>
(a -> f a) -> Int -> Tree a -> f (Tree a)
T.adjustF a -> Const a a
forall {k} a (b :: k). a -> Const a b
Const Int
i Tree a
xs)

-- | \(O(\log n)\). Look up the element at an index.
--
-- ==== __Examples__
--
-- >>> lookup 3 (fromList "haskell")
-- Just 'k'
-- >>> lookup (-1) (singleton 7)
-- Nothing
lookup :: Int -> Seq a -> Maybe a
lookup :: forall a. Int -> Seq a -> Maybe a
lookup !Int
i (Tree a
x Tree a
xs)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Tree a -> Int
forall a. Tree a -> Int
T.size Tree 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 -> Tree a -> a
forall a. Int -> Tree a -> a
indexTree (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Tree a
xs
lookup Int
_ Seq a
Empty = 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.
--
-- ==== __Examples__
--
-- >>> index 3 (fromList "haskell")
-- 'k'
-- >>> index (-1) (singleton 7)
-- *** Exception: ...
index :: Int -> Seq a -> a
index :: forall a. Int -> Seq a -> a
index !Int
i = \case
  Tree a
x Tree a
xs
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> a
x
    | Bool
otherwise -> Int -> Tree a -> a
forall a. Int -> Tree a -> a
indexTree (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Tree a
xs
  Seq a
Empty -> String -> a
forall a. HasCallStack => String -> a
error String
"Seq.index: out of bounds"

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

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

-- | \(O(\log n)\). Update an element at an index. If the index is out of
-- bounds, the sequence is returned unchanged.
--
-- ==== __Examples__
--
-- >>> update 3 'b' (fromList "bird")
-- "birb"
-- >>> update 3 True (singleton False)
-- [False]
update :: Int -> a -> Seq a -> Seq a
update :: forall a. Int -> a -> Seq a -> Seq a
update Int
i a
x Seq a
t = (a -> a) -> Int -> Seq a -> Seq a
forall a. (a -> a) -> Int -> Seq a -> Seq a
adjust (a -> a -> a
forall a b. a -> b -> a
const a
x) Int
i Seq a
t

-- | \(O(\log n)\). Adjust the element at an index. If the index is out of
-- bounds the sequence is returned unchanged.
--
-- ==== __Examples__
--
-- >>> adjust Data.List.reverse 1 (fromList ["Hello", "ereht"])
-- ["Hello","there"]
-- >>> adjust (*100) (-1) (singleton 7)
-- [7]
adjust :: (a -> a) -> Int -> Seq a -> Seq a
adjust :: forall a. (a -> a) -> Int -> Seq a -> Seq a
adjust a -> a
f !Int
i Seq a
t = case Seq a
t of
  Tree a
x Tree a
xs
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Tree a -> Int
forall a. Tree a -> Int
T.size Tree a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i -> Seq a
t
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree (a -> a
f a
x) Tree a
xs
    | Bool
otherwise -> a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x (Identity (Tree a) -> Tree a
forall a. Identity a -> a
runIdentity ((a -> Identity a) -> Int -> Tree a -> Identity (Tree a)
forall (f :: * -> *) a.
Functor f =>
(a -> f a) -> Int -> Tree a -> f (Tree 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) Tree a
xs))
  Seq a
Empty -> Seq a
forall a. Seq a
Empty
{-# 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.
--
-- ==== __Examples__
--
-- >>> insertAt 1 'a' (fromList "ct")
-- "cat"
-- >>> insertAt (-10) 0 (fromList [5,6,7])
-- [0,5,6,7]
-- >>> insertAt 10 0 (fromList [5,6,7])
-- [5,6,7,0]
insertAt :: Int -> a -> Seq a -> Seq a
insertAt :: forall a. Int -> a -> Seq a -> Seq a
insertAt !Int
i a
y Seq a
t = case Seq a
t of
  Tree a
x Tree a
xs
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
cons a
y Seq a
t
    | Bool
otherwise -> a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x (Int -> a -> Tree a -> Tree a
forall a. Int -> a -> Tree a -> Tree a
T.insertAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
y Tree a
xs)
  Seq a
Empty -> a -> Seq a
forall a. a -> Seq a
singleton a
y

-- | \(O(\log n)\). Delete an element at an index. If the index is out of
-- bounds, the sequence is returned unchanged.
--
-- ==== __Examples__
--
-- >>> deleteAt 2 (fromList "cart")
-- "cat"
-- >>> deleteAt 10 (fromList [5,6,7])
-- [5,6,7]
deleteAt :: Int -> Seq a -> Seq a
deleteAt :: forall a. Int -> Seq a -> Seq a
deleteAt !Int
i Seq a
t = case Seq a
t of
  Tree a
x Tree a
xs
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Tree a -> Int
forall a. Tree a -> Int
T.size Tree a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i -> Seq a
t
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree Tree a
xs
    | Bool
otherwise -> a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x (Int -> Tree a -> Tree a
forall a. Int -> Tree a -> Tree a
T.deleteAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Tree a
xs)
  Seq a
Empty -> Seq a
forall a. Seq a
Empty

------------
-- Slicing
------------

-- | \(O(\log n)\). Append a value to the beginning of a sequence.
--
-- ==== __Examples__
--
-- >>> cons 1 (fromList [2,3])
-- [1,2,3]
cons :: a -> Seq a -> Seq a
cons :: forall a. a -> Seq a -> Seq a
cons a
x (Tree a
y Tree a
ys) = a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x (a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a
T.cons a
y Tree a
ys)
cons a
x Seq a
Empty = a -> Seq a
forall a. a -> Seq a
singleton a
x

-- | \(O(\log n)\). Append a value to the end of a sequence.
--
-- ==== __Examples__
--
-- >>> snoc (fromList [1,2]) 3
-- [1,2,3]
snoc :: Seq a -> a -> Seq a
snoc :: forall a. Seq a -> a -> Seq a
snoc (Tree a
y Tree a
ys) a
x = a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
y (Tree a -> a -> Tree a
forall a. Tree a -> a -> Tree a
T.snoc Tree a
ys a
x)
snoc Seq a
Empty a
x = a -> Seq a
forall a. a -> Seq a
singleton a
x

-- | \(O(\log n)\). The head and tail of a sequence.
--
-- ==== __Examples__
--
-- >>> uncons (fromList [1,2,3])
-- Just (1,[2,3])
-- >>> uncons empty
-- Nothing
uncons :: Seq a -> Maybe (a, Seq a)
uncons :: forall a. Seq a -> Maybe (a, Seq a)
uncons (Tree a
x Tree a
xs) = (a, Seq a) -> Maybe (a, Seq a)
forall a. a -> Maybe a
Just ((a, Seq a) -> Maybe (a, Seq a))
-> (Seq a -> (a, Seq a)) -> Seq a -> Maybe (a, Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) a
x (Seq a -> Maybe (a, Seq a)) -> Seq a -> Maybe (a, Seq a)
forall a b. (a -> b) -> a -> b
$! Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree Tree a
xs
uncons Seq a
Empty = Maybe (a, Seq a)
forall a. Maybe a
Nothing
{-# INLINE uncons #-}

-- | \(O(\log n)\). The init and last of a sequence.
--
-- ==== __Examples__
--
-- >>> unsnoc (fromList [1,2,3])
-- Just ([1,2],3)
-- >>> unsnoc empty
-- Nothing
unsnoc :: Seq a -> Maybe (Seq a, a)
unsnoc :: forall a. Seq a -> Maybe (Seq a, a)
unsnoc (Tree a
x Tree a
xs) = case Tree a -> SMaybe (S2 (Tree a) a)
forall a. Tree a -> SMaybe (S2 (Tree a) a)
T.unsnoc Tree a
xs of
  SMaybe (S2 (Tree a) a)
U.SNothing -> (Seq a, a) -> Maybe (Seq a, a)
forall a. a -> Maybe a
Just (Seq a
forall a. Seq a
Empty, a
x)
  U.SJust (U.S2 Tree a
ys a
y) -> (Seq a, a) -> Maybe (Seq a, a)
forall a. a -> Maybe a
Just (a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
ys, a
y)
unsnoc Seq a
Empty = Maybe (Seq a, a)
forall a. Maybe a
Nothing
{-# INLINE unsnoc #-}

-- | \(O(\log n)\). Take a number of elements from the beginning of a sequence.
--
-- ==== __Examples__
--
-- >>> take 3 (fromList "haskell")
-- "has"
-- >>> take (-1) (fromList [1,2,3])
-- []
-- >>> take 10 (fromList [1,2,3])
-- [1,2,3]
take :: Int -> Seq a -> Seq a
take :: forall a. Int -> Seq a -> Seq a
take !Int
i t :: Seq a
t@(Tree a
x Tree a
xs)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Seq a
forall a. Seq a
Empty
  | Tree a -> Int
forall a. Tree a -> Int
T.size Tree a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = Seq a
t
  | Bool
otherwise = a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x (Const (Tree a) (S2 a (Tree a)) -> Tree a
forall {k} a (b :: k). Const a b -> a
getConst (Int -> Tree a -> Const (Tree a) (S2 a (Tree a))
forall (f :: * -> * -> *) a.
Biapplicative f =>
Int -> Tree a -> f (Tree a) (S2 a (Tree a))
T.splitAtF (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Tree a
xs))
take Int
_ Seq a
Empty = Seq a
forall a. Seq a
Empty

-- | \(O(\log n)\). Drop a number of elements from the beginning of a sequence.
--
-- ==== __Examples__
--
-- >>> drop 3 (fromList "haskell")
-- "kell"
-- >>> drop (-1) (fromList [1,2,3])
-- [1,2,3]
-- >>> drop 10 (fromList [1,2,3])
-- []
drop :: Int -> Seq a -> Seq a
drop :: forall a. Int -> Seq a -> Seq a
drop !Int
i t :: Seq a
t@(Tree a
_ Tree a
xs)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Seq a
t
  | Tree a -> Int
forall a. Tree a -> Int
T.size Tree a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = Seq a
forall a. Seq a
Empty
  | Bool
otherwise = case Tagged (Tree a) (S2 a (Tree a)) -> S2 a (Tree a)
forall a b. Tagged a b -> b
U.unTagged (Int -> Tree a -> Tagged (Tree a) (S2 a (Tree a))
forall (f :: * -> * -> *) a.
Biapplicative f =>
Int -> Tree a -> f (Tree a) (S2 a (Tree a))
T.splitAtF (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Tree a
xs) of
      U.S2 a
x' Tree a
xs' -> a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x' Tree a
xs'
drop Int
_ Seq a
Empty = Seq a
forall a. Seq a
Empty

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

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

-- | \(O(\log n)\). The slice of a sequence between two indices (inclusive).
--
-- ==== __Examples__
--
-- >>> slice (1,3) (fromList "haskell")
-- "ask"
-- >>> slice (-10,2) (fromList [1,2,3,4,5])
-- [1,2,3]
-- >>> slice (2,1) (fromList [1,2,3,4,5])
-- []
slice :: (Int, Int) -> Seq a -> Seq a
slice :: forall a. (Int, Int) -> Seq a -> Seq a
slice (Int
i,Int
j) = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
drop Int
i (Seq a -> Seq a) -> (Seq a -> Seq a) -> Seq a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | \(O(\log n)\). Split a sequence at a given index.
--
-- @splitAt n xs == ('take' n xs, 'drop' n xs)@
--
-- ==== __Examples__
--
-- >>> splitAt 3 (fromList "haskell")
-- ("has","kell")
-- >>> splitAt (-1) (fromList [1,2,3])
-- ([],[1,2,3])
-- >>> splitAt 10 (fromList [1,2,3])
-- ([1,2,3],[])
splitAt :: Int -> Seq a -> (Seq a, Seq a)
splitAt :: forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt !Int
i t :: Seq a
t@(Tree a
x Tree a
xs)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Seq a
forall a. Seq a
Empty, Seq a
t)
  | Tree a -> Int
forall a. Tree a -> Int
T.size Tree a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i = (Seq a
t, Seq a
forall a. Seq a
Empty)
  | Bool
otherwise = case Int -> Tree a -> S2 (Tree a) (S2 a (Tree a))
forall (f :: * -> * -> *) a.
Biapplicative f =>
Int -> Tree a -> f (Tree a) (S2 a (Tree a))
T.splitAtF (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Tree a
xs of
      U.S2 Tree a
xs1 (U.S2 a
x' Tree a
xs2) -> (a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
xs1, a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x' Tree a
xs2)
splitAt Int
_ Seq a
Empty = (Seq a
forall a. Seq a
Empty, Seq a
forall a. Seq a
Empty)

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

-- | \(O(n \log n)\). All suffixes of a sequence, longest first.
--
-- ==== __Examples__
--
-- >>> tails (fromList [1,2,3])
-- [[1,2,3],[2,3],[3],[]]
tails :: Seq a -> Seq (Seq a)
tails :: forall a. Seq a -> Seq (Seq a)
tails Seq a
t0 = Seq a -> Seq (Seq a) -> Seq (Seq a)
forall a. a -> Seq a -> Seq a
cons Seq a
t0 (SState (Seq a) (Seq (Seq a)) -> Seq a -> Seq (Seq a)
forall s a. SState s a -> s -> a
U.evalSState ((a -> SStateT (Seq a) Identity (Seq a))
-> Seq a -> SState (Seq a) (Seq (Seq a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
Tr.traverse a -> SStateT (Seq a) Identity (Seq a)
forall {p} {a}. p -> SState (Seq a) (Seq a)
f Seq a
t0) Seq a
t0)
  where
    f :: p -> SState (Seq a) (Seq a)
f p
_ = (Seq a -> S2 (Seq a) (Seq a)) -> SState (Seq a) (Seq a)
forall s a. (s -> S2 s a) -> SState s a
U.sState ((Seq a -> S2 (Seq a) (Seq a)) -> SState (Seq a) (Seq a))
-> (Seq a -> S2 (Seq a) (Seq a)) -> SState (Seq a) (Seq a)
forall a b. (a -> b) -> a -> b
$ \Seq a
t -> case Seq a -> Maybe (a, Seq a)
forall a. Seq a -> Maybe (a, Seq a)
uncons Seq a
t of
      Maybe (a, Seq a)
Nothing -> Seq a -> Seq a -> S2 (Seq a) (Seq a)
forall a b. a -> b -> S2 a b
U.S2 Seq a
t Seq a
t -- impossible
      -- Could have been error but https://gitlab.haskell.org/ghc/ghc/-/issues/24806
      Just (a
_,Seq a
t') -> Seq a -> Seq a -> S2 (Seq a) (Seq a)
forall a b. a -> b -> S2 a b
U.S2 Seq a
t' Seq a
t'
-- See Note [Tails implementation]

-- | \(O(n \log n)\). All prefixes of a sequence, shortest first.
--
-- ==== __Examples__
--
-- >>> inits (fromList [1,2,3])
-- [[],[1],[1,2],[1,2,3]]
inits :: Seq a -> Seq (Seq a)
inits :: forall a. Seq a -> Seq (Seq a)
inits Seq a
t0 = Seq (Seq a) -> Seq a -> Seq (Seq a)
forall a. Seq a -> a -> Seq a
snoc (SState (Seq a) (Seq (Seq a)) -> Seq a -> Seq (Seq a)
forall s a. SState s a -> s -> a
U.evalSState (Backwards (SStateT (Seq a) Identity) (Seq (Seq a))
-> SState (Seq a) (Seq (Seq a))
forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards ((a -> Backwards (SStateT (Seq a) Identity) (Seq a))
-> Seq a -> Backwards (SStateT (Seq a) Identity) (Seq (Seq a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
Tr.traverse a -> Backwards (SStateT (Seq a) Identity) (Seq a)
forall {p} {a}. p -> Backwards (SStateT (Seq a) Identity) (Seq a)
f Seq a
t0)) Seq a
t0) Seq a
t0
  where
    f :: p -> Backwards (SStateT (Seq a) Identity) (Seq a)
f p
_ = SStateT (Seq a) Identity (Seq a)
-> Backwards (SStateT (Seq a) Identity) (Seq a)
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (SStateT (Seq a) Identity (Seq a)
 -> Backwards (SStateT (Seq a) Identity) (Seq a))
-> SStateT (Seq a) Identity (Seq a)
-> Backwards (SStateT (Seq a) Identity) (Seq a)
forall a b. (a -> b) -> a -> b
$ (Seq a -> S2 (Seq a) (Seq a)) -> SStateT (Seq a) Identity (Seq a)
forall s a. (s -> S2 s a) -> SState s a
U.sState ((Seq a -> S2 (Seq a) (Seq a)) -> SStateT (Seq a) Identity (Seq a))
-> (Seq a -> S2 (Seq a) (Seq a))
-> SStateT (Seq a) Identity (Seq a)
forall a b. (a -> b) -> a -> b
$ \Seq a
t -> case Seq a -> Maybe (Seq a, a)
forall a. Seq a -> Maybe (Seq a, a)
unsnoc Seq a
t of
      Maybe (Seq a, a)
Nothing -> Seq a -> Seq a -> S2 (Seq a) (Seq a)
forall a b. a -> b -> S2 a b
U.S2 Seq a
t Seq a
t -- impossible
      Just (Seq a
t',a
_) -> Seq a -> Seq a -> S2 (Seq a) (Seq a)
forall a b. a -> b -> S2 a b
U.S2 Seq a
t' Seq a
t'

-- Note [Tails implementation]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- tails :: Seq a -> Seq (Seq a)
--
-- There are multiple ways to implement tails (and inits):
--
-- 1. imap (or generate) with drop
-- 2. Send down a stack and rebuild
-- 3. traverse (or unfold or replicateA) with uncons
--
-- We do 3 with traverse because it is seen to be faster in benchmarks. Note
-- that in 3 a tail requires all previous tails to be calculated, while this is
-- not true for 1 and 2. But Seqn is value-strict, so it's not like we lose an
-- opportunity to be lazy. If a user wants arbitrary tails, they can use drop
-- which is not too bad. 3 takes ~17% less time compared to 1, according to the
-- "tails" benchmark.


-- | \(O \left(\frac{n}{c} \log c \right)\). Split a sequence into chunks of the
-- given length @c@. If @c <= 0@, 'empty' is returned.
--
-- ==== __Examples__
--
-- >>> chunksOf 3 (fromList [1..10])
-- [[1,2,3],[4,5,6],[7,8,9],[10]]
-- >>> chunksOf 10 (fromList "hello")
-- ["hello"]
-- >>> chunksOf (-1) (singleton 7)
-- []

-- See Note [chunksOf complexity]
chunksOf :: Int -> Seq a -> Seq (Seq a)
chunksOf :: forall a. Int -> Seq a -> Seq (Seq a)
chunksOf !Int
c t :: Seq a
t@(Tree a
x Tree a
xs)
  | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Seq (Seq a)
forall a. Seq a
Empty
  | Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = (a -> Seq a) -> Seq a -> Seq (Seq a)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Seq a
forall a. a -> Seq a
singleton Seq a
t
  | Seq a -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c = Seq a -> Seq (Seq a)
forall a. a -> Seq a
singleton Seq a
t
  | Bool
otherwise = case Int -> Int -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a.
Int -> Int -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
chunksOf_ Int
c Int
1 Tree a
xs of
      U.S3 Tree a
l Tree (Seq a)
m Tree a
r -> case Tree a
r of
        Tree a
T.Tip -> Seq a -> Tree (Seq a) -> Seq (Seq a)
forall a. a -> Tree a -> Seq a
Tree (a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
l) Tree (Seq a)
m
        Tree a
_ -> Seq a -> Tree (Seq a) -> Seq (Seq a)
forall a. a -> Tree a -> Seq a
Tree (a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
l) (Tree (Seq a) -> Seq a -> Tree (Seq a)
forall a. Tree a -> a -> Tree a
T.snoc Tree (Seq a)
m (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree Tree a
r))
chunksOf Int
_ Seq a
Empty = Seq (Seq a)
forall a. Seq a
Empty

-- Preconditions:
-- 1. c > 1
-- 2. at least one chunk boundary passes through the tree
chunksOf_ :: Int -> Int -> Tree a -> U.S3 (Tree a) (Tree (Seq a)) (Tree a)
chunksOf_ :: forall a.
Int -> Int -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
chunksOf_ !Int
_ !Int
_ Tree a
Tip = String -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a. HasCallStack => String -> a
error String
"Seq.chunksOf_: precondition violated"
chunksOf_ Int
c Int
off (Bin Int
sz a
x Tree a
l Tree a
r) = case (Bool
lHasSplit, Bool
rHasSplit) of
  (Bool
False, Bool
False) ->
    -- Here exactly one of (lend==c) and (roff==0) is true.
    -- If both are true, precondition 1 was violated.
    -- If both are false, precondition 2 was violated.
    -- We check roff==0 and assume the other is the complement.
    case (Int
offInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0, Int
roffInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0, Int
rendInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
c) of
      (Bool
False, Bool
True , Bool
False) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 (Tree a -> a -> Tree a
forall a. Tree a -> a -> Tree a
T.snoc Tree a
l a
x) Tree (Seq a)
forall a. Tree a
T.Tip Tree a
r
      (Bool
False, Bool
True , Bool
True ) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 (Tree a -> a -> Tree a
forall a. Tree a -> a -> Tree a
T.snoc Tree a
l a
x) (Seq a -> Tree (Seq a)
forall {a}. a -> Tree a
t1 (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree Tree a
r)) Tree a
forall a. Tree a
T.Tip
      (Bool
False, Bool
False, Bool
False) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
l Tree (Seq a)
forall a. Tree a
T.Tip (a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a
T.cons a
x Tree a
r)
      (Bool
False, Bool
False, Bool
True ) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
l (Seq a -> Tree (Seq a)
forall {a}. a -> Tree a
t1 (a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
r)) Tree a
forall a. Tree a
T.Tip
      (Bool
True , Bool
False, Bool
False) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
forall a. Tree a
T.Tip (Seq a -> Tree (Seq a)
forall {a}. a -> Tree a
t1 (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree Tree a
l)) (a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a
T.cons a
x Tree a
r)
      (Bool
True , Bool
False, Bool
True ) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
forall a. Tree a
T.Tip (Seq a -> Seq a -> Tree (Seq a)
forall {a}. a -> a -> Tree a
t2 (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree Tree a
l) (a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
r)) Tree a
forall a. Tree a
T.Tip
      (Bool
True , Bool
True , Bool
False) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
forall a. Tree a
T.Tip (Seq a -> Tree (Seq a)
forall {a}. a -> Tree a
t1 (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree (Tree a -> a -> Tree a
forall a. Tree a -> a -> Tree a
T.snoc Tree a
l a
x))) Tree a
r
      (Bool
True , Bool
True , Bool
True ) ->
        Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
forall a. Tree a
T.Tip (Seq a -> Seq a -> Tree (Seq a)
forall {a}. a -> a -> Tree a
t2 (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree (Tree a -> a -> Tree a
forall a. Tree a -> a -> Tree a
T.snoc Tree a
l a
x)) (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree Tree a
r)) Tree a
forall a. Tree a
T.Tip
  (Bool
False, Bool
True) -> case Int -> Int -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a.
Int -> Int -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
chunksOf_ Int
c Int
roff Tree a
r of
    U.S3 Tree a
rl Tree (Seq a)
rm Tree a
rr -> case (Int
offInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0, Int
lendInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
c) of
      (Bool
False, Bool
False) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
x Tree a
l Tree a
rl) Tree (Seq a)
rm Tree a
rr
      (Bool
False, Bool
True ) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
l (Seq a -> Tree (Seq a) -> Tree (Seq a)
forall a. a -> Tree a -> Tree a
T.cons (a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
rl) Tree (Seq a)
rm) Tree a
rr
      (Bool
True , Bool
False) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
forall a. Tree a
T.Tip (Seq a -> Tree (Seq a) -> Tree (Seq a)
forall a. a -> Tree a -> Tree a
T.cons (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
x Tree a
l Tree a
rl)) Tree (Seq a)
rm) Tree a
rr
      (Bool
True , Bool
True ) ->
        Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
forall a. Tree a
T.Tip (Seq a -> Tree (Seq a) -> Tree (Seq a)
forall a. a -> Tree a -> Tree a
T.cons (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree Tree a
l) (Seq a -> Tree (Seq a) -> Tree (Seq a)
forall a. a -> Tree a -> Tree a
T.cons (a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
rl) Tree (Seq a)
rm)) Tree a
rr
  (Bool
True, Bool
False) -> case Int -> Int -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a.
Int -> Int -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
chunksOf_ Int
c Int
off Tree a
l of
    U.S3 Tree a
ll Tree (Seq a)
lm Tree a
lr -> case (Int
roffInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0, Int
rendInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
c) of
      (Bool
False, Bool
False) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
ll Tree (Seq a)
lm (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
x Tree a
lr Tree a
r)
      (Bool
False, Bool
True ) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
ll (Tree (Seq a) -> Seq a -> Tree (Seq a)
forall a. Tree a -> a -> Tree a
T.snoc Tree (Seq a)
lm (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
x Tree a
lr Tree a
r))) Tree a
forall a. Tree a
T.Tip
      (Bool
True , Bool
False) -> Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
ll (Tree (Seq a) -> Seq a -> Tree (Seq a)
forall a. Tree a -> a -> Tree a
T.snoc Tree (Seq a)
lm (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree (Tree a -> a -> Tree a
forall a. Tree a -> a -> Tree a
T.snoc Tree a
lr a
x))) Tree a
r
      (Bool
True , Bool
True ) ->
        Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
ll
              (Tree (Seq a) -> Seq a -> Tree (Seq a)
forall a. Tree a -> a -> Tree a
T.snoc (Tree (Seq a) -> Seq a -> Tree (Seq a)
forall a. Tree a -> a -> Tree a
T.snoc Tree (Seq a)
lm (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree (Tree a -> a -> Tree a
forall a. Tree a -> a -> Tree a
T.snoc Tree a
lr a
x))) (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree Tree a
r))
              Tree a
forall a. Tree a
T.Tip
  (Bool
True, Bool
True) -> case (Int -> Int -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a.
Int -> Int -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
chunksOf_ Int
c Int
off Tree a
l, Int -> Int -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a.
Int -> Int -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
chunksOf_ Int
c Int
roff Tree a
r) of
    (U.S3 Tree a
ll Tree (Seq a)
lm Tree a
lr, U.S3 Tree a
rl Tree (Seq a)
rm Tree a
rr) ->
      Tree a
-> Tree (Seq a) -> Tree a -> S3 (Tree a) (Tree (Seq a)) (Tree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 Tree a
ll (Seq a -> Tree (Seq a) -> Tree (Seq a) -> Tree (Seq a)
forall a. a -> Tree a -> Tree a -> Tree a
T.link (Tree a -> Seq a
forall a. Tree a -> Seq a
fromTree (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
x Tree a
lr Tree a
rl)) Tree (Seq a)
lm Tree (Seq a)
rm) Tree a
rr
  where
    szl :: Int
szl = Tree a -> Int
forall a. Tree a -> Int
T.size Tree a
l
    szr :: Int
szr = Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
szl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    lend :: Int
lend = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
szl
    roff :: Int
roff = (Int
lend Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
c
    rend :: Int
rend = Int
roff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
szr
    lHasSplit :: Bool
lHasSplit = Int
lend Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
c
    rHasSplit :: Bool
rHasSplit = Int
rend Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
c
    t1 :: a -> Tree a
t1 a
y = Int -> a -> Tree a -> Tree a -> Tree a
forall a. Int -> a -> Tree a -> Tree a -> Tree a
T.Bin Int
1 a
y Tree a
forall a. Tree a
T.Tip Tree a
forall a. Tree a
T.Tip
    t2 :: a -> a -> Tree a
t2 a
y1 a
y2 = Int -> a -> Tree a -> Tree a -> Tree a
forall a. Int -> a -> Tree a -> Tree a -> Tree a
T.Bin Int
2 a
y1 Tree a
forall a. Tree a
T.Tip (Int -> a -> Tree a -> Tree a -> Tree a
forall a. Int -> a -> Tree a -> Tree a -> Tree a
T.Bin Int
1 a
y2 Tree a
forall a. Tree a
T.Tip Tree a
forall a. Tree a
T.Tip)

-- Note [chunksOf complexity]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The tree of size n is partitioned into ceil(n/c) chunks, each of size at
-- most c. Each chunk is a contiguous subsequence of the original tree, and
-- such chunks are balanced in O(log c) time. The finalizing step of such a
-- chunk is a link of some left and right trees with a root. Since they can be
-- of any size, bounded by the total c, this is O(log c). The left tree here
-- is the result of multiple links of (root, right child) caused by the split
-- at a chunk boundary, again with total size bounded by c. This takes
-- O(log c). For an explanation see the description of the finishing step in
-- Note [fromList implementation]. The same applies to the right tree. Hence,
-- each chunk is balanced in O(log c) and to balance all the chunks we need
-- O((n/c) log c).
--
-- Now the result tree has size ceil(n/c), which needs to be balanced. This is
-- done by linking the recursive results from the left and right children, l and
-- r. The results are triples of
-- (left incomplete chunk, complete chunks, right incomplete chunk).
-- The number of complete chunks from the left child, say l', is at least
-- lmin=ceil((lsz-2(c-1))/c) and at most lmax=floor(lsz/c). It is likewise for
-- the right child, which returns rmin<=r'<=rmax chunks. Balancing the linked
-- tree takes O(|log(l'sz) - log(r'sz)|)
-- = O(max(log lmax - log rmin, log rmax - log lmin))
-- = O(max(log(lmax/rmin), log(rmax/lmin)))
-- = O(max(log(lsz/rsz), log(rsz/lsz))   ; lmax is Θ(lsz/c), rmax is Θ(rsz/c)
-- = O(1)                                ; lsz<=3*rsz && rsz<=3*lsz by balance
-- So all the balancing work here is done in O(n/c).
--
-- The total is dominated by balancing all the chunks, giving us O((n/c) log c).

--------------
-- Filtering
--------------

-- | \(O(n)\). Keep elements that satisfy a predicate.
--
-- ==== __Examples__
--
-- >>> filter even (fromList [1..10])
-- [2,4,6,8,10]
filter :: (a -> Bool) -> Seq a -> Seq a
filter :: forall a. (a -> Bool) -> Seq a -> Seq a
filter =
  (((a -> Identity Bool) -> Seq a -> Identity (Seq a))
-> (a -> Bool) -> Seq a -> Seq a
forall {a}.
((a -> Identity Bool) -> Seq a -> Identity (Seq a))
-> (a -> Bool) -> Seq a -> Seq a
forall a b. Coercible a b => a -> b
coerce :: ((a -> Identity Bool) -> Seq a -> Identity (Seq a))
          -> (a -> Bool) -> Seq a -> Seq a)
  (a -> Identity Bool) -> Seq a -> Identity (Seq a)
forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> Seq a -> f (Seq a)
filterA
{-# INLINE filter #-}

-- | \(O(n)\). Keep the @Just@s in a sequence.
--
-- ==== __Examples__
--
-- >>> catMaybes (fromList [Just 1, Nothing, Nothing, Just 10, Just 100])
-- [1,10,100]
catMaybes :: Seq (Maybe a) -> Seq a
catMaybes :: forall a. Seq (Maybe a) -> Seq a
catMaybes Seq (Maybe a)
t = (Maybe a -> Maybe a) -> Seq (Maybe a) -> Seq a
forall a b. (a -> Maybe b) -> Seq a -> Seq b
mapMaybe Maybe a -> Maybe a
forall a. a -> a
id Seq (Maybe a)
t

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

-- | \(O(n)\). Map over elements and split the @Left@s and @Right@s.
--
-- ==== __Examples__
--
-- >>> mapEither (\x -> if odd x then Left x else Right x) (fromList [1..10])
-- ([1,3,5,7,9],[2,4,6,8,10])
mapEither :: (a -> Either b c) -> Seq a -> (Seq b, Seq c)
mapEither :: forall a b c. (a -> Either b c) -> Seq a -> (Seq b, Seq c)
mapEither =
  (((a -> Identity (Either b c)) -> Seq a -> Identity (Seq b, Seq c))
-> (a -> Either b c) -> Seq a -> (Seq b, Seq c)
forall {a} {b} {c}.
((a -> Identity (Either b c)) -> Seq a -> Identity (Seq b, Seq c))
-> (a -> Either b c) -> Seq a -> (Seq b, Seq c)
forall a b. Coercible a b => a -> b
coerce :: ((a -> Identity (Either b c)) -> Seq a -> Identity (Seq b, Seq c))
          -> (a -> Either b c) -> Seq a -> (Seq b, Seq c))
  (a -> Identity (Either b c)) -> Seq a -> Identity (Seq b, Seq c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> f (Either b c)) -> Seq a -> f (Seq b, Seq c)
mapEitherA
{-# INLINE mapEither #-}

-- | \(O(n)\). Keep elements that satisfy an applicative predicate.
filterA :: Applicative f => (a -> f Bool) -> Seq a -> f (Seq a)
filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> Seq a -> f (Seq a)
filterA a -> f Bool
f = (a -> f (Maybe a)) -> Seq a -> f (Seq a)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Seq a -> f (Seq 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 :: Applicative f => (a -> f (Maybe b)) -> Seq a -> f (Seq b)
mapMaybeA :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Seq a -> f (Seq b)
mapMaybeA a -> f (Maybe b)
f = \case
  Tree a
x Tree a
xs -> (Maybe b -> Tree b -> Seq b)
-> f (Maybe b) -> f (Tree b) -> f (Seq 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 ((Tree b -> Seq b)
-> (b -> Tree b -> Seq b) -> Maybe b -> Tree b -> Seq b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tree b -> Seq b
forall a. Tree a -> Seq a
fromTree b -> Tree b -> Seq b
forall a. a -> Tree a -> Seq a
Tree) (a -> f (Maybe b)
f a
x) ((a -> f (Maybe b)) -> Tree a -> f (Tree b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Tree a -> f (Tree b)
T.mapMaybeA a -> f (Maybe b)
f Tree a
xs)
  Seq a
Empty -> Seq b -> f (Seq b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq b
forall a. Seq a
Empty
{-# INLINE mapMaybeA #-}

-- | \(O(n)\). Traverse over elements and split the @Left@s and @Right@s.
mapEitherA
  :: Applicative f => (a -> f (Either b c)) -> Seq a -> f (Seq b, Seq c)
mapEitherA :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> f (Either b c)) -> Seq a -> f (Seq b, Seq c)
mapEitherA a -> f (Either b c)
f = \case
  Tree a
x Tree a
xs -> (\Either b c -> S2 (Tree b) (Tree c) -> (Seq b, Seq c)
g -> (Either b c -> S2 (Tree b) (Tree c) -> (Seq b, Seq c))
-> f (Either b c) -> f (S2 (Tree b) (Tree c)) -> f (Seq b, Seq 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 (Tree b) (Tree c) -> (Seq b, Seq c)
g (a -> f (Either b c)
f a
x) ((a -> f (Either b c)) -> Tree a -> f (S2 (Tree b) (Tree c))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> f (Either b c)) -> Tree a -> f (S2 (Tree b) (Tree c))
T.mapEitherA a -> f (Either b c)
f Tree a
xs)) ((Either b c -> S2 (Tree b) (Tree c) -> (Seq b, Seq c))
 -> f (Seq b, Seq c))
-> (Either b c -> S2 (Tree b) (Tree c) -> (Seq b, Seq c))
-> f (Seq b, Seq c)
forall a b. (a -> b) -> a -> b
$ \Either b c
mx S2 (Tree b) (Tree c)
z ->
    case Either b c
mx of
      Left b
x' -> S2 (Seq b) (Seq c) -> (Seq b, Seq c)
forall {a} {b}. S2 a b -> (a, b)
unS2 (S2 (Seq b) (Seq c) -> (Seq b, Seq c))
-> S2 (Seq b) (Seq c) -> (Seq b, Seq c)
forall a b. (a -> b) -> a -> b
$ (Tree b -> Seq b)
-> (Tree c -> Seq c) -> S2 (Tree b) (Tree c) -> S2 (Seq b) (Seq 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 -> Tree b -> Seq b
forall a. a -> Tree a -> Seq a
Tree b
x') Tree c -> Seq c
forall a. Tree a -> Seq a
fromTree S2 (Tree b) (Tree c)
z
      Right c
x' -> S2 (Seq b) (Seq c) -> (Seq b, Seq c)
forall {a} {b}. S2 a b -> (a, b)
unS2 (S2 (Seq b) (Seq c) -> (Seq b, Seq c))
-> S2 (Seq b) (Seq c) -> (Seq b, Seq c)
forall a b. (a -> b) -> a -> b
$ (Tree b -> Seq b)
-> (Tree c -> Seq c) -> S2 (Tree b) (Tree c) -> S2 (Seq b) (Seq 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 Tree b -> Seq b
forall a. Tree a -> Seq a
fromTree (c -> Tree c -> Seq c
forall a. a -> Tree a -> Seq a
Tree c
x') S2 (Tree b) (Tree c)
z
  Seq a
Empty -> (Seq b, Seq c) -> f (Seq b, Seq c)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq b
forall a. Seq a
Empty, Seq c
forall a. Seq a
Empty)
  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.
--
-- ==== __Examples__
--
-- >>> takeWhile even (fromList [2,4,6,1,3,2,4])
-- [2,4,6]
takeWhile :: (a -> Bool) -> Seq a -> Seq a
takeWhile :: forall a. (a -> Bool) -> Seq a -> Seq a
takeWhile a -> Bool
p Seq a
t = (Int -> a -> Seq a -> Seq a) -> Seq a -> Seq a -> Seq a
forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
IFo.ifoldr (\Int
i a
x Seq a
z -> if a -> Bool
p a
x then Seq a
z else Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take Int
i Seq a
t) Seq a
t Seq 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.
--
-- ==== __Examples__
--
-- >>> dropWhile even (fromList [2,4,6,1,3,2,4])
-- [1,3,2,4]
dropWhile :: (a -> Bool) -> Seq a -> Seq a
dropWhile :: forall a. (a -> Bool) -> Seq a -> Seq a
dropWhile a -> Bool
p Seq a
t = (Int -> a -> Seq a -> Seq a) -> Seq a -> Seq a -> Seq a
forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
IFo.ifoldr (\Int
i a
x Seq a
z -> if a -> Bool
p a
x then Seq a
z else Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
drop Int
i Seq a
t) Seq a
forall a. Seq a
Empty Seq 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)@
--
-- ==== __Examples__
--
-- >>> span even (fromList [2,4,6,1,3,2,4])
-- ([2,4,6],[1,3,2,4])
span :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
span :: forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
span a -> Bool
p Seq a
t = (Int -> a -> (Seq a, Seq a) -> (Seq a, Seq a))
-> (Seq a, Seq a) -> Seq a -> (Seq a, Seq a)
forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
IFo.ifoldr (\Int
i a
x (Seq a, Seq a)
z -> if a -> Bool
p a
x then (Seq a, Seq a)
z else Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt Int
i Seq a
t) (Seq a
t, Seq a
forall a. Seq a
Empty) Seq 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)@
--
-- ==== __Examples__
--
-- >>> break odd (fromList [2,4,6,1,3,2,4])
-- ([2,4,6],[1,3,2,4])
break :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
break :: forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
break a -> Bool
p = (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq 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 :: (a -> Bool) -> Seq a -> Seq a
takeWhileEnd :: forall a. (a -> Bool) -> Seq a -> Seq a
takeWhileEnd a -> Bool
p Seq a
t = (Int -> Seq a -> a -> Seq a) -> Seq a -> Seq a -> Seq a
forall b a. (Int -> b -> a -> b) -> b -> Seq a -> b
forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
IFo.ifoldl (\Int
i Seq a
z a
x -> if a -> Bool
p a
x then Seq a
z else Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Seq a
t) Seq a
t Seq 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 :: (a -> Bool) -> Seq a -> Seq a
dropWhileEnd :: forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileEnd a -> Bool
p Seq a
t =
  (Int -> Seq a -> a -> Seq a) -> Seq a -> Seq a -> Seq a
forall b a. (Int -> b -> a -> b) -> b -> Seq a -> b
forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
IFo.ifoldl (\Int
i Seq a
z a
x -> if a -> Bool
p a
x then Seq a
z else Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
take (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Seq a
t) Seq a
forall a. Seq a
Empty Seq 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 :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanEnd :: forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
spanEnd a -> Bool
p Seq a
t =
  (Int -> (Seq a, Seq a) -> a -> (Seq a, Seq a))
-> (Seq a, Seq a) -> Seq a -> (Seq a, Seq a)
forall b a. (Int -> b -> a -> b) -> b -> Seq a -> b
forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
IFo.ifoldl (\Int
i (Seq a, Seq a)
z a
x -> if a -> Bool
p a
x then (Seq a, Seq a)
z else Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Seq a
t) (Seq a
forall a. Seq a
Empty, Seq a
t) Seq 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 :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakEnd :: forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
breakEnd a -> Bool
p = (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq 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
--------------

-- | \(O(n)\). Reverse a sequence.
--
-- ==== __Examples__
--
-- >>> reverse (fromList [1,2,3,4,5])
-- [5,4,3,2,1]
reverse :: Seq a -> Seq a
reverse :: forall a. Seq a -> Seq a
reverse (Tree a
x Tree a
xs) = case Tree a -> SMaybe (S2 a (Tree a))
forall a. Tree a -> SMaybe (S2 a (Tree a))
T.uncons (Tree a -> Tree a
forall {a}. Tree a -> Tree a
rev Tree a
xs) of
  SMaybe (S2 a (Tree a))
U.SNothing -> a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
forall a. Tree a
Tip
  U.SJust (U.S2 a
x' Tree a
xs') -> a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x' (Tree a -> a -> Tree a
forall a. Tree a -> a -> Tree a
T.snoc Tree a
xs' a
x)
  where
    rev :: Tree a -> Tree a
rev Tree a
T.Tip = Tree a
forall a. Tree a
T.Tip
    rev (T.Bin Int
sz a
y Tree a
l Tree a
r) = Int -> a -> Tree a -> Tree a -> Tree a
forall a. Int -> a -> Tree a -> Tree a -> Tree a
T.Bin Int
sz a
y (Tree a -> Tree a
rev Tree a
r) (Tree a -> Tree a
rev Tree a
l)
reverse Seq a
Empty = Seq a
forall a. Seq a
Empty

-- | \(O(n)\). Intersperse an element between the elements of a sequence.
--
-- ==== __Examples__
--
-- >>> intersperse '.' (fromList "HELLO")
-- "H.E.L.L.O"
intersperse :: a -> Seq a -> Seq a
intersperse :: forall a. a -> Seq a -> Seq a
intersperse a
y (Tree a
x Tree a
xs) = case Tree a -> SMaybe (S2 (Tree a) a)
forall a. Tree a -> SMaybe (S2 (Tree a) a)
T.unsnoc (Tree a -> Tree a
go Tree a
xs) of
  SMaybe (S2 (Tree a) a)
U.SNothing -> String -> Seq a
forall a. HasCallStack => String -> a
error String
"Seq.intersperse: impossible"
  U.SJust (U.S2 Tree a
xs' a
_) -> a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
xs'
  where
    yt :: Tree a
yt = Int -> a -> Tree a -> Tree a -> Tree a
forall a. Int -> a -> Tree a -> Tree a -> Tree a
T.Bin Int
1 a
y Tree a
forall a. Tree a
T.Tip Tree a
forall a. Tree a
T.Tip
    go :: Tree a -> Tree a
go Tree a
T.Tip = Tree a
yt
    go (T.Bin Int
sz a
z Tree a
l Tree a
r) = Int -> a -> Tree a -> Tree a -> Tree a
forall a. Int -> a -> Tree a -> Tree a -> Tree a
T.Bin (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 (Tree a -> Tree a
go Tree a
l) (Tree a -> Tree a
go Tree a
r)
    -- No need to balance, x <= 3y => 2x+1 <= 3(2y+1)
intersperse a
_ Seq a
Empty = Seq a
forall a. Seq a
Empty

-- | \(O(n)\). Like 'Data.Foldable.foldl'' but keeps all intermediate values.
--
-- ==== __Examples__
--
-- >>> scanl (+) 0 (fromList [1..5])
-- [0,1,3,6,10,15]
scanl :: (b -> a -> b) -> b -> Seq a -> Seq b
scanl :: forall b a. (b -> a -> b) -> b -> Seq a -> Seq b
scanl b -> a -> b
f !b
z0 =
  b -> Seq b -> Seq b
forall a. a -> Seq a -> Seq a
cons b
z0 (Seq b -> Seq b) -> (Seq a -> Seq b) -> Seq a -> Seq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (SState b (Seq b) -> b -> Seq b) -> b -> SState b (Seq b) -> Seq b
forall a b c. (a -> b -> c) -> b -> a -> c
flip SState b (Seq b) -> b -> Seq b
forall s a. SState s a -> s -> a
U.evalSState b
z0 (SState b (Seq b) -> Seq b)
-> (Seq a -> SState b (Seq b)) -> Seq a -> Seq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> SStateT b Identity b) -> Seq a -> SState b (Seq b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
Tr.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 #-}

-- Note [SState for scans]
-- ~~~~~~~~~~~~~~~~~~~~~~
-- SState is better than Trans.State.Strict.
-- For example, for scanl (+) (0 :: Int), the accumulator Int is unboxed with
-- SState but not with Trans.State.Strict.

-- | \(O(n)\). Like 'Data.Foldable.foldr'' but keeps all intermediate values.
--
-- ==== __Examples__
--
-- >>> scanr (+) 0 (fromList [1..5])
-- [15,14,12,9,5,0]
scanr :: (a -> b -> b) -> b -> Seq a -> Seq b
scanr :: forall a b. (a -> b -> b) -> b -> Seq a -> Seq b
scanr a -> b -> b
f !b
z0 =
  (Seq b -> b -> Seq b) -> b -> Seq b -> Seq b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Seq b -> b -> Seq b
forall a. Seq a -> a -> Seq a
snoc b
z0 (Seq b -> Seq b) -> (Seq a -> Seq b) -> Seq a -> Seq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (SState b (Seq b) -> b -> Seq b) -> b -> SState b (Seq b) -> Seq b
forall a b c. (a -> b -> c) -> b -> a -> c
flip SState b (Seq b) -> b -> Seq b
forall s a. SState s a -> s -> a
U.evalSState b
z0 (SState b (Seq b) -> Seq b)
-> (Seq a -> SState b (Seq b)) -> Seq a -> Seq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Backwards (SStateT b Identity) (Seq b) -> SState b (Seq b)
forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards (Backwards (SStateT b Identity) (Seq b) -> SState b (Seq b))
-> (Seq a -> Backwards (SStateT b Identity) (Seq b))
-> Seq a
-> SState b (Seq b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (a -> Backwards (SStateT b Identity) b)
-> Seq a -> Backwards (SStateT b Identity) (Seq b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
Tr.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 #-}
-- See Note [SState for scans]

-- | \(O(n \log n)\). Sort a sequence. The sort is stable.
--
-- ==== __Examples__
--
-- >>> sort (fromList [4,2,3,5,1])
-- [1,2,3,4,5]
sort :: Ord a => Seq a -> Seq a
sort :: forall a. Ord a => Seq a -> Seq a
sort = (a -> a -> Ordering) -> Seq a -> Seq a
forall a. (a -> a -> Ordering) -> Seq a -> Seq 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. The sort is
-- stable.
--
-- ==== __Examples__
--
-- >>> import Data.Ord (Down, comparing)
-- >>> sortBy (comparing Down) (fromList [4,2,3,5,1])
-- [5,4,3,2,1]
sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a
sortBy :: forall a. (a -> a -> Ordering) -> Seq a -> Seq a
sortBy a -> a -> Ordering
cmp Seq a
xs = (Int -> a -> a) -> Seq a -> Seq a
forall a b. (Int -> a -> b) -> Seq a -> Seq b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
IFu.imap (\Int
i a
_ -> Array a -> Int -> a
forall a. Array a -> Int -> a
A.indexArray Array a
xa Int
i) Seq a
xs
  where
    n :: Int
n = Seq a -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq 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 () -> Seq a -> ST s ()
forall a b. (Int -> a -> b -> b) -> b -> Seq 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 ()) Seq 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 #-}

-- Note [Inlinable sortBy]
-- ~~~~~~~~~~~~~~~~~~~~~~~
-- Don't INLINE sortBy because sortArrayBy is huge. The user can use Exts.inline
-- if they like.

--------------------
-- 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) -> Seq a -> Maybe a
findEnd :: forall a. (a -> Bool) -> Seq a -> Maybe a
findEnd a -> Bool
f =
  Last a -> Maybe a
forall a. Last a -> Maybe a
Monoid.getLast (Last a -> Maybe a) -> (Seq a -> Last a) -> Seq a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Last a) -> Seq a -> Last a
forall m a. Monoid m => (a -> m) -> Seq 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.
--
-- ==== __Examples__
--
-- >>> findIndex even (fromList [1..5])
-- Just 1
-- >>> findIndex (<0) (fromList [1..5])
-- Nothing
findIndex :: (a -> Bool) -> Seq a -> Maybe Int
findIndex :: forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndex a -> Bool
f =
  First Int -> Maybe Int
forall a. First a -> Maybe a
Monoid.getFirst (First Int -> Maybe Int)
-> (Seq a -> First Int) -> Seq a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Int -> a -> First Int) -> Seq a -> First Int
forall m a. Monoid m => (Int -> a -> m) -> Seq 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) -> Seq a -> Maybe Int
findIndexEnd :: forall a. (a -> Bool) -> Seq a -> Maybe Int
findIndexEnd a -> Bool
f =
  Last Int -> Maybe Int
forall a. Last a -> Maybe a
Monoid.getLast (Last Int -> Maybe Int)
-> (Seq a -> Last Int) -> Seq a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Int -> a -> Last Int) -> Seq a -> Last Int
forall m a. Monoid m => (Int -> a -> m) -> Seq 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.
--
-- ==== __Examples__
--
-- >>> infixIndices (fromList "ana") (fromList "banana")
-- [1,3]
-- >>> infixIndices (fromList [0]) (fromList [1,2,3])
-- []
-- >>> infixIndices (fromList "") (fromList "abc")
-- [0,1,2,3]
infixIndices :: Eq a => Seq a -> Seq a -> [Int]
infixIndices :: forall a. Eq a => Seq a -> Seq a -> [Int]
infixIndices Seq a
t1 Seq a
t2
  | Seq a -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq a
t1 = [Int
0 .. Seq a -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
t2]
  | Seq a -> Seq a -> Ordering
forall a b. Seq a -> Seq b -> Ordering
compareLength Seq a
t1 Seq a
t2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = []
  | Bool
otherwise =
    let n1 :: Int
n1 = Seq a -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
t1
        t1a :: Array a
t1a = Int -> Seq a -> Array a
forall a. Int -> Seq a -> Array a
infixIndicesMkArray Int
n1 Seq 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) -> Seq a -> State a -> b
forall a b. (Int -> a -> b -> b) -> b -> Seq 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) Seq a
t2 State a
m0
{-# INLINE infixIndices #-} -- Inline for fusion

infixIndicesMkArray :: Int -> Seq a -> A.Array a
infixIndicesMkArray :: forall a. Int -> Seq a -> Array a
infixIndicesMkArray !Int
n !Seq 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 () -> Seq a -> ST s ()
forall a b. (Int -> a -> b -> b) -> b -> Seq 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 ()) Seq 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.
--
-- ==== __Examples__
--
-- >>> binarySearchFind (`compare` 8) (fromList [2,4..10])
-- Just 8
-- >>> binarySearchFind (`compare` 3) (fromList [2,4..10])
-- Nothing
binarySearchFind :: (a -> Ordering) -> Seq a -> Maybe a
binarySearchFind :: forall a. (a -> Ordering) -> Seq a -> Maybe a
binarySearchFind a -> Ordering
f Seq a
t = case Seq a
t of
  Seq a
Empty -> Maybe a
forall a. Maybe a
Nothing
  Tree a
x Tree a
xs -> case a -> Ordering
f a
x of
    Ordering
LT -> Tree a -> Maybe a
go Tree 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 :: Tree a -> Maybe a
go Tree a
Tip = Maybe a
forall a. Maybe a
Nothing
    go (Bin Int
_ a
y Tree a
l Tree a
r) = case a -> Ordering
f a
y of
      Ordering
LT -> Tree a -> Maybe a
go Tree a
r
      Ordering
EQ -> a -> Maybe a
forall a. a -> Maybe a
Just a
y
      Ordering
GT -> Tree a -> Maybe a
go Tree a
l
{-# INLINE binarySearchFind #-}

-- | \(O(\min(n_1,n_2))\). Whether the first sequence is a prefix of the second.
--
-- ==== __Examples__
--
-- >>> fromList "has" `isPrefixOf` fromList "haskell"
-- True
-- >>> fromList "ask" `isPrefixOf` fromList "haskell"
-- False
isPrefixOf :: Eq a => Seq a -> Seq a -> Bool
isPrefixOf :: forall a. Eq a => Seq a -> Seq a -> Bool
isPrefixOf Seq a
t1 Seq a
t2 =
  Seq a -> Seq a -> Ordering
forall a b. Seq a -> Seq b -> Ordering
compareLength Seq a
t1 Seq 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 (Seq a -> Stream a
forall a. Seq a -> Stream a
stream Seq a
t1) (Seq a -> Stream a
forall a. Seq a -> Stream a
stream Seq a
t2)
{-# INLINABLE isPrefixOf #-}

-- | \(O(\min(n_1,n_2))\). Whether the first sequence is a suffix of the second.
--
-- ==== __Examples__
--
-- >>> fromList "ell" `isSuffixOf` fromList "haskell"
-- True
-- >>> fromList "ask" `isSuffixOf` fromList "haskell"
-- False
isSuffixOf :: Eq a => Seq a -> Seq a -> Bool
isSuffixOf :: forall a. Eq a => Seq a -> Seq a -> Bool
isSuffixOf Seq a
t1 Seq a
t2 =
  Seq a -> Seq a -> Ordering
forall a b. Seq a -> Seq b -> Ordering
compareLength Seq a
t1 Seq 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 (Seq a -> Stream a
forall a. Seq a -> Stream a
streamEnd Seq a
t1) (Seq a -> Stream a
forall a. Seq a -> Stream a
streamEnd Seq a
t2)
{-# INLINABLE isSuffixOf #-}

-- | \(O(n_1 + n_2)\). Whether the first sequence is a substring of the second.
--
-- ==== __Examples__
--
-- >>> fromList "meow" `isInfixOf` fromList "homeowner"
-- True
-- >>> fromList [2,4] `isInfixOf` fromList [2,3,4]
-- False
isInfixOf :: Eq a => Seq a -> Seq a -> Bool
isInfixOf :: forall a. Eq a => Seq a -> Seq a -> Bool
isInfixOf Seq a
t1 Seq 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 (Seq a -> Seq a -> [Int]
forall a. Eq a => Seq a -> Seq a -> [Int]
infixIndices Seq a
t1 Seq a
t2)
{-# INLINABLE isInfixOf #-}

-- | \(O(n_1 + n_2)\). Whether the first sequence is a subsequence of the
-- second.
--
-- ==== __Examples__
--
-- >>> fromList [2,4] `isSubsequenceOf` [2,3,4]
-- True
-- >>> fromList "tab" `isSubsequenceOf` fromList "bat"
-- False
isSubsequenceOf :: Eq a => Seq a -> Seq a -> Bool
isSubsequenceOf :: forall a. Eq a => Seq a -> Seq a -> Bool
isSubsequenceOf Seq a
t1 Seq a
t2 =
  Seq a -> Seq a -> Ordering
forall a b. Seq a -> Seq b -> Ordering
compareLength Seq a
t1 Seq 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 (Seq a -> Stream a
forall a. Seq a -> Stream a
stream Seq a
t1) (Seq a -> Stream a
forall a. Seq a -> Stream a
stream Seq a
t2)
{-# INLINABLE isSubsequenceOf #-}

--------
-- Zip
--------

-- | \(O(\min(n_1,n_2))\). Zip two sequences. The result is as long as the
-- shorter sequence.
zip :: Seq a -> Seq b -> Seq (a, b)
zip :: forall a b. Seq a -> Seq b -> Seq (a, b)
zip Seq a
t1 Seq b
t2 = (a -> b -> (a, b)) -> Seq a -> Seq b -> Seq (a, b)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith (,) Seq a
t1 Seq b
t2

-- | \(O(\min(n_1,n_2,n_3))\). Zip three sequences. The result is as long as the
-- shortest sequence.
zip3 :: Seq a -> Seq b -> Seq c -> Seq (a, b, c)
zip3 :: forall a b c. Seq a -> Seq b -> Seq c -> Seq (a, b, c)
zip3 Seq a
t1 Seq b
t2 Seq c
t3 = (a -> b -> c -> (a, b, c))
-> Seq a -> Seq b -> Seq c -> Seq (a, b, c)
forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3 (,,) Seq a
t1 Seq b
t2 Seq c
t3

-- | \(O(\min(n_1,n_2))\). Zip two sequences with a function. The result is
-- as long as the shorter sequence.
--
-- ==== __Examples__
--
-- >>> zipWith (+) (fromList [1,2,3]) (fromList [1,1,1,1,1])
-- [2,3,4]
zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith =
  (((a -> b -> Identity c) -> Seq a -> Seq b -> Identity (Seq c))
-> (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall {a} {b} {c}.
((a -> b -> Identity c) -> Seq a -> Seq b -> Identity (Seq c))
-> (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b. Coercible a b => a -> b
coerce :: ((a -> b -> Identity c) -> Seq a -> Seq b -> Identity (Seq c))
          -> (a -> b -> c) -> Seq a -> Seq b -> Seq c)
  (a -> b -> Identity c) -> Seq a -> Seq b -> Identity (Seq c)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Seq a -> Seq b -> m (Seq 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 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3 :: forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3 =
  (((a -> b -> c -> Identity d)
 -> Seq a -> Seq b -> Seq c -> Identity (Seq d))
-> (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
forall {a} {b} {c} {d}.
((a -> b -> c -> Identity d)
 -> Seq a -> Seq b -> Seq c -> Identity (Seq d))
-> (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
forall a b. Coercible a b => a -> b
coerce :: ((a -> b -> c -> Identity d) -> Seq a -> Seq b -> Seq c -> Identity (Seq d))
          -> (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d)
  (a -> b -> c -> Identity d)
-> Seq a -> Seq b -> Seq c -> Identity (Seq d)
forall (m :: * -> *) a b c d.
Monad m =>
(a -> b -> c -> m d) -> Seq a -> Seq b -> Seq c -> m (Seq d)
zipWith3M
{-# INLINE zipWith3 #-}

-- | \(O(\min(n_1,n_2))\). Zip two sequences with a monadic function. The result
-- is as long as the shorter sequence.
zipWithM :: Monad m => (a -> b -> m c) -> Seq a -> Seq b -> m (Seq c)
zipWithM :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Seq a -> Seq b -> m (Seq c)
zipWithM a -> b -> m c
f Seq a
t1 Seq b
t2 = (a -> b -> m c) -> Seq a -> Stream b -> m (Seq c)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Seq a -> Stream b -> m (Seq c)
zipWithStreamM a -> b -> m c
f Seq a
t1 (Seq b -> Stream b
forall a. Seq a -> Stream a
stream Seq b
t2)
{-# INLINE zipWithM #-}

-- | \(O(\min(n_1,n_2,n_3))\). Zip three sequences with a monadic function. The
-- result is as long as the shortest sequence.
zipWith3M
  :: Monad m => (a -> b -> c -> m d) -> Seq a -> Seq b -> Seq c -> m (Seq d)
zipWith3M :: forall (m :: * -> *) a b c d.
Monad m =>
(a -> b -> c -> m d) -> Seq a -> Seq b -> Seq c -> m (Seq d)
zipWith3M a -> b -> c -> m d
f Seq a
t1 Seq b
t2 Seq c
t3 =
  (a -> S2 b c -> m d) -> Seq a -> Stream (S2 b c) -> m (Seq d)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Seq a -> Stream b -> m (Seq c)
zipWithStreamM
    (\a
x (U.S2 b
y c
z) -> a -> b -> c -> m d
f a
x b
y c
z)
    Seq 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 (Seq b -> Stream b
forall a. Seq a -> Stream a
stream Seq b
t2) (Seq c -> Stream c
forall a. Seq a -> Stream a
stream Seq c
t3))
{-# INLINE zipWith3M #-}

zipWithStreamM :: Monad m => (a -> b -> m c) -> Seq a -> Stream b -> m (Seq c)
zipWithStreamM :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Seq a -> Stream b -> m (Seq c)
zipWithStreamM a -> b -> m c
f Seq a
t Stream b
strm = case Seq a
t of
  Seq a
Empty -> Seq c -> m (Seq c)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq c
forall a. Seq a
Empty
  Tree a
x Tree 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 -> Seq c -> m (Seq c)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq c
forall a. Seq a
Empty
      Yield b
y s
s1 ->
        (c -> Tree c -> Seq c) -> m c -> m (Tree c) -> m (Seq 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 -> Tree c -> Seq c
forall a. a -> Tree a -> Seq a
Tree (a -> b -> m c
f a
x b
y) ((a -> b -> m c) -> Tree a -> Stream b -> m (Tree c)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Tree a -> Stream b -> m (Tree c)
T.zipWithStreamM a -> b -> m c
f Tree 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)\). Unzip a sequence of pairs.
unzip :: Seq (a, b) -> (Seq a, Seq b)
unzip :: forall a b. Seq (a, b) -> (Seq a, Seq b)
unzip Seq (a, b)
t = ((a, b) -> (a, b)) -> Seq (a, b) -> (Seq a, Seq b)
forall a b c. (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith (a, b) -> (a, b)
forall a. a -> a
id Seq (a, b)
t

-- | \(O(n)\). Unzip a sequence of triples.
unzip3 :: Seq (a, b, c) -> (Seq a, Seq b, Seq c)
unzip3 :: forall a b c. Seq (a, b, c) -> (Seq a, Seq b, Seq c)
unzip3 Seq (a, b, c)
t = ((a, b, c) -> (a, b, c)) -> Seq (a, b, c) -> (Seq a, Seq b, Seq c)
forall a b c d. (a -> (b, c, d)) -> Seq a -> (Seq b, Seq c, Seq d)
unzipWith3 (a, b, c) -> (a, b, c)
forall a. a -> a
id Seq (a, b, c)
t

-- | \(O(n)\). Map over a sequence and unzip the result.
--
-- ==== __Examples__
--
-- >>> unzipWith (\x -> (x-1, x*2)) (fromList [1..5])
-- ([0,1,2,3,4],[2,4,6,8,10])
unzipWith :: (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith :: forall a b c. (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWith a -> (b, c)
f Seq a
t = case Seq a
t of
  Tree a
x Tree a
xs ->
    case (a -> (b, c)
f a
x, (a -> Identity (b, c)) -> Tree a -> Identity (S2 (Tree b) (Tree c))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> f (b, c)) -> Tree a -> f (S2 (Tree b) (Tree 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) Tree a
xs) of
      ((b
x1,c
x2), Identity (U.S2 Tree b
xs1 Tree c
xs2)) ->
        let !t1 :: Seq b
t1 = b -> Tree b -> Seq b
forall a. a -> Tree a -> Seq a
Tree b
x1 Tree b
xs1
            !t2 :: Seq c
t2 = c -> Tree c -> Seq c
forall a. a -> Tree a -> Seq a
Tree c
x2 Tree c
xs2
        in (Seq b
t1,Seq c
t2)
  Seq a
Empty -> (Seq b
forall a. Seq a
Empty, Seq c
forall a. Seq a
Empty)
{-# INLINE unzipWith #-}

-- | \(O(n)\). Map over a sequence and unzip the result.
unzipWith3 :: (a -> (b, c, d)) -> Seq a -> (Seq b, Seq c, Seq d)
unzipWith3 :: forall a b c d. (a -> (b, c, d)) -> Seq a -> (Seq b, Seq c, Seq d)
unzipWith3 a -> (b, c, d)
f Seq a
t = case Seq a
t of
  Tree a
x Tree a
xs ->
    case (a -> (b, c, d)
f a
x, (a -> Identity (b, c, d))
-> Tree a -> Identity (S3 (Tree b) (Tree c) (Tree d))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> f (b, c, d)) -> Tree a -> f (S3 (Tree b) (Tree c) (Tree 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) Tree a
xs) of
      ((b
x1,c
x2,d
x3), Identity (U.S3 Tree b
xs1 Tree c
xs2 Tree d
xs3)) ->
        let !t1 :: Seq b
t1 = b -> Tree b -> Seq b
forall a. a -> Tree a -> Seq a
Tree b
x1 Tree b
xs1
            !t2 :: Seq c
t2 = c -> Tree c -> Seq c
forall a. a -> Tree a -> Seq a
Tree c
x2 Tree c
xs2
            !t3 :: Seq d
t3 = d -> Tree d -> Seq d
forall a. a -> Tree a -> Seq a
Tree d
x3 Tree d
xs3
        in (Seq b
t1,Seq c
t2,Seq d
t3)
  Seq a
Empty -> (Seq b
forall a. Seq a
Empty, Seq c
forall a. Seq a
Empty, Seq d
forall a. Seq a
Empty)
{-# INLINE unzipWith3 #-}

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

fromTree :: Tree a -> Seq a
fromTree :: forall a. Tree a -> Seq a
fromTree Tree a
t = case Tree a -> SMaybe (S2 a (Tree a))
forall a. Tree a -> SMaybe (S2 a (Tree a))
T.uncons Tree a
t of
  SMaybe (S2 a (Tree a))
U.SNothing -> Seq a
forall a. Seq a
Empty
  U.SJust (U.S2 a
x Tree a
xs) -> a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
xs
{-# INLINE fromTree #-}

-- Note [compareLength]
-- ~~~~~~~~~~~~~~~~~~~~
-- The following functions exist for a bit of efficiency. GHC generates some
-- unnecessary branches for the simple `compare (length x) (length y)`, because
-- it does not know that the size of a Bin is always > the size of a Tip.

compareLength :: Seq a -> Seq b -> Ordering
compareLength :: forall a b. Seq a -> Seq b -> Ordering
compareLength Seq a
l Seq b
r = case Seq a
l of
  Tree a
_ Tree a
xs -> case Seq b
r of
    Tree b
_ Tree b
ys -> Tree a -> Tree b -> Ordering
forall a b. Tree a -> Tree b -> Ordering
compareSize Tree a
xs Tree b
ys
    Seq b
Empty -> Ordering
GT
  Seq a
Empty -> case Seq b
r of
    Tree b
_ Tree b
_ -> Ordering
LT
    Seq b
Empty -> Ordering
EQ
{-# INLINE compareLength #-}

compareSize :: Tree a -> Tree b -> Ordering
compareSize :: forall a b. Tree a -> Tree b -> Ordering
compareSize Tree a
l Tree b
r = case Tree a
l of
  Bin Int
szl a
_ Tree a
_ Tree a
_ -> case Tree b
r of
    Bin Int
szr b
_ Tree b
_ Tree b
_ -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
szl Int
szr
    Tree b
Tip -> Ordering
GT
  Tree a
Tip -> case Tree b
r of
    Bin Int
_ b
_ Tree b
_ Tree b
_ -> Ordering
LT
    Tree b
Tip -> 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

-- Note [fromList implementation]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- fromList is implemented by keeping a Stack where Seqs at each level have
-- their size as a power of 2. The powers of 2 increase down the stack. New
-- elements are pushed on the stack as Seqs of size 1. They are linked down the
-- stack when they match the next Seq's size. Every such link links two perfect
-- binary trees in O(1) using Bin. For n elements this takes O(n).
--
-- At the end, the Seqs in the stack are linked together from small to large,
-- balancing as necessary. Linking two Seqs A and B takes
-- O(|log(size A) - log(size B)|). The sizes of the Seqs in the stack are the
-- component powers of 2 of the total size n.
-- Let there be k powers of 2 in n, i.e. n = \sum_{i=1}^k p_i.
-- Then the total cost of the links is
--   O(\sum_{i=2}^k (\log 2^{p_i} - \log (\sum_{j=1}^{i-1} 2^{p_j})))
-- = O(\sum_{i=2}^k (\log 2^{p_i} - \log 2^{p_{i-1}}))
-- = O(\sum_{i=2}^k (p_i - p_{i-1}))
-- = O(p_k - p_1)
-- = O(\log n)

-- Note [concatMap implementation]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The concatMap implementation is not unlike the fromList implementation.
-- Since arbitrary sized Seqs have to be concatenated, the Stack will not have
-- trees of sizes as perfect powers of 2. Instead, an invariant is maintained
-- that 2*size(stack!!0) <= size(stack!!1). This keeps the depth of the stack
-- bounded by O(log N), where N is the total size of Seqs in the stack.
--
-- If a new Seq is to be added and it is small enough to not violate the
-- invariant, it is simply pushed on the stack. If it would violate the
-- invariant, Seqs on the stack are linked to restore it. The idea here is
-- to merge Seqs of similar sizes as much as possible, since we want to minimize
-- the cost of linking which is O(|log(size A) - log(size B)|). The exact
-- strategy used for this is "2-merge", which has been described and
-- analyzed by Sam Buss and Alexander Knop in "Strategies for Stable Merge
-- Sorting" (https://arxiv.org/abs/1801.04641) for use in mergesort.
-- A merge strategy for mergesort hasn't been blindly adopted here. I arrived
-- at this strategy in an attempt to adopt fromList's implementation before I
-- was aware of the above paper. The incentives to merge similar sizes are very
-- clear here, more so compared to mergesort.
--
-- Finding a good complexity bound for this algorithm is a little tricky.
-- Given that we merge m Seqs of sizes n_i with total size N, I estimate the
-- complexity to be
-- O(log N - log_{n_m} + \sum_{i=1}^m \max(1, log_{n_i} - log_{n_{i-1})).
-- The log_{n_i} - log_{n_{i-1}} term is an upper bound on the cost of restoring
-- invariants when adding Seqs that turn out to be too big.
-- The log N - log_{n_m} is the final linking cost.
-- A special case of this is if all n_i are equal, say s. The complexity becomes
-- O(log sm - log s + m) = O(m).
-- The worst case occurs when Seqs of size 1 are interleaved into a sequence of
-- Seqs. The complexity becomes O(\sum_{i=1}^m log_{n_i}).

ltrPush :: Stack a -> a -> Stack a
ltrPush :: forall a. Stack a -> a -> Stack a
ltrPush Stack a
stk a
y = case Stack a
stk of
  Push a
x Tree a
Tip Stack a
stk' -> Stack a -> a -> Int -> Tree a -> Stack a
forall a. Stack a -> a -> Int -> Tree a -> Stack a
ltrPushLoop Stack a
stk' a
x Int
1 (Int -> a -> Tree a -> Tree a -> Tree a
forall a. Int -> a -> Tree a -> Tree a -> Tree a
T.Bin Int
1 a
y Tree a
forall a. Tree a
Tip Tree a
forall a. Tree a
Tip)
  Stack a
_ -> a -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
y Tree a
forall a. Tree a
Tip Stack a
stk

ltrPushLoop :: Stack a -> a -> Int -> Tree a -> Stack a
ltrPushLoop :: forall a. Stack a -> a -> Int -> Tree a -> Stack a
ltrPushLoop Stack a
stk a
y !Int
ysz Tree a
ys = case Stack a
stk of
  Push a
x xs :: Tree a
xs@(Bin Int
xsz a
_ Tree a
_ Tree a
_) Stack a
stk'
    | Int
xsz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ysz -> Stack a -> a -> Int -> Tree a -> Stack a
forall a. Stack a -> a -> Int -> Tree a -> Stack a
ltrPushLoop Stack a
stk' a
x Int
sz (Int -> a -> Tree a -> Tree a -> Tree a
forall a. Int -> a -> Tree a -> Tree a -> Tree a
Bin Int
sz a
y Tree a
xs Tree 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 -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
y Tree a
ys Stack a
stk

rtlPush :: a -> Stack a -> Stack a
rtlPush :: forall a. a -> Stack a -> Stack a
rtlPush a
x = \case
  Push a
y Tree a
Tip Stack a
stk' -> a -> Int -> Tree a -> Stack a -> Stack a
forall a. a -> Int -> Tree a -> Stack a -> Stack a
rtlPushLoop a
x Int
1 (Int -> a -> Tree a -> Tree a -> Tree a
forall a. Int -> a -> Tree a -> Tree a -> Tree a
T.Bin Int
1 a
y Tree a
forall a. Tree a
Tip Tree a
forall a. Tree a
Tip) Stack a
stk'
  Stack a
stk -> a -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
x Tree a
forall a. Tree a
Tip Stack a
stk

rtlPushLoop :: a -> Int -> Tree a -> Stack a -> Stack a
rtlPushLoop :: forall a. a -> Int -> Tree a -> Stack a -> Stack a
rtlPushLoop a
x !Int
xsz Tree a
xs = \case
  Push a
y ys :: Tree a
ys@(Bin Int
ysz a
_ Tree a
_ Tree a
_) Stack a
stk'
    | Int
xsz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ysz -> a -> Int -> Tree a -> Stack a -> Stack a
forall a. a -> Int -> Tree a -> Stack a -> Stack a
rtlPushLoop a
x Int
sz (Int -> a -> Tree a -> Tree a -> Tree a
forall a. Int -> a -> Tree a -> Tree a -> Tree a
Bin Int
sz a
y Tree a
xs Tree 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 -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
x Tree a
xs Stack a
stk

ltrPushMany :: Stack a -> a -> Tree a -> Stack a
ltrPushMany :: forall a. Stack a -> a -> Tree a -> Stack a
ltrPushMany Stack a
stk a
y Tree a
ys = case Stack a
stk of
  Push a
x Tree 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 -> Tree a -> a -> Int -> Tree a -> Stack a
forall a.
Stack a -> a -> Int -> Tree a -> a -> Int -> Tree a -> Stack a
ltrPushManyLoop Stack a
stk' a
x Int
xsz Tree a
xs a
y Int
ysz Tree a
ys
    | Bool
otherwise -> a -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
y Tree a
ys Stack a
stk
    where
      xsz :: Int
xsz = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tree a -> Int
forall a. Tree a -> Int
T.size Tree a
xs
      ysz :: Int
ysz = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tree a -> Int
forall a. Tree a -> Int
T.size Tree a
ys
  Stack a
Nil -> a -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
y Tree a
ys Stack a
forall a. Stack a
Nil

ltrPushManyLoop
  :: Stack a -> a -> Int -> Tree a -> a -> Int -> Tree a -> Stack a
ltrPushManyLoop :: forall a.
Stack a -> a -> Int -> Tree a -> a -> Int -> Tree a -> Stack a
ltrPushManyLoop Stack a
stk a
y !Int
ysz Tree a
ys a
z !Int
zsz Tree a
zs = case Stack a
stk of
  Push a
x xs :: Tree a
xs@(Bin Int
xsz1 a
_ Tree a
_ Tree a
_) Stack a
stk'
    | Int
xsz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
zsz
    -> Stack a -> a -> Int -> Tree a -> a -> Int -> Tree a -> Stack a
forall a.
Stack a -> a -> Int -> Tree a -> a -> Int -> Tree a -> Stack a
ltrPushManyLoop Stack a
stk' a
x (Int
xsz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ysz) (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
y Tree a
xs Tree a
ys) a
z Int
zsz Tree 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 -> Tree a -> a -> Int -> Tree a -> Stack a
forall a.
Stack a -> a -> Int -> Tree a -> a -> Int -> Tree a -> Stack a
ltrPushManyLoop Stack a
stk' a
x Int
xsz Tree a
xs a
y Int
yzsz (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
z Tree a
ys Tree a
zs)
    | Bool
otherwise
    -> a -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
y (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
z Tree a
ys Tree 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 -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
y (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
z Tree a
ys Tree a
zs) Stack a
stk

ltrFinish :: Stack a -> Seq a
ltrFinish :: forall a. Stack a -> Seq a
ltrFinish = Seq a
-> (a -> Tree a -> S2 a (Tree a))
-> (S2 a (Tree a) -> a -> Tree a -> S2 a (Tree a))
-> (S2 a (Tree a) -> Seq a)
-> Stack a
-> Seq a
forall c a b.
c
-> (a -> Tree a -> b)
-> (b -> a -> Tree a -> b)
-> (b -> c)
-> Stack a
-> c
wrapUpStack
  Seq a
forall a. Seq a
Empty
  a -> Tree a -> S2 a (Tree a)
forall a b. a -> b -> S2 a b
U.S2
  (\(U.S2 a
y Tree a
ys) a
x Tree a
xs -> a -> Tree a -> S2 a (Tree a)
forall a b. a -> b -> S2 a b
U.S2 a
x (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
y Tree a
xs Tree a
ys))
  (\(U.S2 a
y Tree a
ys) -> a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
y Tree a
ys)

rtlFinish :: Stack a -> Seq a
rtlFinish :: forall a. Stack a -> Seq a
rtlFinish = Seq a
-> (a -> Tree a -> S2 a (Tree a))
-> (S2 a (Tree a) -> a -> Tree a -> S2 a (Tree a))
-> (S2 a (Tree a) -> Seq a)
-> Stack a
-> Seq a
forall c a b.
c
-> (a -> Tree a -> b)
-> (b -> a -> Tree a -> b)
-> (b -> c)
-> Stack a
-> c
wrapUpStack
  Seq a
forall a. Seq a
Empty
  a -> Tree a -> S2 a (Tree a)
forall a b. a -> b -> S2 a b
U.S2
  (\(U.S2 a
x Tree a
xs) a
y Tree a
ys -> a -> Tree a -> S2 a (Tree a)
forall a b. a -> b -> S2 a b
U.S2 a
x (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
T.link a
y Tree a
xs Tree a
ys))
  (\(U.S2 a
x Tree a
xs) -> a -> Tree a -> Seq a
forall a. a -> Tree a -> Seq a
Tree a
x Tree a
xs)

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

-- Note [Streams]
-- ~~~~~~~~~~~~~~~~
-- Streams are used here for two reasons.
--
-- 1. It is better to implement lazy folds (foldr, foldl, etc) using Streams
--    rather than tree traversals. This is because they form loops which GHC
--    can optimize better on fusing with a consumer. For instance, the "cps
--    sum foldr" benchmark takes ~85% more time if foldr is implemented as a
--    recursive tree traversal. However, such an implementation is a little
--    faster for non-fusion use cases. For instance, the "foldr short-circuit"
--    benchmark takes ~30% less time. This behavior can be obtained when
--    desirable using foldMap with Endo.
-- 2. Streams can fuse for zip-like operations, so we use it to implement such
--    functions. These are decently fast, and we are saved from having to write
--    messy multi-tree traversals. Note that fold/build cannot fuse zips.
--    `zip = fromList (List.zip (toList t) (toList t))`, for instance, takes
--    ~40% more time compared to the stream-based zip.

stream :: Seq a -> Stream a
stream :: forall a. Seq a -> Stream a
stream !Seq 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 Seq a
t of
      Tree a
x Tree a
xs -> a -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
x Tree a
xs Stack a
forall a. Stack a
Nil
      Seq a
Empty -> Stack a
forall a. Stack a
Nil
    step :: Stack a -> Step (Stack a) a
step = \case
      Push a
x Tree a
xs Stack a
stk -> let !stk' :: Stack a
stk' = Tree a -> Stack a -> Stack a
forall a. Tree a -> Stack a -> Stack a
down Tree 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'
      Stack a
Nil -> Step (Stack a) a
forall s a. Step s a
Done
    {-# INLINE [0] step #-}
{-# INLINE stream #-}

streamEnd :: Seq a -> Stream a
streamEnd :: forall a. Seq a -> Stream a
streamEnd !Seq 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 Seq a
t of
      Tree a
x Tree a
xs -> a -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
x Tree a
xs Stack a
forall a. Stack a
Nil
      Seq a
Empty -> Stack a
forall a. Stack a
Nil
    step :: Stack a -> Step (Stack a) a
step = \case
      Push a
x Tree a
xs Stack a
stk -> case a -> Tree a -> Stack a -> S2 a (Stack a)
forall a. a -> Tree a -> Stack a -> S2 a (Stack a)
rDown a
x Tree 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'
      Stack a
Nil -> Step (Stack a) a
forall s a. Step s a
Done
    {-# INLINE [0] step #-}
{-# INLINE streamEnd #-}

down :: Tree a -> Stack a -> Stack a
down :: forall a. Tree a -> Stack a -> Stack a
down (Bin Int
_ a
x Tree a
l Tree a
r) Stack a
stk = Tree a -> Stack a -> Stack a
forall a. Tree a -> Stack a -> Stack a
down Tree a
l (a -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
x Tree a
r Stack a
stk)
down Tree a
Tip Stack a
stk = Stack a
stk

rDown :: a -> Tree a -> Stack a -> U.S2 a (Stack a)
rDown :: forall a. a -> Tree a -> Stack a -> S2 a (Stack a)
rDown !a
y (Bin Int
_ a
x Tree a
l Tree a
r) Stack a
stk = a -> Tree a -> Stack a -> S2 a (Stack a)
forall a. a -> Tree a -> Stack a -> S2 a (Stack a)
rDown a
x Tree a
r (a -> Tree a -> Stack a -> Stack a
forall a. a -> Tree a -> Stack a -> Stack a
Push a
y Tree a
l Stack a
stk)
rDown a
y Tree a
Tip 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 !(Tree a) !(Stack a) | Nil

wrapUpStack
  :: c -- empty
  -> (a -> Tree a -> b) -- initial
  -> (b -> a -> Tree a -> b) -- fold fun
  -> (b -> c) -- finish
  -> Stack a
  -> c
wrapUpStack :: forall c a b.
c
-> (a -> Tree a -> b)
-> (b -> a -> Tree a -> b)
-> (b -> c)
-> Stack a
-> c
wrapUpStack c
z0 a -> Tree a -> b
f0 b -> a -> Tree 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 Tree a
xs Stack a
stk) = b -> Stack a -> c
go1 (a -> Tree a -> b
f0 a
x Tree 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 Tree a
xs Stack a
stk) = b -> Stack a -> c
go1 (b -> a -> Tree a -> b
f b
z a
x Tree a
xs) Stack a
stk
{-# INLINE wrapUpStack #-}

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

valid :: Seq a -> Bool
valid :: forall a. Seq a -> Bool
valid = \case
  Tree a
_ Tree a
xs -> Tree a -> Bool
forall a. Tree a -> Bool
T.valid Tree a
xs
  Seq a
Empty -> Bool
True

debugShowsPrec :: Show a => Int -> Seq a -> ShowS
debugShowsPrec :: forall a. Show a => Int -> Seq a -> ShowS
debugShowsPrec Int
p = \case
  Tree a
x Tree 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
"Tree " 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 -> Tree a -> ShowS
forall a. Show a => Int -> Tree a -> ShowS
T.debugShowsPrec Int
11 Tree a
xs
  Seq a
Empty -> String -> ShowS
showString String
"Empty"

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

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