{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Core.Text.Rope (
Rope,
emptyRope,
singletonRope,
packRope,
replicateRope,
replicateChar,
widthRope,
splitRope,
takeRope,
insertRope,
containsCharacter,
findIndexRope,
Textual (fromRope, intoRope, appendRope),
hWrite,
unRope,
nullRope,
unsafeIntoRope,
Width (..),
) where
import Control.DeepSeq (NFData (..))
import Core.Text.Bytes
import qualified Data.ByteString as B (ByteString)
import qualified Data.ByteString.Builder as B (
hPutBuilder,
toLazyByteString,
)
import qualified Data.ByteString.Lazy as L (
ByteString,
foldrChunks,
toStrict,
)
import qualified Data.FingerTree as F (
FingerTree,
Measured (..),
SearchResult (..),
ViewL (..),
empty,
null,
search,
singleton,
viewl,
(<|),
(><),
(|>),
)
import Data.Foldable (foldl', foldr', toList)
import Data.Hashable (Hashable, hashWithSalt)
import Data.String (IsString (..))
import qualified Data.Text as T (Text)
import qualified Data.Text.Lazy as U (
Text,
foldrChunks,
fromChunks,
toStrict,
)
import qualified Data.Text.Lazy.Builder as U (
Builder,
fromText,
toLazyText,
)
import Prettyprinter (Pretty (..), emptyDoc)
import qualified Data.Text.Short as S (
ShortText,
any,
append,
empty,
findIndex,
fromByteString,
fromText,
length,
null,
pack,
replicate,
singleton,
splitAt,
toBuilder,
toText,
unpack,
)
import qualified Data.Text.Short.Unsafe as S (fromByteStringUnsafe)
import GHC.Generics (Generic)
import System.IO (Handle)
newtype Rope
= Rope (F.FingerTree Width S.ShortText)
deriving ((forall x. Rope -> Rep Rope x)
-> (forall x. Rep Rope x -> Rope) -> Generic Rope
forall x. Rep Rope x -> Rope
forall x. Rope -> Rep Rope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rope x -> Rope
$cfrom :: forall x. Rope -> Rep Rope x
Generic)
instance NFData Rope where
rnf :: Rope -> ()
rnf (Rope FingerTree Width ShortText
x) = (ShortText -> ()) -> FingerTree Width ShortText -> ()
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ShortText
piece -> ShortText -> ()
forall a. NFData a => a -> ()
rnf ShortText
piece) FingerTree Width ShortText
x
instance Show Rope where
show :: Rope -> String
show Rope
text = String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rope -> String
forall α. Textual α => Rope -> α
fromRope Rope
text String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
instance Eq Rope where
== :: Rope -> Rope -> Bool
(==) (Rope FingerTree Width ShortText
x1) (Rope FingerTree Width ShortText
x2) = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (FingerTree Width ShortText -> String
forall (t :: * -> *). Foldable t => t ShortText -> String
stream FingerTree Width ShortText
x1) (FingerTree Width ShortText -> String
forall (t :: * -> *). Foldable t => t ShortText -> String
stream FingerTree Width ShortText
x2)
where
stream :: t ShortText -> String
stream t ShortText
x = (ShortText -> String) -> t ShortText -> String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ShortText -> String
S.unpack t ShortText
x
instance Ord Rope where
compare :: Rope -> Rope -> Ordering
compare (Rope FingerTree Width ShortText
x1) (Rope FingerTree Width ShortText
x2) = FingerTree Width ShortText
-> FingerTree Width ShortText -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FingerTree Width ShortText
x1 FingerTree Width ShortText
x2
instance Pretty Rope where
pretty :: Rope -> Doc ann
pretty (Rope FingerTree Width ShortText
x) = (ShortText -> Doc ann -> Doc ann)
-> Doc ann -> FingerTree Width ShortText -> Doc ann
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
(<>) (Doc ann -> Doc ann -> Doc ann)
-> (ShortText -> Doc ann) -> ShortText -> Doc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (ShortText -> Text) -> ShortText -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
S.toText) Doc ann
forall ann. Doc ann
emptyDoc FingerTree Width ShortText
x
unRope :: Rope -> F.FingerTree Width S.ShortText
unRope :: Rope -> FingerTree Width ShortText
unRope (Rope FingerTree Width ShortText
x) = FingerTree Width ShortText
x
{-# INLINE unRope #-}
newtype Width = Width Int
deriving (Width -> Width -> Bool
(Width -> Width -> Bool) -> (Width -> Width -> Bool) -> Eq Width
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Width -> Width -> Bool
$c/= :: Width -> Width -> Bool
== :: Width -> Width -> Bool
$c== :: Width -> Width -> Bool
Eq, Eq Width
Eq Width
-> (Width -> Width -> Ordering)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Bool)
-> (Width -> Width -> Width)
-> (Width -> Width -> Width)
-> Ord Width
Width -> Width -> Bool
Width -> Width -> Ordering
Width -> Width -> Width
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
min :: Width -> Width -> Width
$cmin :: Width -> Width -> Width
max :: Width -> Width -> Width
$cmax :: Width -> Width -> Width
>= :: Width -> Width -> Bool
$c>= :: Width -> Width -> Bool
> :: Width -> Width -> Bool
$c> :: Width -> Width -> Bool
<= :: Width -> Width -> Bool
$c<= :: Width -> Width -> Bool
< :: Width -> Width -> Bool
$c< :: Width -> Width -> Bool
compare :: Width -> Width -> Ordering
$ccompare :: Width -> Width -> Ordering
$cp1Ord :: Eq Width
Ord, Int -> Width -> ShowS
[Width] -> ShowS
Width -> String
(Int -> Width -> ShowS)
-> (Width -> String) -> ([Width] -> ShowS) -> Show Width
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Width] -> ShowS
$cshowList :: [Width] -> ShowS
show :: Width -> String
$cshow :: Width -> String
showsPrec :: Int -> Width -> ShowS
$cshowsPrec :: Int -> Width -> ShowS
Show, Integer -> Width
Width -> Width
Width -> Width -> Width
(Width -> Width -> Width)
-> (Width -> Width -> Width)
-> (Width -> Width -> Width)
-> (Width -> Width)
-> (Width -> Width)
-> (Width -> Width)
-> (Integer -> Width)
-> Num Width
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Width
$cfromInteger :: Integer -> Width
signum :: Width -> Width
$csignum :: Width -> Width
abs :: Width -> Width
$cabs :: Width -> Width
negate :: Width -> Width
$cnegate :: Width -> Width
* :: Width -> Width -> Width
$c* :: Width -> Width -> Width
- :: Width -> Width -> Width
$c- :: Width -> Width -> Width
+ :: Width -> Width -> Width
$c+ :: Width -> Width -> Width
Num, (forall x. Width -> Rep Width x)
-> (forall x. Rep Width x -> Width) -> Generic Width
forall x. Rep Width x -> Width
forall x. Width -> Rep Width x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Width x -> Width
$cfrom :: forall x. Width -> Rep Width x
Generic)
instance F.Measured Width S.ShortText where
measure :: S.ShortText -> Width
measure :: ShortText -> Width
measure ShortText
piece = Int -> Width
Width (ShortText -> Int
S.length ShortText
piece)
instance Semigroup Width where
<> :: Width -> Width -> Width
(<>) (Width Int
w1) (Width Int
w2) = Int -> Width
Width (Int
w1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w2)
instance Monoid Width where
mempty :: Width
mempty = Int -> Width
Width Int
0
mappend :: Width -> Width -> Width
mappend = Width -> Width -> Width
forall a. Semigroup a => a -> a -> a
(<>)
instance IsString Rope where
fromString :: String -> Rope
fromString String
"" = Rope
emptyRope
fromString String
xs = FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText -> Rope)
-> (String -> FingerTree Width ShortText) -> String -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a
F.singleton (ShortText -> FingerTree Width ShortText)
-> (String -> ShortText) -> String -> FingerTree Width ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortText
S.pack (String -> Rope) -> String -> Rope
forall a b. (a -> b) -> a -> b
$ String
xs
instance Semigroup Rope where
<> :: Rope -> Rope -> Rope
(<>) text1 :: Rope
text1@(Rope FingerTree Width ShortText
x1) text2 :: Rope
text2@(Rope FingerTree Width ShortText
x2) =
if FingerTree Width ShortText -> Bool
forall v a. FingerTree v a -> Bool
F.null FingerTree Width ShortText
x2
then Rope
text1
else
if FingerTree Width ShortText -> Bool
forall v a. FingerTree v a -> Bool
F.null FingerTree Width ShortText
x1
then Rope
text2
else FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText
-> FingerTree Width ShortText -> FingerTree Width ShortText
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
(F.><) FingerTree Width ShortText
x1 FingerTree Width ShortText
x2)
instance Monoid Rope where
mempty :: Rope
mempty = Rope
emptyRope
mappend :: Rope -> Rope -> Rope
mappend = Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
(<>)
emptyRope :: Rope
emptyRope :: Rope
emptyRope = FingerTree Width ShortText -> Rope
Rope FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a
F.empty
{-# INLINEABLE emptyRope #-}
singletonRope :: Char -> Rope
singletonRope :: Char -> Rope
singletonRope = FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText -> Rope)
-> (Char -> FingerTree Width ShortText) -> Char -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a
F.singleton (ShortText -> FingerTree Width ShortText)
-> (Char -> ShortText) -> Char -> FingerTree Width ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShortText
S.singleton
packRope :: String -> Rope
packRope :: String -> Rope
packRope String
xs = FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText -> Rope)
-> (String -> FingerTree Width ShortText) -> String -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a
F.singleton (ShortText -> FingerTree Width ShortText)
-> (String -> ShortText) -> String -> FingerTree Width ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortText
S.pack (String -> Rope) -> String -> Rope
forall a b. (a -> b) -> a -> b
$ String
xs
replicateRope :: Int -> Rope -> Rope
replicateRope :: Int -> Rope -> Rope
replicateRope Int
count (Rope FingerTree Width ShortText
x) =
let x' :: FingerTree Width ShortText
x' = (Int -> FingerTree Width ShortText -> FingerTree Width ShortText)
-> FingerTree Width ShortText
-> [Int]
-> FingerTree Width ShortText
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
_ FingerTree Width ShortText
acc -> FingerTree Width ShortText
-> FingerTree Width ShortText -> FingerTree Width ShortText
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
(F.><) FingerTree Width ShortText
x FingerTree Width ShortText
acc) FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a
F.empty [Int
1 .. Int
count]
in FingerTree Width ShortText -> Rope
Rope FingerTree Width ShortText
x'
replicateChar :: Int -> Char -> Rope
replicateChar :: Int -> Char -> Rope
replicateChar Int
count = FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText -> Rope)
-> (Char -> FingerTree Width ShortText) -> Char -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a
F.singleton (ShortText -> FingerTree Width ShortText)
-> (Char -> ShortText) -> Char -> FingerTree Width ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShortText -> ShortText
S.replicate Int
count (ShortText -> ShortText)
-> (Char -> ShortText) -> Char -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShortText
S.singleton
widthRope :: Rope -> Int
widthRope :: Rope -> Int
widthRope = (ShortText -> Int -> Int)
-> Int -> FingerTree Width ShortText -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' ShortText -> Int -> Int
f Int
0 (FingerTree Width ShortText -> Int)
-> (Rope -> FingerTree Width ShortText) -> Rope -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> FingerTree Width ShortText
unRope
where
f :: ShortText -> Int -> Int
f ShortText
piece Int
count = ShortText -> Int
S.length ShortText
piece Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count
nullRope :: Rope -> Bool
nullRope :: Rope -> Bool
nullRope (Rope FingerTree Width ShortText
x) = case FingerTree Width ShortText -> ViewL (FingerTree Width) ShortText
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
F.viewl FingerTree Width ShortText
x of
ViewL (FingerTree Width) ShortText
F.EmptyL -> Bool
True
(F.:<) ShortText
piece FingerTree Width ShortText
_ -> ShortText -> Bool
S.null ShortText
piece
splitRope :: Int -> Rope -> (Rope, Rope)
splitRope :: Int -> Rope -> (Rope, Rope)
splitRope Int
i text :: Rope
text@(Rope FingerTree Width ShortText
x) =
let pos :: Width
pos = Int -> Width
Width Int
i
result :: SearchResult Width ShortText
result = (Width -> Width -> Bool)
-> FingerTree Width ShortText -> SearchResult Width ShortText
forall v a.
Measured v a =>
(v -> v -> Bool) -> FingerTree v a -> SearchResult v a
F.search (\Width
w1 Width
_ -> Width
w1 Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
>= Width
pos) FingerTree Width ShortText
x
in case SearchResult Width ShortText
result of
F.Position FingerTree Width ShortText
before ShortText
piece FingerTree Width ShortText
after ->
let (Width Int
w) = FingerTree Width ShortText -> Width
forall v a. Measured v a => a -> v
F.measure FingerTree Width ShortText
before
(ShortText
one, ShortText
two) = Int -> ShortText -> (ShortText, ShortText)
S.splitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w) ShortText
piece
in (FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText
-> ShortText -> FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
(F.|>) FingerTree Width ShortText
before ShortText
one), FingerTree Width ShortText -> Rope
Rope (ShortText
-> FingerTree Width ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
(F.<|) ShortText
two FingerTree Width ShortText
after))
SearchResult Width ShortText
F.OnLeft -> (FingerTree Width ShortText -> Rope
Rope FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a
F.empty, Rope
text)
SearchResult Width ShortText
F.OnRight -> (Rope
text, FingerTree Width ShortText -> Rope
Rope FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a
F.empty)
SearchResult Width ShortText
F.Nowhere -> String -> (Rope, Rope)
forall a. HasCallStack => String -> a
error String
"Position not found in split. Probable cause: predicate function given not monotonic. This is supposed to be unreachable"
takeRope :: Int -> Rope -> Rope
takeRope :: Int -> Rope -> Rope
takeRope Int
i Rope
text =
let (Rope
before, Rope
_) = Int -> Rope -> (Rope, Rope)
splitRope Int
i Rope
text
in Rope
before
insertRope :: Int -> Rope -> Rope -> Rope
insertRope :: Int -> Rope -> Rope -> Rope
insertRope Int
0 (Rope FingerTree Width ShortText
new) (Rope FingerTree Width ShortText
x) = FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText
-> FingerTree Width ShortText -> FingerTree Width ShortText
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
(F.><) FingerTree Width ShortText
new FingerTree Width ShortText
x)
insertRope Int
i (Rope FingerTree Width ShortText
new) Rope
text =
let (Rope FingerTree Width ShortText
before, Rope FingerTree Width ShortText
after) = Int -> Rope -> (Rope, Rope)
splitRope Int
i Rope
text
in FingerTree Width ShortText -> Rope
Rope ([FingerTree Width ShortText] -> FingerTree Width ShortText
forall a. Monoid a => [a] -> a
mconcat [FingerTree Width ShortText
before, FingerTree Width ShortText
new, FingerTree Width ShortText
after])
findIndexRope :: (Char -> Bool) -> Rope -> Maybe Int
findIndexRope :: (Char -> Bool) -> Rope -> Maybe Int
findIndexRope Char -> Bool
predicate = (Maybe Int, Int) -> Maybe Int
forall a b. (a, b) -> a
fst ((Maybe Int, Int) -> Maybe Int)
-> (Rope -> (Maybe Int, Int)) -> Rope -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Int, Int) -> ShortText -> (Maybe Int, Int))
-> (Maybe Int, Int)
-> FingerTree Width ShortText
-> (Maybe Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Maybe Int, Int) -> ShortText -> (Maybe Int, Int)
f (Maybe Int
forall a. Maybe a
Nothing, Int
0) (FingerTree Width ShortText -> (Maybe Int, Int))
-> (Rope -> FingerTree Width ShortText) -> Rope -> (Maybe Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> FingerTree Width ShortText
unRope
where
f :: (Maybe Int, Int) -> S.ShortText -> (Maybe Int, Int)
f :: (Maybe Int, Int) -> ShortText -> (Maybe Int, Int)
f (Maybe Int, Int)
acc ShortText
piece = case (Maybe Int, Int)
acc of
(Just Int
j, Int
_) -> (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
j, Int
0)
(Maybe Int
Nothing, !Int
i) -> case (Char -> Bool) -> ShortText -> Maybe Int
S.findIndex Char -> Bool
predicate ShortText
piece of
Maybe Int
Nothing -> (Maybe Int
forall a. Maybe a
Nothing, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShortText -> Int
S.length ShortText
piece)
Just !Int
j -> (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j), Int
0)
instance Hashable Rope where
hashWithSalt :: Int -> Rope -> Int
hashWithSalt Int
salt (Rope FingerTree Width ShortText
x) = (Int -> ShortText -> Int)
-> Int -> FingerTree Width ShortText -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> ShortText -> Int
f Int
salt FingerTree Width ShortText
x
where
f :: Int -> S.ShortText -> Int
f :: Int -> ShortText -> Int
f Int
num ShortText
piece = Int -> ShortText -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
num ShortText
piece
class Textual α where
fromRope :: Rope -> α
intoRope :: α -> Rope
appendRope :: α -> Rope -> Rope
appendRope α
thing Rope
text = Rope
text Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> α -> Rope
forall α. Textual α => α -> Rope
intoRope α
thing
instance Textual (F.FingerTree Width S.ShortText) where
fromRope :: Rope -> FingerTree Width ShortText
fromRope = Rope -> FingerTree Width ShortText
unRope
intoRope :: FingerTree Width ShortText -> Rope
intoRope = FingerTree Width ShortText -> Rope
Rope
instance Textual Rope where
fromRope :: Rope -> Rope
fromRope = Rope -> Rope
forall a. a -> a
id
intoRope :: Rope -> Rope
intoRope = Rope -> Rope
forall a. a -> a
id
appendRope :: Rope -> Rope -> Rope
appendRope (Rope FingerTree Width ShortText
x2) (Rope FingerTree Width ShortText
x1) = FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText
-> FingerTree Width ShortText -> FingerTree Width ShortText
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
(F.><) FingerTree Width ShortText
x1 FingerTree Width ShortText
x2)
instance Textual S.ShortText where
fromRope :: Rope -> ShortText
fromRope = (ShortText -> ShortText -> ShortText)
-> ShortText -> FingerTree Width ShortText -> ShortText
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> ShortText -> ShortText
S.append ShortText
S.empty (FingerTree Width ShortText -> ShortText)
-> (Rope -> FingerTree Width ShortText) -> Rope -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> FingerTree Width ShortText
unRope
intoRope :: ShortText -> Rope
intoRope = FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText -> Rope)
-> (ShortText -> FingerTree Width ShortText) -> ShortText -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a
F.singleton
appendRope :: ShortText -> Rope -> Rope
appendRope ShortText
piece (Rope FingerTree Width ShortText
x) = FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText
-> ShortText -> FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
(F.|>) FingerTree Width ShortText
x ShortText
piece)
instance Textual T.Text where
fromRope :: Rope -> Text
fromRope = Text -> Text
U.toStrict (Text -> Text) -> (Rope -> Text) -> Rope -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
U.toLazyText (Builder -> Text) -> (Rope -> Builder) -> Rope -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShortText -> Builder -> Builder)
-> Builder -> FingerTree Width ShortText -> Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> Builder -> Builder
f Builder
forall a. Monoid a => a
mempty (FingerTree Width ShortText -> Builder)
-> (Rope -> FingerTree Width ShortText) -> Rope -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> FingerTree Width ShortText
unRope
where
f :: S.ShortText -> U.Builder -> U.Builder
f :: ShortText -> Builder -> Builder
f ShortText
piece Builder
built = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Builder
U.fromText (ShortText -> Text
S.toText ShortText
piece)) Builder
built
intoRope :: Text -> Rope
intoRope Text
t = FingerTree Width ShortText -> Rope
Rope (ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a
F.singleton (Text -> ShortText
S.fromText Text
t))
appendRope :: Text -> Rope -> Rope
appendRope Text
chunk (Rope FingerTree Width ShortText
x) = FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText
-> ShortText -> FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
(F.|>) FingerTree Width ShortText
x (Text -> ShortText
S.fromText Text
chunk))
instance Textual U.Text where
fromRope :: Rope -> Text
fromRope (Rope FingerTree Width ShortText
x) = [Text] -> Text
U.fromChunks ([Text] -> Text)
-> (FingerTree Width ShortText -> [Text])
-> FingerTree Width ShortText
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShortText -> Text) -> [ShortText] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShortText -> Text
S.toText ([ShortText] -> [Text])
-> (FingerTree Width ShortText -> [ShortText])
-> FingerTree Width ShortText
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Width ShortText -> [ShortText]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (FingerTree Width ShortText -> Text)
-> FingerTree Width ShortText -> Text
forall a b. (a -> b) -> a -> b
$ FingerTree Width ShortText
x
intoRope :: Text -> Rope
intoRope Text
t = FingerTree Width ShortText -> Rope
Rope ((Text -> FingerTree Width ShortText -> FingerTree Width ShortText)
-> FingerTree Width ShortText -> Text -> FingerTree Width ShortText
forall a. (Text -> a -> a) -> a -> Text -> a
U.foldrChunks (ShortText
-> FingerTree Width ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
(F.<|) (ShortText
-> FingerTree Width ShortText -> FingerTree Width ShortText)
-> (Text -> ShortText)
-> Text
-> FingerTree Width ShortText
-> FingerTree Width ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ShortText
S.fromText) FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a
F.empty Text
t)
instance Textual B.ByteString where
fromRope :: Rope -> ByteString
fromRope = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Rope -> ByteString) -> Rope -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString) -> (Rope -> Builder) -> Rope -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShortText -> Builder -> Builder)
-> Builder -> FingerTree Width ShortText -> Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> Builder -> Builder
g Builder
forall a. Monoid a => a
mempty (FingerTree Width ShortText -> Builder)
-> (Rope -> FingerTree Width ShortText) -> Rope -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> FingerTree Width ShortText
unRope
where
g :: ShortText -> Builder -> Builder
g ShortText
piece Builder
built = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (ShortText -> Builder
S.toBuilder ShortText
piece) Builder
built
intoRope :: ByteString -> Rope
intoRope ByteString
b' = case ByteString -> Maybe ShortText
S.fromByteString ByteString
b' of
Just ShortText
piece -> FingerTree Width ShortText -> Rope
Rope (ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a
F.singleton ShortText
piece)
Maybe ShortText
Nothing -> FingerTree Width ShortText -> Rope
Rope FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a
F.empty
appendRope :: ByteString -> Rope -> Rope
appendRope ByteString
b' (Rope FingerTree Width ShortText
x) = case ByteString -> Maybe ShortText
S.fromByteString ByteString
b' of
Just ShortText
piece -> FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText
-> ShortText -> FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
(F.|>) FingerTree Width ShortText
x ShortText
piece)
Maybe ShortText
Nothing -> (FingerTree Width ShortText -> Rope
Rope FingerTree Width ShortText
x)
instance Textual L.ByteString where
fromRope :: Rope -> ByteString
fromRope = Builder -> ByteString
B.toLazyByteString (Builder -> ByteString) -> (Rope -> Builder) -> Rope -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShortText -> Builder -> Builder)
-> Builder -> FingerTree Width ShortText -> Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> Builder -> Builder
g Builder
forall a. Monoid a => a
mempty (FingerTree Width ShortText -> Builder)
-> (Rope -> FingerTree Width ShortText) -> Rope -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> FingerTree Width ShortText
unRope
where
g :: ShortText -> Builder -> Builder
g ShortText
piece Builder
built = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (ShortText -> Builder
S.toBuilder ShortText
piece) Builder
built
intoRope :: ByteString -> Rope
intoRope ByteString
b' = FingerTree Width ShortText -> Rope
Rope ((ByteString
-> FingerTree Width ShortText -> FingerTree Width ShortText)
-> FingerTree Width ShortText
-> ByteString
-> FingerTree Width ShortText
forall a. (ByteString -> a -> a) -> a -> ByteString -> a
L.foldrChunks (ShortText
-> FingerTree Width ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
(F.<|) (ShortText
-> FingerTree Width ShortText -> FingerTree Width ShortText)
-> (ByteString -> ShortText)
-> ByteString
-> FingerTree Width ShortText
-> FingerTree Width ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortText
check) FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a
F.empty ByteString
b')
where
check :: ByteString -> ShortText
check ByteString
chunk = case ByteString -> Maybe ShortText
S.fromByteString ByteString
chunk of
Just ShortText
piece -> ShortText
piece
Maybe ShortText
Nothing -> ShortText
S.empty
instance Textual Bytes where
fromRope :: Rope -> Bytes
fromRope = ByteString -> Bytes
forall α. Binary α => α -> Bytes
intoBytes (ByteString -> Bytes) -> (Rope -> ByteString) -> Rope -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rope -> ByteString
forall α. Textual α => Rope -> α
fromRope :: Rope -> B.ByteString)
intoRope :: Bytes -> Rope
intoRope = ByteString -> Rope
forall α. Textual α => α -> Rope
intoRope (ByteString -> Rope) -> (Bytes -> ByteString) -> Bytes -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteString
unBytes
instance Binary Rope where
fromBytes :: Bytes -> Rope
fromBytes = ByteString -> Rope
forall α. Textual α => α -> Rope
intoRope (ByteString -> Rope) -> (Bytes -> ByteString) -> Bytes -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteString
unBytes
intoBytes :: Rope -> Bytes
intoBytes = ByteString -> Bytes
forall α. Binary α => α -> Bytes
intoBytes (ByteString -> Bytes) -> (Rope -> ByteString) -> Rope -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rope -> ByteString
forall α. Textual α => Rope -> α
fromRope :: Rope -> B.ByteString)
unsafeIntoRope :: B.ByteString -> Rope
unsafeIntoRope :: ByteString -> Rope
unsafeIntoRope = FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText -> Rope)
-> (ByteString -> FingerTree Width ShortText) -> ByteString -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a
F.singleton (ShortText -> FingerTree Width ShortText)
-> (ByteString -> ShortText)
-> ByteString
-> FingerTree Width ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortText
S.fromByteStringUnsafe
instance Textual [Char] where
fromRope :: Rope -> String
fromRope (Rope FingerTree Width ShortText
x) = (ShortText -> ShowS)
-> String -> FingerTree Width ShortText -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> ShowS
h [] FingerTree Width ShortText
x
where
h :: ShortText -> ShowS
h ShortText
piece String
string = (ShortText -> String
S.unpack ShortText
piece) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
string
intoRope :: String -> Rope
intoRope = FingerTree Width ShortText -> Rope
Rope (FingerTree Width ShortText -> Rope)
-> (String -> FingerTree Width ShortText) -> String -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a
F.singleton (ShortText -> FingerTree Width ShortText)
-> (String -> ShortText) -> String -> FingerTree Width ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortText
S.pack
hWrite :: Handle -> Rope -> IO ()
hWrite :: Handle -> Rope -> IO ()
hWrite Handle
handle (Rope FingerTree Width ShortText
x) = Handle -> Builder -> IO ()
B.hPutBuilder Handle
handle ((ShortText -> Builder -> Builder)
-> Builder -> FingerTree Width ShortText -> Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> Builder -> Builder
j Builder
forall a. Monoid a => a
mempty FingerTree Width ShortText
x)
where
j :: ShortText -> Builder -> Builder
j ShortText
piece Builder
built = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (ShortText -> Builder
S.toBuilder ShortText
piece) Builder
built
containsCharacter :: Char -> Rope -> Bool
containsCharacter :: Char -> Rope -> Bool
containsCharacter Char
q (Rope FingerTree Width ShortText
x) = (ShortText -> Bool) -> FingerTree Width ShortText -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ShortText -> Bool
j FingerTree Width ShortText
x
where
j :: ShortText -> Bool
j ShortText
piece = (Char -> Bool) -> ShortText -> Bool
S.any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
q) ShortText
piece