{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Unison.Util.Text where

import Data.Foldable (toList)
import Data.List (foldl', unfoldr)
import Data.List qualified as L
import Data.String (IsString (..))
import Data.Text qualified as T
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 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)

data Chunk = Chunk {-# 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

appendUnbalanced :: Text -> Text -> Text
appendUnbalanced :: Text -> Text -> Text
appendUnbalanced (Text Rope Chunk
t1) (Text Rope Chunk
t2) = Rope Chunk -> Text
Text (Rope Chunk -> Rope Chunk -> Rope Chunk
forall a. Sized a => Rope a -> Rope a -> Rope a
R.two Rope Chunk
t1 Rope Chunk
t2)

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)

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

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

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)

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 => (a -> b) -> Rope a -> Rope b
R.map Chunk -> Chunk
up Rope Chunk
t)
  where
    up :: Chunk -> Chunk
up (Chunk Int
n Text
t) = Int -> Text -> Chunk
Chunk Int
n (Text -> Text
T.toUpper 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 => (a -> b) -> Rope a -> Rope b
R.map Chunk -> Chunk
down Rope Chunk
t)
  where
    down :: Chunk -> Chunk
down (Chunk Int
n Text
t) = Int -> Text -> Chunk
Chunk Int
n (Text -> Text
T.toLower 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 => (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

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

-- | Return the ordinal representation of a number in English.
--   A number ending with '1' must finish with 'st'
--   A number ending with '2' must finish with 'nd'
--   A number ending with '3' must finish with 'rd'
--   _except_ for 11, 12, and 13 which must finish with 'th'
ordinal :: (IsString s) => Int -> s
ordinal :: forall s. IsString s => Int -> s
ordinal Int
n = do
  let s :: String
s = Int -> String
forall a. Show a => a -> String
show Int
n
  String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> String -> s
forall a b. (a -> b) -> a -> b
$
    String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ case Int -> String -> String
forall a. Int -> [a] -> [a]
L.drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
s of
      [Char
'1', Char
'1'] -> String
"th"
      [Char
'1', Char
'2'] -> String
"th"
      [Char
'1', Char
'3'] -> String
"th"
      String
_ -> case String -> Char
forall a. HasCallStack => [a] -> a
last String
s of
        Char
'1' -> String
"st"
        Char
'2' -> String
"nd"
        Char
'3' -> String
"rd"
        Char
_ -> String
"th"

-- 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 #-}

instance Eq Chunk where (Chunk Int
n Text
a) == :: Chunk -> Chunk -> Bool
== (Chunk Int
n2 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
_ Text
a) compare :: Chunk -> Chunk -> Ordering
`compare` (Chunk Int
_ Text
a2) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
a Text
a2

instance Semigroup Chunk where
  Chunk
l <> :: Chunk -> Chunk -> Chunk
<> Chunk
r = Int -> Text -> Chunk
Chunk (Chunk -> Int
forall a. Sized a => a -> Int
R.size Chunk
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Chunk -> Int
forall a. Sized a => a -> Int
R.size Chunk
r) (Chunk -> Text
chunkToText Chunk
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Chunk -> Text
chunkToText Chunk
r)

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

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

instance R.Drop Chunk where
  drop :: Int -> Chunk -> Chunk
drop Int
k c :: Chunk
c@(Chunk Int
n 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 -> Text -> Chunk
Chunk (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) (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 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 -> Text -> Chunk
Chunk Int
k (Int -> Text -> Text
T.take Int
k Text
t)

instance R.Index Chunk Char where
  unsafeIndex :: Int -> Chunk -> Char
unsafeIndex Int
i (Chunk 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 Text
t) = Int -> Text -> Chunk
Chunk Int
n (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