{-# 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. 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) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ShortText
piece -> forall a. NFData a => a -> ()
rnf ShortText
piece) FingerTree Width ShortText
x

instance Show Rope where
    show :: Rope -> [Char]
show Rope
text = [Char]
"\"" forall a. [a] -> [a] -> [a]
++ forall α. Textual α => Rope -> α
fromRope Rope
text forall a. [a] -> [a] -> [a]
++ [Char]
"\""

instance Eq Rope where
    == :: Rope -> Rope -> Bool
(==) (Rope FingerTree Width ShortText
x1) (Rope FingerTree Width ShortText
x2) = forall a. Eq a => a -> a -> Bool
(==) (forall {t :: * -> *}. Foldable t => t ShortText -> [Char]
stream FingerTree Width ShortText
x1) (forall {t :: * -> *}. Foldable t => t ShortText -> [Char]
stream FingerTree Width ShortText
x2)
      where
        stream :: t ShortText -> [Char]
stream t ShortText
x = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ShortText -> [Char]
S.unpack t ShortText
x

instance Ord Rope where
    compare :: Rope -> Rope -> Ordering
compare (Rope FingerTree Width ShortText
x1) (Rope FingerTree Width ShortText
x2) = forall a. Ord a => a -> a -> Ordering
compare FingerTree Width ShortText
x1 FingerTree Width ShortText
x2

instance Pretty Rope where
    pretty :: forall ann. Rope -> Doc ann
pretty (Rope FingerTree Width ShortText
x) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
S.toText) 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
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
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
Ord, Int -> Width -> ShowS
[Width] -> ShowS
Width -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Width] -> ShowS
$cshowList :: [Width] -> ShowS
show :: Width -> [Char]
$cshow :: Width -> [Char]
showsPrec :: Int -> Width -> ShowS
$cshowsPrec :: Int -> Width -> ShowS
Show, Integer -> Width
Width -> Width
Width -> Width -> 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. 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 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 = 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 :: [Char] -> Rope
fromString [Char]
"" = Rope
emptyRope
    fromString [Char]
xs = FingerTree Width ShortText -> Rope
Rope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. Measured v a => a -> FingerTree v a
F.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShortText
S.pack forall a b. (a -> b) -> a -> b
$ [Char]
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 forall v a. FingerTree v a -> Bool
F.null FingerTree Width ShortText
x2
            then Rope
text1
            else
                if forall v a. FingerTree v a -> Bool
F.null FingerTree Width ShortText
x1
                    then Rope
text2
                    else FingerTree Width ShortText -> Rope
