{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}

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

    -- * MTree
  , MTree(..)

    -- * Basic
  , singleton
  , size
  , (<>>)
  , (<<>)
  , bin
  , binn

    -- * Folds
  , foldMap
  , foldl'
  , foldr'
  , ifoldl'
  , ifoldr'
  , traverse
  , ifoldMap
  , itraverse

    -- * Construct
  , generateA

    -- * Index
  , index
  , adjustF
  , insertAt
  , deleteAt

    -- * Slice
  , cons
  , snoc
  , uncons
  , unconsSure
  , unsnoc
  , unsnocSure
  , splitAtF

    -- * Transform
  , mapMaybeA
  , mapEitherA

    -- * Force
  , liftRnf2

    -- * Zip and unzip
  , zipWithStreamM
  , unzipWithA
  , unzipWith3A

    -- * Tree helpers
  , fold
  , foldSimple
  , link
  , merge
  , glue
  , balanceL
  , balanceR

    -- * Testing
  , valid
  , debugShowsPrec
  ) where

import Prelude hiding (foldMap, foldl', traverse)
import qualified Control.Applicative as Ap
import Control.DeepSeq (NFData(..))
import Data.Bifunctor (Bifunctor(..))
import Data.Coerce (coerce)

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

-------------
-- Measured
-------------

-- | Types that have a combinable property, called the measure.
class Semigroup (Measure a) => Measured a where
  type Measure a

  -- | Calculate the measure of a value.
  measure :: a -> Measure a

----------
-- MTree
----------

data MTree a
  = MBin {-# UNPACK #-} !Int !(Measure a) !a !(MTree a) !(MTree a)
  | MTip

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

instance (NFData (Measure a), NFData a) => NFData (MTree a) where
  rnf :: MTree a -> ()
rnf = \case
    MBin Int
_ Measure a
v a
x MTree a
l MTree a
r -> Measure a -> ()
forall a. NFData a => a -> ()
rnf Measure a
v () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> () -> ()
forall a b. a -> b -> b
`seq` MTree a -> ()
forall a. NFData a => a -> ()
rnf MTree a
l () -> () -> ()
forall a b. a -> b -> b
`seq` MTree a -> ()
forall a. NFData a => a -> ()
rnf MTree a
r
    MTree a
MTip -> ()
  {-# INLINABLE rnf #-}

liftRnf2 :: (Measure a -> ()) -> (a -> ()) -> MTree a -> ()
liftRnf2 :: forall a. (Measure a -> ()) -> (a -> ()) -> MTree a -> ()
liftRnf2 Measure a -> ()
g a -> ()
f = MTree a -> ()
go
  where
    go :: MTree a -> ()
go (MBin Int
_ Measure a
v a
x MTree a
l MTree a
r) = Measure a -> ()
g Measure a
v () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
f a
x () -> () -> ()
forall a b. a -> b -> b
`seq` MTree a -> ()
go MTree a
l () -> () -> ()
forall a b. a -> b -> b
`seq` MTree a -> ()
go MTree a
r
    go MTree a
MTip = ()
{-# INLINE liftRnf2 #-}

--------------
-- Basic ops
--------------

singleton :: Measured a => a -> MTree a
singleton :: forall a. Measured a => a -> MTree a
singleton a
x = Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
1 (a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x) a
x MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip
{-# INLINE singleton #-}

size :: MTree a -> Int
size :: forall a. MTree a -> Int
size (MBin Int
n Measure a
_ a
_ MTree a
_ MTree a
_) = Int
n
size MTree a
MTip = Int
0
{-# INLINE size #-}

infixr 6 <>>
infixr 6 <<>

(<>>) :: Measured a => MTree a -> Measure a -> Measure a
MBin Int
_ Measure a
v a
_ MTree a
_ MTree a
_ <>> :: forall a. Measured a => MTree a -> Measure a -> Measure a
<>> Measure a
x = Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
x
MTree a
MTip           <>> Measure a
x = Measure a
x
{-# INLINE (<>>) #-}

(<<>) :: Measured a => Measure a -> MTree a -> Measure a
Measure a
x <<> :: forall a. Measured a => Measure a -> MTree a -> Measure a
<<> MBin Int
_ Measure a
v a
_ MTree a
_ MTree a
_ = Measure a
x Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v
Measure a
x <<> MTree a
MTip           = Measure a
x
{-# INLINE (<<>) #-}

-- O(1). Link two trees with a value in between. Precondition: The trees are
-- balanced wrt each other.
bin :: Measured a => a -> MTree a -> MTree a -> MTree a
bin :: forall a. Measured a => a -> MTree a -> MTree a -> MTree a
bin a
x MTree a
l MTree a
r = Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (MTree a -> Int
forall a. MTree a -> Int
size MTree a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
size MTree a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (MTree a
l MTree a -> Measure a -> Measure a
forall a. Measured a => MTree a -> Measure a -> Measure a
<>> a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x Measure a -> MTree a -> Measure a
forall a. Measured a => Measure a -> MTree a -> Measure a
<<> MTree a
r) a
x MTree a
l MTree a
r
{-# INLINE bin #-}

-- O(1). Link two trees with a value in between and a known total size.
-- Precondition: The trees are balanced wrt each other.
binn :: Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn :: forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
n a
x MTree a
l MTree a
r = Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
n (MTree a
l MTree a -> Measure a -> Measure a
forall a. Measured a => MTree a -> Measure a -> Measure a
<>> a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x Measure a -> MTree a -> Measure a
forall a. Measured a => Measure a -> MTree a -> Measure a
<<> MTree a
r) a
x MTree a
l MTree a
r
{-# INLINE binn #-}

----------
-- Folds
----------

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

foldl' :: (b -> a -> b) -> b -> MTree a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> MTree a -> b
foldl' b -> a -> b
f !b
z0 = \case
  MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r -> b -> a -> MTree a -> MTree a -> b
go b
z0 a
x MTree a
l MTree a
r
  MTree a
MTip -> b
z0
  where
    go :: b -> a -> MTree a -> MTree a -> b
go !b
z !a
x MTree a
l MTree a
r = case MTree a
l of
      MBin Int
_ Measure a
_ a
lx MTree a
ll MTree a
lr -> case MTree a
r of
        MBin Int
_ Measure a
_ a
rx MTree a
rl MTree a
rr ->
          let !z' :: b
z' = b -> a -> MTree a -> MTree a -> b
go b
z a
lx MTree a
ll MTree a
lr
          in b -> a -> MTree a -> MTree a -> b
go (b -> a -> b
f b
z' a
x) a
rx MTree a
rl MTree a
rr
        MTree a
MTip ->
          let !z' :: b
z' = b -> a -> MTree a -> MTree a -> b
go b
z a
lx MTree a
ll MTree a
lr
          in b -> a -> b
f b
z' a
x
      MTree a
MTip -> case MTree a
r of
        MBin Int
_ Measure a
_ a
rx MTree a
rl MTree a
rr -> b -> a -> MTree a -> MTree a -> b
go (b -> a -> b
f b
z a
x) a
rx MTree a
rl MTree a
rr
        MTree a
MTip -> b -> a -> b
f b
z a
x
{-# INLINE foldl' #-}

ifoldl' :: (Int -> b -> a -> b) -> b -> Int -> MTree a -> b
ifoldl' :: forall b a. (Int -> b -> a -> b) -> b -> Int -> MTree a -> b
ifoldl' Int -> b -> a -> b
f !b
z0 !Int
i0 = \case
  MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r -> b -> Int -> a -> MTree a -> MTree a -> b
go b
z0 Int
i0 a
x MTree a
l MTree a
r
  MTree a
MTip -> b
z0
  where
    go :: b -> Int -> a -> MTree a -> MTree a -> b
go !b
z !Int
i !a
x MTree a
l MTree a
r = case MTree a
l of
      MBin Int
lsz Measure a
_ a
lx MTree a
ll MTree a
lr -> case MTree a
r of
        MBin Int
_ Measure a
_ a
rx MTree a
rl MTree a
rr ->
          let !z' :: b
z' = b -> Int -> a -> MTree a -> MTree a -> b
go b
z Int
i a
lx MTree a
ll MTree a
lr
          in b -> Int -> a -> MTree a -> MTree a -> b
go (Int -> b -> a -> b
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsz) b
z' a
x) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lszInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
rx MTree a
rl MTree a
rr
        MTree a
MTip ->
          let !z' :: b
z' = b -> Int -> a -> MTree a -> MTree a -> b
go b
z Int
i a
lx MTree a
ll MTree a
lr
          in Int -> b -> a -> b
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsz) b
z' a
x
      MTree a
MTip -> case MTree a
r of
        MBin Int
_ Measure a
_ a
rx MTree a
rl MTree a
rr -> b -> Int -> a -> MTree a -> MTree a -> b
go (Int -> b -> a -> b
f Int
i b
z a
x) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
rx MTree a
rl MTree a
rr
        MTree a
MTip -> Int -> b -> a -> b
f Int
i b
z a
x
{-# INLINE ifoldl' #-}

foldr' :: (a -> b -> b) -> b -> MTree a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MTree a -> b
foldr' a -> b -> b
f !b
z0 = \case
  MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r -> b -> a -> MTree a -> MTree a -> b
go b
z0 a
x MTree a
l MTree a
r
  MTree a
MTip -> b
z0
  where
    go :: b -> a -> MTree a -> MTree a -> b
go !b
z !a
x MTree a
l MTree a
r = case MTree a
l of
      MBin Int
_ Measure a
_ a
lx MTree a
ll MTree a
lr -> case MTree a
r of
        MBin Int
_ Measure a
_ a
rx MTree a
rl MTree a
rr ->
          let !z' :: b
z' = b -> a -> MTree a -> MTree a -> b
go b
z a
rx MTree a
rl MTree a
rr
          in b -> a -> MTree a -> MTree a -> b
go (a -> b -> b
f a
x b
z') a
lx MTree a
ll MTree a
lr
        MTree a
MTip -> b -> a -> MTree a -> MTree a -> b
go (a -> b -> b
f a
x b
z) a
lx MTree a
ll MTree a
lr
      MTree a
MTip -> case MTree a
r of
        MBin Int
_ Measure a
_ a
rx MTree a
rl MTree a
rr -> a -> b -> b
f a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b -> a -> MTree a -> MTree a -> b
go b
z a
rx MTree a
rl MTree a
rr
        MTree a
MTip -> a -> b -> b
f a
x b
z
{-# INLINE foldr' #-}

ifoldr' :: (Int -> a -> b -> b) -> b -> Int -> MTree a -> b
ifoldr' :: forall a b. (Int -> a -> b -> b) -> b -> Int -> MTree a -> b
ifoldr' Int -> a -> b -> b
f !b
z0 !Int
i0 = \case
  MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r -> b -> Int -> a -> MTree a -> MTree a -> b
go b
z0 Int
i0 a
x MTree a
l MTree a
r
  MTree a
MTip -> b
z0
  where
    go :: b -> Int -> a -> MTree a -> MTree a -> b
go !b
z !Int
i !a
x MTree a
l MTree a
r = case MTree a
l of
      MBin Int
_ Measure a
_ a
lx MTree a
ll MTree a
lr -> case MTree a
r of
        MBin Int
rsz Measure a
_ a
rx MTree a
rl MTree a
rr ->
          let !z' :: b
z' = b -> Int -> a -> MTree a -> MTree a -> b
go b
z Int
i a
rx MTree a
rl MTree a
rr
          in b -> Int -> a -> MTree a -> MTree a -> b
go (Int -> a -> b -> b
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
rsz) a
x b
z') (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
rszInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
lx MTree a
ll MTree a
lr
        MTree a
MTip -> b -> Int -> a -> MTree a -> MTree a -> b
go (Int -> a -> b -> b
f Int
i a
x b
z) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
lx MTree a
ll MTree a
lr
      MTree a
MTip -> case MTree a
r of
        MBin Int
rsz Measure a
_ a
rx MTree a
rl MTree a
rr -> Int -> a -> b -> b
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
rsz) a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b -> Int -> a -> MTree a -> MTree a -> b
go b
z Int
i a
rx MTree a
rl MTree a
rr
        MTree a
MTip -> Int -> a -> b -> b
f Int
i a
x b
z
{-# INLINE ifoldr' #-}

fold
  :: b
  -> (Int -> a -> b -> b -> b)
  -> (Int -> a -> b -> b)
  -> (Int -> a -> b -> b)
  -> (a -> b)
  -> MTree a
  -> b
fold :: forall b a.
b
-> (Int -> a -> b -> b -> b)
-> (Int -> a -> b -> b)
-> (Int -> a -> b -> b)
-> (a -> b)
-> MTree a
-> b
fold b
tip Int -> a -> b -> b -> b
glr Int -> a -> b -> b
gl Int -> a -> b -> b
gr a -> b
g = \case
  MBin Int
sz Measure a
_ a
x MTree a
l MTree a
r -> Int -> a -> MTree a -> MTree a -> b
go Int
sz a
x MTree a
l MTree a
r
  MTree a
MTip -> b
tip
  where
    go :: Int -> a -> MTree a -> MTree a -> b
go !Int
sz !a
x MTree a
l MTree a
r = case MTree a
l of
      MBin Int
lsz Measure a
_ a
lx MTree a
ll MTree a
lr -> case MTree a
r of
        MBin Int
rsz Measure a
_ a
rx MTree a
rl MTree a
rr -> Int -> a -> b -> b -> b
glr Int
sz a
x (Int -> a -> MTree a -> MTree a -> b
go Int
lsz a
lx MTree a
ll MTree a
lr) (Int -> a -> MTree a -> MTree a -> b
go Int
rsz a
rx MTree a
rl MTree a
rr)
        MTree a
MTip -> Int -> a -> b -> b
gl Int
sz a
x (Int -> a -> MTree a -> MTree a -> b
go Int
lsz a
lx MTree a
ll MTree a
lr)
      MTree a
MTip -> case MTree a
r of
        MBin Int
rsz Measure a
_ a
rx MTree a
rl MTree a
rr -> Int -> a -> b -> b
gr Int
sz a
x (Int -> a -> MTree a -> MTree a -> b
go Int
rsz a
rx MTree a
rl MTree a
rr)
        MTree a
MTip -> a -> b
g a
x
{-# INLINE fold #-}

foldSimple :: b -> (Int -> a -> b -> b -> b) -> MTree a -> b
foldSimple :: forall b a. b -> (Int -> a -> b -> b -> b) -> MTree a -> b
foldSimple b
tip Int -> a -> b -> b -> b
f = b
-> (Int -> a -> b -> b -> b)
-> (Int -> a -> b -> b)
-> (Int -> a -> b -> b)
-> (a -> b)
-> MTree a
-> b
forall b a.
b
-> (Int -> a -> b -> b -> b)
-> (Int -> a -> b -> b)
-> (Int -> a -> b -> b)
-> (a -> b)
-> MTree a
-> b
fold b
tip Int -> a -> b -> b -> b
f Int -> a -> b -> b
gl Int -> a -> b -> b
gr a -> b
g
  where
    gl :: Int -> a -> b -> b
gl !Int
sz a
x b
ml = Int -> a -> b -> b -> b
f Int
sz a
x b
ml b
tip
    {-# INLINE gl #-}
    gr :: Int -> a -> b -> b
gr !Int
sz a
x b
mr = Int -> a -> b -> b -> b
f Int
sz a
x b
tip b
mr
    {-# INLINE gr #-}
    g :: a -> b
g a
x = Int -> a -> b -> b -> b
f Int
1 a
x b
tip b
tip
    {-# INLINE g #-}
{-# INLINE foldSimple #-}

foldMap :: forall a m. Monoid m => (a -> m) -> MTree a -> m
foldMap :: forall a m. Monoid m => (a -> m) -> MTree a -> m
foldMap a -> m
f = (m
 -> (Int -> a -> m -> m -> m)
 -> (Int -> a -> m -> m)
 -> (Int -> a -> m -> m)
 -> (a -> m)
 -> MTree a
 -> m)
-> m
-> (Int -> a -> m -> m -> m)
-> (Int -> a -> m -> m)
-> (Int -> a -> m -> m)
-> (a -> m)
-> MTree a
-> m
forall a b. Coercible a b => a -> b
coerce (forall b a.
b
-> (Int -> a -> b -> b -> b)
-> (Int -> a -> b -> b)
-> (Int -> a -> b -> b)
-> (a -> b)
-> MTree a
-> b
fold @m @a) (forall a. Monoid a => a
mempty @m) Int -> a -> m -> m -> m
glr Int -> a -> m -> m
gl Int -> a -> m -> m
gr a -> m
f
  where
    glr :: Int -> a -> m -> m -> m
glr (Int
_ :: Int) a
x m
l m
r = m
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
r
    {-# INLINE glr #-}
    gl :: Int -> a -> m -> m
gl (Int
_ :: Int) a
x m
l = m
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
x
    {-# INLINE gl #-}
    gr :: Int -> a -> m -> m
gr (Int
_ :: Int) a
x m
r = a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
r
    {-# INLINE gr #-}
{-# INLINE foldMap #-}

traverse :: (Measured b, Applicative f) => (a -> f b) -> MTree a -> f (MTree b)
traverse :: forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(a -> f b) -> MTree a -> f (MTree b)
traverse a -> f b
f = f (MTree b)
-> (Int -> a -> f (MTree b) -> f (MTree b) -> f (MTree b))
-> (Int -> a -> f (MTree b) -> f (MTree b))
-> (Int -> a -> f (MTree b) -> f (MTree b))
-> (a -> f (MTree b))
-> MTree a
-> f (MTree b)
forall b a.
b
-> (Int -> a -> b -> b -> b)
-> (Int -> a -> b -> b)
-> (Int -> a -> b -> b)
-> (a -> b)
-> MTree a
-> b
fold (MTree b -> f (MTree b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MTree b
forall a. MTree a
MTip) Int -> a -> f (MTree b) -> f (MTree b) -> f (MTree b)
glr Int -> a -> f (MTree b) -> f (MTree b)
gl Int -> a -> f (MTree b) -> f (MTree b)
gr a -> f (MTree b)
g
  where
    glr :: Int -> a -> f (MTree b) -> f (MTree b) -> f (MTree b)
glr !Int
sz a
x f (MTree b)
ml f (MTree b)
mr = (MTree b -> b -> MTree b -> MTree b)
-> f (MTree b) -> f b -> f (MTree b) -> f (MTree b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Ap.liftA3 ((b -> MTree b -> MTree b -> MTree b)
-> MTree b -> b -> MTree b -> MTree b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> b -> MTree b -> MTree b -> MTree b
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz)) f (MTree b)
ml (a -> f b
f a
x) f (MTree b)
mr
    {-# INLINE glr #-}
    gl :: Int -> a -> f (MTree b) -> f (MTree b)
gl !Int
sz a
x f (MTree b)
ml = (MTree b -> b -> MTree b) -> f (MTree b) -> f b -> f (MTree b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 (\MTree b
l' b
x' -> Int -> b -> MTree b -> MTree b -> MTree b
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz b
x' MTree b
l' MTree b
forall a. MTree a
MTip) f (MTree b)
ml (a -> f b
f a
x)
    {-# INLINE gl #-}
    gr :: Int -> a -> f (MTree b) -> f (MTree b)
gr !Int
sz a
x f (MTree b)
mr = (b -> MTree b -> MTree b) -> f b -> f (MTree b) -> f (MTree 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
x' MTree b
r' -> Int -> b -> MTree b -> MTree b -> MTree b
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz b
x' MTree b
forall a. MTree a
MTip MTree b
r') (a -> f b
f a
x) f (MTree b)
mr
    {-# INLINE gr #-}
    g :: a -> f (MTree b)
g a
x = (b -> MTree b) -> f b -> f (MTree b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> MTree b
forall a. Measured a => a -> MTree a
singleton (a -> f b
f a
x)
    {-# INLINE g #-}
{-# INLINE traverse #-}

ifoldMap :: Monoid m => (Int -> a -> m) -> Int -> MTree a -> m
ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> Int -> MTree a -> m
ifoldMap Int -> a -> m
f !Int
i0 = \case
  MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r -> Int -> a -> MTree a -> MTree a -> m
go Int
i0 a
x MTree a
l MTree a
r
  MTree a
MTip -> m
forall a. Monoid a => a
mempty
  where
    go :: Int -> a -> MTree a -> MTree a -> m
go !Int
i a
x MTree a
l MTree a
r = case MTree a
l of
      MBin Int
lsz Measure a
_ a
lx MTree a
ll MTree a
lr -> case MTree a
r of
        MBin Int
_ Measure a
_ a
rx MTree a
rl MTree a
rr ->
          Int -> a -> MTree a -> MTree a -> m
go Int
i a
lx MTree a
ll MTree a
lr m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Int -> a -> m
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsz) a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Int -> a -> MTree a -> MTree a -> m
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lszInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
rx MTree a
rl MTree a
rr
        MTree a
MTip -> Int -> a -> MTree a -> MTree a -> m
go Int
i a
lx MTree a
ll MTree a
lr m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Int -> a -> m
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsz) a
x
      MTree a
MTip -> case MTree a
r of
        MBin Int
_ Measure a
_ a
rx MTree a
rl MTree a
rr -> Int -> a -> m
f Int
i a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Int -> a -> MTree a -> MTree a -> m
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
rx MTree a
rl MTree a
rr
        MTree a
MTip -> Int -> a -> m
f Int
i a
x
{-# INLINE ifoldMap #-}

itraverse
  :: (Measured b, Applicative f)
  => (Int -> a -> f b) -> Int -> MTree a -> f (MTree b)
itraverse :: forall b (f :: * -> *) a.
(Measured b, Applicative f) =>
(Int -> a -> f b) -> Int -> MTree a -> f (MTree b)
itraverse Int -> a -> f b
f !Int
i0 = \case
  MBin Int
sz Measure a
_ a
x MTree a
l MTree a
r -> Int -> Int -> a -> MTree a -> MTree a -> f (MTree b)
go Int
i0 Int
sz a
x MTree a
l MTree a
r
  MTree a
MTip -> MTree b -> f (MTree b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MTree b
forall a. MTree a
MTip
  where
    go :: Int -> Int -> a -> MTree a -> MTree a -> f (MTree b)
go !Int
i !Int
sz a
x MTree a
l MTree a
r = case MTree a
l of
      MBin Int
lsz Measure a
_ a
lx MTree a
ll MTree a
lr -> case MTree a
r of
        MBin Int
rsz Measure a
_ a
rx MTree a
rl MTree a
rr ->
          (MTree b -> b -> MTree b -> MTree b)
-> f (MTree b) -> f b -> f (MTree b) -> f (MTree b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Ap.liftA3
            ((b -> MTree b -> MTree b -> MTree b)
-> MTree b -> b -> MTree b -> MTree b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> b -> MTree b -> MTree b -> MTree b
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz))
            (Int -> Int -> a -> MTree a -> MTree a -> f (MTree b)
go Int
i Int
lsz a
lx MTree a
ll MTree a
lr)
            (Int -> a -> f b
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsz) a
x)
            (Int -> Int -> a -> MTree a -> MTree a -> f (MTree b)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lszInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
rsz a
rx MTree a
rl MTree a
rr)
        MTree a
MTip ->
          (MTree b -> b -> MTree b) -> f (MTree b) -> f b -> f (MTree b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2
            (\MTree b
l' b
x' -> Int -> b -> MTree b -> MTree b -> MTree b
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz b
x' MTree b
l' MTree b
forall a. MTree a
MTip)
            (Int -> Int -> a -> MTree a -> MTree a -> f (MTree b)
go Int
i Int
lsz a
lx MTree a
ll MTree a
lr)
            (Int -> a -> f b
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsz) a
x)
      MTree a
MTip -> case MTree a
r of
        MBin Int
rsz Measure a
_ a
rx MTree a
rl MTree a
rr ->
          (b -> MTree b -> MTree b) -> f b -> f (MTree b) -> f (MTree 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
x' MTree b
r' -> Int -> b -> MTree b -> MTree b -> MTree b
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz b
x' MTree b
forall a. MTree a
MTip MTree b
r')
            (Int -> a -> f b
f Int
i a
x)
            (Int -> Int -> a -> MTree a -> MTree a -> f (MTree b)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
rsz a
rx MTree a
rl MTree a
rr)
        MTree a
MTip ->
          (b -> MTree b) -> f b -> f (MTree b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> MTree b
forall a. Measured a => a -> MTree a
singleton (Int -> a -> f b
f Int
i a
x)
{-# INLINE itraverse #-}

-----------------
-- Construction
-----------------

generateA
  :: (Measured a, Applicative f)
  => (Int -> f a) -> Int -> Int -> f (MTree a)
generateA :: forall a (f :: * -> *).
(Measured a, Applicative f) =>
(Int -> f a) -> Int -> Int -> f (MTree a)
generateA Int -> f a
f = Int -> Int -> f (MTree a)
go
  where
    go :: Int -> Int -> f (MTree a)
go !Int
i Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = MTree a -> f (MTree a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MTree a
forall a. MTree a
MTip
      | Bool
otherwise =
          (MTree a -> a -> MTree a -> MTree a)
-> f (MTree a) -> f a -> f (MTree a) -> f (MTree a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Ap.liftA3
            ((a -> MTree a -> MTree a -> MTree a)
-> MTree a -> a -> MTree a -> MTree a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
n))
            (Int -> Int -> f (MTree a)
go Int
i Int
lsz)
            (Int -> f a
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsz))
            (Int -> Int -> f (MTree a)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lszInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lszInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
      where
        lsz :: Int
lsz = (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
{-# INLINE generateA #-}

-------------
-- Indexing
-------------

-- Precondition: 0 <= i < size xs
index :: Int -> MTree a -> a
index :: forall a. Int -> MTree a -> a
index !Int
i = \case
  MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r -> case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
szl of
    Ordering
LT -> Int -> MTree a -> a
forall a. Int -> MTree a -> a
index Int
i MTree a
l
    Ordering
EQ -> a
x
    Ordering
GT -> Int -> MTree a -> a
forall a. Int -> MTree a -> a
index (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
szlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
r
    where
      szl :: Int
szl = MTree a -> Int
forall a. MTree a -> Int
size MTree a
l
  MTree a
MTip -> String -> a
forall a. String -> a
errorOutOfBounds String
"MTree.index"

-- Precondition: 0 <= i < size xs
adjustF
  :: (Measured a, Functor f)
  => (a -> f a) -> Int -> MTree a -> f (MTree a)
adjustF :: forall a (f :: * -> *).
(Measured a, Functor f) =>
(a -> f a) -> Int -> MTree a -> f (MTree a)
adjustF a -> f a
f = Int -> MTree a -> f (MTree a)
go
  where
    go :: Int -> MTree a -> f (MTree a)
go !Int
i = \case
      MBin Int
sz Measure a
_ a
x MTree a
l MTree a
r -> case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
szl of
        Ordering
LT -> (MTree a -> MTree a) -> f (MTree a) -> f (MTree a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\MTree a
l' -> Int -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz a
x MTree a
l' MTree a
r) (Int -> MTree a -> f (MTree a)
go Int
i MTree a
l)
        Ordering
EQ -> (a -> MTree a) -> f a -> f (MTree a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x' -> Int -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz a
x' MTree a
l MTree a
r) (a -> f a
f a
x)
        Ordering
GT -> (MTree a -> MTree a) -> f (MTree a) -> f (MTree a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz a
x MTree a
l) (Int -> MTree a -> f (MTree a)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
szlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
r)
        where
          szl :: Int
szl = MTree a -> Int
forall a. MTree a -> Int
size MTree a
l
      MTree a
MTip -> String -> f (MTree a)
forall a. String -> a
errorOutOfBounds String
"MTree.adjustF"
{-# INLINE adjustF #-}

-- Inserts at ends if not in bounds
insertAt :: Measured a => Int -> a -> MTree a -> MTree a
insertAt :: forall a. Measured a => Int -> a -> MTree a -> MTree a
insertAt !Int
i a
x (MBin Int
_ Measure a
_ a
y MTree a
l MTree a
r)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
szl = a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceL a
y (Int -> a -> MTree a -> MTree a
forall a. Measured a => Int -> a -> MTree a -> MTree a
insertAt Int
i a
x MTree a
l) MTree a
r
  | Bool
otherwise = a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceR a
y MTree a
l (Int -> a -> MTree a -> MTree a
forall a. Measured a => Int -> a -> MTree a -> MTree a
insertAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
szlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
x MTree a
r)
  where
    szl :: Int
szl = MTree a -> Int
forall a. MTree a -> Int
size MTree a
l
insertAt Int
_ a
x MTree a
MTip = a -> MTree a
forall a. Measured a => a -> MTree a
singleton a
x
{-# INLINABLE insertAt #-}

-- Precondition: 0 <= i < size xs
deleteAt :: Measured a => Int -> MTree a -> MTree a
deleteAt :: forall a. Measured a => Int -> MTree a -> MTree a
deleteAt !Int
i (MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r) = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
szl of
  Ordering
LT -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceR a
x (Int -> MTree a -> MTree a
forall a. Measured a => Int -> MTree a -> MTree a
deleteAt Int
i MTree a
l) MTree a
r
  Ordering
EQ -> MTree a -> MTree a -> MTree a
forall a. Measured a => MTree a -> MTree a -> MTree a
glue MTree a
l MTree a
r
  Ordering
GT -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceL a
x MTree a
l (Int -> MTree a -> MTree a
forall a. Measured a => Int -> MTree a -> MTree a
deleteAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
szlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
r)
  where
    szl :: Int
szl = MTree a -> Int
forall a. MTree a -> Int
size MTree a
l
deleteAt Int
_ MTree a
MTip = String -> MTree a
forall a. String -> a
errorOutOfBounds String
"MTree.deleteAt"
{-# INLINABLE deleteAt #-}

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

cons :: Measured a => a -> MTree a -> MTree a
cons :: forall a. Measured a => a -> MTree a -> MTree a
cons a
x MTree a
MTip = a -> MTree a
forall a. Measured a => a -> MTree a
singleton a
x
cons a
x (MBin Int
_ Measure a
_ a
y MTree a
l MTree a
r) = a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceL a
y (a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a
cons a
x MTree a
l) MTree a
r
{-# INLINABLE cons #-}

snoc :: Measured a => MTree a -> a -> MTree a
snoc :: forall a. Measured a => MTree a -> a -> MTree a
snoc MTree a
MTip a
x = a -> MTree a
forall a. Measured a => a -> MTree a
singleton a
x
snoc (MBin Int
_ Measure a
_ a
y MTree a
l MTree a
r) a
x = a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceR a
y MTree a
l (MTree a -> a -> MTree a
forall a. Measured a => MTree a -> a -> MTree a
snoc MTree a
r a
x)
{-# INLINABLE snoc #-}

uncons :: Measured a => MTree a -> U.SMaybe (U.S2 a (MTree a))
uncons :: forall a. Measured a => MTree a -> SMaybe (S2 a (MTree a))
uncons (MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r) = S2 a (MTree a) -> SMaybe (S2 a (MTree a))
forall a. a -> SMaybe a
U.SJust (a -> MTree a -> MTree a -> S2 a (MTree a)
forall a. Measured a => a -> MTree a -> MTree a -> S2 a (MTree a)
unconsSure a
x MTree a
l MTree a
r)
uncons MTree a
MTip = SMaybe (S2 a (MTree a))
forall a. SMaybe a
U.SNothing
{-# INLINE uncons #-}

unconsSure :: Measured a => a -> MTree a -> MTree a -> U.S2 a (MTree a)
unconsSure :: forall a. Measured a => a -> MTree a -> MTree a -> S2 a (MTree a)
unconsSure a
x (MBin Int
_ Measure a
_ a
lx MTree a
ll MTree a
lr) MTree a
r = case a -> MTree a -> MTree a -> S2 a (MTree a)
forall a. Measured a => a -> MTree a -> MTree a -> S2 a (MTree a)
unconsSure a
lx MTree a
ll MTree a
lr of
  U.S2 a
y MTree a
l' -> a -> MTree a -> S2 a (MTree a)
forall a b. a -> b -> S2 a b
U.S2 a
y (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceR a
x MTree a
l' MTree a
r)
unconsSure a
x MTree a
MTip MTree a
r = a -> MTree a -> S2 a (MTree a)
forall a b. a -> b -> S2 a b
U.S2 a
x MTree a
r
{-# INLINABLE unconsSure #-}

unsnoc :: Measured a => MTree a -> U.SMaybe (U.S2 (MTree a) a)
unsnoc :: forall a. Measured a => MTree a -> SMaybe (S2 (MTree a) a)
unsnoc (MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r) = S2 (MTree a) a -> SMaybe (S2 (MTree a) a)
forall a. a -> SMaybe a
U.SJust (S2 (MTree a) a -> SMaybe (S2 (MTree a) a))
-> S2 (MTree a) a -> SMaybe (S2 (MTree a) a)
forall a b. (a -> b) -> a -> b
$ a -> MTree a -> MTree a -> S2 (MTree a) a
forall a. Measured a => a -> MTree a -> MTree a -> S2 (MTree a) a
unsnocSure a
x MTree a
l MTree a
r
unsnoc MTree a
MTip = SMaybe (S2 (MTree a) a)
forall a. SMaybe a
U.SNothing
{-# INLINE unsnoc #-}

unsnocSure :: Measured a => a -> MTree a -> MTree a -> U.S2 (MTree a) a
unsnocSure :: forall a. Measured a => a -> MTree a -> MTree a -> S2 (MTree a) a
unsnocSure a
x MTree a
l (MBin Int
_ Measure a
_ a
rx MTree a
rl MTree a
rr) = case a -> MTree a -> MTree a -> S2 (MTree a) a
forall a. Measured a => a -> MTree a -> MTree a -> S2 (MTree a) a
unsnocSure a
rx MTree a
rl MTree a
rr of
  U.S2 MTree a
r' a
y -> MTree a -> a -> S2 (MTree a) a
forall a b. a -> b -> S2 a b
U.S2 (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceL a
x MTree a
l MTree a
r') a
y
unsnocSure a
x MTree a
l MTree a
MTip = MTree a -> a -> S2 (MTree a) a
forall a b. a -> b -> S2 a b
U.S2 MTree a
l a
x
{-# INLINABLE unsnocSure #-}

-- Precondition: 0 <= i < size xs
splitAtF
  :: (Measured a, U.Biapplicative f)
  => Int -> MTree a -> f (MTree a) (U.S2 a (MTree a))
splitAtF :: forall a (f :: * -> * -> *).
(Measured a, Biapplicative f) =>
Int -> MTree a -> f (MTree a) (S2 a (MTree a))
splitAtF = Int -> MTree a -> f (MTree a) (S2 a (MTree a))
forall {p :: * -> * -> *} {a}.
(Measured a, Biapplicative p) =>
Int -> MTree a -> p (MTree a) (S2 a (MTree a))
go
  where
    go :: Int -> MTree a -> p (MTree a) (S2 a (MTree a))
go !Int
i (MBin Int
_ Measure a
_ a
x MTree a
l MTree a
r) = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
szl of
      Ordering
LT -> (S2 a (MTree a) -> S2 a (MTree a))
-> p (MTree a) (S2 a (MTree a)) -> p (MTree a) (S2 a (MTree a))
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((MTree a -> MTree a) -> S2 a (MTree a) -> S2 a (MTree a)
forall b c a. (b -> c) -> S2 a b -> S2 a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (\MTree a
lr -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
link a
x MTree a
lr MTree a
r)) (Int -> MTree a -> p (MTree a) (S2 a (MTree a))
go Int
i MTree a
l)
      Ordering
EQ -> MTree a -> S2 a (MTree a) -> p (MTree a) (S2 a (MTree a))
forall a b. a -> b -> p a b
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
U.bipure MTree a
l (a -> MTree a -> S2 a (MTree a)
forall a b. a -> b -> S2 a b
U.S2 a
x MTree a
r)
      Ordering
GT -> (MTree a -> MTree a)
-> p (MTree a) (S2 a (MTree a)) -> p (MTree a) (S2 a (MTree a))
forall a b c. (a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
link a
x MTree a
l) (Int -> MTree a -> p (MTree a) (S2 a (MTree a))
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
szlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MTree a
r)
      where
        szl :: Int
szl = MTree a -> Int
forall a. MTree a -> Int
size MTree a
l
    go Int
_ MTree a
MTip = String -> p (MTree a) (S2 a (MTree a))
forall a. String -> a
errorOutOfBounds String
"MTree.splitAtF"
{-# INLINE splitAtF #-}

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

mapMaybeA
  :: (Applicative f, Measured b)
  => (a -> f (Maybe b)) -> MTree a -> f (MTree b)
mapMaybeA :: forall (f :: * -> *) b a.
(Applicative f, Measured b) =>
(a -> f (Maybe b)) -> MTree a -> f (MTree b)
mapMaybeA a -> f (Maybe b)
f = f (MTree b)
-> (Int -> a -> f (MTree b) -> f (MTree b) -> f (MTree b))
-> MTree a
-> f (MTree b)
forall b a. b -> (Int -> a -> b -> b -> b) -> MTree a -> b
foldSimple f (MTree b)
forall {a}. f (MTree a)
tip Int -> a -> f (MTree b) -> f (MTree b) -> f (MTree b)
g
  where
    tip :: f (MTree a)
tip = MTree a -> f (MTree a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MTree a
forall a. MTree a
MTip
    {-# INLINE tip #-}
    g :: Int -> a -> f (MTree b) -> f (MTree b) -> f (MTree b)
g Int
_ a
x f (MTree b)
ml f (MTree b)
mr = (\MTree b -> Maybe b -> MTree b -> MTree b
h -> (MTree b -> Maybe b -> MTree b -> MTree b)
-> f (MTree b) -> f (Maybe b) -> f (MTree b) -> f (MTree b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Ap.liftA3 MTree b -> Maybe b -> MTree b -> MTree b
h f (MTree b)
ml (a -> f (Maybe b)
f a
x) f (MTree b)
mr) ((MTree b -> Maybe b -> MTree b -> MTree b) -> f (MTree b))
-> (MTree b -> Maybe b -> MTree b -> MTree b) -> f (MTree b)
forall a b. (a -> b) -> a -> b
$ \MTree b
l Maybe b
my MTree b
r ->
      case Maybe b
my of
        Maybe b
Nothing -> MTree b -> MTree b -> MTree b
forall a. Measured a => MTree a -> MTree a -> MTree a
merge MTree b
l MTree b
r
        Just b
y -> b -> MTree b -> MTree b -> MTree b
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
link b
y MTree b
l MTree b
r
    {-# INLINE g #-}
{-# INLINE mapMaybeA #-}

mapEitherA
  :: (Applicative f, Measured b, Measured c)
  => (a -> f (Either b c)) -> MTree a -> f (U.S2 (MTree b) (MTree c))
mapEitherA :: forall (f :: * -> *) b c a.
(Applicative f, Measured b, Measured c) =>
(a -> f (Either b c)) -> MTree a -> f (S2 (MTree b) (MTree c))
mapEitherA a -> f (Either b c)
f = f (S2 (MTree b) (MTree c))
-> (Int
    -> a
    -> f (S2 (MTree b) (MTree c))
    -> f (S2 (MTree b) (MTree c))
    -> f (S2 (MTree b) (MTree c)))
-> MTree a
-> f (S2 (MTree b) (MTree c))
forall b a. b -> (Int -> a -> b -> b -> b) -> MTree a -> b
foldSimple f (S2 (MTree b) (MTree c))
forall {a} {a}. f (S2 (MTree a) (MTree a))
tip Int
-> a
-> f (S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
g
  where
    tip :: f (S2 (MTree a) (MTree a))
tip = S2 (MTree a) (MTree a) -> f (S2 (MTree a) (MTree a))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MTree a -> MTree a -> S2 (MTree a) (MTree a)
forall a b. a -> b -> S2 a b
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
U.bipure MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip)
    {-# INLINE tip #-}
    g :: Int
-> a
-> f (S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
g Int
_ a
x f (S2 (MTree b) (MTree c))
ml f (S2 (MTree b) (MTree c))
mr = (\S2 (MTree b) (MTree c)
-> Either b c -> S2 (MTree b) (MTree c) -> S2 (MTree b) (MTree c)
h -> (S2 (MTree b) (MTree c)
 -> Either b c -> S2 (MTree b) (MTree c) -> S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
-> f (Either b c)
-> f (S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Ap.liftA3 S2 (MTree b) (MTree c)
-> Either b c -> S2 (MTree b) (MTree c) -> S2 (MTree b) (MTree c)
h f (S2 (MTree b) (MTree c))
ml (a -> f (Either b c)
f a
x) f (S2 (MTree b) (MTree c))
mr) ((S2 (MTree b) (MTree c)
  -> Either b c -> S2 (MTree b) (MTree c) -> S2 (MTree b) (MTree c))
 -> f (S2 (MTree b) (MTree c)))
-> (S2 (MTree b) (MTree c)
    -> Either b c -> S2 (MTree b) (MTree c) -> S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
forall a b. (a -> b) -> a -> b
$ \S2 (MTree b) (MTree c)
l Either b c
my S2 (MTree b) (MTree c)
r ->
      case Either b c
my of
        Left b
y -> (MTree b -> MTree b -> MTree b)
-> (MTree c -> MTree c -> MTree c)
-> S2 (MTree b) (MTree c)
-> S2 (MTree b) (MTree c)
-> S2 (MTree b) (MTree c)
forall a b c d e f.
(a -> b -> c) -> (d -> e -> f) -> S2 a d -> S2 b e -> S2 c f
forall (p :: * -> * -> *) a b c d e f.
Biapplicative p =>
(a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
U.biliftA2 (b -> MTree b -> MTree b -> MTree b
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
link b
y) MTree c -> MTree c -> MTree c
forall a. Measured a => MTree a -> MTree a -> MTree a
merge S2 (MTree b) (MTree c)
l S2 (MTree b) (MTree c)
r
        Right c
y -> (MTree b -> MTree b -> MTree b)
-> (MTree c -> MTree c -> MTree c)
-> S2 (MTree b) (MTree c)
-> S2 (MTree b) (MTree c)
-> S2 (MTree b) (MTree c)
forall a b c d e f.
(a -> b -> c) -> (d -> e -> f) -> S2 a d -> S2 b e -> S2 c f
forall (p :: * -> * -> *) a b c d e f.
Biapplicative p =>
(a -> b -> c) -> (d -> e -> f) -> p a d -> p b e -> p c f
U.biliftA2 MTree b -> MTree b -> MTree b
forall a. Measured a => MTree a -> MTree a -> MTree a
merge (c -> MTree c -> MTree c -> MTree c
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
link c
y) S2 (MTree b) (MTree c)
l S2 (MTree b) (MTree c)
r
    {-# INLINE g #-}
{-# INLINE mapEitherA #-}

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

zipWithStreamM
  :: (Measured c, Monad m)
  => (a -> b -> m c) -> MTree a -> Stream b -> m (MTree c)
zipWithStreamM :: forall c (m :: * -> *) a b.
(Measured c, Monad m) =>
(a -> b -> m c) -> MTree a -> Stream b -> m (MTree c)
zipWithStreamM a -> b -> m c
f MTree a
t (Stream s -> Step s b
step s
s) = SStateT s m (MTree c) -> s -> m (MTree c)
forall (m :: * -> *) s a. Functor m => SStateT s m a -> s -> m a
U.evalSStateT (SStateT s m (MTree c)
-> (Int
    -> a
    -> SStateT s m (MTree c)
    -> SStateT s m (MTree c)
    -> SStateT s m (MTree c))
-> MTree a
-> SStateT s m (MTree c)
forall b a. b -> (Int -> a -> b -> b -> b) -> MTree a -> b
foldSimple SStateT s m (MTree c)
forall {a}. SStateT s m (MTree a)
tip Int
-> a
-> SStateT s m (MTree c)
-> SStateT s m (MTree c)
-> SStateT s m (MTree c)
g MTree a
t) s
s
  where
    tip :: SStateT s m (MTree a)
tip = MTree a -> SStateT s m (MTree a)
forall a. a -> SStateT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MTree a
forall a. MTree a
MTip
    {-# INLINE tip #-}
    g :: Int
-> a
-> SStateT s m (MTree c)
-> SStateT s m (MTree c)
-> SStateT s m (MTree c)
g Int
_ a
x SStateT s m (MTree c)
ml SStateT s m (MTree c)
mr = (s -> m (S2 s (MTree c))) -> SStateT s m (MTree c)
forall s (m :: * -> *) a. (s -> m (S2 s a)) -> SStateT s m a
U.SStateT ((s -> m (S2 s (MTree c))) -> SStateT s m (MTree c))
-> (s -> m (S2 s (MTree c))) -> SStateT s m (MTree c)
forall a b. (a -> b) -> a -> b
$ \s
s2 -> do
      U.S2 s
s3 MTree c
l <- SStateT s m (MTree c) -> s -> m (S2 s (MTree c))
forall s (m :: * -> *) a. SStateT s m a -> s -> m (S2 s a)
U.runSStateT SStateT s m (MTree c)
ml s
s2
      case s -> Step s b
step s
s3 of
        Step s b
Done -> S2 s (MTree c) -> m (S2 s (MTree c))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (S2 s (MTree c) -> m (S2 s (MTree c)))
-> S2 s (MTree c) -> m (S2 s (MTree c))
forall a b. (a -> b) -> a -> b
$ s -> MTree c -> S2 s (MTree c)
forall a b. a -> b -> S2 a b
U.S2 s
s3 MTree c
l
        Yield b
y s
s4 -> do
          c
z <- a -> b -> m c
f a
x b
y
          U.S2 s
s5 MTree c
r <- SStateT s m (MTree c) -> s -> m (S2 s (MTree c))
forall s (m :: * -> *) a. SStateT s m a -> s -> m (S2 s a)
U.runSStateT SStateT s m (MTree c)
mr s
s4
          S2 s (MTree c) -> m (S2 s (MTree c))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (S2 s (MTree c) -> m (S2 s (MTree c)))
-> S2 s (MTree c) -> m (S2 s (MTree c))
forall a b. (a -> b) -> a -> b
$! s -> MTree c -> S2 s (MTree c)
forall a b. a -> b -> S2 a b
U.S2 s
s5 (c -> MTree c -> MTree c -> MTree c
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
link c
z MTree c
l MTree c
r)
    {-# INLINE g #-}
{-# INLINE zipWithStreamM #-}

unzipWithA
  :: (Measured b, Measured c, Applicative f)
  => (a -> f (b, c)) -> MTree a -> f (U.S2 (MTree b) (MTree c))
unzipWithA :: forall b c (f :: * -> *) a.
(Measured b, Measured c, Applicative f) =>
(a -> f (b, c)) -> MTree a -> f (S2 (MTree b) (MTree c))
unzipWithA a -> f (b, c)
f = f (S2 (MTree b) (MTree c))
-> (Int
    -> a
    -> f (S2 (MTree b) (MTree c))
    -> f (S2 (MTree b) (MTree c))
    -> f (S2 (MTree b) (MTree c)))
-> MTree a
-> f (S2 (MTree b) (MTree c))
forall b a. b -> (Int -> a -> b -> b -> b) -> MTree a -> b
foldSimple f (S2 (MTree b) (MTree c))
forall {a} {a}. f (S2 (MTree a) (MTree a))
tip Int
-> a
-> f (S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
g
  where
    tip :: f (S2 (MTree a) (MTree a))
tip = S2 (MTree a) (MTree a) -> f (S2 (MTree a) (MTree a))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MTree a -> MTree a -> S2 (MTree a) (MTree a)
forall a b. a -> b -> S2 a b
U.S2 MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip)
    {-# INLINE tip #-}
    g :: Int
-> a
-> f (S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
g !Int
sz a
x f (S2 (MTree b) (MTree c))
ml f (S2 (MTree b) (MTree c))
mr = (S2 (MTree b) (MTree c)
 -> (b, c) -> S2 (MTree b) (MTree c) -> S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
-> f (b, c)
-> f (S2 (MTree b) (MTree c))
-> f (S2 (MTree b) (MTree c))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Ap.liftA3 S2 (MTree b) (MTree c)
-> (b, c) -> S2 (MTree b) (MTree c) -> S2 (MTree b) (MTree c)
bin2 f (S2 (MTree b) (MTree c))
ml (a -> f (b, c)
f a
x) f (S2 (MTree b) (MTree c))
mr
      where
        bin2 :: S2 (MTree b) (MTree c)
-> (b, c) -> S2 (MTree b) (MTree c) -> S2 (MTree b) (MTree c)
bin2 (U.S2 MTree b
l1 MTree c
l2) (b
x1,c
x2) (U.S2 MTree b
r1 MTree c
r2) =
          MTree b -> MTree c -> S2 (MTree b) (MTree c)
forall a b. a -> b -> S2 a b
U.S2 (Int -> b -> MTree b -> MTree b -> MTree b
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz b
x1 MTree b
l1 MTree b
r1) (Int -> c -> MTree c -> MTree c -> MTree c
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz c
x2 MTree c
l2 MTree c
r2)
    {-# INLINE g #-}
{-# INLINE unzipWithA #-}

unzipWith3A
  :: (Measured b, Measured c, Measured d, Applicative f)
  => (a -> f (b, c, d))
  -> MTree a
  -> f (U.S3 (MTree b) (MTree c) (MTree d))
unzipWith3A :: forall b c d (f :: * -> *) a.
(Measured b, Measured c, Measured d, Applicative f) =>
(a -> f (b, c, d))
-> MTree a -> f (S3 (MTree b) (MTree c) (MTree d))
unzipWith3A a -> f (b, c, d)
f = f (S3 (MTree b) (MTree c) (MTree d))
-> (Int
    -> a
    -> f (S3 (MTree b) (MTree c) (MTree d))
    -> f (S3 (MTree b) (MTree c) (MTree d))
    -> f (S3 (MTree b) (MTree c) (MTree d)))
-> MTree a
-> f (S3 (MTree b) (MTree c) (MTree d))
forall b a. b -> (Int -> a -> b -> b -> b) -> MTree a -> b
foldSimple f (S3 (MTree b) (MTree c) (MTree d))
forall {a} {a} {a}. f (S3 (MTree a) (MTree a) (MTree a))
tip Int
-> a
-> f (S3 (MTree b) (MTree c) (MTree d))
-> f (S3 (MTree b) (MTree c) (MTree d))
-> f (S3 (MTree b) (MTree c) (MTree d))
g
  where
    tip :: f (S3 (MTree a) (MTree a) (MTree a))
tip = S3 (MTree a) (MTree a) (MTree a)
-> f (S3 (MTree a) (MTree a) (MTree a))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MTree a -> MTree a -> MTree a -> S3 (MTree a) (MTree a) (MTree a)
forall a b c. a -> b -> c -> S3 a b c
U.S3 MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip)
    {-# INLINE tip #-}
    g :: Int
-> a
-> f (S3 (MTree b) (MTree c) (MTree d))
-> f (S3 (MTree b) (MTree c) (MTree d))
-> f (S3 (MTree b) (MTree c) (MTree d))
g !Int
sz a
x f (S3 (MTree b) (MTree c) (MTree d))
ml f (S3 (MTree b) (MTree c) (MTree d))
mr = (S3 (MTree b) (MTree c) (MTree d)
 -> (b, c, d)
 -> S3 (MTree b) (MTree c) (MTree d)
 -> S3 (MTree b) (MTree c) (MTree d))
-> f (S3 (MTree b) (MTree c) (MTree d))
-> f (b, c, d)
-> f (S3 (MTree b) (MTree c) (MTree d))
-> f (S3 (MTree b) (MTree c) (MTree d))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
Ap.liftA3 S3 (MTree b) (MTree c) (MTree d)
-> (b, c, d)
-> S3 (MTree b) (MTree c) (MTree d)
-> S3 (MTree b) (MTree c) (MTree d)
bin3 f (S3 (MTree b) (MTree c) (MTree d))
ml (a -> f (b, c, d)
f a
x) f (S3 (MTree b) (MTree c) (MTree d))
mr
      where
        bin3 :: S3 (MTree b) (MTree c) (MTree d)
-> (b, c, d)
-> S3 (MTree b) (MTree c) (MTree d)
-> S3 (MTree b) (MTree c) (MTree d)
bin3 (U.S3 MTree b
l1 MTree c
l2 MTree d
l3) (b
x1,c
x2,d
x3) (U.S3 MTree b
r1 MTree c
r2 MTree d
r3) =
          MTree b -> MTree c -> MTree d -> S3 (MTree b) (MTree c) (MTree d)
forall a b c. a -> b -> c -> S3 a b c
U.S3 (Int -> b -> MTree b -> MTree b -> MTree b
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz b
x1 MTree b
l1 MTree b
r1) (Int -> c -> MTree c -> MTree c -> MTree c
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz c
x2 MTree c
l2 MTree c
r2) (Int -> d -> MTree d -> MTree d -> MTree d
forall a. Measured a => Int -> a -> MTree a -> MTree a -> MTree a
binn Int
sz d
x3 MTree d
l3 MTree d
r3)
    {-# INLINE g #-}
{-# INLINE unzipWith3A #-}

-----------
-- Errors
-----------

errorOutOfBounds :: String -> a
errorOutOfBounds :: forall a. String -> a
errorOutOfBounds String
name = String -> a
forall a. HasCallStack => String -> a
error (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": out of bounds")

------------
-- Balance
------------

-- O(|log n1 - log n2|). Link two trees with a value in between.
link :: Measured a => a -> MTree a -> MTree a -> MTree a
link :: forall a. Measured a => a -> MTree a -> MTree a -> MTree a
link !a
x MTree a
MTip MTree a
r = a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a
cons a
x MTree a
r
link a
x MTree a
l MTree a
MTip = MTree a -> a -> MTree a
forall a. Measured a => MTree a -> a -> MTree a
snoc MTree a
l a
x
link a
x l :: MTree a
l@(MBin Int
ls Measure a
lv a
lx MTree a
ll MTree a
lr) r :: MTree a
r@(MBin Int
rs Measure a
rv a
rx MTree a
rl MTree a
rr)
  | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rs = a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceL a
rx (a -> Int -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> Int -> MTree a -> MTree a -> MTree a
linkL a
x Int
ls MTree a
l MTree a
rl) MTree a
rr
  | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ls = a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceR a
lx MTree a
ll (a -> MTree a -> Int -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> Int -> MTree a -> MTree a
linkR a
x MTree a
lr Int
rs MTree a
r)
  | Bool
otherwise     = Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv) a
x MTree a
l MTree a
r
{-# INLINE link #-}

linkL :: Measured a => a -> Int -> MTree a -> MTree a -> MTree a
linkL :: forall a. Measured a => a -> Int -> MTree a -> MTree a -> MTree a
linkL !a
x !Int
ls !MTree a
l MTree a
r = case MTree a
r of
  MBin Int
rs Measure a
rv a
rx MTree a
rl MTree a
rr
    | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rs -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceL a
rx (a -> Int -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> Int -> MTree a -> MTree a -> MTree a
linkL a
x Int
ls MTree a
l MTree a
rl) MTree a
rr
    | Bool
otherwise     -> Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) (MTree a
l MTree a -> Measure a -> Measure a
forall a. Measured a => MTree a -> Measure a -> Measure a
<>> a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv) a
x MTree a
l MTree a
r
  MTree a
MTip -> String -> MTree a
forall a. HasCallStack => String -> a
error String
"MTree.linkL: impossible"
{-# INLINABLE linkL #-}

linkR :: Measured a => a -> MTree a -> Int -> MTree a -> MTree a
linkR :: forall a. Measured a => a -> MTree a -> Int -> MTree a -> MTree a
linkR !a
x MTree a
l !Int
rs !MTree a
r = case MTree a
l of
  MBin Int
ls Measure a
lv a
lx MTree a
ll MTree a
lr
    | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ls -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceR a
lx MTree a
ll (a -> MTree a -> Int -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> Int -> MTree a -> MTree a
linkR a
x MTree a
lr Int
rs MTree a
r)
    | Bool
otherwise     -> Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x Measure a -> MTree a -> Measure a
forall a. Measured a => Measure a -> MTree a -> Measure a
<<> MTree a
r) a
x MTree a
l MTree a
r
  MTree a
MTip -> String -> MTree a
forall a. HasCallStack => String -> a
error String
"MTree.linkR: impossible"
{-# INLINABLE linkR #-}

-- O(log (n1 + n2)). Link two trees.
merge :: Measured a => MTree a -> MTree a -> MTree a
merge :: forall a. Measured a => MTree a -> MTree a -> MTree a
merge MTree a
MTip MTree a
r = MTree a
r
merge MTree a
l MTree a
MTip = MTree a
l
merge l :: MTree a
l@(MBin Int
ls Measure a
_ a
lx MTree a
ll MTree a
lr) r :: MTree a
r@(MBin Int
rs Measure a
_ a
rx MTree a
rl MTree a
rr)
  | Int
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rs = case a -> MTree a -> MTree a -> S2 (MTree a) a
forall a. Measured a => a -> MTree a -> MTree a -> S2 (MTree a) a
unsnocSure a
lx MTree a
ll MTree a
lr of U.S2 MTree a
l' a
mx -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
link a
mx MTree a
l' MTree a
r
  | Bool
otherwise = case a -> MTree a -> MTree a -> S2 a (MTree a)
forall a. Measured a => a -> MTree a -> MTree a -> S2 a (MTree a)
unconsSure a
rx MTree a
rl MTree a
rr of U.S2 a
mx MTree a
r' -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
link a
mx MTree a
l MTree a
r'
{-# INLINE merge #-}

-- O(log (n1 + n2)). Link two trees. Precondition: The trees must be balanced
-- wrt each other.
glue :: Measured a => MTree a -> MTree a -> MTree a
glue :: forall a. Measured a => MTree a -> MTree a -> MTree a
glue MTree a
MTip MTree a
r = MTree a
r
glue MTree a
l MTree a
MTip = MTree a
l
glue l :: MTree a
l@(MBin Int
ls Measure a
_ a
lx MTree a
ll MTree a
lr) r :: MTree a
r@(MBin Int
rs Measure a
_ a
rx MTree a
rl MTree a
rr)
  | Int
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
rs = case a -> MTree a -> MTree a -> S2 (MTree a) a
forall a. Measured a => a -> MTree a -> MTree a -> S2 (MTree a) a
unsnocSure a
lx MTree a
ll MTree a
lr of U.S2 MTree a
l' a
m -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceR a
m MTree a
l' MTree a
r
  | Bool
otherwise = case a -> MTree a -> MTree a -> S2 a (MTree a)
forall a. Measured a => a -> MTree a -> MTree a -> S2 a (MTree a)
unconsSure a
rx MTree a
rl MTree a
rr of U.S2 a
m MTree a
r' -> a -> MTree a -> MTree a -> MTree a
forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceL a
m MTree a
l MTree a
r'
{-# INLINE glue #-}

-- See Note [Balance] in Data.Seqn.Internal.Tree
delta, ratio :: Int
delta :: Int
delta = Int
3
ratio :: Int
ratio = Int
2

-- O(1). Restores balance with at most one right rotation. Precondition: One
-- right rotation must be enough to restore balance. This is the case when the
-- left tree might have been inserted to or the right tree deleted from.
balanceL :: Measured a => a -> MTree a -> MTree a -> MTree a
balanceL :: forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceL !a
x MTree a
l MTree a
r = case MTree a
r of
  MTree a
MTip -> case MTree a
l of
    MTree a
MTip -> Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
1 Measure a
v a
x MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip
    MBin Int
_ Measure a
lv a
lx MTree a
ll MTree a
lr -> case MTree a
lr of
      MTree a
MTip -> case MTree a
ll of
        MTree a
MTip -> Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
2 (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v) a
x MTree a
l MTree a
forall a. MTree a
MTip
        MBin Int
_ Measure a
_ a
_ MTree a
_ MTree a
_ ->
          Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
3 (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v) a
lx MTree a
ll (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
1 Measure a
v a
x MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip)
      MBin Int
_ Measure a
lrv a
lrx MTree a
_ MTree a
_ -> case MTree a
ll of
        MTree a
MTip ->
          Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
3
               (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v)
               a
lrx
               (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
1 (a -> Measure a
forall a. Measured a => a -> Measure a
measure a
lx) a
lx MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip)
               (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
1 Measure a
v a
x MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip)
        MBin Int
_ Measure a
_ a
_ MTree a
_ MTree a
_ ->
          Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
4 (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v) a
lx MTree a
ll (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
2 (Measure a
lrv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x) a
x MTree a
lr MTree a
forall a. MTree a
MTip)
  MBin Int
rs Measure a
rv a
_ MTree a
_ MTree a
_ -> case MTree a
l of
    MTree a
MTip -> Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) (Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv) a
x MTree a
forall a. MTree a
MTip MTree a
r
    MBin Int
ls Measure a
lv a
lx MTree a
ll MTree a
lr
      | Int
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rs -> case (MTree a
ll, MTree a
lr) of
        (MBin Int
lls Measure a
llv a
_ MTree a
_ MTree a
_, MBin Int
lrs Measure a
lrv a
lrx MTree a
lrl MTree a
lrr)
          | Int
lrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lls ->
            Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs)
                 (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv)
                 a
lx
                 MTree a
ll
                 (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lrs) (Measure a
lrv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv) a
x MTree a
lr MTree a
r)
          | Bool
otherwise ->
            Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs)
                 (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv)
                 a
lrx
                 (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
llsInt -> Int -> Int
forall a. Num a => a -> a -> a
+MTree a -> Int
forall a. MTree a -> Int
size MTree a
lrl) (Measure a
llv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> a -> Measure a
forall a. Measured a => a -> Measure a
measure a
lx Measure a -> MTree a -> Measure a
forall a. Measured a => Measure a -> MTree a -> Measure a
<<> MTree a
lrl) a
lx MTree a
ll MTree a
lrl)
                 (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rsInt -> Int -> Int
forall a. Num a => a -> a -> a
+MTree a -> Int
forall a. MTree a -> Int
size MTree a
lrr) (MTree a
lrr MTree a -> Measure a -> Measure a
forall a. Measured a => MTree a -> Measure a -> Measure a
<>> Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv) a
x MTree a
lrr MTree a
r)
        (MTree a, MTree a)
_ -> String -> MTree a
forall a. HasCallStack => String -> a
error String
"MTree.balanceL: impossible"
      | Bool
otherwise -> Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv) a
x MTree a
l MTree a
r
  where
    v :: Measure a
v = a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x
{-# INLINABLE balanceL #-}

-- O(1). Restores balance with at most one left rotation. Precondition: One left
-- rotation must be enough to restore balance. This is the case when the right
-- tree might have been inserted to or the left tree deleted from.
balanceR :: Measured a => a -> MTree a -> MTree a -> MTree a
balanceR :: forall a. Measured a => a -> MTree a -> MTree a -> MTree a
balanceR !a
x MTree a
l MTree a
r = case MTree a
l of
  MTree a
MTip -> case MTree a
r of
    MTree a
MTip -> Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
1 Measure a
v a
x MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip
    MBin Int
_ Measure a
rv a
rx MTree a
rl MTree a
rr -> case MTree a
rl of
      MTree a
MTip -> case MTree a
rr of
        MTree a
MTip -> Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
2 (Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv) a
x MTree a
forall a. MTree a
MTip MTree a
r
        MBin Int
_ Measure a
_ a
_ MTree a
_ MTree a
_ -> Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
3 (Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv) a
rx (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
1 Measure a
v a
x MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip) MTree a
rr
      MBin Int
_ Measure a
rlv a
rlx MTree a
_ MTree a
_ -> case MTree a
rr of
        MTree a
MTip ->
          Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
3
               (Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv)
               a
rlx
               (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
1 Measure a
v a
x MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip)
               (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
1 (a -> Measure a
forall a. Measured a => a -> Measure a
measure a
rx) a
rx MTree a
forall a. MTree a
MTip MTree a
forall a. MTree a
MTip)
        MBin Int
_ Measure a
_ a
_ MTree a
_ MTree a
_ ->
          Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
4 (Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv) a
rx (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin Int
2 (Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rlv) a
x MTree a
forall a. MTree a
MTip MTree a
rl) MTree a
rr
  MBin Int
ls Measure a
lv a
_ MTree a
_ MTree a
_ -> case MTree a
r of
    MTree a
MTip -> Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v) a
x MTree a
l MTree a
forall a. MTree a
MTip
    MBin Int
rs Measure a
rv a
rx MTree a
rl MTree a
rr
      | Int
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ls -> case (MTree a
rl, MTree a
rr) of
        (MBin Int
rls Measure a
rlv a
rlx MTree a
rll MTree a
rlr, MBin Int
rrs Measure a
rrv a
_ MTree a
_ MTree a
_)
          | Int
rls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rrs ->
            Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs)
                 (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv)
                 a
rx
                 (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rls) (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rlv) a
x MTree a
l MTree a
rl)
                 MTree a
rr
          | Bool
otherwise ->
            Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs)
                 (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv)
                 a
rlx
                 (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+MTree a -> Int
forall a. MTree a -> Int
size MTree a
rll) (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v Measure a -> MTree a -> Measure a
forall a. Measured a => Measure a -> MTree a -> Measure a
<<> MTree a
rll) a
x MTree a
l MTree a
rll)
                 (Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rrsInt -> Int -> Int
forall a. Num a => a -> a -> a
+MTree a -> Int
forall a. MTree a -> Int
size MTree a
rlr) (MTree a
rlr MTree a -> Measure a -> Measure a
forall a. Measured a => MTree a -> Measure a -> Measure a
<>> a -> Measure a
forall a. Measured a => a -> Measure a
measure a
rx Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rrv) a
rx MTree a
rlr MTree a
rr)
        (MTree a, MTree a)
_ -> String -> MTree a
forall a. HasCallStack => String -> a
error String
"MTree.balanceR: impossible"
      | Bool
otherwise -> Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
forall a. Int -> Measure a -> a -> MTree a -> MTree a -> MTree a
MBin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) (Measure a
lv Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
v Measure a -> Measure a -> Measure a
forall a. Semigroup a => a -> a -> a
<> Measure a
rv) a
x MTree a
l MTree a
r
  where
    v :: Measure a
v = a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x
{-# INLINABLE balanceR #-}

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

valid :: (Measured a, Eq (Measure a)) => MTree a -> Bool
valid :: forall a. (Measured a, Eq (Measure a)) => MTree a -> Bool
valid MTree a
s = MTree a -> Bool
forall {a}. MTree a -> Bool
balanceOk MTree a
s Bool -> Bool -> Bool
&& MTree a -> Bool
forall {a}. MTree a -> Bool
sizeOk MTree a
s Bool -> Bool -> Bool
&& MTree a -> Bool
measureOk MTree a
s
  where
    balanceOk :: MTree a -> Bool
balanceOk = \case
      MBin Int
_ Measure a
_ a
_ MTree a
l MTree a
r -> Bool
ok Bool -> Bool -> Bool
&& MTree a -> Bool
balanceOk MTree a
l Bool -> Bool -> Bool
&& MTree a -> Bool
balanceOk MTree a
r
        where
          ok :: Bool
ok = MTree a -> Int
forall a. MTree a -> Int
size MTree a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
size MTree a
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
||
               (MTree a -> Int
forall a. MTree a -> Int
size MTree a
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
* MTree a -> Int
forall a. MTree a -> Int
size MTree a
r Bool -> Bool -> Bool
&& MTree a -> Int
forall a. MTree a -> Int
size MTree a
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
* MTree a -> Int
forall a. MTree a -> Int
size MTree a
l)
      MTree a
MTip -> Bool
True

    sizeOk :: MTree a -> Bool
sizeOk = \case
      MBin Int
sz Measure a
_ a
_ MTree a
l MTree a
r -> MTree a -> Bool
sizeOk MTree a
l Bool -> Bool -> Bool
&& MTree a -> Bool
sizeOk MTree a
r Bool -> Bool -> Bool
&& MTree a -> Int
forall a. MTree a -> Int
size MTree a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MTree a -> Int
forall a. MTree a -> Int
size MTree a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz
      MTree a
MTip -> Bool
True

    measureOk :: MTree a -> Bool
measureOk = \case
      MBin Int
_ Measure a
v a
x MTree a
l MTree a
r ->
        MTree a -> Bool
measureOk MTree a
l Bool -> Bool -> Bool
&& MTree a -> Bool
measureOk MTree a
r Bool -> Bool -> Bool
&& MTree a
l MTree a -> Measure a -> Measure a
forall a. Measured a => MTree a -> Measure a -> Measure a
<>> a -> Measure a
forall a. Measured a => a -> Measure a
measure a
x Measure a -> MTree a -> Measure a
forall a. Measured a => Measure a -> MTree a -> Measure a
<<> MTree a
r Measure a -> Measure a -> Bool
forall a. Eq a => a -> a -> Bool
== Measure a
v
      MTree a
MTip -> Bool
True

debugShowsPrec :: (Show a, Show (Measure a)) => Int -> MTree a -> ShowS
debugShowsPrec :: forall a.
(Show a, Show (Measure a)) =>
Int -> MTree a -> String -> String
debugShowsPrec Int
p = \case
  MBin Int
sz Measure a
v a
x MTree a
l MTree a
r ->
    Bool -> (String -> String) -> String -> String
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
      String -> String -> String
showString String
"MBin " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> String -> String
forall a. Show a => a -> String -> String
shows Int
sz (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> String -> String
showString String
" " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> Measure a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 Measure a
v (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> String -> String
showString String
" " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 a
x (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> String -> String
showString String
" " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> MTree a -> String -> String
forall a.
(Show a, Show (Measure a)) =>
Int -> MTree a -> String -> String
debugShowsPrec Int
11 MTree a
l (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> String -> String
showString String
" " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> MTree a -> String -> String
forall a.
(Show a, Show (Measure a)) =>
Int -> MTree a -> String -> String
debugShowsPrec Int
11 MTree a
r
  MTree a
MTip -> String -> String -> String
showString String
"MTip"