-- |
-- Copyright:   (c) 2021-2022 Andrew Lelechenko
-- Licence:     BSD3
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>
--
-- @since 0.3

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}

#ifdef DEBUG
#define DEFRAGMENTATION_THRESHOLD 4
#else
#define DEFRAGMENTATION_THRESHOLD 4096
#endif

module Data.Text.Mixed.Rope
  ( Rope
  , fromText
  , fromTextLines
  , toText
  , toTextLines
  , null
  -- * Lines
  , lines
  , lengthInLines
  , splitAtLine
  , getLine
  -- * Code points
  , charLength
  , charSplitAt
  , charLengthAsPosition
  , charSplitAtPosition
  -- * UTF-16 code units
  , utf16Length
  , utf16SplitAt
  , utf16LengthAsPosition
  , utf16SplitAtPosition
  -- * UTF-8 code units
  , utf8Length
  , utf8SplitAt
  , utf8LengthAsPosition
  , utf8SplitAtPosition
  ) where

import Prelude ((-), (+), seq)
import Control.DeepSeq (NFData, rnf)
import Data.Bool (Bool(..), otherwise)
import Data.Char (Char)
import Data.Eq (Eq, (==))
import Data.Function ((.), ($), on)
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Ord (Ord, compare, (<), (<=))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TextLazy
import qualified Data.Text.Lazy.Builder as Builder
import Data.Text.Lines.Internal (TextLines)
import qualified Data.Text.Lines.Internal as TL (null, fromText, toText, lines, splitAtLine, newlines)
import qualified Data.Text.Lines as Char
import qualified Data.Text.Utf8.Lines as Utf8
import qualified Data.Text.Utf16.Lines as Utf16
import Data.Word (Word)
import Text.Show (Show)

#ifdef DEBUG
import Prelude (error)
import GHC.Stack (HasCallStack)
#else
#define HasCallStack ()
import Text.Show (show)
#endif

-- | Rope of 'Text' chunks with logarithmic concatenation. This rope offers
-- three interfaces: one based on code points, one based on UTF-16 code units,
-- and one based on UTF-8 code units. This comes with a price of more
-- bookkeeping and is less performant than "Data.Text.Rope",
-- "Data.Text.Utf8.Rope", or "Data.Text.Utf16.Rope".
data Rope
  = Empty
  | Node
    { Rope -> Rope
_ropeLeft    :: !Rope
    , Rope -> TextLines
_ropeMiddle  :: !TextLines
    , Rope -> Rope
_ropeRight   :: !Rope
    , Rope -> Metrics
_ropeMetrics :: {-# UNPACK #-} !Metrics
    }

data Metrics = Metrics
  { Metrics -> Word
_metricsNewlines :: !Word
  , Metrics -> Word
_metricsCharLen  :: !Word
  , Metrics -> Word
_metricsUtf8Len :: !Word
  , Metrics -> Word
_metricsUtf16Len :: !Word
  }

instance NFData Rope where
  rnf :: Rope -> ()
rnf Rope
Empty = ()
  -- No need to deepseq strict fields, for which WHNF = NF
  rnf (Node Rope
l TextLines
_ Rope
r Metrics
_) = Rope -> ()
forall a. NFData a => a -> ()
rnf Rope
l () -> () -> ()
forall a b. a -> b -> b
`seq` Rope -> ()
forall a. NFData a => a -> ()
rnf Rope
r

instance Eq Rope where
  == :: Rope -> Rope -> Bool
(==) = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool) -> (Rope -> Text) -> Rope -> Rope -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Rope -> Text
toLazyText

instance Ord Rope where
  compare :: Rope -> Rope -> Ordering
compare = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> (Rope -> Text) -> Rope -> Rope -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Rope -> Text
toLazyText

instance Semigroup Metrics where
  Metrics Word
nls1 Word
c1 Word
u1 Word
u1' <> :: Metrics -> Metrics -> Metrics
<> Metrics Word
nls2 Word
c2 Word
u2 Word
u2' =
    Word -> Word -> Word -> Word -> Metrics
