{-# language BangPatterns #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language MultiParamTypeClasses #-}
module Data.Rope.UTF16.Internal where
import Data.Foldable as Foldable
import Data.Function
import Data.List
import Data.Semigroup
import Data.String
import Data.Text(Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy
import qualified Data.Text.Unsafe as Unsafe
import Data.Rope.UTF16.Internal.Position
import Data.Rope.UTF16.Internal.Text
import Data.SplayTree(SplayTree, measure)
import qualified Data.SplayTree as SplayTree
data Chunk = Chunk { Chunk -> Text
chunkText :: !Text, Chunk -> Position
chunkMeasure :: !Position }
instance Show Chunk where
show :: Chunk -> String
show (Chunk Text
t Position
_) = Text -> String
forall a. Show a => a -> String
show Text
t
instance Semigroup Chunk where
Chunk Text
t1 Position
m1 <> :: Chunk -> Chunk -> Chunk
<> Chunk Text
t2 Position
m2 = Text -> Position -> Chunk
Chunk (Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t2) (Position
m1 Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> Position
m2)
chunk :: Text -> Chunk
chunk :: Text -> Chunk
chunk Text
t = Text -> Position -> Chunk
Chunk Text
t (Position -> Chunk) -> Position -> Chunk
forall a b. (a -> b) -> a -> b
$ Int -> RowColumn -> Position
Position Int
len (RowColumn -> Position) -> RowColumn -> Position
forall a b. (a -> b) -> a -> b
$ Int -> RowColumn -> RowColumn
go Int
0 (RowColumn -> RowColumn) -> RowColumn -> RowColumn
forall a b. (a -> b) -> a -> b
$ Int -> Int -> RowColumn
RowColumn Int
0 Int
0
where
len :: Int
len = Text -> Int
Unsafe.lengthWord16 Text
t
go :: Int -> RowColumn -> RowColumn
go Int
i !RowColumn
v
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = RowColumn
v
| Bool
otherwise = case Text -> Int -> Iter
Unsafe.iter Text
t Int
i of
Unsafe.Iter Char
'\n' Int
delta -> Int -> RowColumn -> RowColumn
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta) (RowColumn
v RowColumn -> RowColumn -> RowColumn
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> RowColumn
RowColumn Int
1 Int
0)
Unsafe.Iter Char
_ Int
delta -> Int -> RowColumn -> RowColumn
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta) (RowColumn
v RowColumn -> RowColumn -> RowColumn
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> RowColumn
RowColumn Int
0 Int
delta)
instance SplayTree.Measured Position Chunk where
measure :: Chunk -> Position
measure (Chunk Text
_ Position
m) = Position
m
newtype Rope = Rope { Rope -> SplayTree Position Chunk
unrope :: SplayTree Position Chunk }
deriving (SplayTree.Measured Position, Int -> Rope -> ShowS
[Rope] -> ShowS
Rope -> String
(Int -> Rope -> ShowS)
-> (Rope -> String) -> ([Rope] -> ShowS) -> Show Rope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rope] -> ShowS
$cshowList :: [Rope] -> ShowS
show :: Rope -> String
$cshow :: Rope -> String
showsPrec :: Int -> Rope -> ShowS
$cshowsPrec :: Int -> Rope -> ShowS
Show)
chunkLength :: Int
chunkLength :: Int
chunkLength = Int
1000
instance Semigroup Rope where
Rope SplayTree Position Chunk
r1 <> :: Rope -> Rope -> Rope
<> Rope SplayTree Position Chunk
r2 = case (SplayTree Position Chunk -> Maybe (SplayTree Position Chunk, Chunk)
forall v a.
Measured v a =>
SplayTree v a -> Maybe (SplayTree v a, a)
SplayTree.unsnoc SplayTree Position Chunk
r1, SplayTree Position Chunk -> Maybe (Chunk, SplayTree Position Chunk)
forall v a.
Measured v a =>
SplayTree v a -> Maybe (a, SplayTree v a)
SplayTree.uncons SplayTree Position Chunk
r2) of
(Maybe (SplayTree Position Chunk, Chunk)
Nothing, Maybe (Chunk, SplayTree Position Chunk)
_) -> SplayTree Position Chunk -> Rope
Rope SplayTree Position Chunk
r2
(Maybe (SplayTree Position Chunk, Chunk)
_, Maybe (Chunk, SplayTree Position Chunk)
Nothing) -> SplayTree Position Chunk -> Rope
Rope SplayTree Position Chunk
r1
(Just (SplayTree Position Chunk
r1', Chunk
a), Just (Chunk
b, SplayTree Position Chunk
r2'))
| Position -> Int
codeUnits (Chunk -> Position
forall v a. Measured v a => a -> v
SplayTree.measure Chunk
a) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Position -> Int
codeUnits (Chunk -> Position
forall v a. Measured v a => a -> v
SplayTree.measure Chunk
b) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
chunkLength
-> SplayTree Position Chunk -> Rope
Rope (SplayTree Position Chunk -> Rope)
-> SplayTree Position Chunk -> Rope
forall a b. (a -> b) -> a -> b
$ SplayTree Position Chunk
r1' SplayTree Position Chunk
-> SplayTree Position Chunk -> SplayTree Position Chunk
forall a. Semigroup a => a -> a -> a
<> ((Chunk
a Chunk -> Chunk -> Chunk
forall a. Semigroup a => a -> a -> a
<> Chunk
b) Chunk -> SplayTree Position Chunk -> SplayTree Position Chunk
forall v a. Measured v a => a -> SplayTree v a -> SplayTree v a
SplayTree.<| SplayTree Position Chunk
r2')
| Bool
otherwise
-> SplayTree Position Chunk -> Rope
Rope (SplayTree Position Chunk -> Rope)
-> SplayTree Position Chunk -> Rope
forall a b. (a -> b) -> a -> b
$ SplayTree Position Chunk
r1' SplayTree Position Chunk
-> SplayTree Position Chunk -> SplayTree Position Chunk
forall a. Semigroup a => a -> a -> a
<> (Chunk
a Chunk -> SplayTree Position Chunk -> SplayTree Position Chunk
forall v a. Measured v a => a -> SplayTree v a -> SplayTree v a
SplayTree.<| Chunk
b Chunk -> SplayTree Position Chunk -> SplayTree Position Chunk
forall v a. Measured v a => a -> SplayTree v a -> SplayTree v a
SplayTree.<| SplayTree Position Chunk
r2')
instance Monoid Rope where
mempty :: Rope
mempty = SplayTree Position Chunk -> Rope
Rope SplayTree Position Chunk
forall a. Monoid a => a
mempty
mappend :: Rope -> Rope -> Rope
mappend = Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
(<>)
instance Eq Rope where
== :: Rope -> Rope -> Bool
(==) = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool) -> (Rope -> Text) -> Rope -> Rope -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Rope -> Text
toText
instance Ord Rope where
compare :: Rope -> Rope -> Ordering
compare = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> (Rope -> Text) -> Rope -> Rope -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Rope -> Text
toText
instance IsString Rope where
fromString :: String -> Rope
fromString = Text -> Rope
fromText (Text -> Rope) -> (String -> Text) -> String -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
{-# INLINE null #-}
null :: Rope -> Bool
null :: Rope -> Bool
null (Rope SplayTree Position Chunk
r) = SplayTree Position Chunk -> Bool
forall v a. SplayTree v a -> Bool
SplayTree.null SplayTree Position Chunk
r
length :: Rope -> Int
length :: Rope -> Int
length = Position -> Int
codeUnits (Position -> Int) -> (Rope -> Position) -> Rope -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Position
forall v a. Measured v a => a -> v
SplayTree.measure
rows :: Rope -> Int
rows :: Rope -> Int
rows (Rope SplayTree Position Chunk
r) = RowColumn -> Int
row (RowColumn -> Int) -> RowColumn -> Int
forall a b. (a -> b) -> a -> b
$ Position -> RowColumn
rowColumn (Position -> RowColumn) -> Position -> RowColumn
forall a b. (a -> b) -> a -> b
$ SplayTree Position Chunk -> Position
forall v a. Measured v a => a -> v
SplayTree.measure SplayTree Position Chunk
r
columns :: Rope -> Int
columns :: Rope -> Int
columns (Rope SplayTree Position Chunk
r) = RowColumn -> Int
column (RowColumn -> Int) -> RowColumn -> Int
forall a b. (a -> b) -> a -> b
$ Position -> RowColumn
rowColumn (Position -> RowColumn) -> Position -> RowColumn
forall a b. (a -> b) -> a -> b
$ SplayTree Position Chunk -> Position
forall v a. Measured v a => a -> v
SplayTree.measure SplayTree Position Chunk
r
toText :: Rope -> Text
toText :: Rope -> Text
toText = [Text] -> Text
Text.concat ([Text] -> Text) -> (Rope -> [Text]) -> Rope -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> [Text]
toChunks
toLazyText :: Rope -> Lazy.Text
toLazyText :: Rope -> Text
toLazyText = [Text] -> Text
Lazy.fromChunks ([Text] -> Text) -> (Rope -> [Text]) -> Rope -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> [Text]
toChunks
fromText :: Text -> Rope
fromText :: Text -> Rope
fromText Text
t
| Text -> Bool
Text.null Text
t = Rope
forall a. Monoid a => a
mempty
| Bool
otherwise = SplayTree Position Chunk -> Rope
Rope (SplayTree Position Chunk -> Rope)
-> SplayTree Position Chunk -> Rope
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> SplayTree Position Chunk
go Int
numChunks [Text]
chunks
where
chunks :: [Text]
chunks = Int -> Text -> [Text]
chunks16Of Int
chunkLength Text
t
numChunks :: Int
numChunks = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Text]
chunks
go :: Int -> [Text] -> SplayTree Position Chunk
go !Int
_ [] = SplayTree Position Chunk
forall a. Monoid a => a
mempty
go Int
len [Text]
cs = SplayTree Position Chunk
-> Chunk -> SplayTree Position Chunk -> SplayTree Position Chunk
forall v a.
Measured v a =>
SplayTree v a -> a -> SplayTree v a -> SplayTree v a
SplayTree.fork (Int -> [Text] -> SplayTree Position Chunk
go Int
mid [Text]
pre) (Text -> Chunk
chunk Text
c) (Int -> [Text] -> SplayTree Position Chunk
go (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mid Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Text]
post)
where
([Text]
pre, Text
c:[Text]
post) = Int -> [Text] -> ([Text], [Text])
forall a. Int -> [a] -> ([a], [a])
Prelude.splitAt Int
mid [Text]
cs
mid :: Int
mid = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
fromShortText :: Text -> Rope
fromShortText :: Text -> Rope
fromShortText Text
t
| Text -> Bool
Text.null Text
t = Rope
forall a. Monoid a => a
mempty
| Bool
otherwise = SplayTree Position Chunk -> Rope
Rope (SplayTree Position Chunk -> Rope)
-> SplayTree Position Chunk -> Rope
forall a b. (a -> b) -> a -> b
$ Chunk -> SplayTree Position Chunk
forall v a. Measured v a => a -> SplayTree v a
SplayTree.singleton (Chunk -> SplayTree Position Chunk)
-> Chunk -> SplayTree Position Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
t
toString :: Rope -> String
toString :: Rope -> String
toString = (Text -> String) -> [Text] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
Foldable.concatMap Text -> String
Text.unpack ([Text] -> String) -> (Rope -> [Text]) -> Rope -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> [Text]
toChunks
map :: (Char -> Char) -> Rope -> Rope
map :: (Char -> Char) -> Rope -> Rope
map Char -> Char
f (Rope SplayTree Position Chunk
r) = SplayTree Position Chunk -> Rope
Rope (SplayTree Position Chunk -> Rope)
-> SplayTree Position Chunk -> Rope
forall a b. (a -> b) -> a -> b
$ (Chunk -> Chunk)
-> SplayTree Position Chunk -> SplayTree Position Chunk
forall v a w b.
(Measured v a, Measured w b) =>
(a -> b) -> SplayTree v a -> SplayTree w b
SplayTree.map (Text -> Chunk
chunk (Text -> Chunk) -> (Chunk -> Text) -> Chunk -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
Text.map Char -> Char
f (Text -> Text) -> (Chunk -> Text) -> Chunk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Text
chunkText) SplayTree Position Chunk
r
intercalate :: Rope -> [Rope] -> Rope
intercalate :: Rope -> [Rope] -> Rope
intercalate Rope
r [Rope]
rs = [Rope] -> Rope
forall a. Monoid a => [a] -> a
mconcat ([Rope] -> Rope) -> [Rope] -> Rope
forall a b. (a -> b) -> a -> b
$ Rope -> [Rope] -> [Rope]
forall a. a -> [a] -> [a]
intersperse Rope
r [Rope]
rs
toChunks :: Rope -> [Text]
toChunks :: Rope -> [Text]
toChunks = (Chunk -> Text) -> [Chunk] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Chunk -> Text
chunkText ([Chunk] -> [Text]) -> (Rope -> [Chunk]) -> Rope -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SplayTree Position Chunk -> [Chunk]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (SplayTree Position Chunk -> [Chunk])
-> (Rope -> SplayTree Position Chunk) -> Rope -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> SplayTree Position Chunk
unrope
unconsChunk :: Rope -> Maybe (Text, Rope)
unconsChunk :: Rope -> Maybe (Text, Rope)
unconsChunk (Rope SplayTree Position Chunk
r) = case SplayTree Position Chunk -> Maybe (Chunk, SplayTree Position Chunk)
forall v a.
Measured v a =>
SplayTree v a -> Maybe (a, SplayTree v a)
SplayTree.uncons SplayTree Position Chunk
r of
Maybe (Chunk, SplayTree Position Chunk)
Nothing -> Maybe (Text, Rope)
forall a. Maybe a
Nothing
Just (Chunk Text
t Position
_, SplayTree Position Chunk
r') -> (Text, Rope) -> Maybe (Text, Rope)
forall a. a -> Maybe a
Just (Text
t, SplayTree Position Chunk -> Rope
Rope SplayTree Position Chunk
r')
unsnocChunk :: Rope -> Maybe (Rope, Text)
unsnocChunk :: Rope -> Maybe (Rope, Text)
unsnocChunk (Rope SplayTree Position Chunk
r) = case SplayTree Position Chunk -> Maybe (SplayTree Position Chunk, Chunk)
forall v a.
Measured v a =>
SplayTree v a -> Maybe (SplayTree v a, a)
SplayTree.unsnoc SplayTree Position Chunk
r of
Maybe (SplayTree Position Chunk, Chunk)
Nothing -> Maybe (Rope, Text)
forall a. Maybe a
Nothing
Just (SplayTree Position Chunk
r', Chunk Text
t Position
_) -> (Rope, Text) -> Maybe (Rope, Text)
forall a. a -> Maybe a
Just (SplayTree Position Chunk -> Rope
Rope SplayTree Position Chunk
r', Text
t)
splitAt :: Int -> Rope -> (Rope, Rope)
splitAt :: Int -> Rope -> (Rope, Rope)
splitAt Int
n (Rope SplayTree Position Chunk
r) = case (Position -> Bool)
-> SplayTree Position Chunk -> SplitResult Position Chunk
forall v a.
Measured v a =>
(v -> Bool) -> SplayTree v a -> SplitResult v a
SplayTree.split ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n) (Int -> Bool) -> (Position -> Int) -> Position -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int
codeUnits) SplayTree Position Chunk
r of
SplitResult Position Chunk
SplayTree.Outside
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> (Rope
forall a. Monoid a => a
mempty, SplayTree Position Chunk -> Rope
Rope SplayTree Position Chunk
r)
| Bool
otherwise -> (SplayTree Position Chunk -> Rope
Rope SplayTree Position Chunk
r, Rope
forall a. Monoid a => a
mempty)
SplayTree.Inside SplayTree Position Chunk
pre (Chunk Text
t Position
_) SplayTree Position Chunk
post -> (SplayTree Position Chunk -> Rope
Rope SplayTree Position Chunk
pre Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Text -> Rope
fromShortText Text
pret, Text -> Rope
fromShortText Text
postt Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> SplayTree Position Chunk -> Rope
Rope SplayTree Position Chunk
post)
where
n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Position -> Int
codeUnits (SplayTree Position Chunk -> Position
forall v a. Measured v a => a -> v
SplayTree.measure SplayTree Position Chunk
pre)
(Text
pret, Text
postt) = Int -> Text -> (Text, Text)
split16At Int
n' Text
t
take :: Int -> Rope -> Rope
take :: Int -> Rope -> Rope
take Int
n = (Rope, Rope) -> Rope
forall a b. (a, b) -> a
fst ((Rope, Rope) -> Rope) -> (Rope -> (Rope, Rope)) -> Rope -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rope -> (Rope, Rope)
Data.Rope.UTF16.Internal.splitAt Int
n
drop :: Int -> Rope -> Rope
drop :: Int -> Rope -> Rope
drop Int
n = (Rope, Rope) -> Rope
forall a b. (a, b) -> b
snd ((Rope, Rope) -> Rope) -> (Rope -> (Rope, Rope)) -> Rope -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rope -> (Rope, Rope)
Data.Rope.UTF16.Internal.splitAt Int
n
rowColumnCodeUnits :: RowColumn -> Rope -> Int
rowColumnCodeUnits :: RowColumn -> Rope -> Int
rowColumnCodeUnits RowColumn
v (Rope SplayTree Position Chunk
r) = case (Position -> Bool)
-> SplayTree Position Chunk -> SplitResult Position Chunk
forall v a.
Measured v a =>
(v -> Bool) -> SplayTree v a -> SplitResult v a
SplayTree.split ((RowColumn -> RowColumn -> Bool
forall a. Ord a => a -> a -> Bool
> RowColumn
v) (RowColumn -> Bool) -> (Position -> RowColumn) -> Position -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> RowColumn
rowColumn) SplayTree Position Chunk
r of
SplitResult Position Chunk
SplayTree.Outside
| RowColumn
v RowColumn -> RowColumn -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int -> RowColumn
RowColumn Int
0 Int
0 -> Int
0
| Bool
otherwise -> Position -> Int
codeUnits (Position -> Int) -> Position -> Int
forall a b. (a -> b) -> a -> b
$ SplayTree Position Chunk -> Position
forall v a. Measured v a => a -> v
SplayTree.measure SplayTree Position Chunk
r
SplayTree.Inside SplayTree Position Chunk
pre (Chunk Text
t Position
_) SplayTree Position Chunk
_ -> Int -> RowColumn -> Int
go Int
0 (RowColumn -> Int) -> RowColumn -> Int
forall a b. (a -> b) -> a -> b
$ Position -> RowColumn
rowColumn Position
prePos
where
prePos :: Position
prePos = SplayTree Position Chunk -> Position
forall v a. Measured v a => a -> v
SplayTree.measure SplayTree Position Chunk
pre
len :: Int
len = Text -> Int
Unsafe.lengthWord16 Text
t
go :: Int -> RowColumn -> Int
go Int
i !RowColumn
v'
| RowColumn
v RowColumn -> RowColumn -> Bool
forall a. Ord a => a -> a -> Bool
<= RowColumn
v' Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Position -> Int
codeUnits Position
prePos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
| Bool
otherwise = case Text -> Int -> Iter
Unsafe.iter Text
t Int
i of
Unsafe.Iter Char
'\n' Int
delta -> Int -> RowColumn -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta) (RowColumn
v' RowColumn -> RowColumn -> RowColumn
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> RowColumn
RowColumn Int
1 Int
0)
Unsafe.Iter Char
_ Int
2 | RowColumn
v RowColumn -> RowColumn -> Bool
forall a. Eq a => a -> a -> Bool
== RowColumn
v' RowColumn -> RowColumn -> RowColumn
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> RowColumn
RowColumn Int
0 Int
1 -> Position -> Int
codeUnits Position
prePos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
Unsafe.Iter Char
_ Int
delta -> Int -> RowColumn -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta) (RowColumn
v' RowColumn -> RowColumn -> RowColumn
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> RowColumn
RowColumn Int
0 Int
delta)
codeUnitsRowColumn :: Int -> Rope -> RowColumn
codeUnitsRowColumn :: Int -> Rope -> RowColumn
codeUnitsRowColumn Int
offset Rope
rope
= (Position -> RowColumn
rowColumn (Position -> RowColumn) -> (Rope -> Position) -> Rope -> RowColumn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Position
forall v a. Measured v a => a -> v
measure) (Int -> Rope -> Rope
Data.Rope.UTF16.Internal.take Int
offset Rope
rope)
splitAtLine :: Int -> Rope -> (Rope, Rope)
splitAtLine :: Int -> Rope -> (Rope, Rope)
splitAtLine Int
r Rope
rope = Int -> Rope -> (Rope, Rope)
Data.Rope.UTF16.Internal.splitAt Int
i Rope
rope
where
i :: Int
i = RowColumn -> Rope -> Int
rowColumnCodeUnits (Int -> Int -> RowColumn
RowColumn Int
r Int
0) Rope
rope
span :: (Char -> Bool) -> Rope -> (Rope, Rope)
span :: (Char -> Bool) -> Rope -> (Rope, Rope)
span Char -> Bool
f (Rope SplayTree Position Chunk
r) = case SplayTree Position Chunk -> Maybe (Chunk, SplayTree Position Chunk)
forall v a.
Measured v a =>
SplayTree v a -> Maybe (a, SplayTree v a)
SplayTree.uncons SplayTree Position Chunk
r of
Maybe (Chunk, SplayTree Position Chunk)
Nothing -> (Rope
forall a. Monoid a => a
mempty, Rope
forall a. Monoid a => a
mempty)
Just (Chunk
t, SplayTree Position Chunk
r')
| Text -> Bool
Text.null Text
postt -> (SplayTree Position Chunk -> Rope
Rope (Chunk -> SplayTree Position Chunk
forall v a. Measured v a => a -> SplayTree v a
SplayTree.singleton Chunk
t) Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
pre', Rope
post')
| Bool
otherwise -> (Text -> Rope
fromShortText Text
pret, Text -> Rope
fromShortText Text
postt Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> SplayTree Position Chunk -> Rope
Rope SplayTree Position Chunk
r')
where
(Text
pret, Text
postt) = (Char -> Bool) -> Text -> (Text, Text)
Text.span Char -> Bool
f (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Chunk -> Text
chunkText Chunk
t
(Rope
pre', Rope
post') = (Char -> Bool) -> Rope -> (Rope, Rope)
Data.Rope.UTF16.Internal.span Char -> Bool
f (Rope -> (Rope, Rope)) -> Rope -> (Rope, Rope)
forall a b. (a -> b) -> a -> b
$ SplayTree Position Chunk -> Rope
Rope SplayTree Position Chunk
r'
break :: (Char -> Bool) -> Rope -> (Rope, Rope)
break :: (Char -> Bool) -> Rope -> (Rope, Rope)
break Char -> Bool
f = (Char -> Bool) -> Rope -> (Rope, Rope)
Data.Rope.UTF16.Internal.span (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f)
takeWhile :: (Char -> Bool) -> Rope -> Rope
takeWhile :: (Char -> Bool) -> Rope -> Rope
takeWhile Char -> Bool
f = (Rope, Rope) -> Rope
forall a b. (a, b) -> a
fst ((Rope, Rope) -> Rope) -> (Rope -> (Rope, Rope)) -> Rope -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Rope -> (Rope, Rope)
Data.Rope.UTF16.Internal.span Char -> Bool
f
dropWhile :: (Char -> Bool) -> Rope -> Rope
dropWhile :: (Char -> Bool) -> Rope -> Rope
dropWhile Char -> Bool
f = (Rope, Rope) -> Rope
forall a b. (a, b) -> b
snd ((Rope, Rope) -> Rope) -> (Rope -> (Rope, Rope)) -> Rope -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Rope -> (Rope, Rope)
Data.Rope.UTF16.Internal.span Char -> Bool
f
foldl :: (a -> Char -> a) -> a -> Rope -> a
foldl :: (a -> Char -> a) -> a -> Rope -> a
foldl a -> Char -> a
f a
a (Rope SplayTree Position Chunk
r) = (a -> Chunk -> a) -> a -> SplayTree Position Chunk -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl (\a
a' Chunk
c -> (a -> Char -> a) -> a -> Text -> a
forall a. (a -> Char -> a) -> a -> Text -> a
Text.foldl a -> Char -> a
f a
a' (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Chunk -> Text
chunkText Chunk
c) a
a SplayTree Position Chunk
r
foldl' :: (a -> Char -> a) -> a -> Rope -> a
foldl' :: (a -> Char -> a) -> a -> Rope -> a
foldl' a -> Char -> a
f a
a (Rope SplayTree Position Chunk
r) = (a -> Chunk -> a) -> a -> SplayTree Position Chunk -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' (\a
a' Chunk
c -> (a -> Char -> a) -> a -> Text -> a
forall a. (a -> Char -> a) -> a -> Text -> a
Text.foldl' a -> Char -> a
f a
a' (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Chunk -> Text
chunkText Chunk
c) a
a SplayTree Position Chunk
r
foldr :: (Char -> a -> a) -> a -> Rope -> a
foldr :: (Char -> a -> a) -> a -> Rope -> a
foldr Char -> a -> a
f a
a (Rope SplayTree Position Chunk
r) = (Chunk -> a -> a) -> a -> SplayTree Position Chunk -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr (\Chunk
c a
a' -> (Char -> a -> a) -> a -> Text -> a
forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr Char -> a -> a
f a
a' (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Chunk -> Text
chunkText Chunk
c) a
a SplayTree Position Chunk
r
any :: (Char -> Bool) -> Rope -> Bool
any :: (Char -> Bool) -> Rope -> Bool
any Char -> Bool
p (Rope SplayTree Position Chunk
r) = Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$ (Chunk -> Any) -> SplayTree Position Chunk -> Any
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> Any
Any (Bool -> Any) -> (Chunk -> Bool) -> Chunk -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
Text.any Char -> Bool
p (Text -> Bool) -> (Chunk -> Text) -> Chunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Text
chunkText) SplayTree Position Chunk
r
all :: (Char -> Bool) -> Rope -> Bool
all :: (Char -> Bool) -> Rope -> Bool
all Char -> Bool
p (Rope SplayTree Position Chunk
r) = All -> Bool
getAll (All -> Bool) -> All -> Bool
forall a b. (a -> b) -> a -> b
$ (Chunk -> All) -> SplayTree Position Chunk -> All
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> All
All (Bool -> All) -> (Chunk -> Bool) -> Chunk -> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
p (Text -> Bool) -> (Chunk -> Text) -> Chunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Text
chunkText) SplayTree Position Chunk
r