module Unison.Util.Rope
  ( chunks,
    singleton,
    one,
    map,
    traverse,
    null,
    flatten,
    two,
    cons,
    uncons,
    snoc,
    unsnoc,
    index,
    debugDepth,
    Sized (..),
    Take (..),
    Drop (..),
    Reverse (..),
    Index (..),
    Rope,
  )
where

import Control.DeepSeq (NFData (..))
import Data.Foldable (toList)
import Prelude hiding (drop, map, null, reverse, take, traverse)

-- | Roughly size-balanced binary tree of chunks. There are
-- a few operations that are sloppier about rebalancing as long
-- as that can't lead to trees of more than logarithmic depth.
--
-- The `Int` in the `Two` constructor is a cached size of that subtree.
data Rope a
  = Empty
  | One !a
  | Two {-# UNPACK #-} !Int !(Rope a) !(Rope a)
  deriving ((forall m. Monoid m => Rope m -> m)
-> (forall m a. Monoid m => (a -> m) -> Rope a -> m)
-> (forall m a. Monoid m => (a -> m) -> Rope a -> m)
-> (forall a b. (a -> b -> b) -> b -> Rope a -> b)
-> (forall a b. (a -> b -> b) -> b -> Rope a -> b)
-> (forall b a. (b -> a -> b) -> b -> Rope a -> b)
-> (forall b a. (b -> a -> b) -> b -> Rope a -> b)
-> (forall a. (a -> a -> a) -> Rope a -> a)
-> (forall a. (a -> a -> a) -> Rope a -> a)
-> (forall a. Rope a -> [a])
-> (forall a. Rope a -> Bool)
-> (forall a. Rope a -> Int)
-> (forall a. Eq a => a -> Rope a -> Bool)
-> (forall a. Ord a => Rope a -> a)
-> (forall a. Ord a => Rope a -> a)
-> (forall a. Num a => Rope a -> a)
-> (forall a. Num a => Rope a -> a)
-> Foldable Rope
forall a. Eq a => a -> Rope a -> Bool
forall a. Num a => Rope a -> a
forall a. Ord a => Rope a -> a
forall m. Monoid m => Rope m -> m
forall a. Rope a -> Bool
forall a. Rope a -> Int
forall a. Rope a -> [a]
forall a. (a -> a -> a) -> Rope a -> a
forall m a. Monoid m => (a -> m) -> Rope a -> m
forall b a. (b -> a -> b) -> b -> Rope a -> b
forall a b. (a -> b -> b) -> b -> Rope a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Rope m -> m
fold :: forall m. Monoid m => Rope m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Rope a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Rope a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Rope a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Rope a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Rope a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Rope a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Rope a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Rope a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Rope a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Rope a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Rope a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Rope a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Rope a -> a
foldr1 :: forall a. (a -> a -> a) -> Rope a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Rope a -> a
foldl1 :: forall a. (a -> a -> a) -> Rope a -> a
$ctoList :: forall a. Rope a -> [a]
toList :: forall a. Rope a -> [a]
$cnull :: forall a. Rope a -> Bool
null :: forall a. Rope a -> Bool
$clength :: forall a. Rope a -> Int
length :: forall a. Rope a -> Int
$celem :: forall a. Eq a => a -> Rope a -> Bool
elem :: forall a. Eq a => a -> Rope a -> Bool
$cmaximum :: forall a. Ord a => Rope a -> a
maximum :: forall a. Ord a => Rope a -> a
$cminimum :: forall a. Ord a => Rope a -> a
minimum :: forall a. Ord a => Rope a -> a
$csum :: forall a. Num a => Rope a -> a
sum :: forall a. Num a => Rope a -> a
$cproduct :: forall a. Num a => Rope a -> a
product :: forall a. Num a => Rope a -> a
Foldable)

chunks :: Rope a -> [a]
chunks :: forall a. Rope a -> [a]
chunks = Rope a -> [a]
forall a. Rope a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

singleton, one :: (Sized a) => a -> Rope a
one :: forall a. Sized a => a -> Rope a
one a
a | a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Rope a
forall a. Rope a
Empty
one a
a = a -> Rope a
forall a. a -> Rope a
One a
a
singleton :: forall a. Sized a => a -> Rope a
singleton = a -> Rope a
forall a. Sized a => a -> Rope a
one

-- Note: this function doesn't do rebalancing, so it shouldn't
-- be used unless the function is "roughly" size-preserving.
-- So converting from text to utf-8 encoded text chunks is okay,
-- wherease filtering out 95% of the chunks will lead to a size-unbalanced tree
map :: (Sized b) => (a -> b) -> Rope a -> Rope b
map :: forall b a. Sized b => (a -> b) -> Rope a -> Rope b
map a -> b
f = \case
  Rope a
Empty -> Rope b
forall a. Rope a
Empty
  One a
a -> b -> Rope b
forall a. Sized a => a -> Rope a
one (a -> b
f a
a)
  Two Int
_ Rope a
l Rope a
r -> Rope b -> Rope b -> Rope b
forall a. Sized a => Rope a -> Rope a -> Rope a
two ((a -> b) -> Rope a -> Rope b
forall b a. Sized b => (a -> b) -> Rope a -> Rope b
map a -> b
f Rope a
l) ((a -> b) -> Rope a -> Rope b
forall b a. Sized b => (a -> b) -> Rope a -> Rope b
map a -> b
f Rope a
r)

-- Like `map`, this doesn't do rebalancing
traverse :: (Applicative f, Sized b) => (a -> f b) -> Rope a -> f (Rope b)
traverse :: forall (f :: * -> *) b a.
(Applicative f, Sized b) =>
(a -> f b) -> Rope a -> f (Rope b)
traverse a -> f b
f = \case
  Rope a
Empty -> Rope b -> f (Rope b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rope b
forall a. Rope a
Empty
  One a
a -> b -> Rope b
forall a. Sized a => a -> Rope a
one (b -> Rope b) -> f b -> f (Rope b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
  Two Int
_ Rope a
l Rope a
r -> Rope b -> Rope b -> Rope b
forall a. Sized a => Rope a -> Rope a -> Rope a
two (Rope b -> Rope b -> Rope b) -> f (Rope b) -> f (Rope b -> Rope b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Rope a -> f (Rope b)
forall (f :: * -> *) b a.
(Applicative f, Sized b) =>
(a -> f b) -> Rope a -> f (Rope b)
traverse a -> f b
f Rope a
l f (Rope b -> Rope b) -> f (Rope b) -> f (Rope b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Rope a -> f (Rope b)
forall (f :: * -> *) b a.
(Applicative f, Sized b) =>
(a -> f b) -> Rope a -> f (Rope b)
traverse a -> f b
f Rope a
r

-- typeclasses used for abstracting over the chunk type
class Sized a where size :: a -> Int

class Take a where take :: Int -> a -> a

class Drop a where drop :: Int -> a -> a

class Index a elem where unsafeIndex :: Int -> a -> elem

class Reverse a where reverse :: a -> a

instance (Sized a) => Sized (Rope a) where
  size :: Rope a -> Int
size = \case
    Rope a
Empty -> Int
0
    One a
a -> a -> Int
forall a. Sized a => a -> Int
size a
a
    Two Int
n Rope a
_ Rope a
_ -> Int
n

null :: (Sized a) => Rope a -> Bool
null :: forall a. Sized a => Rope a -> Bool
null Rope a
r = Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

flatten :: (Monoid a) => Rope a -> a
flatten :: forall m. Monoid m => Rope m -> m
flatten = [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> (Rope a -> [a]) -> Rope a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope a -> [a]
forall a. Rope a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance (Sized a, Semigroup a) => Semigroup (Rope a) where
  Rope a
r1 <> :: Rope a -> Rope a -> Rope a
<> Rope a
r2 = case (Rope a
r1, Rope a
r2) of
    (Rope a
Empty, Rope a
k) -> Rope a
k
    (Rope a
k, Rope a
Empty) -> Rope a
k
    (One a
a0, Rope a
k2) -> Int -> a -> Rope a -> Rope a
forall a. (Sized a, Semigroup a) => Int -> a -> Rope a -> Rope a
cons' (a -> Int
forall a. Sized a => a -> Int
size a
a0) a
a0 Rope a
k2
    (Rope a
k1, One a
aN) -> Rope a -> Int -> a -> Rope a
forall a. (Sized a, Semigroup a) => Rope a -> Int -> a -> Rope a
snoc' Rope a
k1 (a -> Int
forall a. Sized a => a -> Int
size a
aN) a
aN
    (k1 :: Rope a
k1@(Two Int
sz1 Rope a
l1 Rope a
r1), k2 :: Rope a
k2@(Two Int
sz2 Rope a
l2 Rope a
r2))
      | Int
sz1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz2 Bool -> Bool -> Bool
&& Int
sz2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz1 -> Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two (Int
sz1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sz2) Rope a
k1 Rope a
k2
      | Int
sz1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sz2 -> Int -> Rope a -> Rope a -> Rope a
forall a. Sized a => Int -> Rope a -> Rope a -> Rope a
appendL (Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
l1) Rope a
l1 (Rope a
r1 Rope a -> Rope a -> Rope a
forall a. Semigroup a => a -> a -> a
<> Rope a
k2)
      | Bool
otherwise -> Rope a -> Int -> Rope a -> Rope a
forall a. Sized a => Rope a -> Int -> Rope a -> Rope a
appendR (Rope a
k1 Rope a -> Rope a -> Rope a
forall a. Semigroup a => a -> a -> a
<> Rope a
l2) (Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
r2) Rope a
r2

instance (Sized a, Semigroup a) => Monoid (Rope a) where
  mempty :: Rope a
mempty = Rope a
forall a. Rope a
Empty

-- size-balanced append, leaving the left tree as is
appendL :: (Sized a) => Int -> Rope a -> Rope a -> Rope a
appendL :: forall a. Sized a => Int -> Rope a -> Rope a -> Rope a
appendL Int
0 Rope a
_ Rope a
a = Rope a
a
appendL Int
_ Rope a
l Rope a
Empty = Rope a
l
appendL Int
szl Rope a
l r :: Rope a
r@(One a
a) = Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two (Int
szl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a) Rope a
l Rope a
r
appendL Int
szl Rope a
l r :: Rope a
r@(Two Int
szr Rope a
r1 Rope a
r2)
  | Int
szl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
szr = Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two (Int
szl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
szr) Rope a
l Rope a
r
  | Bool
otherwise = Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two (Int
szl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
szr) (Int -> Rope a -> Rope a -> Rope a
forall a. Sized a => Int -> Rope a -> Rope a -> Rope a
appendL Int
szl Rope a
l Rope a
r1) Rope a
r2

-- size-balanced append, leaving the right tree as is
appendR :: (Sized a) => Rope a -> Int -> Rope a -> Rope a
appendR :: forall a. Sized a => Rope a -> Int -> Rope a -> Rope a
appendR Rope a
a Int
0 Rope a
_ = Rope a
a
appendR Rope a
Empty Int
_ Rope a
r = Rope a
r
appendR l :: Rope a
l@(One a
a) Int
szr Rope a
r = Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
szr) Rope a
l Rope a
r
appendR l :: Rope a
l@(Two Int
szl Rope a
l1 Rope a
l2) Int
szr Rope a
r
  | Int
szr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
szl = Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two (Int
szl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
szr) Rope a
l Rope a
r
  | Bool
otherwise = Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two (Int
szl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
szr) Rope a
l1 (Rope a -> Int -> Rope a -> Rope a
forall a. Sized a => Rope a -> Int -> Rope a -> Rope a
appendR Rope a
l2 Int
szr Rope a
r)

cons :: (Sized a, Semigroup a) => a -> Rope a -> Rope a
cons :: forall a. (Sized a, Semigroup a) => a -> Rope a -> Rope a
cons a
a Rope a
r = Int -> a -> Rope a -> Rope a
forall a. (Sized a, Semigroup a) => Int -> a -> Rope a -> Rope a
cons' (a -> Int
forall a. Sized a => a -> Int
size a
a) a
a Rope a
r

snoc :: (Sized a, Semigroup a) => Rope a -> a -> Rope a
snoc :: forall a. (Sized a, Semigroup a) => Rope a -> a -> Rope a
snoc Rope a
as a
a = Rope a -> Int -> a -> Rope a
forall a. (Sized a, Semigroup a) => Rope a -> Int -> a -> Rope a
snoc' Rope a
as (a -> Int
forall a. Sized a => a -> Int
size a
a) a
a

cons' :: (Sized a, Semigroup a) => Int -> a -> Rope a -> Rope a
cons' :: forall a. (Sized a, Semigroup a) => Int -> a -> Rope a -> Rope a
cons' Int
0 a
_ Rope a
as = Rope a
as
cons' Int
sz0 a
a0 Rope a
as = Rope a -> Rope a
go Rope a
as
  where
    go :: Rope a -> Rope a
go Rope a
as = case Rope a
as of
      Rope a
Empty -> a -> Rope a
forall a. a -> Rope a
One a
a0
      One a
a1 -> case Int
sz0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
a1 of
        Int
n
          | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
threshold -> a -> Rope a
forall a. a -> Rope a
One (a
a0 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a1)
          | Bool
otherwise -> Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two Int
n (a -> Rope a
forall a. a -> Rope a
One a
a0) Rope a
as
      Two Int
sz Rope a
l Rope a
r
        | Int
sz0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz -> Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two (Int
sz0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sz) (a -> Rope a
forall a. a -> Rope a
One a
a0) Rope a
as
        | Bool
otherwise -> Rope a -> Int -> Rope a -> Rope a
forall a. Sized a => Rope a -> Int -> Rope a -> Rope a
appendR (Rope a -> Rope a
go Rope a
l) (Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
r) Rope a
r

snoc' :: (Sized a, Semigroup a) => Rope a -> Int -> a -> Rope a
snoc' :: forall a. (Sized a, Semigroup a) => Rope a -> Int -> a -> Rope a
snoc' Rope a
as Int
0 a
_ = Rope a
as
snoc' Rope a
as Int
szN a
aN = Rope a -> Rope a
go Rope a
as
  where
    go :: Rope a -> Rope a
go Rope a
as = case Rope a
as of
      Rope a
Empty -> a -> Rope a
forall a. a -> Rope a
One a
aN
      One a
a0 -> case a -> Int
forall a. Sized a => a -> Int
size a
a0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
szN of
        Int
n
          | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
threshold -> a -> Rope a
forall a. a -> Rope a
One (a
a0 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
aN)
          | Bool
otherwise -> Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two Int
n Rope a
as (a -> Rope a
forall a. a -> Rope a
One a
aN)
      Two Int
sz Rope a
l Rope a
r
        | Int
szN Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz -> Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
szN) Rope a
as (a -> Rope a
forall a. a -> Rope a
One a
aN)
        | Bool
otherwise -> Int -> Rope a -> Rope a -> Rope a
forall a. Sized a => Int -> Rope a -> Rope a -> Rope a
appendL (Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
l) Rope a
l (Rope a -> Rope a
go Rope a
r)

instance (Reverse a) => Reverse (Rope a) where
  reverse :: Rope a -> Rope a
reverse = \case
    One a
a -> a -> Rope a
forall a. a -> Rope a
One (a -> a
forall a. Reverse a => a -> a
reverse a
a)
    Two Int
sz Rope a
l Rope a
r -> Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two Int
sz (Rope a -> Rope a
forall a. Reverse a => a -> a
reverse Rope a
r) (Rope a -> Rope a
forall a. Reverse a => a -> a
reverse Rope a
l)
    Rope a
Empty -> Rope a
forall a. Rope a
Empty

two :: (Sized a) => Rope a -> Rope a -> Rope a
two :: forall a. Sized a => Rope a -> Rope a -> Rope a
two Rope a
r1 Rope a
r2 = Int -> Rope a -> Rope a -> Rope a
forall a. Int -> Rope a -> Rope a -> Rope a
Two (Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
r2) Rope a
r1 Rope a
r2

-- Cutoff for when `snoc` or `cons` will create a new subtree
-- rather than just snoc/cons-ing onto the underlying chunk.
--
-- See https://github.com/unisonweb/unison/pull/1899#discussion_r742953469
threshold :: Int
threshold :: Int
threshold = Int
32

index :: (Sized a, Index a ch) => Int -> Rope a -> Maybe ch
index :: forall a ch. (Sized a, Index a ch) => Int -> Rope a -> Maybe ch
index Int
i Rope a
r
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
r = ch -> Maybe ch
forall a. a -> Maybe a
Just (Int -> Rope a -> ch
forall a elem. Index a elem => Int -> a -> elem
unsafeIndex Int
i Rope a
r)
  | Bool
otherwise = Maybe ch
forall a. Maybe a
Nothing
{-# INLINE index #-}

instance (Sized a, Index a ch) => Index (Rope a) ch where
  unsafeIndex :: Int -> Rope a -> ch
unsafeIndex Int
i = \case
    One a
a -> Int -> a -> ch
forall a elem. Index a elem => Int -> a -> elem
unsafeIndex Int
i a
a
    Two Int
sz Rope a
l Rope a
r
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
l -> Int -> Rope a -> ch
forall a elem. Index a elem => Int -> a -> elem
unsafeIndex Int
i Rope a
l
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz -> [Char] -> ch
forall a. HasCallStack => [Char] -> a
error [Char]
"out of bounds"
      | Bool
otherwise -> Int -> Rope a -> ch
forall a elem. Index a elem => Int -> a -> elem
unsafeIndex (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
l) Rope a
r
    Rope a
Empty -> [Char] -> ch
forall a. HasCallStack => [Char] -> a
error [Char]
"out of bounds"

instance (Sized a, Semigroup a, Take a) => Take (Rope a) where
  -- this avoids rebalancing the tree, which is more efficient
  -- when walking a large rope from left to right via take/drop
  take :: Int -> Rope a -> Rope a
take Int
n Rope a
as = case Rope a
as of
    One a
a -> if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Rope a
forall a. Rope a
Empty else a -> Rope a
forall a. Sized a => a -> Rope a
one (Int -> a -> a
forall a. Take a => Int -> a -> a
take Int
n a
a)
    Two Int
sz Rope a
l Rope a
r
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
l -> Int -> Rope a -> Rope a
forall a. Take a => Int -> a -> a
take Int
n Rope a
l
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz -> Rope a
as
      | Bool
otherwise -> Rope a -> Rope a -> Rope a
forall a. Sized a => Rope a -> Rope a -> Rope a
two Rope a
l (Int -> Rope a -> Rope a
forall a. Take a => Int -> a -> a
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
l) Rope a
r) -- don't rebalance
    Rope a
Empty -> Rope a
forall a. Rope a
Empty

instance (Sized a, Semigroup a, Drop a) => Drop (Rope a) where
  -- this avoids rebalancing the tree, which is more efficient
  -- when walking a large rope from left to right via take/drop
  drop :: Int -> Rope a -> Rope a
drop Int
n Rope a
as = case Rope a
as of
    One a
a -> if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Int
forall a. Sized a => a -> Int
size a
a then Rope a
forall a. Rope a
Empty else a -> Rope a
forall a. Sized a => a -> Rope a
one (Int -> a -> a
forall a. Drop a => Int -> a -> a
drop Int
n a
a)
    Two Int
sz Rope a
l Rope a
r
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
l -> Int -> Rope a -> Rope a
forall a. Drop a => Int -> a -> a
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
l) Rope a
r
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz -> Rope a
forall a. Rope a
Empty
      | Bool
otherwise -> Rope a -> Rope a -> Rope a
forall a. Sized a => Rope a -> Rope a -> Rope a
two (Int -> Rope a -> Rope a
forall a. Drop a => Int -> a -> a
drop Int
n Rope a
l) Rope a
r -- don't rebalance
    Rope a
Empty -> Rope a
forall a. Rope a
Empty

uncons :: (Sized a) => Rope a -> Maybe (a, Rope a)
uncons :: forall a. Sized a => Rope a -> Maybe (a, Rope a)
uncons = \case
  Rope a
Empty -> Maybe (a, Rope a)
forall a. Maybe a
Nothing
  One a
a -> (a, Rope a) -> Maybe (a, Rope a)
forall a. a -> Maybe a
Just (a
a, Rope a
forall a. Rope a
Empty)
  Two Int
_ Rope a
l Rope a
r -> case Rope a -> Maybe (a, Rope a)
forall a. Sized a => Rope a -> Maybe (a, Rope a)
uncons Rope a
l of
    Maybe (a, Rope a)
Nothing -> Rope a -> Maybe (a, Rope a)
forall a. Sized a => Rope a -> Maybe (a, Rope a)
uncons Rope a
r
    Just (a
hd, Rope a
tl) -> (a, Rope a) -> Maybe (a, Rope a)
forall a. a -> Maybe a
Just (a
hd, Rope a -> Rope a -> Rope a
forall a. Sized a => Rope a -> Rope a -> Rope a
two Rope a
tl Rope a
r)

unsnoc :: (Sized a) => Rope a -> Maybe (Rope a, a)
unsnoc :: forall a. Sized a => Rope a -> Maybe (Rope a, a)
unsnoc = \case
  Rope a
Empty -> Maybe (Rope a, a)
forall a. Maybe a
Nothing
  One a
a -> (Rope a, a) -> Maybe (Rope a, a)
forall a. a -> Maybe a
Just (Rope a
forall a. Rope a
Empty, a
a)
  Two Int
_ Rope a
l Rope a
r -> case Rope a -> Maybe (Rope a, a)
forall a. Sized a => Rope a -> Maybe (Rope a, a)
unsnoc Rope a
r of
    Maybe (Rope a, a)
Nothing -> Rope a -> Maybe (Rope a, a)
forall a. Sized a => Rope a -> Maybe (Rope a, a)
unsnoc Rope a
l
    Just (Rope a
init, a
last) -> (Rope a, a) -> Maybe (Rope a, a)
forall a. a -> Maybe a
Just (Rope a -> Rope a -> Rope a
forall a. Sized a => Rope a -> Rope a -> Rope a
two Rope a
l Rope a
init, a
last)

-- Produces two lists of chunks where the chunks have the same length
alignChunks :: (Sized a, Take a, Drop a) => [a] -> [a] -> ([a], [a])
alignChunks :: forall a. (Sized a, Take a, Drop a) => [a] -> [a] -> ([a], [a])
alignChunks [a]
bs1 [a]
bs2 = ([a]
cs1, [a]
cs2)
  where
    cs1 :: [a]
cs1 = [a] -> [a] -> [a]
forall {a} {b}.
(Sized a, Sized b, Take b, Drop a, Drop b) =>
[b] -> [a] -> [b]
alignTo [a]
bs1 [a]
bs2
    cs2 :: [a]
cs2 = [a] -> [a] -> [a]
forall {a} {b}.
(Sized a, Sized b, Take b, Drop a, Drop b) =>
[b] -> [a] -> [b]
alignTo [a]
bs2 [a]
cs1
    alignTo :: [b] -> [a] -> [b]
alignTo [b]
bs1 [] = [b]
bs1
    alignTo [] [a]
_ = []
    alignTo (b
hd1 : [b]
tl1) (a
hd2 : [a]
tl2)
      | Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len2 = b
hd1 b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b] -> [a] -> [b]
alignTo [b]
tl1 [a]
tl2
      | Int
