{-# language CPP #-}
{-# language BangPatterns #-}
{-# language DeriveDataTypeable #-}
{-# language LambdaCase #-}
{-# language MultiParamTypeClasses #-}
{-# language OverloadedStrings #-}
{-# language ScopedTypeVariables #-}
{-# language ViewPatterns #-}
{-# options_haddock show-extensions #-}

-- |
-- Module      :  Yi.Rope
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- This module defines a @rope@ data structure for use in Yi. This
-- specific implementation uses a fingertree over Text.
--
-- In contrast to our old implementation, we can now reap all the
-- benefits of Text: automatic unicode handling and blazing fast
-- implementation on underlying strings. This frees us from a lot of
-- book-keeping. We don't lose out on not using ByteString directly
-- because the old implementation encoded it into UTF8 anyway, making
-- it unsuitable for storing anything but text.

module Yi.Rope (
   Yi.Rope.YiString,

   -- * Conversions to YiString
   Yi.Rope.fromString, Yi.Rope.fromText,
   Yi.Rope.fromString', Yi.Rope.fromText',

   -- * Conversions from YiString
   Yi.Rope.toString, Yi.Rope.toReverseString,
   Yi.Rope.toText, Yi.Rope.toReverseText,

   -- * Functions over content
   Yi.Rope.null, Yi.Rope.empty, Yi.Rope.take, Yi.Rope.drop,
   Yi.Rope.length, Yi.Rope.reverse, Yi.Rope.countNewLines,
   Yi.Rope.lines, Yi.Rope.lines', Yi.Rope.unlines,
   Yi.Rope.splitAt, Yi.Rope.splitAtLine,
   Yi.Rope.cons, Yi.Rope.snoc, Yi.Rope.singleton,
   Yi.Rope.head, Yi.Rope.last,
   Yi.Rope.append, Yi.Rope.concat,
   Yi.Rope.any, Yi.Rope.all,
   Yi.Rope.dropWhile, Yi.Rope.takeWhile,
   Yi.Rope.dropWhileEnd, Yi.Rope.takeWhileEnd,
   Yi.Rope.intercalate, Yi.Rope.intersperse,
   Yi.Rope.filter, Yi.Rope.map,
   Yi.Rope.words, Yi.Rope.unwords,
   Yi.Rope.split, Yi.Rope.init, Yi.Rope.tail,
   Yi.Rope.span, Yi.Rope.break, Yi.Rope.foldl',
   Yi.Rope.replicate, Yi.Rope.replicateChar,

   -- * IO
   Yi.Rope.readFile, Yi.Rope.writeFile,

   -- * Escape latches to underlying content. Note that these are safe
   -- to use but it does not mean they should.
   Yi.Rope.fromRope, Yi.Rope.withText, Yi.Rope.unsafeWithText

  ) where

import           Control.DeepSeq
import           Control.Exception (try)
import           Data.Binary
import qualified Data.ByteString.Lazy as BSL
import           Data.Char (isSpace)
import qualified Data.FingerTree as T
import           Data.FingerTree hiding (null, empty, reverse, split)
import qualified Data.List as L (foldl')
import           Data.Maybe
import           Data.Monoid
import           Data.String (IsString(..))
import qualified Data.Text as TX
import qualified Data.Text.Encoding.Error as TXEE
import qualified Data.Text.Lazy as TXL
import qualified Data.Text.Lazy.Encoding as TXLE
import qualified Data.Text.IO as TXIO (writeFile)
import           Data.Typeable
import           Prelude hiding (drop)

-- | Used to cache the size of the strings.
data Size = Indices { Size -> Int
charIndex :: {-# UNPACK #-} !Int
                      -- ^ How many characters under here?
                    , Size -> Int
lineIndex :: Int
                      -- ^ How many lines under here?
                    } deriving (Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
/= :: Size -> Size -> Bool
Eq, Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Size -> ShowS
showsPrec :: Int -> Size -> ShowS
$cshow :: Size -> String
show :: Size -> String
$cshowList :: [Size] -> ShowS
showList :: [Size] -> ShowS
Show, Typeable)

-- | A chunk storing the string of the type it is indexed by. It
-- caches the length of stored string.
data YiChunk = Chunk { YiChunk -> Int
chunkSize :: {-# UNPACK #-} !Int
                     , YiChunk -> Text
_fromChunk :: {-# UNPACK #-} !TX.Text
                     } deriving (Int -> YiChunk -> ShowS
[YiChunk] -> ShowS
YiChunk -> String
(Int -> YiChunk -> ShowS)
-> (YiChunk -> String) -> ([YiChunk] -> ShowS) -> Show YiChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YiChunk -> ShowS
showsPrec :: Int -> YiChunk -> ShowS
$cshow :: YiChunk -> String
show :: YiChunk -> String
$cshowList :: [YiChunk] -> ShowS
showList :: [YiChunk] -> ShowS
Show, YiChunk -> YiChunk -> Bool
(YiChunk -> YiChunk -> Bool)
-> (YiChunk -> YiChunk -> Bool) -> Eq YiChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: YiChunk -> YiChunk -> Bool
== :: YiChunk -> YiChunk -> Bool
$c/= :: YiChunk -> YiChunk -> Bool
/= :: YiChunk -> YiChunk -> Bool
Eq, Typeable)

-- | Makes a chunk from a given string. We allow for an arbitrary
-- length function here to allow us to bypass the calculation with
-- 'const' in case the length is known ahead of time. In most cases,
-- the use of this is
--
-- > mkChunk 'TX.Text.length' someText
mkChunk :: (TX.Text -> Int) -- ^ The length function to use.
        -> TX.Text
        -> YiChunk
mkChunk :: (Text -> Int) -> Text -> YiChunk
mkChunk Text -> Int
l Text
t = Int -> Text -> YiChunk
Chunk (Text -> Int
l Text
t) Text
t

-- | Transform the chunk content. It's vital that the transformation
-- preserves the length of the content.
overChunk :: (TX.Text -> TX.Text) -- ^ Length-preserving content transformation.
          -> YiChunk -> YiChunk
overChunk :: (Text -> Text) -> YiChunk -> YiChunk
overChunk Text -> Text
f (Chunk Int
l Text
t) = Int -> Text -> YiChunk
Chunk Int
l (Text -> Text
f Text
t)

-- | Counts number of newlines in the given 'TX.Text'.
countNl :: TX.Text -> Int
countNl :: Text -> Int
countNl = HasCallStack => Text -> Text -> Int
Text -> Text -> Int
TX.count Text
"\n"

#if __GLASGOW_HASKELL__ >= 804
instance Semigroup Size where
  <> :: Size -> Size -> Size
(<>) = Size -> Size -> Size
forall a. Monoid a => a -> a -> a
mappend
#endif

instance Monoid Size where
  mempty :: Size
mempty = Int -> Int -> Size
Indices Int
0 Int
0
  Indices Int
c Int
l mappend :: Size -> Size -> Size
`mappend` Indices Int
c' Int
l' = Int -> Int -> Size
Indices (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c') (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l')

instance Measured Size YiChunk where
  measure :: YiChunk -> Size
measure (Chunk Int
l Text
t) = Int -> Int -> Size
Indices Int
l (Text -> Int
countNl Text
t)

-- | A 'YiString' is a 'FingerTree' with cached char and line counts
-- over chunks of 'TX.Text'.
newtype YiString = YiString { YiString -> FingerTree Size YiChunk
fromRope :: FingerTree Size YiChunk }
                 deriving (Int -> YiString -> ShowS
[YiString] -> ShowS
YiString -> String
(Int -> YiString -> ShowS)
-> (YiString -> String) -> ([YiString] -> ShowS) -> Show YiString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YiString -> ShowS
showsPrec :: Int -> YiString -> ShowS
$cshow :: YiString -> String
show :: YiString -> String
$cshowList :: [YiString] -> ShowS
showList :: [YiString] -> ShowS
Show, Typeable)

-- | Two 'YiString's are equal if their underlying text is.
--
-- Implementation note: This just uses 'TX.Text' equality as there is
-- no real opportunity for optimisation here except for a cached
-- length check first. We could unroll the trees and mess around with
-- matching prefixes but the overhead would be higher than a simple
-- conversion and relying on GHC optimisation.
--
-- The derived Eq implementation for the underlying tree only passes
-- the equality check if the chunks are the same too which is not what
-- we want.
instance Eq YiString where
  YiString
t == :: YiString -> YiString -> Bool
== YiString
t' = YiString -> Int
Yi.Rope.length YiString
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== YiString -> Int
Yi.Rope.length YiString
t' Bool -> Bool -> Bool
&& YiString -> Text
toText YiString
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== YiString -> Text
toText YiString
t'

instance NFData Size where
  rnf :: Size -> ()
rnf (Indices !Int
c !Int
l) = Int
c Int -> () -> ()
forall a b. a -> b -> b
`seq` Int
l Int -> () -> ()
forall a b. a -> b -> b
`seq` ()

instance NFData YiChunk where
  rnf :: YiChunk -> ()
rnf (Chunk !Int
i !Text
t) = Int
i Int -> () -> ()
forall a b. a -> b -> b
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
t

instance NFData YiString where
  rnf :: YiString -> ()
rnf = Text -> ()
forall a. NFData a => a -> ()
rnf (Text -> ()) -> (YiString -> Text) -> YiString -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
toText

instance IsString YiString where
  fromString :: String -> YiString
fromString = String -> YiString
Yi.Rope.fromString

#if __GLASGOW_HASKELL__ >= 804
instance Semigroup YiString where
  <> :: YiString -> YiString -> YiString
(<>) = YiString -> YiString -> YiString
forall a. Monoid a => a -> a -> a
mappend
#endif

instance Monoid YiString where
  mempty :: YiString
mempty = YiString
Yi.Rope.empty
  mappend :: YiString -> YiString -> YiString
mappend = YiString -> YiString -> YiString
Yi.Rope.append
  mconcat :: [YiString] -> YiString
mconcat = [YiString] -> YiString
Yi.Rope.concat

instance Ord YiString where
  compare :: YiString -> YiString -> Ordering
compare YiString
x YiString
y = YiString -> Text
toText YiString
x Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` YiString -> Text
toText YiString
y

(-|) :: YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
YiChunk
b -| :: YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
-| FingerTree Size YiChunk
t | YiChunk -> Int
chunkSize YiChunk
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = FingerTree Size YiChunk
t
       | Bool
otherwise        = YiChunk
b YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree Size YiChunk
t

(|-) :: FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
FingerTree Size YiChunk
t |- :: FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
|- YiChunk
b | YiChunk -> Int
chunkSize YiChunk
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = FingerTree Size YiChunk
t
       | Bool
otherwise        = FingerTree Size YiChunk
t FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
|> YiChunk
b

-- | Default size chunk to use. Currently @1200@ as this is what
-- benchmarks suggest.
--
-- This makes the biggest difference with 'lines'-like and
-- 'concat'-like functions. Bigger chunks make 'concat' (much) faster
-- but 'lines' slower. In general it seems that we benefit more from
-- larger chunks and 1200 seems to be the sweet spot.
defaultChunkSize :: Int
defaultChunkSize :: Int
defaultChunkSize = Int
1200

-- | Reverse the whole underlying string.
--
-- This involves reversing the order of the chunks as well as content
-- of the chunks. We use a little optimisation here that re-uses the
-- content of each chunk but this exposes a potential problem: after
-- many transformations, our chunks size might become quite varied
-- (but never more than the default size), perhaps we should
-- periodically rechunk the tree to recover nice sizes?
reverse :: YiString -> YiString
reverse :: YiString -> YiString
reverse = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YiChunk -> YiChunk)
-> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall v1 a1 v2 a2.
(Measured v1 a1, Measured v2 a2) =>
(a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
fmap' ((Text -> Text) -> YiChunk -> YiChunk
overChunk Text -> Text
TX.reverse) (FingerTree Size YiChunk -> FingerTree Size YiChunk)
-> (YiString -> FingerTree Size YiChunk)
-> YiString
-> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a -> FingerTree v a
T.reverse (FingerTree Size YiChunk -> FingerTree Size YiChunk)
-> (YiString -> FingerTree Size YiChunk)
-> YiString
-> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope

-- | See 'fromText'.
fromString :: String -> YiString
fromString :: String -> YiString
fromString = Text -> YiString
fromText (Text -> YiString) -> (String -> Text) -> String -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TX.pack

-- | See 'fromText''.
fromString' :: Int -> String -> YiString
fromString' :: Int -> String -> YiString
fromString' Int
n = Int -> Text -> YiString
fromText' Int
n (Text -> YiString) -> (String -> Text) -> String -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TX.pack

-- | See 'toText'.
toString :: YiString -> String
toString :: YiString -> String
toString = Text -> String
TX.unpack (Text -> String) -> (YiString -> Text) -> YiString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
toText

-- | See 'toReverseText'.
--
-- Note that it is actually ~4.5 times faster to use 'toReverseText'
-- and unpack the result than to convert to 'String' and use
-- 'Prelude.reverse'.
toReverseString :: YiString -> String
toReverseString :: YiString -> String
toReverseString = Text -> String
TX.unpack (Text -> String) -> (YiString -> Text) -> YiString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
toReverseText

-- | This is like 'fromText' but it allows the user to specify the
-- chunk size to be used. Uses 'defaultChunkSize' if the given
-- size is <= 0.
fromText' :: Int -> TX.Text -> YiString
fromText' :: Int -> Text -> YiString
fromText' Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> Text -> YiString
fromText' Int
defaultChunkSize
            | Bool
otherwise = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (Text -> FingerTree Size YiChunk) -> Text -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> [Text] -> FingerTree Size YiChunk
r FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a
T.empty ([Text] -> FingerTree Size YiChunk)
-> (Text -> [Text]) -> Text -> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
f
  where
    f :: Text -> [Text]
f = Int -> Text -> [Text]
TX.chunksOf Int
n

    -- Convert the given string into chunks in the tree. We have a
    -- special case for a single element case: because we split on
    -- predetermined chunk size, we know that all chunks but the last
    -- one will be the specified size so we can optimise here instead
    -- of having to recompute chunk size at creation.
    r :: FingerTree Size YiChunk -> [TX.Text] -> FingerTree Size YiChunk
    r :: FingerTree Size YiChunk -> [Text] -> FingerTree Size YiChunk
r !FingerTree Size YiChunk
tr []     = FingerTree Size YiChunk
tr
    r !FingerTree Size YiChunk
tr (Text
t:[]) = FingerTree Size YiChunk
tr FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
|- (Text -> Int) -> Text -> YiChunk
mkChunk Text -> Int
TX.length Text
t
    r !FingerTree Size YiChunk
tr (Text
t:[Text]
ts) = let r' :: FingerTree Size YiChunk
r' = FingerTree Size YiChunk
tr FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
|- (Text -> Int) -> Text -> YiChunk
mkChunk (Int -> Text -> Int
forall a b. a -> b -> a
const Int
n) Text
t
                   in FingerTree Size YiChunk -> [Text] -> FingerTree Size YiChunk
r FingerTree Size YiChunk
r' [Text]
ts

-- | Converts a 'TX.Text' into a 'YiString' using
-- 'defaultChunkSize'-sized chunks for the underlying tree.
fromText :: TX.Text -> YiString
fromText :: Text -> YiString
fromText = Int -> Text -> YiString
fromText' Int
defaultChunkSize

fromLazyText :: TXL.Text -> YiString
fromLazyText :: Text -> YiString
fromLazyText = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (Text -> FingerTree Size YiChunk) -> Text -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [YiChunk] -> FingerTree Size YiChunk
forall v a. Measured v a => [a] -> FingerTree v a
T.fromList ([YiChunk] -> FingerTree Size YiChunk)
-> (Text -> [YiChunk]) -> Text -> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> YiChunk) -> [Text] -> [YiChunk]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Int) -> Text -> YiChunk
mkChunk Text -> Int
TX.length) ([Text] -> [YiChunk]) -> (Text -> [Text]) -> Text -> [YiChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
TXL.toChunks

-- | Consider whether you really need to use this!
toText :: YiString -> TX.Text
toText :: YiString -> Text
toText = [Text] -> Text
TX.concat ([Text] -> Text) -> (YiString -> [Text]) -> YiString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> [Text]
go (FingerTree Size YiChunk -> [Text])
-> (YiString -> FingerTree Size YiChunk) -> YiString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope
  where
    go :: FingerTree Size YiChunk -> [TX.Text]
    go :: FingerTree Size YiChunk -> [Text]
go FingerTree Size YiChunk
t = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
t of
      Chunk Int
_ !Text
c :< FingerTree Size YiChunk
cs -> Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: FingerTree Size YiChunk -> [Text]
go FingerTree Size YiChunk
cs
      ViewL (FingerTree Size) YiChunk
EmptyL -> []

-- | Spits out the underlying string, reversed.
--
-- Note that this is actually slightly faster than manually unrolling
-- the tree from the end, 'TX.reverse'ing each chunk and
-- 'TX.concat'ing, at least with -O2 which you really need to be using
-- with 'TX.Text' anyway.
toReverseText :: YiString -> TX.Text
toReverseText :: YiString -> Text
toReverseText = Text -> Text
TX.reverse (Text -> Text) -> (YiString -> Text) -> YiString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
toText

-- | Checks if the given 'YiString' is actually empty.
null :: YiString -> Bool
null :: YiString -> Bool
null = FingerTree Size YiChunk -> Bool
forall v a. FingerTree v a -> Bool
T.null (FingerTree Size YiChunk -> Bool)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope

-- | Creates an empty 'YiString'.
empty :: YiString
empty :: YiString
empty = FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a
T.empty

-- | Length of the whole underlying string.
--
-- Amortized constant time.
length :: YiString -> Int
length :: YiString -> Int
length = Size -> Int
charIndex (Size -> Int) -> (YiString -> Size) -> YiString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> Size
forall v a. Measured v a => a -> v
measure (FingerTree Size YiChunk -> Size)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope

-- | Count the number of newlines in the underlying string. This is
-- actually amortized constant time as we cache this information in
-- the underlying tree.
countNewLines :: YiString -> Int
countNewLines :: YiString -> Int
countNewLines = Size -> Int
lineIndex (Size -> Int) -> (YiString -> Size) -> YiString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> Size
forall v a. Measured v a => a -> v
measure (FingerTree Size YiChunk -> Size)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope

-- | Append two 'YiString's.
--
-- We take the extra time to optimise this append for many small
-- insertions. With naive append of the inner fingertree with 'T.><',
-- it is often the case that we end up with a large collection of tiny
-- chunks. This function instead tries to join the underlying trees at
-- outermost chunks up to 'defaultChunkSize' which while slower,
-- should improve memory usage.
--
-- I suspect that this pays for itself as we'd spend more time
-- computing over all the little chunks than few large ones anyway.
append :: YiString -> YiString -> YiString
append :: YiString -> YiString -> YiString
append (YiString FingerTree Size YiChunk
t) (YiString FingerTree Size YiChunk
t') = case (FingerTree Size YiChunk -> ViewR (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
viewr FingerTree Size YiChunk
t, FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
t') of
  (ViewR (FingerTree Size) YiChunk
EmptyR, ViewL (FingerTree Size) YiChunk
_) -> FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
t'
  (ViewR (FingerTree Size) YiChunk
_, ViewL (FingerTree Size) YiChunk
EmptyL) -> FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
t
  (FingerTree Size YiChunk
ts :> Chunk Int
l Text
x, Chunk Int
l' Text
x' :< FingerTree Size YiChunk
ts') ->
    let len :: Int
len = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l' in case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
len Int
defaultChunkSize of
      Ordering
GT -> FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk
t FingerTree Size YiChunk
-> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall a. Semigroup a => a -> a -> a
<> FingerTree Size YiChunk
t')
      Ordering
_ -> FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk
ts FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
|- Int -> Text -> YiChunk
Chunk Int
len (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x') FingerTree Size YiChunk
-> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall a. Semigroup a => a -> a -> a
<> FingerTree Size YiChunk
ts')

-- | Concat a list of 'YiString's.
concat :: [YiString] -> YiString
concat :: [YiString] -> YiString
concat = (YiString -> YiString -> YiString)
-> YiString -> [YiString] -> YiString
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' YiString -> YiString -> YiString
append YiString
empty

-- | Take the first character of the underlying string if possible.
head :: YiString -> Maybe Char
head :: YiString -> Maybe Char
head (YiString FingerTree Size YiChunk
t) = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
t of
  ViewL (FingerTree Size) YiChunk
EmptyL -> Maybe Char
forall a. Maybe a
Nothing
  Chunk Int
_ Text
x :< FingerTree Size YiChunk
_ -> if Text -> Bool
TX.null Text
x then Maybe Char
forall a. Maybe a
Nothing else Char -> Maybe Char
forall a. a -> Maybe a
Just (HasCallStack => Text -> Char
Text -> Char
TX.head Text
x)

-- | Take the last character of the underlying string if possible.
last :: YiString -> Maybe Char
last :: YiString -> Maybe Char
last (YiString FingerTree Size YiChunk
t) = case FingerTree Size YiChunk -> ViewR (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
viewr FingerTree Size YiChunk
t of
  ViewR (FingerTree Size) YiChunk
EmptyR -> Maybe Char
forall a. Maybe a
Nothing
  FingerTree Size YiChunk
_ :> Chunk Int
_ Text
x -> if Text -> Bool
TX.null Text
x then Maybe Char
forall a. Maybe a
Nothing else Char -> Maybe Char
forall a. a -> Maybe a
Just (HasCallStack => Text -> Char
Text -> Char
TX.last Text
x)

-- | Takes every character but the last one: returns Nothing on empty
-- string.
init :: YiString -> Maybe YiString
init :: YiString -> Maybe YiString
init (YiString FingerTree Size YiChunk
t) = case FingerTree Size YiChunk -> ViewR (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
viewr FingerTree Size YiChunk
t of
  ViewR (FingerTree Size) YiChunk
EmptyR -> Maybe YiString
forall a. Maybe a
Nothing
  FingerTree Size YiChunk
ts :> Chunk Int
0 Text
_ -> YiString -> Maybe YiString
Yi.Rope.init (FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
ts)
  FingerTree Size YiChunk
ts :> Chunk Int
l Text
x -> YiString -> Maybe YiString
forall a. a -> Maybe a
Just (YiString -> Maybe YiString)
-> (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk
-> Maybe YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> Maybe YiString)
-> FingerTree Size YiChunk -> Maybe YiString
forall a b. (a -> b) -> a -> b
$ FingerTree Size YiChunk
ts FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
|- Int -> Text -> YiChunk
Chunk (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (HasCallStack => Text -> Text
Text -> Text
TX.init Text
x)

-- | Takes the tail of the underlying string. If the string is empty
-- to begin with, returns Nothing.
tail :: YiString -> Maybe YiString
tail :: YiString -> Maybe YiString
tail (YiString FingerTree Size YiChunk
t) = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
t of
  ViewL (FingerTree Size) YiChunk
EmptyL -> Maybe YiString
forall a. Maybe a
Nothing
  Chunk Int
0 Text
_ :< FingerTree Size YiChunk
ts -> YiString -> Maybe YiString
Yi.Rope.tail (FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
ts)
  Chunk Int
l Text
x :< FingerTree Size YiChunk
ts -> YiString -> Maybe YiString
forall a. a -> Maybe a
Just (YiString -> Maybe YiString)
-> (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk
-> Maybe YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> Maybe YiString)
-> FingerTree Size YiChunk -> Maybe YiString
forall a b. (a -> b) -> a -> b
$ Int -> Text -> YiChunk
Chunk (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (HasCallStack => Text -> Text
Text -> Text
TX.tail Text
x) YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
-| FingerTree Size YiChunk
ts

-- | Splits the string at given character position.
--
-- If @position <= 0@ then the left string is empty and the right string
-- contains everything else.
--
-- If @position >= length of the string@ then the left string contains
-- everything and the right string is empty.
--
-- Implementation note: the way this works is by splitting the
-- underlying finger at a closest chunk that goes *over* the given
-- position (see 'T.split'). This either results in a perfect split at
-- which point we're done or more commonly, it leaves as few
-- characters short and we need to take few characters from the first
-- chunk of the right side of the split. We do precisely that.
--
-- All together, this split is only as expensive as underlying
-- 'T.split', the cost of splitting a chunk into two, the cost of one
-- cons and one cons of a chunk and lastly the cost of 'T.splitAt' of
-- the underlying 'TX.Text'. It turns out to be fairly fast all
-- together.
splitAt :: Int -> YiString -> (YiString, YiString)
splitAt :: Int -> YiString -> (YiString, YiString)
splitAt Int
n (YiString FingerTree Size YiChunk
t)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (YiString
forall a. Monoid a => a
mempty, FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
t)
  | Bool
otherwise = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
s of
    Chunk Int
l Text
x :< FingerTree Size YiChunk
ts | Int
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 ->
      let (Text
lx, Text
rx) = Int -> Text -> (Text, Text)
TX.splitAt Int
n' Text
x
      in (FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk -> YiString
forall a b. (a -> b) -> a -> b
$ FingerTree Size YiChunk
f FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
|> Int -> Text -> YiChunk
Chunk Int
n' Text
lx,
          FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk -> YiString
forall a b. (a -> b) -> a -> b
$ Int -> Text -> YiChunk
Chunk (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n') Text
rx YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
-| FingerTree Size YiChunk
ts)
    ViewL (FingerTree Size) YiChunk
_ -> (FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
f, FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
s)
  where
    (FingerTree Size YiChunk
f, FingerTree Size YiChunk
s) = (Size -> Bool)
-> FingerTree Size YiChunk
-> (FingerTree Size YiChunk, FingerTree Size YiChunk)
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
T.split ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n) (Int -> Bool) -> (Size -> Int) -> Size -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Int
charIndex) FingerTree Size YiChunk
t
    n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Size -> Int
charIndex (FingerTree Size YiChunk -> Size
forall v a. Measured v a => a -> v
measure FingerTree Size YiChunk
f)

-- | Takes the first n given characters.
take :: Int -> YiString -> YiString
take :: Int -> YiString -> YiString
take Int
1 = YiString -> (Char -> YiString) -> Maybe Char -> YiString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe YiString
forall a. Monoid a => a
mempty Char -> YiString
Yi.Rope.singleton (Maybe Char -> YiString)
-> (YiString -> Maybe Char) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Maybe Char
Yi.Rope.head
take Int
n = (YiString, YiString) -> YiString
forall a b. (a, b) -> a
fst ((YiString, YiString) -> YiString)
-> (YiString -> (YiString, YiString)) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> (YiString, YiString)
Yi.Rope.splitAt Int
n

-- | Drops the first n characters.
drop :: Int -> YiString -> YiString
drop :: Int -> YiString -> YiString
drop Int
1 = YiString -> Maybe YiString -> YiString
forall a. a -> Maybe a -> a
fromMaybe YiString
forall a. Monoid a => a
mempty (Maybe YiString -> YiString)
-> (YiString -> Maybe YiString) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Maybe YiString
Yi.Rope.tail
drop Int
n = (YiString, YiString) -> YiString
forall a b. (a, b) -> b
snd ((YiString, YiString) -> YiString)
-> (YiString -> (YiString, YiString)) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> (YiString, YiString)
Yi.Rope.splitAt Int
n

-- | The usual 'Prelude.dropWhile' optimised for 'YiString's.
dropWhile :: (Char -> Bool) -> YiString -> YiString
dropWhile :: (Char -> Bool) -> YiString -> YiString
dropWhile Char -> Bool
p = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> FingerTree Size YiChunk
go (FingerTree Size YiChunk -> FingerTree Size YiChunk)
-> (YiString -> FingerTree Size YiChunk)
-> YiString
-> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope
  where
    go :: FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
t = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
t of
      ViewL (FingerTree Size) YiChunk
EmptyL -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a
T.empty
      Chunk Int
0 Text
_ :< FingerTree Size YiChunk
ts -> FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
ts
      Chunk Int
l Text
x :< FingerTree Size YiChunk
ts ->
        let r :: Text
r = (Char -> Bool) -> Text -> Text
TX.dropWhile Char -> Bool
p Text
x
            l' :: Int
l' = Text -> Int
TX.length Text
r
        in case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l' Int
l of
          -- We dropped nothing so we must be done.
          Ordering
EQ -> FingerTree Size YiChunk
t
          -- We dropped something, if it was everything then drop from
          -- next chunk.
          Ordering
LT | Text -> Bool
TX.null Text
r -> FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
ts
          -- It wasn't everything and we have left-overs, we must be done.
             | Bool
otherwise -> Int -> Text -> YiChunk
Chunk Int
l' Text
r YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree Size YiChunk
ts
          -- We shouldn't really get here or it would mean that
          -- dropping stuff resulted in more content than we had. This
          -- can only happen if unsafe functions don't preserve the
          -- chunk size and it goes out of sync with the text length.
          -- Preserve this abomination, it may be useful for
          -- debugging.
          Ordering
_ -> Int -> Text -> YiChunk
Chunk Int
l' Text
r YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
-| FingerTree Size YiChunk
ts

-- | As 'Yi.Rope.dropWhile' but drops from the end instead.
dropWhileEnd :: (Char -> Bool) -> YiString -> YiString
dropWhileEnd :: (Char -> Bool) -> YiString -> YiString
dropWhileEnd Char -> Bool
p = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> FingerTree Size YiChunk
go (FingerTree Size YiChunk -> FingerTree Size YiChunk)
-> (YiString -> FingerTree Size YiChunk)
-> YiString
-> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope
  where
    go :: FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
t = case FingerTree Size YiChunk -> ViewR (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
viewr FingerTree Size YiChunk
t of
      ViewR (FingerTree Size) YiChunk
EmptyR -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a
T.empty
      FingerTree Size YiChunk
ts :> Chunk Int
0 Text
_ -> FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
ts
      FingerTree Size YiChunk
ts :> Chunk Int
l Text
x ->
        let r :: Text
r = (Char -> Bool) -> Text -> Text
TX.dropWhileEnd Char -> Bool
p Text
x
            l' :: Int
l' = Text -> Int
TX.length Text
r
        in case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l' Int
l of
          Ordering
EQ -> FingerTree Size YiChunk
t
          Ordering
LT | Text -> Bool
TX.null Text
r -> FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
ts
             | Bool
otherwise -> FingerTree Size YiChunk
ts FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
|> Int -> Text -> YiChunk
Chunk Int
l' Text
r
          Ordering
_ -> FingerTree Size YiChunk
ts FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
|- Int -> Text -> YiChunk
Chunk Int
l' Text
r

-- | The usual 'Prelude.takeWhile' optimised for 'YiString's.
takeWhile :: (Char -> Bool) -> YiString -> YiString
takeWhile :: (Char -> Bool) -> YiString -> YiString
takeWhile Char -> Bool
p = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> FingerTree Size YiChunk
go (FingerTree Size YiChunk -> FingerTree Size YiChunk)
-> (YiString -> FingerTree Size YiChunk)
-> YiString
-> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope
  where
    go :: FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
t = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
t of
      ViewL (FingerTree Size) YiChunk
EmptyL -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a
T.empty
      Chunk Int
0 Text
_ :< FingerTree Size YiChunk
ts -> FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
ts
      Chunk Int
l Text
x :< FingerTree Size YiChunk
ts ->
        let r :: Text
r = (Char -> Bool) -> Text -> Text
TX.takeWhile Char -> Bool
p Text
x
            l' :: Int
l' = Text -> Int
TX.length Text
r
        in case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l' Int
l of
          -- We took the whole chunk, keep taking more.
          Ordering
EQ -> Int -> Text -> YiChunk
Chunk Int
l Text
x YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
-| FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
ts
          -- We took some stuff but not everything so we're done.
          -- Alternatively, we took more than the size chunk so
          -- preserve this wonder. This should only ever happen if you
          -- use unsafe functions and Chunk size goes out of sync with
          -- actual text length.
          Ordering
_ -> YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => a -> FingerTree v a
T.singleton (YiChunk -> FingerTree Size YiChunk)
-> YiChunk -> FingerTree Size YiChunk
forall a b. (a -> b) -> a -> b
$ Int -> Text -> YiChunk
Chunk Int
l' Text
r

-- | Like 'Yi.Rope.takeWhile' but takes from the end instead.
takeWhileEnd :: (Char -> Bool) -> YiString -> YiString
takeWhileEnd :: (Char -> Bool) -> YiString -> YiString
takeWhileEnd Char -> Bool
p = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> FingerTree Size YiChunk
go (FingerTree Size YiChunk -> FingerTree Size YiChunk)
-> (YiString -> FingerTree Size YiChunk)
-> YiString
-> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope
  where
    go :: FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
t = case FingerTree Size YiChunk -> ViewR (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
viewr FingerTree Size YiChunk
t of
      ViewR (FingerTree Size) YiChunk
EmptyR -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a
T.empty
      FingerTree Size YiChunk
ts :> Chunk Int
0 Text
_ -> FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
ts
      FingerTree Size YiChunk
ts :> Chunk Int
l Text
x -> case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l' Int
l of
        Ordering
EQ -> FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
ts FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
|> Int -> Text -> YiChunk
Chunk Int
l Text
x
        Ordering
_ -> YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => a -> FingerTree v a
T.singleton (YiChunk -> FingerTree Size YiChunk)
-> YiChunk -> FingerTree Size YiChunk
forall a b. (a -> b) -> a -> b
$ Int -> Text -> YiChunk
Chunk Int
l' Text
r
        where
          -- no TX.takeWhileEnd – https://github.com/bos/text/issues/89
          r :: Text
r = Text -> Text
TX.reverse (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
TX.takeWhile Char -> Bool
p (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TX.reverse (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
x
          l' :: Int
l' = Text -> Int
TX.length Text
r


-- | Returns a pair whose first element is the longest prefix
-- (possibly empty) of t of elements that satisfy p, and whose second
-- is the remainder of the string. See also 'TX.span'.
--
-- This implementation uses 'Yi.Rope.splitAt' which actually is just
-- as fast as hand-unrolling the tree. GHC sure is great!
span :: (Char -> Bool) -> YiString -> (YiString, YiString)
span :: (Char -> Bool) -> YiString -> (YiString, YiString)
span Char -> Bool
p YiString
y = let x :: YiString
x = (Char -> Bool) -> YiString -> YiString
Yi.Rope.takeWhile Char -> Bool
p YiString
y
           in case Int -> YiString -> (YiString, YiString)
Yi.Rope.splitAt (YiString -> Int
Yi.Rope.length YiString
x) YiString
y of
             -- Re-using ‘x’ seems to gain us a minor performance
             -- boost.
             (YiString
_, YiString
y') -> (YiString
x, YiString
y')

-- | Just like 'Yi.Rope.span' but with the predicate negated.
break :: (Char -> Bool) -> YiString -> (YiString, YiString)
break :: (Char -> Bool) -> YiString -> (YiString, YiString)
break Char -> Bool
p = (Char -> Bool) -> YiString -> (YiString, YiString)
Yi.Rope.span (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p)

-- | Concatenates the list of 'YiString's after inserting the
-- user-provided 'YiString' between the elements.
--
-- Empty 'YiString's are not ignored and will end up as strings of
-- length 1. If you don't want this, it's up to you to pre-process the
-- list. Just as with 'Yi.Rope.intersperse', it is up to the user to
-- pre-process the list.
intercalate :: YiString -> [YiString] -> YiString
intercalate :: YiString -> [YiString] -> YiString
intercalate YiString
_ [] = YiString
forall a. Monoid a => a
mempty
intercalate (YiString FingerTree Size YiChunk
t') (YiString FingerTree Size YiChunk
s:[YiString]
ss) = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk -> YiString
forall a b. (a -> b) -> a -> b
$ FingerTree Size YiChunk -> [YiString] -> FingerTree Size YiChunk
go FingerTree Size YiChunk
s [YiString]
ss
  where
    go :: FingerTree Size YiChunk -> [YiString] -> FingerTree Size YiChunk
go !FingerTree Size YiChunk
acc []                = FingerTree Size YiChunk
acc
    go FingerTree Size YiChunk
acc (YiString FingerTree Size YiChunk
t : [YiString]
ts') = FingerTree Size YiChunk -> [YiString] -> FingerTree Size YiChunk
go (FingerTree Size YiChunk
acc FingerTree Size YiChunk
-> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree Size YiChunk
t' FingerTree Size YiChunk
-> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall v a.
Measured v a =>
FingerTree v a -> FingerTree v a -> FingerTree v a
>< FingerTree Size YiChunk
t) [YiString]
ts'

-- | Intersperses the given character between the 'YiString's. This is
-- useful when you have a bunch of strings you just want to separate
-- something with, comma or a dash. Note that it only inserts the
-- character between the elements.
--
-- What's more, the result is a single 'YiString'. You can easily
-- achieve a version that blindly inserts elements to the back by
-- mapping over the list instead of using this function.
--
-- You can think of it as a specialised version of
-- 'Yi.Rope.intercalate'. Note that what this does __not__ do is
-- intersperse characters into the underlying text, you should convert
-- and use 'TX.intersperse' for that instead.
intersperse :: Char -> [YiString] -> YiString
intersperse :: Char -> [YiString] -> YiString
intersperse Char
_ [] = YiString
forall a. Monoid a => a
mempty
intersperse Char
c (YiString
t:[YiString]
ts) = YiString -> [YiString] -> YiString
go YiString
t [YiString]
ts
  where
    go :: YiString -> [YiString] -> YiString
go !YiString
acc [] = YiString
acc
    go YiString
acc (YiString
t':[YiString]
ts') = YiString -> [YiString] -> YiString
go (YiString
acc YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> (Char
c Char -> YiString -> YiString
`cons` YiString
t')) [YiString]
ts'

-- | Add a 'Char' in front of a 'YiString'.
cons :: Char -> YiString -> YiString
cons :: Char -> YiString -> YiString
cons Char
c (YiString FingerTree Size YiChunk
t) = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
t of
  ViewL (FingerTree Size) YiChunk
EmptyL -> Char -> YiString
Yi.Rope.singleton Char
c
  Chunk Int
l Text
x :< FingerTree Size YiChunk
ts | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
defaultChunkSize -> FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk -> YiString
forall a b. (a -> b) -> a -> b
$ Int -> Text -> YiChunk
Chunk (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char
c Char -> Text -> Text
`TX.cons` Text
x) YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree Size YiChunk
ts
  ViewL (FingerTree Size) YiChunk
_ -> FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk -> YiString
forall a b. (a -> b) -> a -> b
$ Int -> Text -> YiChunk
Chunk Int
1 (Char -> Text
TX.singleton Char
c) YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree Size YiChunk
t

-- | Add a 'Char' in the back of a 'YiString'.
snoc :: YiString -> Char -> YiString
snoc :: YiString -> Char -> YiString
snoc (YiString FingerTree Size YiChunk
t) Char
c = case FingerTree Size YiChunk -> ViewR (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
viewr FingerTree Size YiChunk
t of
  ViewR (FingerTree Size) YiChunk
EmptyR -> Char -> YiString
Yi.Rope.singleton Char
c
  FingerTree Size YiChunk
ts :> Chunk Int
l Text
x | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
defaultChunkSize -> FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk -> YiString
forall a b. (a -> b) -> a -> b
$ FingerTree Size YiChunk
ts FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
|> Int -> Text -> YiChunk
Chunk (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Text
x Text -> Char -> Text
`TX.snoc` Char
c)
  ViewR (FingerTree Size) YiChunk
_ -> FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk -> YiString
forall a b. (a -> b) -> a -> b
$ FingerTree Size YiChunk
t FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
|> Int -> Text -> YiChunk
Chunk Int
1 (Char -> Text
TX.singleton Char
c)

-- | Single character 'YiString'. Consider whether it's worth creating
-- this, maybe you can use 'cons' or 'snoc' instead?
singleton :: Char -> YiString
singleton :: Char -> YiString
singleton Char
c = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (YiChunk -> FingerTree Size YiChunk) -> YiChunk -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => a -> FingerTree v a
T.singleton (YiChunk -> YiString) -> YiChunk -> YiString
forall a b. (a -> b) -> a -> b
$ Int -> Text -> YiChunk
Chunk Int
1 (Char -> Text
TX.singleton Char
c)

-- | Splits the underlying string before the given line number.
-- Zero-indexed lines.
--
-- Splitting at line <= 0 gives you an empty string. Splitting at
-- @n > 0@ gives you the first n lines.
--
-- Also see 'splitAtLine''.
splitAtLine :: Int -> YiString -> (YiString, YiString)
splitAtLine :: Int -> YiString -> (YiString, YiString)
splitAtLine Int
n YiString
r | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = (YiString
empty, YiString
r)
                | Bool
otherwise = Int -> YiString -> (YiString, YiString)
splitAtLine' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) YiString
r

-- | Splits the underlying string after the given line number.
-- Zero-indexed lines.
--
-- Splitting at line <= 0 gives you the first line. Splitting at
-- @n > 0@ gives you the first n + 1 lines.
--
-- The implementation is similar to that of 'splitAt' except we are
-- now looking for extra newlines in the next chunk rather than extra
-- characters.
splitAtLine' :: Int -> YiString -> (YiString, YiString)
splitAtLine' :: Int -> YiString -> (YiString, YiString)
splitAtLine' Int
p (YiString FingerTree Size YiChunk
tr) = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
s of
  ch :: YiChunk
ch@(Chunk Int
_ Text
x) :< FingerTree Size YiChunk
r ->
    let excess :: Int
excess = Size -> Int
lineIndex (FingerTree Size YiChunk -> Size
forall v a. Measured v a => a -> v
measure FingerTree Size YiChunk
f) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Size -> Int
lineIndex (YiChunk -> Size
forall v a. Measured v a => a -> v
measure YiChunk
ch) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        (Text
lx, Text
rx) = Int -> Text -> (Text, Text)
cutExcess Int
excess Text
x
    in (FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk -> YiString
forall a b. (a -> b) -> a -> b
$ FingerTree Size YiChunk
f FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
|- (Text -> Int) -> Text -> YiChunk
mkChunk Text -> Int
TX.length Text
lx,
        FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk -> YiString
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> Text -> YiChunk
mkChunk Text -> Int
TX.length Text
rx YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
-| FingerTree Size YiChunk
r)
  ViewL (FingerTree Size) YiChunk
_ -> (FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
f, FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
s)
  where
    (FingerTree Size YiChunk
f, FingerTree Size YiChunk
s) = (Size -> Bool)
-> FingerTree Size YiChunk
-> (FingerTree Size YiChunk, FingerTree Size YiChunk)
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
T.split ((Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<) (Int -> Bool) -> (Size -> Int) -> Size -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Int
lineIndex) FingerTree Size YiChunk
tr

    cutExcess :: Int -> TX.Text -> (TX.Text, TX.Text)
    cutExcess :: Int -> Text -> (Text, Text)
cutExcess Int
n Text
t = case Text -> Int
TX.length Text
t of
      Int
0 -> (Text
TX.empty, Text
TX.empty)
      Int
_ -> let ns :: Int
ns = Text -> Int
countNl Text
t
               ls :: [Text]
ls = Text -> [Text]
TX.lines Text
t
               front :: Text
front = [Text] -> Text
TX.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
Prelude.take (Int
ns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) [Text]
ls
               back :: Text
back = Int -> Text -> Text
TX.drop (Text -> Int
TX.length Text
front) Text
t
           in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ns
              then (Text
t, Text
TX.empty)
              else (Text
front, Text
back)

-- | This is like 'lines'' but it does *not* preserve newlines.
--
-- Specifically, we just strip the newlines from the result of
-- 'lines''.
--
-- This behaves slightly differently than the old split: the number of
-- resulting strings here is equal to the number of newline characters
-- in the underlying string. This is much more consistent than the old
-- behaviour which blindly used @ByteString@s split and stitched the
-- result back together which was inconsistent with the rest of the
-- interface which worked with number of newlines.
lines :: YiString -> [YiString]
lines :: YiString -> [YiString]
lines = (YiString -> YiString) -> [YiString] -> [YiString]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map YiString -> YiString
dropNl ([YiString] -> [YiString])
-> (YiString -> [YiString]) -> YiString -> [YiString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> [YiString]
lines'
  where
    dropNl :: YiString -> YiString
dropNl (YiString FingerTree Size YiChunk
t)  = case FingerTree Size YiChunk -> ViewR (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
viewr FingerTree Size YiChunk
t of
      ViewR (FingerTree Size) YiChunk
EmptyR -> YiString
Yi.Rope.empty
      FingerTree Size YiChunk
ts :> ch :: YiChunk
ch@(Chunk Int
l Text
tx) ->
        FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> FingerTree Size YiChunk -> YiString
forall a b. (a -> b) -> a -> b
$ FingerTree Size YiChunk
ts FingerTree Size YiChunk -> YiChunk -> FingerTree Size YiChunk
|- if Text -> Bool
TX.null Text
tx
                         then YiChunk
ch
                         else case HasCallStack => Text -> Char
Text -> Char
TX.last Text
tx of
                           Char
'\n' -> Int -> Text -> YiChunk
Chunk (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (HasCallStack => Text -> Text
Text -> Text
TX.init Text
tx)
                           Char
_ -> YiChunk
ch

-- | Splits the 'YiString' into a list of 'YiString' each containing a
-- line.
--
-- Note that in old implementation this allowed an arbitrary character
-- to split on. If you want to do that, manually convert 'toText' and
-- use 'TX.splitOn' to suit your needs. This case is optimised for
-- newlines only which seems to have been the only use of the original
-- function.
--
-- The newlines are preserved so this should hold:
--
-- > 'toText' . 'concat' . 'lines'' ≡ 'toText'
--
-- but the underlying structure might change: notably, chunks will
-- most likely change sizes.
lines' :: YiString -> [YiString]
lines' :: YiString -> [YiString]
lines' YiString
t = let (YiString FingerTree Size YiChunk
f, YiString FingerTree Size YiChunk
s) = Int -> YiString -> (YiString, YiString)
splitAtLine' Int
0 YiString
t
           in if FingerTree Size YiChunk -> Bool
forall v a. FingerTree v a -> Bool
T.null FingerTree Size YiChunk
s
              then if FingerTree Size YiChunk -> Bool
forall v a. FingerTree v a -> Bool
T.null FingerTree Size YiChunk
f then [] else [FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
f]
              else FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
f YiString -> [YiString] -> [YiString]
forall a. a -> [a] -> [a]
: YiString -> [YiString]
lines' (FingerTree Size YiChunk -> YiString
YiString FingerTree Size YiChunk
s)

-- | Joins up lines by a newline character. It does not leave a
-- newline after the last line. If you want a more classical
-- 'Prelude.unlines' behaviour, use 'Yi.Rope.map' along with
-- 'Yi.Rope.snoc'.
unlines :: [YiString] -> YiString
unlines :: [YiString] -> YiString
unlines = Char -> [YiString] -> YiString
Yi.Rope.intersperse Char
'\n'

-- | 'YiString' specialised @any@.
--
-- Implementation note: this currently just does any by doing ‘TX.Text’
-- conversions upon consecutive chunks. We should be able to speed it
-- up by running it in parallel over multiple chunks.
any :: (Char -> Bool) -> YiString -> Bool
any :: (Char -> Bool) -> YiString -> Bool
any Char -> Bool
p = FingerTree Size YiChunk -> Bool
go (FingerTree Size YiChunk -> Bool)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope
  where
    go :: FingerTree Size YiChunk -> Bool
go FingerTree Size YiChunk
x = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
x of
      ViewL (FingerTree Size) YiChunk
EmptyL -> Bool
False
      Chunk Int
_ Text
t :< FingerTree Size YiChunk
ts -> (Char -> Bool) -> Text -> Bool
TX.any Char -> Bool
p Text
t Bool -> Bool -> Bool
|| FingerTree Size YiChunk -> Bool
go FingerTree Size YiChunk
ts

-- | 'YiString' specialised @all@.
--
-- See the implementation note for 'Yi.Rope.any'.
all :: (Char -> Bool) -> YiString -> Bool
all :: (Char -> Bool) -> YiString -> Bool
all Char -> Bool
p = FingerTree Size YiChunk -> Bool
go (FingerTree Size YiChunk -> Bool)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope
  where
    go :: FingerTree Size YiChunk -> Bool
go FingerTree Size YiChunk
x = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
x of
      ViewL (FingerTree Size) YiChunk
EmptyL -> Bool
True
      Chunk Int
_ Text
t :< FingerTree Size YiChunk
ts -> (Char -> Bool) -> Text -> Bool
TX.all Char -> Bool
p Text
t Bool -> Bool -> Bool
&& FingerTree Size YiChunk -> Bool
go FingerTree Size YiChunk
ts

-- | To serialise a 'YiString', we turn it into a regular 'String'
-- first.
instance Binary YiString where
  put :: YiString -> Put
put = String -> Put
forall t. Binary t => t -> Put
put (String -> Put) -> (YiString -> String) -> YiString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> String
toString
  get :: Get YiString
get = String -> YiString
Yi.Rope.fromString (String -> YiString) -> Get String -> Get YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get

-- | Write a 'YiString' into the given file.
--
-- It's up to the user to handle exceptions.
writeFile :: FilePath -> YiString -> IO ()
writeFile :: String -> YiString -> IO ()
writeFile String
f = String -> Text -> IO ()
TXIO.writeFile String
f (Text -> IO ()) -> (YiString -> Text) -> YiString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
toText

-- | Reads file into the rope, also returning the 'ConverterName' that
-- was used for decoding. You should resupply this to 'writeFile' if
-- you're aiming to preserve the original encoding.
--
-- If we fail to guess the encoding used, error message is given
-- instead.
--
-- It is up to the user to handle exceptions not directly related to
-- character decoding.
readFile :: FilePath -> IO (Either TX.Text YiString)
readFile :: String -> IO (Either Text YiString)
readFile String
fp = String -> IO ByteString
BSL.readFile String
fp IO ByteString
-> (ByteString -> IO (Either Text YiString))
-> IO (Either Text YiString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ByteString -> Text] -> ByteString -> IO (Either Text YiString)
forall {t}. [t -> Text] -> t -> IO (Either Text YiString)
go [ByteString -> Text]
decoders
  where
  go :: [t -> Text] -> t -> IO (Either Text YiString)
go [] t
_ = Either Text YiString -> IO (Either Text YiString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text YiString
forall a b. a -> Either a b
Left Text
err)
  go (t -> Text
d : [t -> Text]
ds) t
bytes =
      IO Text -> IO (Either UnicodeException Text)
forall e a. Exception e => IO a -> IO (Either e a)
try (Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Text
d t
bytes)) IO (Either UnicodeException Text)
-> (Either UnicodeException Text -> IO (Either Text YiString))
-> IO (Either Text YiString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left (UnicodeException
_ :: TXEE.UnicodeException) -> [t -> Text] -> t -> IO (Either Text YiString)
go [t -> Text]
ds t
bytes
          Right Text
text -> Either Text YiString -> IO (Either Text YiString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (YiString -> Either Text YiString
forall a b. b -> Either a b
Right (Text -> YiString
fromLazyText Text
text))
  err :: Text
err = Text
"Could not guess the encoding of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
TX.pack String
fp
  decoders :: [ByteString -> Text]
decoders =
      [ ByteString -> Text
TXLE.decodeUtf8
      , ByteString -> Text
TXLE.decodeUtf16LE
      , ByteString -> Text
TXLE.decodeUtf16BE
      , ByteString -> Text
TXLE.decodeUtf32LE
      , ByteString -> Text
TXLE.decodeUtf32BE
      ]

-- | Filters the characters from the underlying string.
--
-- >>> filter (/= 'a') "bac"
-- "bc"
filter :: (Char -> Bool) -> YiString -> YiString
filter :: (Char -> Bool) -> YiString -> YiString
filter Char -> Bool
p = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> FingerTree Size YiChunk
go (FingerTree Size YiChunk -> FingerTree Size YiChunk)
-> (YiString -> FingerTree Size YiChunk)
-> YiString
-> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope
  where
    go :: FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
t = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
t of
      ViewL (FingerTree Size) YiChunk
EmptyL -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a
T.empty
      Chunk Int
_ Text
x :< FingerTree Size YiChunk
ts -> (Text -> Int) -> Text -> YiChunk
mkChunk Text -> Int
TX.length ((Char -> Bool) -> Text -> Text
TX.filter Char -> Bool
p Text
x) YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
-| FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
ts

-- | Maps the characters over the underlying string.
map :: (Char -> Char) -> YiString -> YiString
map :: (Char -> Char) -> YiString -> YiString
map Char -> Char
f = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree Size YiChunk -> FingerTree Size YiChunk
go (FingerTree Size YiChunk -> FingerTree Size YiChunk)
-> (YiString -> FingerTree Size YiChunk)
-> YiString
-> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope
  where
    go :: FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
t = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
t of
      ViewL (FingerTree Size) YiChunk
EmptyL -> FingerTree Size YiChunk
forall v a. Measured v a => FingerTree v a
T.empty
      Chunk Int
l Text
x :< FingerTree Size YiChunk
ts -> Int -> Text -> YiChunk
Chunk Int
l ((Char -> Char) -> Text -> Text
TX.map Char -> Char
f Text
x) YiChunk -> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree Size YiChunk -> FingerTree Size YiChunk
go FingerTree Size YiChunk
ts

-- | Join given 'YiString's with a space. Empty lines will be filtered
-- out first.
unwords :: [YiString] -> YiString
unwords :: [YiString] -> YiString
unwords = Char -> [YiString] -> YiString
Yi.Rope.intersperse Char
' '

-- | Splits the given 'YiString' into a list of words, where spaces
-- are determined by 'isSpace'. No empty strings are in the result
-- list.
words :: YiString -> [YiString]
words :: YiString -> [YiString]
words = (YiString -> Bool) -> [YiString] -> [YiString]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (Bool -> Bool
not (Bool -> Bool) -> (YiString -> Bool) -> YiString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Bool
Yi.Rope.null) ([YiString] -> [YiString])
-> (YiString -> [YiString]) -> YiString -> [YiString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> YiString -> [YiString]
Yi.Rope.split Char -> Bool
isSpace

-- | Splits the 'YiString' on characters matching the predicate, like
-- 'TX.split'.
--
-- For splitting on newlines use 'Yi.Rope.lines' or 'Yi.Rope.lines''
-- instead.
--
-- Implementation note: GHC actually makes this naive implementation
-- about as fast and in cases with lots of splits, faster, as a
-- hand-rolled version on chunks with appends which is quite amazing
-- in itself.
split :: (Char -> Bool) -> YiString -> [YiString]
split :: (Char -> Bool) -> YiString -> [YiString]
split Char -> Bool
p = (Text -> YiString) -> [Text] -> [YiString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> YiString
fromText ([Text] -> [YiString])
-> (YiString -> [Text]) -> YiString -> [YiString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
TX.split Char -> Bool
p (Text -> [Text]) -> (YiString -> Text) -> YiString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
toText

-- | Left fold.
--
-- Benchmarks show that folding is actually Pretty Damn Slow™: consider
-- whether folding is really the best thing to use in your scenario.
foldl' :: (a -> Char -> a) -> a -> YiString -> a
foldl' :: forall a. (a -> Char -> a) -> a -> YiString -> a
foldl' a -> Char -> a
f a
a = a -> FingerTree Size YiChunk -> a
go a
a (FingerTree Size YiChunk -> a)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope
  where
    go :: a -> FingerTree Size YiChunk -> a
go a
acc FingerTree Size YiChunk
t = case FingerTree Size YiChunk -> ViewL (FingerTree Size) YiChunk
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl FingerTree Size YiChunk
t of
      ViewL (FingerTree Size) YiChunk
EmptyL -> a
acc
      Chunk Int
_ Text
x :< FingerTree Size YiChunk
ts -> let r :: a
r = (a -> Char -> a) -> a -> Text -> a
forall a. (a -> Char -> a) -> a -> Text -> a
TX.foldl' a -> Char -> a
f a
acc Text
x
                         in a
r a -> a -> a
forall a b. a -> b -> b
`seq` a -> FingerTree Size YiChunk -> a
go a
r FingerTree Size YiChunk
ts

-- | Replicate the given YiString set number of times, concatenating
-- the results. Also see 'Yi.Rope.replicateChar'.
replicate :: Int -> YiString -> YiString
replicate :: Int -> YiString -> YiString
replicate Int
n YiString
t | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = YiString
forall a. Monoid a => a
mempty
              | Bool
otherwise = YiString
t YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> Int -> YiString -> YiString
Yi.Rope.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) YiString
t

-- | Replicate the given character set number of times and pack the
-- result into a 'YiString'.
--
-- >>> replicateChar 4 ' '
-- "    "
replicateChar :: Int -> Char -> YiString
replicateChar :: Int -> Char -> YiString
replicateChar Int
n = Text -> YiString
fromText (Text -> YiString) -> (Char -> Text) -> Char -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
TX.replicate Int
n (Text -> Text) -> (Char -> Text) -> Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
TX.singleton

-- | Helper function doing conversions of to and from underlying
-- 'TX.Text'. You should aim to implement everything in terms of
-- 'YiString' instead.
--
-- Please note that this maps over each __chunk__ so this can only be
-- used with layout-agnostic functions. For example
--
-- >>> let t = 'fromString' "abc" <> 'fromString' "def"
-- >>> 'toString' $ 'withText' 'TX.reverse' t
-- "cbafed"
--
-- Probably doesn't do what you wanted, but 'TX.toUpper' would.
-- Specifically, for any @f : 'TX.Text' → 'TX.Text'@, 'withText' will
-- only do the ‘expected’ thing iff
--
-- @f x <> f y ≡ f (x <> y)@
--
-- which should look very familiar.
withText :: (TX.Text -> TX.Text) -> YiString -> YiString
withText :: (Text -> Text) -> YiString -> YiString
withText Text -> Text
f = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YiChunk -> YiChunk)
-> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall v1 a1 v2 a2.
(Measured v1 a1, Measured v2 a2) =>
(a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
T.fmap' ((Text -> Int) -> Text -> YiChunk
mkChunk Text -> Int
TX.length (Text -> YiChunk) -> (YiChunk -> Text) -> YiChunk -> YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
f (Text -> Text) -> (YiChunk -> Text) -> YiChunk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiChunk -> Text
_fromChunk) (FingerTree Size YiChunk -> FingerTree Size YiChunk)
-> (YiString -> FingerTree Size YiChunk)
-> YiString
-> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope

-- | Maps over each __chunk__ which means this function is UNSAFE! If
-- you use this with functions which don't preserve 'Size', that is
-- the chunk length and number of newlines, things will break really,
-- really badly. You should not need to use this.
--
-- Also see 'T.unsafeFmap'
unsafeWithText :: (TX.Text -> TX.Text) -> YiString -> YiString
unsafeWithText :: (Text -> Text) -> YiString -> YiString
unsafeWithText Text -> Text
f = FingerTree Size YiChunk -> YiString
YiString (FingerTree Size YiChunk -> YiString)
-> (YiString -> FingerTree Size YiChunk) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YiChunk -> YiChunk)
-> FingerTree Size YiChunk -> FingerTree Size YiChunk
forall a b v. (a -> b) -> FingerTree v a -> FingerTree v b
T.unsafeFmap YiChunk -> YiChunk
g (FingerTree Size YiChunk -> FingerTree Size YiChunk)
-> (YiString -> FingerTree Size YiChunk)
-> YiString
-> FingerTree Size YiChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> FingerTree Size YiChunk
fromRope
  where
    g :: YiChunk -> YiChunk
g (Chunk Int
l Text
t) = Int -> Text -> YiChunk
Chunk Int
l (Text -> Text
f Text
t)