{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{- |
If you're accustomed to working with text in almost any other programming
language, you'd be aware that a \"string\" typically refers to an in-memory
/array/ of characters. Traditionally this was a single ASCII byte per
character; more recently UTF-8 variable byte encodings which dramatically
complicates finding offsets but which gives efficient support for the entire
Unicode character space. In Haskell, the original text type, 'String', is
implemented as a list of 'Char' which, because a Haskell list is implemented
as a /linked-list of boxed values/, is wildly inefficient at any kind of
scale.

In modern Haskell there are two primary ways to represent text.

First is via the [rather poorly named] @ByteString@ from the __bytestring__
package (which is an array of bytes in pinned memory). The
"Data.ByteString.Char8" submodule gives you ways to manipulate those arrays as
if they were ASCII characters. Confusingly there are both strict
(@Data.ByteString@) and lazy (@Data.ByteString.Lazy@) variants which are often
hard to tell the difference between when reading function signatures or
haddock documentation. The performance problem an immutable array backed data
type runs into is that appending a character (that is, ASCII byte) or
concatonating a string (that is, another array of ASCII bytes) is very
expensive and requires allocating a new larger array and copying the whole
thing into it. This led to the development of \"builders\" which amortize this
reallocation cost over time, but it can be cumbersome to switch between
@Builder@, the lazy @ByteString@ that results, and then having to inevitably
convert to a strict @ByteString@ because that's what the next function in your
sequence requires.

The second way is through the opaque @Text@ type of "Data.Text" from the
__text__ package, which is well tuned and high-performing but suffers from the
same design; it is likewise backed by arrays. (Historically, the storage
backing Text objects was encoded in UTF-16, meaning every time you wanted to
work with unicode characters that came in from /anywhere/ else and which
inevitably were UTF-8 encoded they had to be converted to UTF-16 and copied
into a further new array! Fortunately Haskell has recently adopted a UTF-8
backed @Text@ type, reducing this overhead. The challenge of appending pinned
allocations remains, however.)

In this package we introduce 'Rope', a text type backed by the 2-3
'Data.FingerTree.FingerTree' data structure from the __fingertree__ package.
This is not an uncommon solution in many languages as finger trees support
exceptionally efficient appending to either end and good performance inserting
anywhere else (you often find them as the backing data type underneath text
editors for this reason). Rather than 'Char' the pieces of the rope are
'Data.Text.Short.ShortText' from the __text-short__ package, which are UTF-8
encoded and in normal memory managed by the Haskell runtime. Conversion from
other Haskell text types is not /O(1)/ (UTF-8 validity must be checked, or
UTF-16 decoded, or...), but in our benchmarking the performance has been
comparable to the established types and you may find the resultant interface
for combining chunks is comparable to using a Builder, without being forced to
use a Builder.

'Rope' is used as the text type throughout this library. If you use the
functions within this package (rather than converting to other text types)
operations are quite efficient. When you do need to convert to another type
you can use 'fromRope' or 'intoRope' from the 'Textual' typeclass.

Note that we haven't tried to cover the entire gamut of operations or
customary convenience functions you would find in the other libraries; so far
'Rope' is concentrated on aiding interoperation, being good at appending (lots
of) small pieces, and then efficiently taking the resultant text object out to
a file handle, be that the terminal console, a file, or a network socket.
-}
module Core.Text.Rope (
    -- * Rope type
    Rope,
    emptyRope,
    singletonRope,
    packRope,
    replicateRope,
    replicateChar,
    widthRope,
    unconsRope,
    splitRope,
    takeRope,
    insertRope,
    containsCharacter,
    findIndexRope,

    -- * Interoperation and Output
    Textual (fromRope, intoRope, appendRope),
    hWrite,

    -- * Internals
    unRope,
    nullRope,
    unsafeIntoRope,
    copyRope,
    Width (..),
) where

import Control.DeepSeq (NFData (..))
import Core.Text.Bytes
import Data.ByteString qualified as B (ByteString)
import Data.ByteString.Builder qualified as B (
    Builder,
    hPutBuilder,
    toLazyByteString,
 )
import Data.ByteString.Lazy qualified as L (
    ByteString,
    foldrChunks,
    toStrict,
 )
import Data.FingerTree qualified as F (
    FingerTree,
    Measured (..),
    SearchResult (..),
    ViewL (..),
    empty,
    null,
    search,
    singleton,
    viewl,
    (<|),
    (><),
    (|>),
 )
import Data.Foldable (foldl', toList)
import Data.Hashable (Hashable, hashWithSalt)
import Data.String (IsString (..))
import Data.Text qualified as T (Text)
import Data.Text.Lazy qualified as U (
    Text,
    foldrChunks,
    fromChunks,
    toStrict,
 )
import Data.Text.Lazy.Builder qualified as U (
    Builder,
    fromText,
    toLazyText,
 )
import Data.Text.Short qualified as S (
    ShortText,
    any,
    append,
    empty,
    findIndex,
    fromByteString,
    fromText,
    length,
    pack,
    replicate,
    singleton,
    splitAt,
    toBuilder,
    toText,
    uncons,
    unpack,
 )
import Data.Text.Short.Unsafe qualified as S (fromByteStringUnsafe)
import GHC.Generics (Generic)
import Prettyprinter (Pretty (..), emptyDoc)
import System.IO (Handle)

{- |
A type for textual data. A rope is text backed by a tree data structure,
rather than a single large continguous array, as is the case for strings.

There are three use cases:

/Referencing externally sourced data/

Often we interpret large blocks of data sourced from external systems as text.
Ideally we would hold onto this without copying the memory, but (as in the
case of @ByteString@ which is the most common source of data) before we can
treat it as text we have to validate the UTF-8 content. Safety first. We also
copy it out of pinned memory, allowing the Haskell runtime to manage the
storage.

/Interoperating with other libraries/

The only constant of the Haskell universe is that you won't have the right
combination of {strict, lazy} × {@Text@, @ByteString@, @String@, @[Word8]@,
etc} you need for the next function call. The 'Textual' typeclass provides for
moving between different text representations. To convert between @Rope@ and
something else use 'fromRope'; to construct a @Rope@ from textual content in
another type use 'intoRope'.

You can get at the underlying finger tree with the 'unRope' function.

/Assembling text to go out/

This involves considerable appending of data, very very occaisionally
inserting it. Often the pieces are tiny. To add text to a @Rope@ use the
'appendRope' method as below or the ('Data.Semigroup.<>') operator from
"Data.Monoid" (like you would have with a @Builder@).

Output to a @Handle@ can be done efficiently with 'hWrite'.
-}
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

{- |
Access the finger tree underlying the @Rope@. You'll want the following
imports:

@
import qualified "Data.FingerTree" as F  -- from the __fingertree__ package
import qualified "Data.Text.Short" as S  -- from the __text-short__ package
@
-}
unRope :: Rope -> F.FingerTree Width S.ShortText
unRope :: Rope -> FingerTree Width ShortText
unRope (Rope FingerTree Width ShortText
x) = FingerTree Width ShortText
x
{-# INLINE unRope #-}

{- |
The length of the @Rope@, in characters. This is the monoid used to
structure the finger tree underlying the @Rope@.
-}
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
(<>)

-- here Maybe we just need type Strand = ShortText and then Rope is
-- FingerTree Strand or Builder (Strand)

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) -- god I hate these operators

instance Monoid Rope where
    mempty :: Rope
mempty = Rope
emptyRope
    mappend :: Rope -> Rope -> Rope
mappend = Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
(<>)

{- |
A zero-length 'Rope'. You can also use @\"\"@ presuming the
__@OverloadedStrings@__ language extension is turned on in your source file.
-}
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 #-}

{- |
A 'Rope' with but a single character.
-}
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

{- |
A 'Rope' built from a list of characters. Equivalent to calling 'intoRope' on
the String, but can help you avoid ambiguious type errors when composing
functions or working with literals.

@since 0.3.4
-}
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

{- |
Repeat the input 'Rope' @n@ times. The follows the same semantics as other
@replicate@ functions; if you ask for zero copies you'll get an empty text and
if you ask for lots of @""@ you'll get ... an empty text.

/Implementation note/

Rather than copying the input /n/ times, this will simply add structure to
hold /n/ references to the provided input text.
-}
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'

{- |
Repeat the input 'Char' @n@ times. This is a special case of 'replicateRope'
above.

/Implementation note/

Rather than making a huge FingerTree full of single characters, this function
will allocate a single ShortText comprised of the repeated input character.
-}
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

{- |
Get the length of this text, in characters.
-}
widthRope :: Rope -> Int
widthRope :: Rope -> Int
widthRope Rope
text =
    let x :: FingerTree Width ShortText
x = Rope -> FingerTree Width ShortText
unRope Rope
text
        (Width Int
w) = FingerTree Width ShortText -> Width
forall v a. Measured v a => a -> v
F.measure FingerTree Width ShortText
x
     in Int
w

nullRope :: Rope -> Bool
nullRope :: Rope -> Bool
nullRope Rope
text = Rope -> Int
widthRope Rope
text Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

{- |
Read the first character from a 'Rope', assuming it's length 1 or greater,
returning 'Just' that character and the remainder of the text. Returns
'Nothing' if the input is 0 length.

@since 0.3.7
-}
unconsRope :: Rope -> Maybe (Char, Rope)
unconsRope :: Rope -> Maybe (Char, Rope)
unconsRope Rope
text =
    let x :: FingerTree Width ShortText
x = Rope -> FingerTree Width ShortText
unRope Rope
text
     in 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 -> Maybe (Char, Rope)
forall a. Maybe a
Nothing
            (F.:<) ShortText
piece FingerTree Width ShortText
x' ->
                case ShortText -> Maybe (Char, ShortText)
S.uncons ShortText
piece of
                    Maybe (Char, ShortText)
Nothing -> Maybe (Char, Rope)
forall a. Maybe a
Nothing
                    Just (Char
c, ShortText
piece') -> (Char, Rope) -> Maybe (Char, Rope)
forall a. a -> Maybe a
Just (Char
c, 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
piece' FingerTree Width ShortText
x'))

{- |
Break the text into two pieces at the specified offset.

Examples:

@
λ> __splitRope 0 \"abcdef\"__
(\"\", \"abcdef\")
λ> __splitRope 3 \"abcdef\"__
(\"abc\", \"def\")
λ> __splitRope 6 \"abcdef\"__
(\"abcdef\",\"\")
@

Going off either end behaves sensibly:

@
λ> __splitRope 7 \"abcdef\"__
(\"abcdef\",\"\")
λ> __splitRope (-1) \"abcdef\"__
(\"\", \"abcdef\")
@
-}
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"

{- |
Take the first _n_ characters from the beginning of the Rope.

@
λ> __takeRope 3 \"123456789\"__
\"123\"
@
-}
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

{- |
Insert a new piece of text into an existing @Rope@ at the specified offset.

Examples:

@
λ> __insertRope 3 \"Con\" \"Def 1\"__
"DefCon 1"
λ> __insertRope 0 \"United \" \"Nations\"__
"United Nations"
@
-}
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
    -- convert this to Maybe monad, maybe
    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)

--
-- Manual instance to get around the fact that FingerTree doesn't have a
-- Hashable instance. If this were ever to become a hotspot we could
-- potentially use the Hashed caching type in the finger tree as
--
-- FingerTree Width (Hashed S.ShortText)
--
-- at the cost of endless unwrapping. Another alternative would be to cache
-- hash values in the monoid, changing Width from being a wrapper of Int to
-- a record type with width, hash, and perhaps newlines within the
-- corresponding tree.
--
instance Hashable Rope where
    hashWithSalt :: Int -> Rope -> Int
hashWithSalt Int
salt Rope
text =
        let (Rope FingerTree Width ShortText
x') = Rope -> Rope
copyRope Rope
text
            piece :: ShortText
piece = 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 -> ShortText
S.empty
                (F.:<) ShortText
first FingerTree Width ShortText
_ -> ShortText
first
         in Int -> ShortText -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt ShortText
piece

{- |
Copy the pieces underlying a 'Rope' into a single piece object.

/Warning/

This function was necessary to have a reliable 'Hashable' instance. Currently
constructing this new 'Rope' is quite inefficient if the number of pieces or
their respective lengths are large. Usually, however, we're calling
'Data.Hashable.hash' so the value can be used as a key in a hash table and
such keys are typically simple (or at least not ridiculously long), so this is
not an issue in normal usage.
-}
copyRope :: Rope -> Rope
copyRope :: Rope -> Rope
copyRope text :: Rope
text@(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 -> Rope
text
        (F.:<) ShortText
_ 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 -> Rope
text
            -- TODO replace this with a function that allocates a ByteArray#
            -- of the appropriate length then copies the pieces in
            ViewL (FingerTree Width) ShortText
_ -> FingerTree Width ShortText -> Rope
Rope (ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a
F.singleton ((ShortText -> ShortText -> ShortText)
-> ShortText -> FingerTree Width ShortText -> ShortText
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ShortText -> ShortText -> ShortText
S.append ShortText
S.empty FingerTree Width ShortText
x))

{- |
Machinery to interpret a type as containing valid Unicode that can be
represented as a 'Rope' object.

/Implementation notes/

Given that 'Rope' is backed by a finger tree, 'appendRope' is relatively
inexpensive, plus whatever the cost of conversion is. There is a subtle trap,
however: if adding small fragments of that were obtained by slicing (for
example) a large 'Data.ByteString.ByteString' we would end up holding on to a
reference to the entire underlying block of memory. This module is optimized
to reduce heap fragmentation by letting the Haskell runtime and garbage
collector manage the memory, so instances are expected to /copy/ these
substrings out of pinned memory.

The 'Data.ByteString.ByteString' instance requires that its content be valid
UTF-8. If not an empty 'Rope' will be returned.

Several of the 'fromRope' implementations are expensive and involve a lot of
intermediate allocation and copying. If you're ultimately writing to a handle
prefer 'hWrite' which will write directly to the output buffer.
-}
class Textual α where
    -- | Convert a @Rope@ into another text-like type.
    fromRope :: Rope -> α

    -- | Take another text-like type and convert it to a @Rope@.
    intoRope :: α -> Rope

    -- | Append some text to this @Rope@. The default implementation is basically a convenience wrapper around calling 'intoRope' and 'mappend'ing it to your text (which will work just fine, but for some types more efficient implementations are possible).
    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)

-- | from "Data.Text.Short"
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)

-- | from "Data.Text" Strict
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))

-- | from "Data.Text.Lazy"
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)

-- | from "Data.ByteString" Strict
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

    -- If the input ByteString does not contain valid UTF-8 then an empty
    -- Rope will be returned. That's not ideal.
    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 -- bad

    -- ditto
    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) -- bad

-- | from "Data.ByteString.Builder"
instance Textual B.Builder where
    fromRope :: Rope -> Builder
fromRope = (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 :: Builder -> Rope
intoRope =
        FingerTree Width ShortText -> Rope
Rope
            (FingerTree Width ShortText -> Rope)
-> (Builder -> FingerTree Width ShortText) -> Builder -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( (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
S.fromByteStringUnsafe
                    )
                    FingerTree Width ShortText
forall v a. Measured v a => FingerTree v a
F.empty
              )
            (ByteString -> FingerTree Width ShortText)
-> (Builder -> ByteString) -> Builder -> FingerTree Width ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString

-- | from "Data.ByteString.Lazy"
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 -- very bad

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)

{- |
If you /know/ the input bytes are valid UTF-8 encoded characters, then you can
use this function to convert to a piece of @Rope@.
-}
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

-- | from "Data.String"
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 -- ugh
    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

{- |
Write the 'Rope' to the given 'Handle'.

@
import "Core.Text"
import "Core.System" -- re-exports stdout

main :: IO ()
main =
  let text :: 'Rope'
      text = "Hello World"
   in 'hWrite' 'System.IO.stdout' text
@
because it's tradition.

Uses 'Data.ByteString.Builder.hPutBuilder' internally which saves all kinds of
intermediate allocation and copying because we can go from the
'Data.Text.Short.ShortText's in the finger tree to
'Data.ByteString.Short.ShortByteString' to 'Data.ByteString.Builder.Builder'
to the 'System.IO.Handle''s output buffer in one go.

If you're working in the __core-program__ 'Core.Program.Execute.Program' @τ@
monad, then the 'Core.Program.Logging.write' function there provides an
efficient way to write a 'Rope' to @stdout@.
-}
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

{- |
Does the text contain this character?

We've used it to ask whether there are newlines present in a @Rope@, for
example:

@
    if 'containsCharacter' \'\\n\' text
        then handleComplexCase
        else keepItSimple
@
-}
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