Metrics (Word
nls1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
nls2) (Word
c1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
c2) (Word
u1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
u2) (Word
u1' Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
u2')
  {-# INLINE (<>) #-}

instance Monoid Metrics where
  mempty :: Metrics
mempty = Word -> Word -> Word -> Word -> Metrics
Metrics Word
0 Word
0 Word
0 Word
0
  mappend :: Metrics -> Metrics -> Metrics
mappend = Metrics -> Metrics -> Metrics
forall a. Semigroup a => a -> a -> a
(<>)

subMetrics :: Metrics -> Metrics -> Metrics
subMetrics :: Metrics -> Metrics -> Metrics
subMetrics (Metrics Word
nls1 Word
c1 Word
u1 Word
u1') (Metrics Word
nls2 Word
c2 Word
u2 Word
u2') =
  Word -> Word -> Word -> Word -> Metrics
Metrics (Word
nls1 Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
nls2) (Word
c1 Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
c2) (Word
u1 Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
u2) (Word
u1' Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
u2')

metrics :: Rope -> Metrics
metrics :: Rope -> Metrics
metrics = \case
  Rope
Empty -> Metrics
forall a. Monoid a => a
mempty
  Node Rope
_ TextLines
_ Rope
_ Metrics
m -> Metrics
m

linesMetrics :: Char.TextLines -> Metrics
linesMetrics :: TextLines -> Metrics
linesMetrics TextLines
tl = Metrics
  { _metricsNewlines :: Word
_metricsNewlines = TextLines -> Word
TL.newlines TextLines
tl
  , _metricsCharLen :: Word
_metricsCharLen = Word
charLen
  , _metricsUtf8Len :: Word
_metricsUtf8Len = Word
utf8Len
  , _metricsUtf16Len :: Word
_metricsUtf16Len = if Word
charLen Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
utf8Len then Word
charLen else TextLines -> Word
Utf16.length TextLines
tl
  }
  where
    charLen :: Word
charLen = TextLines -> Word
Char.length TextLines
tl
    utf8Len :: Word
utf8Len = TextLines -> Word
Utf8.length TextLines
tl


#ifdef DEBUG
deriving instance Show Metrics
deriving instance Show Rope
#else
instance Show Rope where
  show :: Rope -> String
show = Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (Rope -> Text) -> Rope -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Text
toLazyText
#endif

instance IsString Rope where
  fromString :: String -> Rope
fromString = TextLines -> Rope
fromTextLines (TextLines -> Rope) -> (String -> TextLines) -> String -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TextLines
forall a. IsString a => String -> a
fromString

-- | Check whether a rope is empty, O(1).
null :: Rope -> Bool
null :: Rope -> Bool
null = \case
  Rope
Empty -> Bool
True
  Node{} -> Bool
False

-- | Length in code points, similar to @Data.Text.@'Data.Text.length', O(1).
--
-- >>> :set -XOverloadedStrings
-- >>> charLength "fя𐀀"
-- 3
--
charLength :: Rope -> Word
charLength :: Rope -> Word
charLength = Metrics -> Word
_metricsCharLen (Metrics -> Word) -> (Rope -> Metrics) -> Rope -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Metrics
metrics

-- | Length in UTF-8 code units aka bytes, O(1).
--
-- >>> :set -XOverloadedStrings
-- >>> utf8Length "fя𐀀"
-- 4
--
utf8Length :: Rope -> Word
utf8Length :: Rope -> Word
utf8Length = Metrics -> Word
_metricsUtf8Len (Metrics -> Word) -> (Rope -> Metrics) -> Rope -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Metrics
metrics

-- | Length in UTF-16 code units, O(1).
--
-- >>> :set -XOverloadedStrings
-- >>> utf16Length "fя𐀀"
-- 4
--
utf16Length :: Rope -> Word
utf16Length :: Rope -> Word
utf16Length = Metrics -> Word
_metricsUtf16Len (Metrics -> Word) -> (Rope -> Metrics) -> Rope -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Metrics
metrics

-- | The number of newline characters, O(1).
--
-- >>> :set -XOverloadedStrings
-- >>> newlines ""
-- 0
-- >>> newlines "foo"
-- 0
-- >>> newlines "foo\n"
-- 1
-- >>> newlines "foo\n\n"
-- 2
-- >>> newlines "foo\nbar"
-- 1
--
newlines :: Rope -> Word
newlines :: Rope -> Word
newlines = Metrics -> Word
_metricsNewlines (Metrics -> Word) -> (Rope -> Metrics) -> Rope -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Metrics
metrics

-- | Measure text length as an amount of lines and columns.
-- Time is linear in the length of the last line.
--
-- >>> :set -XOverloadedStrings
-- >>> charLengthAsPosition "f𐀀"
-- Position {posLine = 0, posColumn = 2}
-- >>> charLengthAsPosition "f\n𐀀"
-- Position {posLine = 1, posColumn = 1}
-- >>> charLengthAsPosition "f\n𐀀\n"
-- Position {posLine = 2, posColumn = 0}
--
charLengthAsPosition :: Rope -> Char.Position
charLengthAsPosition :: Rope -> Position
charLengthAsPosition Rope
rp =
  Word -> Word -> Position
Char.Position Word
nls (Rope -> Word
charLength Rope
line)
  where
    nls :: Word
nls = Rope -> Word
newlines Rope
rp
    (Rope
_, Rope
line) = Word -> Rope -> (Rope, Rope)
splitAtLine Word
nls Rope
rp

-- | Measure text length as an amount of lines and columns.
-- Time is linear in the length of the last line.
--
utf8LengthAsPosition :: Rope -> Utf8.Position
utf8LengthAsPosition :: Rope -> Position
utf8LengthAsPosition Rope
rp =
  Word -> Word -> Position
Utf8.Position Word
nls (Rope -> Word
utf8Length Rope
line)
  where
    nls :: Word
nls = Rope -> Word
newlines Rope
rp
    (Rope
_, Rope
line) = Word -> Rope -> (Rope, Rope)
splitAtLine Word
nls Rope
rp

-- | Measure text length as an amount of lines and columns.
-- Time is linear in the length of the last line.
--
-- >>> :set -XOverloadedStrings
-- >>> utf16LengthAsPosition "f𐀀"
-- Position {posLine = 0, posColumn = 3}
-- >>> utf16LengthAsPosition "f\n𐀀"
-- Position {posLine = 1, posColumn = 2}
-- >>> utf16LengthAsPosition "f\n𐀀\n"
-- Position {posLine = 2, posColumn = 0}
--
utf16LengthAsPosition :: Rope -> Utf16.Position
utf16LengthAsPosition :: Rope -> Position
utf16LengthAsPosition Rope
rp =
  Word -> Word -> Position
Utf16.Position Word
nls (Rope -> Word
utf16Length Rope
line)
  where
    nls :: Word
nls = Rope -> Word
newlines Rope
rp
    (Rope
_, Rope
line) = Word -> Rope -> (Rope, Rope)
splitAtLine Word
nls Rope
rp

instance Semigroup Rope where
  Rope
Empty <> :: Rope -> Rope -> Rope
<> Rope
t = Rope
t
  Rope
t <> Rope
Empty = Rope
t
  Node Rope
l1 TextLines
c1 Rope
r1 Metrics
m1 <> Node Rope
l2 TextLines
c2 Rope
r2 Metrics
m2 = Rope -> TextLines -> Rope -> Metrics -> Rope
defragment
    Rope
l1
    TextLines
c1
    (Rope -> TextLines -> Rope -> Metrics -> Rope
Node (Rope
r1 Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
l2) TextLines
c2 Rope
r2 (Rope -> Metrics
metrics Rope
r1 Metrics -> Metrics -> Metrics
forall a. Semigroup a => a -> a -> a
<> Metrics
m2))
    (Metrics
m1 Metrics -> Metrics -> Metrics
forall a. Semigroup a => a -> a -> a
<> Metrics
m2)

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

defragment :: HasCallStack => Rope -> TextLines -> Rope -> Metrics -> Rope
defragment :: Rope -> TextLines -> Rope -> Metrics -> Rope
defragment !Rope
l !TextLines
c !Rope
r !Metrics
m
#ifdef DEBUG
  | TL.null c = error "Data.Text.Lines: violated internal invariant"
#endif
  | Metrics -> Word
_metricsUtf16Len Metrics
m Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< DEFRAGMENTATION_THRESHOLD
  = Rope -> TextLines -> Rope -> Metrics -> Rope
Node Rope
Empty (Rope -> TextLines
toTextLines Rope
rp) Rope
Empty Metrics
m
  | Bool
otherwise
  = Rope
rp
  where
    rp :: Rope
rp = Rope -> TextLines -> Rope -> Metrics -> Rope
Node Rope
l TextLines
c Rope
r Metrics
m

-- | Create from 'TextLines', linear time.
fromTextLines :: TextLines -> Rope
fromTextLines :: TextLines -> Rope
fromTextLines TextLines
tl
  | TextLines -> Bool
TL.null TextLines
tl = Rope
Empty
  | Bool
otherwise = Rope -> TextLines -> Rope -> Metrics -> Rope
Node Rope
Empty TextLines
tl Rope
Empty (TextLines -> Metrics
linesMetrics TextLines
tl)

-- | Create a 'Node', defragmenting it if necessary. The 'Metrics' argument is
-- the computed metrics of the 'TL.TextLines' argument.
node :: HasCallStack => Rope -> TextLines -> Metrics -> Rope -> Rope
node :: Rope -> TextLines -> Metrics -> Rope -> Rope
node Rope
l TextLines
c Metrics
cm Rope
r = Rope -> TextLines -> Rope -> Metrics -> Rope
defragment Rope
l TextLines
c Rope
r (Rope -> Metrics
metrics Rope
l Metrics -> Metrics -> Metrics
forall a. Semigroup a => a -> a -> a
<> Metrics
cm Metrics -> Metrics -> Metrics
forall a. Semigroup a => a -> a -> a
<> Rope -> Metrics
metrics Rope
r)

-- | Append a 'TL.TextLines' with the given 'Metrics' to a 'Rope'.
snoc :: Rope -> TextLines -> Metrics -> Rope
snoc :: Rope -> TextLines -> Metrics -> Rope
snoc Rope
tr TextLines
tl Metrics
tlm
  | TextLines -> Bool
TL.null TextLines
tl = Rope
tr
  | Bool
otherwise = Rope -> TextLines -> Metrics -> Rope -> Rope
node Rope
tr TextLines
tl Metrics
tlm Rope
Empty

-- | Prepend a 'TL.TextLines' with the given 'Metrics' to a 'Rope'.
cons :: TextLines -> Metrics -> Rope -> Rope
cons :: TextLines -> Metrics -> Rope -> Rope
cons TextLines
tl Metrics
tlm Rope
tr
  | TextLines -> Bool
TL.null TextLines
tl = Rope
tr
  | Bool
otherwise = Rope -> TextLines -> Metrics -> Rope -> Rope
node Rope
Empty TextLines
tl Metrics
tlm Rope
tr

-- | Create from 'Text', linear time.
fromText :: Text -> Rope
fromText :: Text -> Rope
fromText = TextLines -> Rope
fromTextLines (TextLines -> Rope) -> (Text -> TextLines) -> Text -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TextLines
TL.fromText

foldMapRope :: Monoid a => (TextLines -> a) -> Rope -> a
foldMapRope :: forall a. Monoid a => (TextLines -> a) -> Rope -> a
foldMapRope TextLines -> a
f = Rope -> a
go
  where
    go :: Rope -> a
go = \case
      Rope
Empty -> a
forall a. Monoid a => a
mempty
      Node Rope
l TextLines
c Rope
r Metrics
_ -> Rope -> a
go Rope
l a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` TextLines -> a
f TextLines
c a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` Rope -> a
go Rope
r

data Lines = Lines ![Text] !Bool

instance Semigroup Lines where
  Lines [] Bool
_ <> :: Lines -> Lines -> Lines
<> Lines
ls = Lines
ls
  Lines
ls <> Lines [] Bool
_ = Lines
ls
  Lines [Text]
xs Bool
x <> Lines [Text]
ys Bool
y = [Text] -> Bool -> Lines
Lines (if Bool
x then [Text]
xs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ys else [Text] -> [Text] -> [Text]
forall {a}. Semigroup a => [a] -> [a] -> [a]
go [Text]
xs [Text]
ys) Bool
y
    where
      go :: [a] -> [a] -> [a]
go [] [a]
vs = [a]
vs
      go [a
u] (a
v : [a]
vs) = (a
u a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
v) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
vs
      go (a
u : [a]
us) [a]
vs = a
u a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
us [a]
vs

instance Monoid Lines where
  mempty :: Lines
mempty = [Text] -> Bool -> Lines
Lines [] Bool
False
  mappend :: Lines -> Lines -> Lines
mappend = Lines -> Lines -> Lines
forall a. Semigroup a => a -> a -> a
(<>)

-- | Split into lines by @\\n@, similar to @Data.Text.@'Data.Text.lines'.
-- Each line is produced in O(1).
--
-- >>> :set -XOverloadedStrings
-- >>> lines ""
-- []
-- >>> lines "foo"
-- ["foo"]
-- >>> lines "foo\n"
-- ["foo"]
-- >>> lines "foo\n\n"
-- ["foo",""]
-- >>> lines "foo\nbar"
-- ["foo","bar"]
--
lines :: Rope -> [Text]
lines :: Rope -> [Text]
lines = (\(Lines [Text]
ls Bool
_) -> [Text]
ls) (Lines -> [Text]) -> (Rope -> Lines) -> Rope -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextLines -> Lines) -> Rope -> Lines
forall a. Monoid a => (TextLines -> a) -> Rope -> a
foldMapRope
  -- This assumes that there are no empty chunks:
  (\TextLines
tl -> [Text] -> Bool -> Lines
Lines (TextLines -> [Text]
TL.lines TextLines
tl) (HasCallStack => Text -> Char
Text -> Char
T.last (TextLines -> Text
TL.toText TextLines
tl) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'))

lastChar :: Rope -> Maybe Char
lastChar :: Rope -> Maybe Char
lastChar = \case
  Rope
Empty -> Maybe Char
forall a. Maybe a
Nothing
  -- This assumes that there are no empty chunks:
  Node Rope
_ TextLines
c Rope
Empty Metrics
_ -> Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
T.last (Text -> Char) -> Text -> Char
forall a b. (a -> b) -> a -> b
$ TextLines -> Text
TL.toText TextLines
c
  Node Rope
_ TextLines
_ Rope
r Metrics
_ -> Rope -> Maybe Char
lastChar Rope
r

-- | Equivalent to 'Data.List.length' . 'lines', but in logarithmic time.
--
-- >>> :set -XOverloadedStrings
-- >>> lengthInLines ""
-- 0
-- >>> lengthInLines "foo"
-- 1
-- >>> lengthInLines "foo\n"
-- 1
-- >>> lengthInLines "foo\n\n"
-- 2
-- >>> lengthInLines "foo\nbar"
-- 2
--
-- If you do not care about ignoring the last newline character,
-- you can use 'Char.posLine' . 'charLengthAsPosition' instead, which works in O(1).
--
lengthInLines :: Rope -> Word
lengthInLines :: Rope -> Word
lengthInLines Rope
rp = case Rope -> Maybe Char
lastChar Rope
rp of
  Maybe Char
Nothing -> Word
0
  Just Char
ch -> Position -> Word
Char.posLine (Rope -> Position
charLengthAsPosition Rope
rp) Word -> Word -> Word
forall a. Num a => a -> a -> a
+ (if Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then Word
0 else Word
1)

-- | Glue chunks into 'TextLines', linear time.
toTextLines :: Rope -> TextLines
toTextLines :: Rope -> TextLines
toTextLines = [TextLines] -> TextLines
forall a. Monoid a => [a] -> a
mconcat ([TextLines] -> TextLines)
-> (Rope -> [TextLines]) -> Rope -> TextLines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextLines -> [TextLines]) -> Rope -> [TextLines]
forall a. Monoid a => (TextLines -> a) -> Rope -> a
foldMapRope (TextLines -> [TextLines] -> [TextLines]
forall a. a -> [a] -> [a]
:[])

toLazyText :: Rope -> TextLazy.Text
toLazyText :: Rope -> Text
toLazyText = (TextLines -> Text) -> Rope -> Text
forall a. Monoid a => (TextLines -> a) -> Rope -> a
foldMapRope (Text -> Text
TextLazy.fromStrict (Text -> Text) -> (TextLines -> Text) -> TextLines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextLines -> Text
TL.toText)

-- | Glue chunks into 'Text', linear time.
toText :: Rope -> Text
toText :: Rope -> Text
toText = Text -> Text
TextLazy.toStrict (Text -> Text) -> (Rope -> Text) -> Rope -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText (Builder -> Text) -> (Rope -> Builder) -> Rope -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextLines -> Builder) -> Rope -> Builder
forall a. Monoid a => (TextLines -> a) -> Rope -> a
foldMapRope (Text -> Builder
Builder.fromText (Text -> Builder) -> (TextLines -> Text) -> TextLines -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextLines -> Text
TL.toText)

-- | Split at given code point, similar to @Data.Text.@'Data.Text.splitAt'.
-- Takes linear time.
--
-- >>> :set -XOverloadedStrings
-- >>> map (\c -> charSplitAt c "fя𐀀") [0..4]
-- [("","fя𐀀"),("f","я𐀀"),("fя","𐀀"),("fя𐀀",""),("fя𐀀","")]
--
charSplitAt :: HasCallStack => Word -> Rope -> (Rope, Rope)
charSplitAt :: Word -> Rope -> (Rope, Rope)
charSplitAt !Word
len = \case
  Rope
Empty -> (Rope
Empty, Rope
Empty)
  Node Rope
l TextLines
c Rope
r Metrics
m
    | Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
ll -> case Word -> Rope -> (Rope, Rope)
charSplitAt Word
len Rope
l of
        (Rope
before, Rope
after) -> (Rope
before, Rope -> TextLines -> Metrics -> Rope -> Rope
node Rope
after TextLines
c Metrics
cm Rope
r)
    | Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
llc -> do
      let i :: Word
i = Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
ll
      case Word -> TextLines -> (TextLines, TextLines)
Char.splitAt Word
i TextLines
c of
        (TextLines
before, TextLines
after) -> do
          let utf8Len :: Word
utf8Len = TextLines -> Word
Utf8.length TextLines
before
          let beforeMetrics :: Metrics
beforeMetrics = Metrics
                { _metricsNewlines :: Word
_metricsNewlines = TextLines -> Word
TL.newlines TextLines
before
                , _metricsCharLen :: Word
_metricsCharLen = Word
i
                , _metricsUtf8Len :: Word
_metricsUtf8Len = Word
utf8Len
                , _metricsUtf16Len :: Word
_metricsUtf16Len = if Word
i Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
utf8Len then Word
i else TextLines -> Word
Utf16.length TextLines
before
                }
          let afterMetrics :: Metrics
afterMetrics = Metrics -> Metrics -> Metrics
subMetrics Metrics
cm Metrics
beforeMetrics
          (Rope -> TextLines -> Metrics -> Rope
snoc Rope
l TextLines
before Metrics
beforeMetrics, TextLines -> Metrics -> Rope -> Rope
cons TextLines
after Metrics
afterMetrics Rope
r)
    | Bool
otherwise -> case Word -> Rope -> (Rope, Rope)
charSplitAt (Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
llc) Rope
r of
      (Rope
before, Rope
after) -> (Rope -> TextLines -> Metrics -> Rope -> Rope
node Rope
l TextLines
c Metrics
cm Rope
before, Rope
after)
    where
      ll :: Word
ll = Rope -> Word
charLength Rope
l
      llc :: Word
llc = Word
ll Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Metrics -> Word
_metricsCharLen Metrics
cm
      cm :: Metrics
cm = Metrics -> Metrics -> Metrics
subMetrics Metrics
m (Rope -> Metrics
metrics Rope
l Metrics -> Metrics -> Metrics
forall a. Semigroup a => a -> a -> a
<> Rope -> Metrics
metrics Rope
r)

-- | Split at given UTF-8 code unit aka byte.
-- If requested number of code units splits a code point in half, return 'Nothing'.
-- Takes linear time.
--
utf8SplitAt :: HasCallStack => Word -> Rope -> Maybe (Rope, Rope)
utf8SplitAt :: Word -> Rope -> Maybe (Rope, Rope)
utf8SplitAt !Word
len = \case
  Rope
Empty -> (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope
Empty, Rope
Empty)
  Node Rope
l TextLines
c Rope
r Metrics
m
    | Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
ll -> case Word -> Rope -> Maybe (Rope, Rope)
utf8SplitAt Word
len Rope
l of
        Maybe (Rope, Rope)
Nothing -> Maybe (Rope, Rope)
forall a. Maybe a
Nothing
        Just (Rope
before, Rope
after) -> (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope
before, Rope -> TextLines -> Metrics -> Rope -> Rope
node Rope
after TextLines
c Metrics
cm Rope
r)
    | Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
llc -> do
      let i :: Word
i = Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
ll
      case Word -> TextLines -> Maybe (TextLines, TextLines)
Utf8.splitAt (Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
ll) TextLines
c of
        Maybe (TextLines, TextLines)
Nothing -> Maybe (Rope, Rope)
forall a. Maybe a
Nothing
        Just (TextLines
before, TextLines
after) -> do
          let charLen :: Word
charLen = TextLines -> Word
Char.length TextLines
before
          let beforeMetrics :: Metrics
beforeMetrics = Metrics
                { _metricsNewlines :: Word
_metricsNewlines = TextLines -> Word
TL.newlines TextLines
before
                , _metricsCharLen :: Word
_metricsCharLen = Word
charLen
                , _metricsUtf8Len :: Word
_metricsUtf8Len = Word
i
                , _metricsUtf16Len :: Word
_metricsUtf16Len = if Word
i Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
charLen then Word
i else TextLines -> Word
Utf16.length TextLines
before
                }
          let afterMetrics :: Metrics
afterMetrics = Metrics -> Metrics -> Metrics
subMetrics Metrics
cm Metrics
beforeMetrics
          (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope -> TextLines -> Metrics -> Rope
snoc Rope
l TextLines
before Metrics
beforeMetrics, TextLines -> Metrics -> Rope -> Rope
cons TextLines
after Metrics
afterMetrics Rope
r)
    | Bool
otherwise -> case Word -> Rope -> Maybe (Rope, Rope)
utf8SplitAt (Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
llc) Rope
r of
      Maybe (Rope, Rope)
Nothing -> Maybe (Rope, Rope)
forall a. Maybe a
Nothing
      Just (Rope
before, Rope
after) -> (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope -> TextLines -> Metrics -> Rope -> Rope
node Rope
l TextLines
c Metrics
cm Rope
before, Rope
after)
    where
      ll :: Word
ll = Rope -> Word
utf8Length Rope
l
      llc :: Word
llc = Word
ll Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Metrics -> Word
_metricsUtf8Len Metrics
cm
      cm :: Metrics
cm = Metrics -> Metrics -> Metrics
subMetrics Metrics
m (Rope -> Metrics
metrics Rope
l Metrics -> Metrics -> Metrics
forall a. Semigroup a => a -> a -> a
<> Rope -> Metrics
metrics Rope
r)

-- | Split at given UTF-16 code unit.
-- If requested number of code units splits a code point in half, return 'Nothing'.
-- Takes linear time.
--
-- >>> :set -XOverloadedStrings
-- >>> map (\c -> utf16SplitAt c "fя𐀀") [0..4]
-- [Just ("","fя𐀀"),Just ("f","я𐀀"),Just ("fя","𐀀"),Nothing,Just ("fя𐀀","")]
--
utf16SplitAt :: HasCallStack => Word -> Rope -> Maybe (Rope, Rope)
utf16SplitAt :: Word -> Rope -> Maybe (Rope, Rope)
utf16SplitAt !Word
len = \case
  Rope
Empty -> (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope
Empty, Rope
Empty)
  Node Rope
l TextLines
c Rope
r Metrics
m
    | Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
ll -> case Word -> Rope -> Maybe (Rope, Rope)
utf16SplitAt Word
len Rope
l of
        Maybe (Rope, Rope)
Nothing -> Maybe (Rope, Rope)
forall a. Maybe a
Nothing
        Just (Rope
before, Rope
after) -> (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope
before, Rope -> TextLines -> Metrics -> Rope -> Rope
node Rope
after TextLines
c Metrics
cm Rope
r)
    | Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
llc -> do
      let i :: Word
i = Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
ll
      case Word -> TextLines -> Maybe (TextLines, TextLines)
Utf16.splitAt (Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
ll) TextLines
c of
        Maybe (TextLines, TextLines)
Nothing -> Maybe (Rope, Rope)
forall a. Maybe a
Nothing
        Just (TextLines
before, TextLines
after) -> do
          let beforeMetrics :: Metrics
beforeMetrics = Metrics
                { _metricsNewlines :: Word
_metricsNewlines = TextLines -> Word
TL.newlines TextLines
before
                , _metricsCharLen :: Word
_metricsCharLen = TextLines -> Word
Char.length TextLines
before
                , _metricsUtf8Len :: Word
_metricsUtf8Len = TextLines -> Word
Utf8.length TextLines
before
                , _metricsUtf16Len :: Word
_metricsUtf16Len = Word
i
                }
          let afterMetrics :: Metrics
afterMetrics = Metrics -> Metrics -> Metrics
subMetrics Metrics
cm Metrics
beforeMetrics
          (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope -> TextLines -> Metrics -> Rope
snoc Rope
l TextLines
before Metrics
beforeMetrics, TextLines -> Metrics -> Rope -> Rope
cons TextLines
after Metrics
afterMetrics Rope
r)
    | Bool
otherwise -> case Word -> Rope -> Maybe (Rope, Rope)
utf16SplitAt (Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
llc) Rope
r of
      Maybe (Rope, Rope)
Nothing -> Maybe (Rope, Rope)
forall a. Maybe a
Nothing
      Just (Rope
before, Rope
after) -> (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope -> TextLines -> Metrics -> Rope -> Rope
node Rope
l TextLines
c Metrics
cm Rope
before, Rope
after)
    where
      ll :: Word
ll = Rope -> Word
utf16Length Rope
l
      llc :: Word
llc = Word
ll Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Metrics -> Word
_metricsUtf16Len Metrics
cm
      cm :: Metrics
cm = Metrics -> Metrics -> Metrics
subMetrics Metrics
m (Rope -> Metrics
metrics Rope
l Metrics -> Metrics -> Metrics
forall a. Semigroup a => a -> a -> a
<> Rope -> Metrics
metrics Rope
r)

-- | Split at given line, logarithmic time.
--
-- >>> :set -XOverloadedStrings
-- >>> map (\l -> splitAtLine l "foo\nbar") [0..3]
-- [("","foo\nbar"),("foo\n","bar"),("foo\nbar",""),("foo\nbar","")]
--
splitAtLine :: HasCallStack => Word -> Rope -> (Rope, Rope)
splitAtLine :: Word -> Rope -> (Rope, Rope)
splitAtLine !Word
len = \case
  Rope
Empty -> (Rope
Empty, Rope
Empty)
  Node Rope
l TextLines
c Rope
r Metrics
m
    | Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
ll -> case Word -> Rope -> (Rope, Rope)
splitAtLine Word
len Rope
l of
      (Rope
before, Rope
after) -> (Rope
before, Rope -> TextLines -> Metrics -> Rope -> Rope
node Rope
after TextLines
c Metrics
cm Rope
r)
    | Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
llc -> do
      let i :: Word
i = Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
ll
      case Word -> TextLines -> (TextLines, TextLines)
TL.splitAtLine Word
i TextLines
c of
        (TextLines
before, TextLines
after) -> do
          let beforeMetrics :: Metrics
beforeMetrics = TextLines -> Metrics
linesMetrics TextLines
before
          let afterMetrics :: Metrics
afterMetrics = Metrics -> Metrics -> Metrics
subMetrics Metrics
cm Metrics
beforeMetrics
          (Rope -> TextLines -> Metrics -> Rope
snoc Rope
l TextLines
before Metrics
beforeMetrics, TextLines -> Metrics -> Rope -> Rope
cons TextLines
after Metrics
afterMetrics Rope
r)
    | Bool
otherwise -> case Word -> Rope -> (Rope, Rope)
splitAtLine (Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
llc) Rope
r of
      (Rope
before, Rope
after) -> (Rope -> TextLines -> Metrics -> Rope -> Rope
node Rope
l TextLines
c Metrics
cm Rope
before, Rope
after)
    where
      -- posLine is the same both in Char.lengthAsPosition and Utf16.lengthAsPosition
      ll :: Word
ll = Rope -> Word
newlines Rope
l
      llc :: Word
llc = Word
ll Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Metrics -> Word
_metricsNewlines Metrics
cm
      cm :: Metrics
cm = Metrics -> Metrics -> Metrics
subMetrics Metrics
m (Rope -> Metrics
metrics Rope
l Metrics -> Metrics -> Metrics
forall a. Semigroup a => a -> a -> a
<> Rope -> Metrics
metrics Rope
r)

-- | Combination of 'splitAtLine' and subsequent 'charSplitAt'.
-- Time is linear in 'Char.posColumn' and logarithmic in 'Char.posLine'.
--
-- >>> :set -XOverloadedStrings
-- >>> charSplitAtPosition (Position 1 0) "f\n𐀀я"
-- ("f\n","𐀀я")
-- >>> charSplitAtPosition (Position 1 1) "f\n𐀀я"
-- ("f\n𐀀","я")
-- >>> charSplitAtPosition (Position 1 2) "f\n𐀀я"
-- ("f\n𐀀я","")
-- >>> charSplitAtPosition (Position 0 2) "f\n𐀀я"
-- ("f\n","𐀀я")
-- >>> charSplitAtPosition (Position 0 3) "f\n𐀀я"
-- ("f\n𐀀","я")
-- >>> charSplitAtPosition (Position 0 4) "f\n𐀀я"
-- ("f\n𐀀я","")
--
charSplitAtPosition :: HasCallStack => Char.Position -> Rope -> (Rope, Rope)
charSplitAtPosition :: Position -> Rope -> (Rope, Rope)
charSplitAtPosition (Char.Position Word
l Word
c) Rope
rp = (Rope
beforeLine Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
beforeColumn, Rope
afterColumn)
  where
    (Rope
beforeLine, Rope
afterLine) = Word -> Rope -> (Rope, Rope)
splitAtLine Word
l Rope
rp
    (Rope
beforeColumn, Rope
afterColumn) = Word -> Rope -> (Rope, Rope)
charSplitAt Word
c Rope
afterLine

-- | Combination of 'splitAtLine' and subsequent 'utf8SplitAt'.
-- Time is linear in 'Utf8.posColumn' and logarithmic in 'Utf8.posLine'.
--
utf8SplitAtPosition :: HasCallStack => Utf8.Position -> Rope -> Maybe (Rope, Rope)
utf8SplitAtPosition :: Position -> Rope -> Maybe (Rope, Rope)
utf8SplitAtPosition (Utf8.Position Word
l Word
c) Rope
rp = do
  let (Rope
beforeLine, Rope
afterLine) = Word -> Rope -> (Rope, Rope)
splitAtLine Word
l Rope
rp
  (Rope
beforeColumn, Rope
afterColumn) <- Word -> Rope -> Maybe (Rope, Rope)
utf8SplitAt Word
c Rope
afterLine
  (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope
beforeLine Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
beforeColumn, Rope
afterColumn)

-- | Combination of 'splitAtLine' and subsequent 'utf16SplitAt'.
-- Time is linear in 'Utf16.posColumn' and logarithmic in 'Utf16.posLine'.
--
-- >>> :set -XOverloadedStrings
-- >>> utf16SplitAtPosition (Position 1 0) "f\n𐀀я"
-- Just ("f\n","𐀀я")
-- >>> utf16SplitAtPosition (Position 1 1) "f\n𐀀я"
-- Nothing
-- >>> utf16SplitAtPosition (Position 1 2) "f\n𐀀я"
-- Just ("f\n𐀀","я")
-- >>> utf16SplitAtPosition (Position 0 2) "f\n𐀀я"
-- Just ("f\n","𐀀я")
-- >>> utf16SplitAtPosition (Position 0 3) "f\n𐀀я"
-- Nothing
-- >>> utf16SplitAtPosition (Position 0 4) "f\n𐀀я"
-- Just ("f\n𐀀","я")
--
utf16SplitAtPosition :: HasCallStack => Utf16.Position -> Rope -> Maybe (Rope, Rope)
utf16SplitAtPosition :: Position -> Rope -> Maybe (Rope, Rope)
utf16SplitAtPosition (Utf16.Position Word
l Word
c) Rope
rp = do
  let (Rope
beforeLine, Rope
afterLine) = Word -> Rope -> (Rope, Rope)
splitAtLine Word
l Rope
rp
  (Rope
beforeColumn, Rope
afterColumn) <- Word -> Rope -> Maybe (Rope, Rope)
utf16SplitAt Word
c Rope
afterLine
  (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope
beforeLine Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
beforeColumn, Rope
afterColumn)

-- | Get a line by its 0-based index.
-- Returns 'mempty' if the index is out of bounds.
-- The result doesn't contain @\\n@ characters.
--
-- >>> :set -XOverloadedStrings
-- >>> map (\l -> getLine l "foo\nbar\n😊😊\n\n") [0..3]
-- ["foo","bar","😊😊",""]
--
-- @since 0.3
getLine :: Word -> Rope -> Rope
getLine :: Word -> Rope -> Rope
getLine Word
lineIdx Rope
rp =
  case Word -> Rope -> (Rope, Rope)
charSplitAt (Rope -> Word
charLength Rope
firstLine Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Rope
firstLine of
    (Rope
firstLineInit, Rope
firstLineLast)
      | Rope -> Bool
isNewline Rope
firstLineLast -> Rope
firstLineInit
    (Rope, Rope)
_ -> Rope
firstLine
  where
    (Rope
_, Rope
afterIndex) = Word -> Rope -> (Rope, Rope)
splitAtLine Word
lineIdx Rope
rp
    (Rope
firstLine, Rope
_ ) = Word -> Rope -> (Rope, Rope)
splitAtLine Word
1 Rope
afterIndex

isNewline :: Rope -> Bool
isNewline :: Rope -> Bool
isNewline = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Text
T.singleton Char
'\n') (Text -> Bool) -> (Rope -> Text) -> Rope -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Text
toText