{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- The JIT's C helpers read and build these constructors (unison-runtime's
-- cbits/jit_rt.c), so their layout must be the same in every build: fields are
-- unpacked only when optimizing.
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Unison.Util.Text where

import Data.Digest.Murmur64 (Hash64, Hashable64 (..))
import Data.Foldable (toList)
import Data.List (unfoldr)
import Data.Primitive.ByteArray (ByteArray (..), copyByteArray, newByteArray, readByteArray, unsafeFreezeByteArray, unsafeThawByteArray, writeByteArray)
import Data.String (IsString (..))
import Data.Text qualified as T
import Data.Text.Array qualified as TA
import Data.Text.Encoding qualified as T
import Data.Text.Internal qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Unsafe qualified as T (Iter (..), iter)
import Data.Word (Word64)
import GHC.IO (unsafeDupablePerformIO)
import Unison.Util.Bytes qualified as B
import Unison.Util.Rope qualified as R
import Prelude hiding (drop, replicate, take)

-- Text type represented as a `Rope` of chunks
newtype Text = Text (R.Rope Chunk)
  deriving stock (Text -> Text -> Bool
(Text -> Text -> Bool) -> (Text -> Text -> Bool) -> Eq Text
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Text -> Text -> Bool
== :: Text -> Text -> Bool
$c/= :: Text -> Text -> Bool
/= :: Text -> Text -> Bool
Eq, Eq Text
Eq Text =>
(Text -> Text -> Ordering)
-> (Text -> Text -> Bool)
-> (Text -> Text -> Bool)
-> (Text -> Text -> Bool)
-> (Text -> Text -> Bool)
-> (Text -> Text -> Text)
-> (Text -> Text -> Text)
-> Ord Text
Text -> Text -> Bool
Text -> Text -> Ordering
Text -> Text -> Text
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Text -> Text -> Ordering
compare :: Text -> Text -> Ordering
$c< :: Text -> Text -> Bool
< :: Text -> Text -> Bool
$c<= :: Text -> Text -> Bool
<= :: Text -> Text -> Bool
$c> :: Text -> Text -> Bool
> :: Text -> Text -> Bool
$c>= :: Text -> Text -> Bool
>= :: Text -> Text -> Bool
$cmax :: Text -> Text -> Text
max :: Text -> Text -> Text
$cmin :: Text -> Text -> Text
min :: Text -> Text -> Text
Ord)
  deriving newtype (NonEmpty Text -> Text
Text -> Text -> Text
(Text -> Text -> Text)
-> (NonEmpty Text -> Text)
-> (forall b. Integral b => b -> Text -> Text)
-> Semigroup Text
forall b. Integral b => b -> Text -> Text
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Text -> Text -> Text
<> :: Text -> Text -> Text
$csconcat :: NonEmpty Text -> Text
sconcat :: NonEmpty Text -> Text
$cstimes :: forall b. Integral b => b -> Text -> Text
stimes :: forall b. Integral b => b -> Text -> Text
Semigroup, Semigroup Text
Text
Semigroup Text =>
Text -> (Text -> Text -> Text) -> ([Text] -> Text) -> Monoid Text
[Text] -> Text
Text -> Text -> Text
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Text
mempty :: Text
$cmappend :: Text -> Text -> Text
mappend :: Text -> Text -> Text
$cmconcat :: [Text] -> Text
mconcat :: [Text] -> Text
Monoid)

-- A chunk: its character count, its capacity and its text. Text is a UTF-8
-- slice of a byte array, so a chunk unpacks to the array, the count, the
-- capacity, the byte offset and the byte length; the JIT's C helpers read and
-- build that layout (cbits/jit_rt.c, the text RopeKind).
--
-- Slack. An array that 'joinChunks' allocates is larger than its contents, so
-- that the next append can write into it instead of copying: word 0 of the
-- array holds its used byte length, the contents start at byte 8, and the
-- chunk's capacity is the array's size in bytes. A chunk owns the array's tail
-- exactly when its end is the used length; an append to such a chunk advances
-- the used length by compare-and-swap, so of two appends to the same chunk the
-- first writes in place and the second copies. Bytes within a chunk's slice
-- are never written again, so a chunk's text is as immutable as any other. A
-- chunk cut from a text or taken from a Data.Text has capacity 0 and is
-- always copied.
data Chunk = Chunk {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !T.Text

empty :: Text
empty :: Text
empty = Rope Chunk -> Text
Text Rope Chunk
forall a. Monoid a => a
mempty

one, singleton :: Char -> Text
one :: Char -> Text
one Char
ch = Rope Chunk -> Text
Text (Chunk -> Rope Chunk
forall a. Sized a => a -> Rope a
R.one (Text -> Chunk
chunk (Char -> Text
T.singleton Char
ch)))
singleton :: Char -> Text
singleton = Char -> Text
one

threshold :: Int
threshold :: Int
threshold = Int
512

replicate :: Int -> Text -> Text
replicate :: Int -> Text -> Text
replicate Int
n Text
t | Text -> Int
size Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
threshold = Rope Chunk -> Text
Text (Chunk -> Rope Chunk
forall a. Sized a => a -> Rope a
R.one (Text -> Chunk
chunk (Int -> Text -> Text
T.replicate Int
n (Text -> Text
toText Text
t))))
replicate Int
0 Text
_ = Text
forall a. Monoid a => a
mempty
replicate Int
1 Text
t = Text
t
replicate Int
n Text
t =
  Int -> Text -> Text
replicate (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)) Text
t