len1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len2 = b
hd1 b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b] -> [a] -> [b]
alignTo [b]
tl1 (Int -> a -> a
forall a. Drop a => Int -> a -> a
drop Int
len1 a
hd2 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
tl2)
      | Bool
otherwise -- len1 > len2
        =
          let (b
hd1', b
hd1rem) = (Int -> b -> b
forall a. Take a => Int -> a -> a
take Int
len2 b
hd1, Int -> b -> b
forall a. Drop a => Int -> a -> a
drop Int
len2 b
hd1)
           in b
hd1' b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b] -> [a] -> [b]
alignTo (b
hd1rem b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
tl1) [a]
tl2
      where
        len1 :: Int
len1 = b -> Int
forall a. Sized a => a -> Int
size b
hd1
        len2 :: Int
len2 = a -> Int
forall a. Sized a => a -> Int
size a
hd2

instance (Sized a, Take a, Drop a, Eq a) => Eq (Rope a) where
  Rope a
b1 == :: Rope a -> Rope a -> Bool
== Rope a
b2
    | Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
b1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Rope a -> Int
forall a. Sized a => a -> Int
size Rope a
b2 =
        ([a] -> [a] -> Bool) -> ([a], [a]) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([a] -> [a] -> ([a], [a])
forall a. (Sized a, Take a, Drop a) => [a] -> [a] -> ([a], [a])
alignChunks (Rope a -> [a]
forall a. Rope a -> [a]
chunks Rope a
b1) (Rope a -> [a]
forall a. Rope a -> [a]
chunks Rope a
b2))
  Rope a