Rope (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 = 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. Measured v a => a -> FingerTree v a
F.singleton 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 :: [Char] -> Rope
packRope [Char]
xs = FingerTree Width ShortText -> Rope
Rope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. Measured v a => a -> FingerTree v a
F.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShortText
S.pack forall a b. (a -> b) -> a -> b
$ [Char]
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' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
_ FingerTree Width ShortText
acc -> forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
(F.><) FingerTree Width ShortText
x FingerTree Width ShortText
acc) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. Measured v a => a -> FingerTree v a
F.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShortText -> ShortText
S.replicate Int
count 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) = 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 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 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 -> 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 -> forall a. Maybe a
Nothing
                    Just (Char
c, ShortText
piece') -> forall a. a -> Maybe a
Just (Char
c, FingerTree Width ShortText -> Rope
Rope (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 = forall v a.
Measured v a =>
(v -> v -> Bool) -> FingerTree v a -> SearchResult v a
F.search (\Width
w1 Width
_ -> Width
w1 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) = 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 forall a. Num a => a -> a -> a
- Int
w) ShortText
piece
                in  (FingerTree Width ShortText -> Rope
Rope (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 (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 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 forall v a. Measured v a => FingerTree v a
F.empty)
            SearchResult Width ShortText
F.Nowhere -> forall a. HasCallStack => [Char] -> a
error [Char]
"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 (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 (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 = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Maybe Int, Int) -> ShortText -> (Maybe Int, Int)
f (forall a. Maybe a
Nothing, Int
0) 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
_) -> (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 -> (forall a. Maybe a
Nothing, Int
i forall a. Num a => a -> a -> a
+ ShortText -> Int
S.length ShortText
piece)
            Just !Int
j -> (forall a. a -> Maybe a
Just (Int
i 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 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  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 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 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 (forall v a. Measured v a => a -> FingerTree v a
F.singleton (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 forall a. Semigroup a => a -> a -> a
<> 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 = forall a. a -> a
id
    intoRope :: Rope -> Rope
intoRope = 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 (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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> ShortText -> ShortText
S.append ShortText
S.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> FingerTree Width ShortText
unRope
    intoRope :: ShortText -> Rope
intoRope = FingerTree Width ShortText -> Rope
Rope forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
U.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> Builder -> Builder
f forall a. Monoid a => a
mempty 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 = 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 (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 (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShortText -> Text
S.toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ FingerTree Width ShortText
x
    intoRope :: Text -> Rope
intoRope Text
t = FingerTree Width ShortText -> Rope
Rope (forall a. (Text -> a -> a) -> a -> Text -> a
U.foldrChunks (forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
(F.<|) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ShortText
S.fromText) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> Builder -> Builder
g forall a. Monoid a => a
mempty 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 = 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 (forall v a. Measured v a => a -> FingerTree v a
F.singleton ShortText
piece)
        Maybe ShortText
Nothing -> FingerTree Width ShortText -> Rope
Rope 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 (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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> Builder -> Builder
g forall a. Monoid a => a
mempty 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 = forall a. Semigroup a => a -> a -> a
(<>) (ShortText -> Builder
S.toBuilder ShortText
piece) Builder
built
    intoRope :: Builder -> Rope
intoRope =
        FingerTree Width ShortText -> Rope
Rope
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( forall a. (ByteString -> a -> a) -> a -> ByteString -> a
L.foldrChunks
                    ( forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
(F.<|) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortText
S.fromByteStringUnsafe
                    )
                    forall v a. Measured v a => FingerTree v a
F.empty
              )
            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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> Builder -> Builder
g forall a. Monoid a => a
mempty 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 = 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 (forall a. (ByteString -> a -> a) -> a -> ByteString -> a
L.foldrChunks (forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
(F.<|) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortText
check) 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 = forall α. Binary α => α -> Bytes
intoBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall α. Textual α => Rope -> α
fromRope :: Rope -> B.ByteString)
    intoRope :: Bytes -> Rope
intoRope = forall α. Textual α => α -> Rope
intoRope forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteString
unBytes

instance Binary Rope where
    fromBytes :: Bytes -> Rope
fromBytes = forall α. Textual α => α -> Rope
intoRope forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteString
unBytes
    intoBytes :: Rope -> Bytes
intoBytes = forall α. Binary α => α -> Bytes
intoBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. Measured v a => a -> FingerTree v a
F.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortText
S.fromByteStringUnsafe

-- | from "Data.String"
instance Textual [Char] where
    fromRope :: Rope -> [Char]
fromRope (Rope FingerTree Width ShortText
x) = 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 [Char]
string = (ShortText -> [Char]
S.unpack ShortText
piece) forall a. [a] -> [a] -> [a]
++ [Char]
string -- ugh
    intoRope :: [Char] -> Rope
intoRope = FingerTree Width ShortText -> Rope
Rope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. Measured v a => a -> FingerTree v a
F.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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 (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> Builder -> Builder
j forall a. Monoid a => a
mempty FingerTree Width ShortText
x)
  where
    j :: ShortText -> Builder -> Builder
j ShortText
piece Builder
built = 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) = 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 forall a. Eq a => a -> a -> Bool
== Char
q) ShortText
piece