toLazyText :: Text -> TL.Text
toLazyText :: Text -> Text
toLazyText (Text Rope Chunk
t) = [Text] -> Text
TL.fromChunks (Chunk -> Text
chunkToText (Chunk -> Text) -> [Chunk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rope Chunk -> [Chunk]
forall a. Rope a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Rope Chunk
t)

fromLazyText :: TL.Text -> Text
fromLazyText :: Text -> Text
fromLazyText =
  Rope Chunk -> Text
Text (Rope Chunk -> Text) -> (Text -> Rope Chunk) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rope Chunk -> Text -> Rope Chunk)
-> Rope Chunk -> [Text] -> Rope Chunk
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Rope Chunk
t -> Rope Chunk -> Chunk -> Rope Chunk
forall a. (Sized a, Semigroup a) => Rope a -> a -> Rope a
R.snoc Rope Chunk
t (Chunk -> Rope Chunk) -> (Text -> Chunk) -> Text -> Rope Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk) Rope Chunk
forall a. Monoid a => a
mempty ([Text] -> Rope Chunk) -> (Text -> [Text]) -> Text -> Rope Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
TL.toChunks

chunkToText :: Chunk -> T.Text
chunkToText :: Chunk -> Text
chunkToText (Chunk Int
_ Int
_ Text
t) = Text
t

chunk :: T.Text -> Chunk
chunk :: Text -> Chunk
chunk Text
t = Int -> Int -> Text -> Chunk
Chunk (Text -> Int
T.length Text
t) Int
0 Text
t

-- | A chunk's capacity: the size of its array when it was allocated with slack, else 0.
chunkCapacity :: Chunk -> Int
chunkCapacity :: Chunk -> Int
chunkCapacity (Chunk Int
_ Int
cap Text
_) = Int
cap

take :: Int -> Text -> Text
take :: Int -> Text -> Text
take Int
n (Text Rope Chunk
t) = Rope Chunk -> Text
Text (Int -> Rope Chunk -> Rope Chunk
forall a. Take a => Int -> a -> a
R.take Int
n Rope Chunk
t)

drop :: Int -> Text -> Text
drop :: Int -> Text -> Text
drop Int
n (Text Rope Chunk
t) = Rope Chunk -> Text
Text (Int -> Rope Chunk -> Rope Chunk
forall a. Drop a => Int -> a -> a
R.drop Int
n Rope Chunk
t)