_ == Rope a
_ = Bool
False

-- Lexicographical ordering
instance (Sized a, Take a, Drop a, Ord a) => Ord (Rope a) where
  Rope a
b1 compare :: Rope a -> Rope a -> Ordering
`compare` Rope a
b2 = ([a] -> [a] -> Ordering) -> ([a], [a]) -> Ordering
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([a] -> [a] -> ([a], [a])
forall a. (Sized a, Take a, Drop a) => [a] -> [a] -> ([a], [a])
alignChunks (Rope a -> [a]
forall a. Rope a -> [a]
chunks Rope a
b1) (Rope a -> [a]
forall a. Rope a -> [a]
chunks Rope a
b2))

instance (NFData a) => NFData (Rope a) where
  rnf :: Rope a -> ()
rnf Rope a
Empty = ()
  rnf (One a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (Two Int
_ Rope a
l Rope a
r) = Rope a -> ()
forall a. NFData a => a -> ()
rnf Rope a
l () -> () -> ()
forall a b. a -> b -> b
`seq` Rope a -> ()
forall a. NFData a => a -> ()
rnf Rope a
r

debugDepth :: Rope a -> Int
debugDepth :: forall a. Rope a -> Int
debugDepth Rope a
Empty = Int
0
debugDepth One {} = Int
0
debugDepth (Two Int
_ Rope a
l Rope a
r) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Rope a -> Int
forall a. Rope a -> Int
debugDepth Rope a
l Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Rope a -> Int
forall a. Rope a -> Int
debugDepth Rope a
r)