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

{-# 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.Rope
  ( Rope
  , fromText
  , fromTextLines
  , toText
  , toTextLines
  , null
  -- * Lines
  , lines
  , lengthInLines
  , splitAtLine
  , getLine
  -- * Code points
  , length
  , splitAt
  , Position(..)
  , lengthAsPosition
  , splitAtPosition
  ) 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 (Position(..))
import qualified Data.Text.Lines as TL
import qualified Data.Text.Lines.Internal as TL (newlines)
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 an interface, based on code points.
-- Use "Data.Text.Utf16.Rope", if you need UTF-16 code units,
-- or "Data.Text.Mixed.Rope", if you need both interfaces.
data Rope
  = Empty
  | Node
    { Rope -> Rope
_ropeLeft    :: !Rope
    , Rope -> TextLines
_ropeMiddle  :: !TL.TextLines
    , Rope -> Rope
_ropeRight   :: !Rope
    , Rope -> Metrics
_ropeMetrics :: {-# UNPACK #-} !Metrics
    }

data Metrics = Metrics
  { Metrics -> Word
_metricsNewlines :: !Word
  , Metrics -> Word
_metricsCharLen  :: !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 <> :: Metrics -> Metrics -> Metrics
<> Metrics Word
nls2 Word
c2 =
    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)
  {-# INLINE (<>) #-}

instance Monoid Metrics where
  mempty :: Metrics
mempty = Word -> Word -> Metrics
Metrics 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) (Metrics Word
nls2 Word
c2) =
  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)

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 :: TL.TextLines -> Metrics
linesMetrics :: TextLines -> Metrics
linesMetrics TextLines
tl = Metrics
  { _metricsNewlines :: Word
_metricsNewlines = TextLines -> Word
TL.newlines TextLines
tl
  , _metricsCharLen :: Word
_metricsCharLen = TextLines -> Word
TL.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
-- >>> length "fя𐀀"
-- 3
-- >>> Data.Text.Utf16.Rope.length "fя𐀀"
-- 4
--
length :: Rope -> Word
length :: Rope -> Word
length = Metrics -> Word
_metricsCharLen (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
-- >>> lengthAsPosition "f𐀀"
-- Position {posLine = 0, posColumn = 2}
-- >>> lengthAsPosition "f\n𐀀"
-- Position {posLine = 1, posColumn = 1}
-- >>> lengthAsPosition "f\n𐀀\n"
-- Position {posLine = 2, posColumn = 0}
--
lengthAsPosition :: Rope -> Position
lengthAsPosition :: Rope -> Position
lengthAsPosition Rope
rp =
  Word -> Word -> Position
Position Word
nls (Rope -> Word
length 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 -> TL.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
_metricsCharLen 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 'TL.TextLines', linear time.
fromTextLines :: TL.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 -> TL.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 -> TL.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 :: TL.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 => (TL.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 'posLine' . 'lengthAsPosition' 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
TL.posLine (Rope -> Position
lengthAsPosition 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 'TL.TextLines', linear time.
toTextLines :: Rope -> TL.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 -> splitAt c "fя𐀀") [0..4]
-- [("","fя𐀀"),("f","я𐀀"),("fя","𐀀"),("fя𐀀",""),("fя𐀀","")]
--
splitAt :: HasCallStack => Word -> Rope -> (Rope, Rope)
splitAt :: Word -> Rope -> (Rope, Rope)
splitAt !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)
splitAt 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.splitAt Word
i TextLines
c of
        (TextLines
before, TextLines
after) -> do
          let beforeMetrics :: Metrics
beforeMetrics = Metrics
                { _metricsNewlines :: Word
_metricsNewlines = TextLines -> Word
TL.newlines TextLines
before
                , _metricsCharLen :: Word
_metricsCharLen = Word
i
                }
          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)
splitAt (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
length 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 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 -> case Word -> TextLines -> (TextLines, TextLines)
TL.splitAtLine (Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
ll) TextLines
c of
      (TextLines
before, TextLines
after) -> (Rope -> TextLines -> Metrics -> Rope
snoc Rope
l TextLines
before (TextLines -> Metrics
linesMetrics TextLines
before), TextLines -> Metrics -> Rope -> Rope
cons TextLines
after (TextLines -> Metrics
linesMetrics TextLines
after) 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
      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 'splitAt'.
-- Time is linear in 'posColumn' and logarithmic in 'posLine'.
--
-- >>> :set -XOverloadedStrings
-- >>> splitAtPosition (Position 1 0) "f\n𐀀я"
-- ("f\n","𐀀я")
-- >>> splitAtPosition (Position 1 1) "f\n𐀀я"
-- ("f\n𐀀","я")
-- >>> splitAtPosition (Position 1 2) "f\n𐀀я"
-- ("f\n𐀀я","")
-- >>> splitAtPosition (Position 0 2) "f\n𐀀я"
-- ("f\n","𐀀я")
-- >>> splitAtPosition (Position 0 3) "f\n𐀀я"
-- ("f\n𐀀","я")
-- >>> splitAtPosition (Position 0 4) "f\n𐀀я"
-- ("f\n𐀀я","")
--
splitAtPosition :: HasCallStack => Position -> Rope -> (Rope, Rope)
splitAtPosition :: Position -> Rope -> (Rope, Rope)
splitAtPosition (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)
splitAt Word
c Rope
afterLine

-- | 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)
splitAt (Rope -> Word
length 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