uncons :: Text -> Maybe (Char, Text)
uncons :: Text -> Maybe (Char, Text)
uncons Text
t | Text -> Int
size Text
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe (Char, Text)
forall a. Maybe a
Nothing
uncons Text
t = (,Int -> Text -> Text
drop Int
1 Text
t) (Char -> (Char, Text)) -> Maybe Char -> Maybe (Char, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Text -> Maybe Char
at Int
0 Text
t

unsnoc :: Text -> Maybe (Text, Char)
unsnoc :: Text -> Maybe (Text, Char)
unsnoc Text
t | Text -> Int
size Text
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe (Text, Char)
forall a. Maybe a
Nothing
unsnoc Text
t = (Int -> Text -> Text
take (Text -> Int
size Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
t,) (Char -> (Text, Char)) -> Maybe Char -> Maybe (Text, Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Text -> Maybe Char
at (Text -> Int
size Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
t

unconsChunk :: Text -> Maybe (Chunk, Text)
unconsChunk :: Text -> Maybe (Chunk, Text)
unconsChunk (Text Rope Chunk
r) = (\(Chunk
a, Rope Chunk
b) -> (Chunk
a, Rope Chunk -> Text
Text Rope Chunk
b)) ((Chunk, Rope Chunk) -> (Chunk, Text))
-> Maybe (Chunk, Rope Chunk) -> Maybe (Chunk, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rope Chunk -> Maybe (Chunk, Rope Chunk)
forall a. Sized a => Rope a -> Maybe (a, Rope a)
R.uncons Rope Chunk
r

unsnocChunk :: Text -> Maybe (Text, Chunk)
unsnocChunk :: Text -> Maybe (Text, Chunk)
unsnocChunk (Text Rope Chunk
r) = (\(Rope Chunk
a, Chunk
b) -> (Rope Chunk -> Text
Text Rope Chunk
a, Chunk
b)) ((Rope Chunk, Chunk) -> (Text, Chunk))
-> Maybe (Rope Chunk, Chunk) -> Maybe (Text, Chunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rope Chunk -> Maybe (Rope Chunk, Chunk)
forall a. Sized a => Rope a -> Maybe (Rope a, a)
R.unsnoc Rope Chunk
r

at :: Int -> Text -> Maybe Char
at :: Int -> Text -> Maybe Char
at Int
n (Text Rope Chunk
t) = Int -> Rope Chunk -> Maybe Char
forall a ch. (Sized a, Index a ch) => Int -> Rope a -> Maybe ch
R.index Int
n Rope Chunk
t

size :: Text -> Int
size :: Text -> Int
size (Text Rope Chunk
t) = Rope Chunk -> Int
forall a. Sized a => a -> Int
R.size Rope Chunk
t

reverse :: Text -> Text
reverse :: Text -> Text
reverse (Text Rope Chunk
t) = Rope Chunk -> Text
Text (Rope Chunk -> Rope Chunk
forall a. Reverse a => a -> a
R.reverse Rope Chunk
t)

-- A case mapping can change the character count ("ß" uppercases to "SS"),
-- so the chunk's count is recomputed rather than carried over: a chunk that
-- claims fewer characters than it has puts `size` and indexing off.
toUppercase :: Text -> Text
toUppercase :: Text -> Text
toUppercase (Text Rope Chunk
t) = Rope Chunk -> Text
Text ((Chunk -> Chunk) -> Rope Chunk -> Rope Chunk
forall b a. (Sized b, Semigroup b) => (a -> b) -> Rope a -> Rope b
R.map Chunk -> Chunk
up Rope Chunk
t)
  where
    up :: Chunk -> Chunk
up (Chunk Int
_ Int
_ Text
t) = let t' :: Text
t' = Text -> Text
T.toUpper Text
t in Int -> Int -> Text -> Chunk
Chunk (Text -> Int
T.length Text
t') Int
0 Text
t'

toLowercase :: Text -> Text
toLowercase :: Text -> Text
toLowercase (Text Rope Chunk
t) = Rope Chunk -> Text
Text ((Chunk -> Chunk) -> Rope Chunk -> Rope Chunk
forall b a. (Sized b, Semigroup b) => (a -> b) -> Rope a -> Rope b
R.map Chunk -> Chunk
down Rope Chunk
t)
  where
    down :: Chunk -> Chunk
down (Chunk Int
_ Int
_ Text
t) = let t' :: Text
t' = Text -> Text
T.toLower Text
t in Int -> Int -> Text -> Chunk
Chunk (Text -> Int
T.length Text
t') Int
0 Text
t'

fromUtf8 :: B.Bytes -> Either String Text
fromUtf8 :: Bytes -> Either String Text
fromUtf8 Bytes
bs =
  case ByteString -> Either UnicodeException Text
T.decodeUtf8' (Bytes -> ByteString
B.toByteString Bytes
bs) of
    Right Text
t -> Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Text
fromText Text
t)
    Left UnicodeException
e -> String -> Either String Text
forall a b. a -> Either a b
Left (UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e)

toUtf8 :: Text -> B.Bytes
toUtf8 :: Text -> Bytes
toUtf8 (Text Rope Chunk
t) = Rope Chunk -> Bytes
B.Bytes ((Chunk -> Chunk) -> Rope Chunk -> Rope Chunk
forall b a. (Sized b, Semigroup b) => (a -> b) -> Rope a -> Rope b
R.map (ByteString -> Chunk
B.chunkFromByteString (ByteString -> Chunk) -> (Chunk -> ByteString) -> Chunk -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (Chunk -> Text) -> Chunk -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Text
chunkToText) Rope Chunk
t)

fromText :: T.Text -> Text
fromText :: Text -> Text
fromText Text
s | Text -> Bool
T.null Text
s = Text
forall a. Monoid a => a
mempty
fromText Text
s = Rope Chunk -> Text
Text ([Chunk] -> Rope Chunk
go (Text -> Chunk
chunk (Text -> Chunk) -> [Text] -> [Chunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Text -> [Text]
T.chunksOf Int
threshold Text
s))
  where
    go :: [Chunk] -> Rope Chunk
go = (Rope Chunk -> Chunk -> Rope Chunk)
-> Rope Chunk -> [Chunk] -> Rope Chunk
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Rope Chunk -> Chunk -> Rope Chunk
forall a. (Sized a, Semigroup a) => Rope a -> a -> Rope a
R.snoc Rope Chunk
forall a. Monoid a => a
mempty

fromTextUnchunked :: T.Text -> Text
fromTextUnchunked :: Text -> Text
fromTextUnchunked Text
t = Rope Chunk -> Text
Text (Rope Chunk -> Text) -> (Chunk -> Rope Chunk) -> Chunk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Rope Chunk
forall a. Sized a => a -> Rope a
R.one (Chunk -> Text) -> Chunk -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
t

pack :: String -> Text
pack :: String -> Text
pack = Text -> Text
fromText (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
{-# INLINE pack #-}

toString, unpack :: Text -> String
toString :: Text -> String
toString (Text Rope Chunk
bs) = Rope Chunk -> [Chunk]
forall a. Rope a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Rope Chunk
bs [Chunk] -> (Chunk -> String) -> String
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> String
T.unpack (Text -> String) -> (Chunk -> Text) -> Chunk -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Text
chunkToText)
{-# INLINE toString #-}
{-# INLINE unpack #-}
unpack :: Text -> String
unpack = Text -> String
toString

toText :: Text -> T.Text
toText :: Text -> Text
toText (Text Rope Chunk
t) = [Text] -> Text
T.concat (Chunk -> Text
chunkToText (Chunk -> Text) -> [Chunk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rope Chunk -> Maybe (Chunk, Rope Chunk)) -> Rope Chunk -> [Chunk]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Rope Chunk -> Maybe (Chunk, Rope Chunk)
forall a. Sized a => Rope a -> Maybe (a, Rope a)
R.uncons Rope Chunk
t)
{-# INLINE toText #-}

indexOf :: Text -> Text -> Maybe Word64
indexOf :: Text -> Text -> Maybe Word64
indexOf Text
"" Text
_ = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
0
indexOf Text
needle Text
haystack =
  case HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
TL.breakOn Text
needle' Text
haystack' of
    (Text
_, Text
"") -> Maybe Word64
forall a. Maybe a
Nothing
    (Text
prefix, Text
_) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int64
TL.length Text
prefix))
  where
    needle' :: Text
needle' = Text -> Text
toLazyText Text
needle
    haystack' :: Text
haystack' = Text -> Text
toLazyText Text
haystack

-- Drop with both a maximum size and a predicate. Yields actual number of
-- dropped characters.
--
-- Unavailable from text package.
dropTextWhileMax :: (Char -> Bool) -> Int -> T.Text -> (Int, T.Text)
dropTextWhileMax :: (Char -> Bool) -> Int -> Text -> (Int, Text)
dropTextWhileMax Char -> Bool
p Int
n t :: Text
t@(T.Text Array
arr Int
off Int
len) = Int -> Int -> (Int, Text)
loop Int
0 Int
0
  where
    loop :: Int -> Int -> (Int, Text)
loop !Int
i !Int
j
      | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = (Int
i, Text
T.empty)
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n, Char -> Bool
p Char
c = Int -> Int -> (Int, Text)
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d)
      | Bool
otherwise = (Int
i, Array -> Int -> Int -> Text
T.Text Array
arr (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j))
      where
        T.Iter Char
c Int
d = Text -> Int -> Iter
T.iter Text
t Int
j
{-# INLINE [1] dropTextWhileMax #-}

dropWhileMax :: (Char -> Bool) -> Int -> Text -> (Int, Text)
dropWhileMax :: (Char -> Bool) -> Int -> Text -> (Int, Text)
dropWhileMax Char -> Bool
p = Int -> Int -> Text -> (Int, Text)
go Int
0
  where
    go :: Int -> Int -> Text -> (Int, Text)
go !Int
total !Int
d Text
t
      | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Int
total, Text
t)
      | Just (Chunk
chunk, Text
t) <- Text -> Maybe (Chunk, Text)
unconsChunk Text
t =
          case (Char -> Bool) -> Int -> Text -> (Int, Text)
dropTextWhileMax Char -> Bool
p Int
d (Chunk -> Text
chunkToText Chunk
chunk) of
            (Int
i, Text
rest)
              | Text -> Bool
T.null Text
rest, Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
d -> Int -> Int -> Text -> (Int, Text)
go (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Text
t
              | Text -> Bool
T.null Text
rest -> (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i, Text
t)
              | Bool
otherwise -> (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i, Text -> Text
fromText Text
rest Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
      | Bool
otherwise = (Int
total, Text
empty)
{-# INLINE dropWhileMax #-}

-- Adds the codepoints of the Text into a murmur hash. This depends only
-- on the characters, so adding texts chunked in different ways, or
-- multiple texts that would concatenate to the same text will give the
-- same result.
hash64AddText :: Text -> Hash64 -> Hash64
hash64AddText :: Text -> Hash64 -> Hash64
hash64AddText (Text Rope Chunk
tx) Hash64
h = (Hash64 -> Chunk -> Hash64) -> Hash64 -> Rope Chunk -> Hash64
forall b a. (b -> a -> b) -> b -> Rope a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Hash64 -> Chunk -> Hash64
addChunk Hash64
h Rope Chunk
tx
  where
    addChunk :: Hash64 -> Chunk -> Hash64
addChunk Hash64
h (Chunk Int
_ Int
_ Text
tx) = (Hash64 -> Char -> Hash64) -> Hash64 -> Text -> Hash64
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' ((Char -> Hash64 -> Hash64) -> Hash64 -> Char -> Hash64
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Hash64 -> Hash64
forall a. Hashable64 a => a -> Hash64 -> Hash64
hash64Add) Hash64
h Text
tx

foldMapChunks :: (Monoid r) => (T.Text -> r) -> Text -> r
foldMapChunks :: forall r. Monoid r => (Text -> r) -> Text -> r
foldMapChunks Text -> r
f (Text Rope Chunk
tx) = (Chunk -> r) -> Rope Chunk -> r
forall m a. Monoid m => (a -> m) -> Rope a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> r
f (Text -> r) -> (Chunk -> Text) -> Chunk -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Text
chunkToText) Rope Chunk
tx

instance Eq Chunk where (Chunk Int
n Int
_ Text
a) == :: Chunk -> Chunk -> Bool
== (Chunk Int
n2 Int
_ Text
a2) = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2 Bool -> Bool -> Bool
&& Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
a2

instance Ord Chunk where (Chunk Int
_ Int
_ Text
a) compare :: Chunk -> Chunk -> Ordering
`compare` (Chunk Int
_ Int
_ Text
a2) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
a Text
a2

instance Semigroup Chunk where
  l :: Chunk
l@(Chunk Int
n Int
_ Text
_) <> :: Chunk -> Chunk -> Chunk
<> r :: Chunk
r@(Chunk Int
m Int
_ Text
_)
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Chunk
r
    | Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Chunk
l
    | Bool
otherwise = Chunk -> Chunk -> Chunk
joinChunks Chunk
l Chunk
r
  {-# INLINE (<>) #-}

-- | Both chunks' characters as one chunk: in place when the left chunk owns
-- its array's tail and has room (see 'Chunk'), else in a fresh array.
joinChunks :: Chunk -> Chunk -> Chunk
joinChunks :: Chunk -> Chunk -> Chunk
joinChunks (Chunk Int
n Int
cap (T.Text (TA.ByteArray ByteArray#
arr) Int
off Int
len)) (Chunk Int
m Int
_ (T.Text (TA.ByteArray ByteArray#
arr2) Int
off2 Int
len2)) =
  IO Chunk -> Chunk
forall a. IO a -> a
unsafeDupablePerformIO do
    -- the left chunk owns the tail of its array and has room: claim the
    -- room with a compare-and-swap on the used length (word 0) and copy
    -- the right chunk in place
    Bool
inPlace <-
      if Int
cap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cap
        then do
          MutableByteArray RealWorld
marr <- Array -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Array -> m (MutableByteArray (PrimState m))
unsafeThawByteArray (ByteArray# -> Array
ByteArray ByteArray#
arr)
          Int
used <- MutableByteArray (PrimState IO) -> Int -> IO Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
marr Int
0
          if Int
used Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end
            then do
              Int
old <- MutableByteArray RealWorld -> Int -> Int -> IO Int
B.casUsed MutableByteArray RealWorld
marr Int
end (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2)
              if Int
old Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end
                then do
                  MutableByteArray (PrimState IO)
-> Int -> Array -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> Array -> Int -> Int -> m ()
copyByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
marr Int
end (ByteArray# -> Array
ByteArray ByteArray#
arr2) Int
off2 Int
len2
                  pure Bool
True
                else Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            else Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        else Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    if Bool
inPlace
      then Chunk -> IO Chunk
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Text -> Chunk
Chunk (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m) Int
cap (Array -> Int -> Int -> Text
T.Text (ByteArray# -> Array
TA.ByteArray ByteArray#
arr) Int
off (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2)))
      else case Int -> Int -> Int
B.slackCapacity Int
cap Int
need of
        Int
0 -> Chunk -> IO Chunk
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Text -> Chunk
Chunk (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m) Int
0 (Array -> Int -> Int -> Text
T.Text (ByteArray# -> Array
TA.ByteArray ByteArray#
arr) Int
off Int
len Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Array -> Int -> Int -> Text
T.Text (ByteArray# -> Array
TA.ByteArray ByteArray#
arr2) Int
off2 Int
len2))
        Int
newCap -> do
          MutableByteArray RealWorld
marr <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
newCap
          MutableByteArray (PrimState IO) -> Int -> Int -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
marr Int
0 (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
need :: Int)
          MutableByteArray (PrimState IO)
-> Int -> Array -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> Array -> Int -> Int -> m ()
copyByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
marr Int
8 (ByteArray# -> Array
ByteArray ByteArray#
arr) Int
off Int
len
          MutableByteArray (PrimState IO)
-> Int -> Array -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> Array -> Int -> Int -> m ()
copyByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
marr (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) (ByteArray# -> Array
ByteArray ByteArray#
arr2) Int
off2 Int
len2
          ByteArray ByteArray#
farr <- MutableByteArray (PrimState IO) -> IO Array
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m Array
unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
marr
          Chunk -> IO Chunk
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Text -> Chunk
Chunk (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m) Int
newCap (Array -> Int -> Int -> Text
T.Text (ByteArray# -> Array
TA.ByteArray ByteArray#
farr) Int
8 Int
need))
  where
    !end :: Int
end = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
    !need :: Int
need = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2
{-# NOINLINE joinChunks #-}

instance Monoid Chunk where
  mempty :: Chunk
mempty = Int -> Int -> Text -> Chunk
Chunk Int
0 Int
0 Text
forall a. Monoid a => a
mempty

instance R.Sized Chunk where size :: Chunk -> Int
size (Chunk Int
n Int
_ Text
_) = Int
n

instance R.Drop Chunk where
  drop :: Int -> Chunk -> Chunk
drop Int
k c :: Chunk
c@(Chunk Int
n Int
_ Text
t)
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Chunk
forall a. Monoid a => a
mempty
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Chunk
c
    | Bool
otherwise = Int -> Int -> Text -> Chunk
Chunk (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) Int
0 (Int -> Text -> Text
T.drop Int
k Text
t)

instance R.Take Chunk where
  take :: Int -> Chunk -> Chunk
take Int
k c :: Chunk
c@(Chunk Int
n Int
_ Text
t)
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Chunk
c
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Chunk
forall a. Monoid a => a
mempty
    | Bool
otherwise = Int -> Int -> Text -> Chunk
Chunk Int
k Int
0 (Int -> Text -> Text
T.take Int
k Text
t)

instance R.Index Chunk Char where
  unsafeIndex :: Int -> Chunk -> Char
unsafeIndex Int
i (Chunk Int
_ Int
_ Text
t) = HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
t Int
i

instance R.Reverse Chunk where
  reverse :: Chunk -> Chunk
reverse (Chunk Int
n Int
_ Text
t) = Int -> Int -> Text -> Chunk
Chunk Int
n Int
0 (Text -> Text
T.reverse Text
t)

instance R.Sized Text where size :: Text -> Int
size (Text Rope Chunk
t) = Rope Chunk -> Int
forall a. Sized a => a -> Int
R.size Rope Chunk
t

instance Show Text where
  show :: Text -> String
show Text
t = Text -> String
forall a. Show a => a -> String
show (Text -> Text
toText Text
t)

instance IsString Text where
  fromString :: String -> Text
fromString = String -> Text
pack