-- |
-- 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.Utf16.Rope.Mixed
  ( Rope
  , fromText
  , fromTextLines
  , toText
  , toTextLines
  , null
  -- * Lines
  , lines
  , lengthInLines
  , splitAtLine
  -- * Code points
  , charLength
  , charSplitAt
  , charLengthAsPosition
  , charSplitAtPosition
  -- * UTF-16 code units
  , utf16Length
  , utf16SplitAt
  , utf16LengthAsPosition
  , utf16SplitAtPosition
  ) 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, (<), (<=), Ordering(..))
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)
import qualified Data.Text.Lines as Char
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 two interfaces: one based on code points
-- and another one based on UTF-16 code units. This comes with a price
-- of double bookkeeping and is less performant than "Data.Text.Rope"
-- or "Data.Text.Utf16.Rope".
data Rope
  = Empty
  | Node
    { Rope -> Rope
_ropeLeft          :: !Rope
    , Rope -> TextLines
_ropeMiddle        :: !TextLines
    , Rope -> Rope
_ropeRight         :: !Rope
    , Rope -> Word
_ropeCharLen       :: !Word
    , Rope -> Position
_ropeCharLenAsPos  :: !Char.Position
    , Rope -> Word
_ropeUtf16Len      :: !Word
    , Rope -> Position
_ropeUtf16LenAsPos :: !Utf16.Position
    }

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 Word
_ Position
_ Word
_ Position
_) = 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

#ifdef DEBUG
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 = \case
  Rope
Empty -> Word
0
  Node Rope
_ TextLines
_ Rope
_ Word
w Position
_ Word
_ Position
_ -> Word
w

-- | Length in UTF-16 code units, O(1).
--
-- >>> :set -XOverloadedStrings
-- >>> utf16Length "fя𐀀"
-- 4
--
utf16Length :: Rope -> Word
utf16Length :: Rope -> Word
utf16Length = \case
  Rope
Empty -> Word
0
  Node Rope
_ TextLines
_ Rope
_ Word
_ Position
_ Word
w Position
_ -> Word
w

-- | Measure text length as an amount of lines and columns, O(1).
--
-- >>> :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 = \case
  Rope
Empty -> Position
forall a. Monoid a => a
mempty
  Node Rope
_ TextLines
_ Rope
_ Word
_ Position
p Word
_ Position
_ -> Position
p

-- | Measure text length as an amount of lines and columns, O(1).
--
-- >>> :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 = \case
  Rope
Empty -> Position
forall a. Monoid a => a
mempty
  Node Rope
_ TextLines
_ Rope
_ Word
_ Position
_ Word
_ Position
p -> Position
p

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 Word
u1 Position
p1 Word
u1' Position
p1' <> Node Rope
l2 TextLines
c2 Rope
r2 Word
u2 Position
p2 Word
u2' Position
p2' = Rope
-> TextLines
-> Rope
-> Word
-> Position
-> Word
-> Position
-> Rope
defragment
    Rope
l1
    TextLines
c1
    (Rope
-> TextLines
-> Rope
-> Word
-> Position
-> Word
-> Position
-> Rope
Node (Rope
r1 Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
l2) TextLines
c2 Rope
r2 (Rope -> Word
charLength Rope
r1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
u2) (Rope -> Position
charLengthAsPosition Rope
r1 Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> Position
p2) (Rope -> Word
utf16Length Rope
r1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
u2') (Rope -> Position
utf16LengthAsPosition Rope
r1 Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> Position
p2'))
    (Word
u1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
u2)
    (Position
p1 Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> Position
p2)
    (Word
u1' Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
u2')
    (Position
p1' Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> Position
p2')

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 -> Word -> Char.Position -> Word -> Utf16.Position -> Rope
defragment :: Rope
-> TextLines
-> Rope
-> Word
-> Position
-> Word
-> Position
-> Rope
defragment !Rope
l !TextLines
c !Rope
r !Word
u !Position
p !Word
u' !Position
p'
#ifdef DEBUG
  | TL.null c = error "Data.Text.Lines: violated internal invariant"
#endif
  | Word
u Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< DEFRAGMENTATION_THRESHOLD
  = Rope
-> TextLines
-> Rope
-> Word
-> Position
-> Word
-> Position
-> Rope
Node Rope
Empty (Rope -> TextLines
toTextLines Rope
rp) Rope
Empty Word
u Position
p Word
u' Position
p'
  | Bool
otherwise
  = Rope
rp
  where
    rp :: Rope
rp = Rope
-> TextLines
-> Rope
-> Word
-> Position
-> Word
-> Position
-> Rope
Node Rope
l TextLines
c Rope
r Word
u Position
p Word
u' Position
p'

-- | 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
-> Word
-> Position
-> Word
-> Position
-> Rope
Node Rope
Empty TextLines
tl Rope
Empty (TextLines -> Word
Char.length TextLines
tl) (TextLines -> Position
Char.lengthAsPosition TextLines
tl) (TextLines -> Word
Utf16.length TextLines
tl) (TextLines -> Position
Utf16.lengthAsPosition TextLines
tl)

node :: HasCallStack => Rope -> TextLines -> Rope -> Rope
node :: Rope -> TextLines -> Rope -> Rope
node Rope
l TextLines
c Rope
r = Rope
-> TextLines
-> Rope
-> Word
-> Position
-> Word
-> Position
-> Rope
defragment Rope
l TextLines
c Rope
r Word
totalLength Position
totalLengthAsPosition Word
totalLength' Position
totalLengthAsPosition'
  where
    totalLength :: Word
totalLength = Rope -> Word
charLength Rope
l Word -> Word -> Word
forall a. Num a => a -> a -> a
+ TextLines -> Word
Char.length TextLines
c Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Rope -> Word
charLength Rope
r
    totalLengthAsPosition :: Position
totalLengthAsPosition = Rope -> Position
charLengthAsPosition Rope
l Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> TextLines -> Position
Char.lengthAsPosition TextLines
c Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> Rope -> Position
charLengthAsPosition Rope
r
    totalLength' :: Word
totalLength' = Rope -> Word
utf16Length Rope
l Word -> Word -> Word
forall a. Num a => a -> a -> a
+ TextLines -> Word
Utf16.length TextLines
c Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Rope -> Word
utf16Length Rope
r
    totalLengthAsPosition' :: Position
totalLengthAsPosition' = Rope -> Position
utf16LengthAsPosition Rope
l Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> TextLines -> Position
Utf16.lengthAsPosition TextLines
c Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> Rope -> Position
utf16LengthAsPosition Rope
r

(|>) :: Rope -> TextLines -> Rope
Rope
tr |> :: Rope -> TextLines -> Rope
|> TextLines
tl
  | TextLines -> Bool
TL.null TextLines
tl = Rope
tr
  | Bool
otherwise = Rope -> TextLines -> Rope -> Rope
node Rope
tr TextLines
tl Rope
Empty

(<|) :: TextLines -> Rope -> Rope
TextLines
tl <| :: TextLines -> Rope -> Rope
<| Rope
tr
  | TextLines -> Bool
TL.null TextLines
tl = Rope
tr
  | Bool
otherwise = Rope -> TextLines -> Rope -> Rope
node Rope
Empty TextLines
tl 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 Word
_ Position
_ Word
_ Position
_ -> 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 Word
_ Position
_ Word
_ Position
_ -> 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 Word
_ Position
_ Word
_ Position
_ -> 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 Word
_ Position
_ Word
_ Position
_
    | 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 -> Rope -> Rope
node Rope
after TextLines
c Rope
r)
    | Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
llc -> case Word -> TextLines -> (TextLines, TextLines)
Char.splitAt (Word
len Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
ll) TextLines
c of
      (TextLines
before, TextLines
after) -> (Rope
l Rope -> TextLines -> Rope
|> TextLines
before, TextLines
after TextLines -> Rope -> Rope
<| 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 -> Rope -> Rope
node Rope
l TextLines
c 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
+ TextLines -> Word
Char.length TextLines
c

-- | 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 Word
_ Position
_ Word
_ Position
_
    | 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 -> Rope -> Rope
node Rope
after TextLines
c Rope
r)
    | Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
llc -> 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) -> (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope
l Rope -> TextLines -> Rope
|> TextLines
before, TextLines
after TextLines -> Rope -> Rope
<| 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 -> Rope -> Rope
node Rope
l TextLines
c 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
+ TextLines -> Word
Utf16.length TextLines
c

-- | 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 Word
_ Position
_ Word
_ Position
_
    | 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 -> Rope -> Rope
node Rope
after TextLines
c 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
l Rope -> TextLines -> Rope
|> TextLines
before, TextLines
after TextLines -> Rope -> Rope
<| 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 -> Rope -> Rope
node Rope
l TextLines
c Rope
before, Rope
after)
    where
      -- posLine is the same both in Char.lengthAsPosition and Utf16.lengthAsPosition
      ll :: Word
ll = Position -> Word
Char.posLine (Rope -> Position
charLengthAsPosition Rope
l)
      llc :: Word
llc = Word
ll Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Position -> Word
Char.posLine (TextLines -> Position
Char.lengthAsPosition TextLines
c)

charSubOnRope :: Rope -> Char.Position -> Char.Position -> Char.Position
charSubOnRope :: Rope -> Position -> Position -> Position
charSubOnRope Rope
rp (Char.Position Word
xl Word
xc) (Char.Position Word
yl Word
yc) = case Word
xl Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Word
yl of
  Ordering
GT -> Word -> Word -> Position
Char.Position (Word
xl Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yl) Word
xc
  Ordering
EQ -> Word -> Word -> Position
Char.Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yc)
  Ordering
LT -> Word -> Word -> Position
Char.Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Rope -> Word
charLength Rope
rp')
  where
    (Rope
_, Rope
rp') = Word -> Rope -> (Rope, Rope)
splitAtLine Word
xl Rope
rp

utf16SubOnRope :: Rope -> Utf16.Position -> Utf16.Position -> Utf16.Position
utf16SubOnRope :: Rope -> Position -> Position -> Position
utf16SubOnRope Rope
rp (Utf16.Position Word
xl Word
xc) (Utf16.Position Word
yl Word
yc) = case Word
xl Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Word
yl of
  Ordering
GT -> Word -> Word -> Position
Utf16.Position (Word
xl Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yl) Word
xc
  Ordering
EQ -> Word -> Word -> Position
Utf16.Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yc)
  Ordering
LT -> Word -> Word -> Position
Utf16.Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Rope -> Word
utf16Length Rope
rp')
  where
    (Rope
_, Rope
rp') = Word -> Rope -> (Rope, Rope)
splitAtLine Word
xl Rope
rp

charSubOnLines :: Char.TextLines -> Char.Position -> Char.Position -> Char.Position
charSubOnLines :: TextLines -> Position -> Position -> Position
charSubOnLines TextLines
tl (Char.Position Word
xl Word
xc) (Char.Position Word
yl Word
yc) = case Word
xl Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Word
yl of
  Ordering
GT -> Word -> Word -> Position
Char.Position (Word
xl Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yl) Word
xc
  Ordering
EQ -> Word -> Word -> Position
Char.Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yc)
  Ordering
LT -> Word -> Word -> Position
Char.Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- TextLines -> Word
Char.length TextLines
tl')
  where
    (TextLines
_, TextLines
tl') = Word -> TextLines -> (TextLines, TextLines)
Char.splitAtLine Word
xl TextLines
tl

utf16SubOnLines :: Utf16.TextLines -> Utf16.Position -> Utf16.Position -> Utf16.Position
utf16SubOnLines :: TextLines -> Position -> Position -> Position
utf16SubOnLines TextLines
tl (Utf16.Position Word
xl Word
xc) (Utf16.Position Word
yl Word
yc) = case Word
xl Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Word
yl of
  Ordering
GT -> Word -> Word -> Position
Utf16.Position (Word
xl Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yl) Word
xc
  Ordering
EQ -> Word -> Word -> Position
Utf16.Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yc)
  Ordering
LT -> Word -> Word -> Position
Utf16.Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- TextLines -> Word
Utf16.length TextLines
tl')
  where
    (TextLines
_, TextLines
tl') = Word -> TextLines -> (TextLines, TextLines)
Utf16.splitAtLine Word
xl TextLines
tl

-- | 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
0 Word
0) = (Rope
forall a. Monoid a => a
mempty,)
charSplitAtPosition !Position
len = \case
  Rope
Empty -> (Rope
Empty, Rope
Empty)
  Node Rope
l TextLines
c Rope
r Word
_ Position
_ Word
_ Position
_
    | Position
len Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
ll -> case Position -> Rope -> (Rope, Rope)
charSplitAtPosition Position
len Rope
l of
      (Rope
before, Rope
after)
        | Rope -> Bool
null Rope
after -> case Position -> Rope -> (Rope, Rope)
charSplitAtPosition Position
len' (TextLines
c TextLines -> Rope -> Rope
<| Rope
r) of
          (Rope
r', Rope
r'') -> (Rope
l Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
r', Rope
r'')
        | Bool
otherwise -> (Rope
before, Rope -> TextLines -> Rope -> Rope
node Rope
after TextLines
c Rope
r)
    | Position
len Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
llc -> case Position -> TextLines -> (TextLines, TextLines)
Char.splitAtPosition Position
len' TextLines
c of
      (TextLines
before, TextLines
after)
        | TextLines -> Bool
TL.null TextLines
after -> case Position -> Rope -> (Rope, Rope)
charSplitAtPosition Position
len'' Rope
r of
          (Rope
r', Rope
r'') -> ((Rope
l Rope -> TextLines -> Rope
|> TextLines
c) Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
r', Rope
r'')
        | Bool
otherwise -> (Rope
l Rope -> TextLines -> Rope
|> TextLines
before, TextLines
after TextLines -> Rope -> Rope
<| Rope
r)
    | Bool
otherwise -> case Position -> Rope -> (Rope, Rope)
charSplitAtPosition Position
len'' Rope
r of
      (Rope
before, Rope
after) -> (Rope -> TextLines -> Rope -> Rope
node Rope
l TextLines
c Rope
before, Rope
after)
    where
      ll :: Position
ll = Rope -> Position
charLengthAsPosition Rope
l
      lc :: Position
lc = TextLines -> Position
Char.lengthAsPosition TextLines
c
      llc :: Position
llc = Position
ll Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> Position
lc
      len' :: Position
len' = Rope -> Position -> Position -> Position
charSubOnRope Rope
l Position
len Position
ll
      len'' :: Position
len'' = TextLines -> Position -> Position -> Position
charSubOnLines TextLines
c Position
len' Position
lc

-- | 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
0 Word
0) = (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just ((Rope, Rope) -> Maybe (Rope, Rope))
-> (Rope -> (Rope, Rope)) -> Rope -> Maybe (Rope, Rope)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rope
forall a. Monoid a => a
mempty,)
utf16SplitAtPosition !Position
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 Word
_ Position
_ Word
_ Position
_
    | Position
len Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
ll -> case Position -> Rope -> Maybe (Rope, Rope)
utf16SplitAtPosition Position
len Rope
l of
      Maybe (Rope, Rope)
Nothing -> Maybe (Rope, Rope)
forall a. Maybe a
Nothing
      Just (Rope
before, Rope
after)
        | Rope -> Bool
null Rope
after -> case Position -> Rope -> Maybe (Rope, Rope)
utf16SplitAtPosition Position
len' (TextLines
c TextLines -> Rope -> Rope
<| Rope
r) of
          Maybe (Rope, Rope)
Nothing -> Maybe (Rope, Rope)
forall a. Maybe a
Nothing
          Just (Rope
r', Rope
r'') -> (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope
l Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
r', Rope
r'')
        | Bool
otherwise -> (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope
before, Rope -> TextLines -> Rope -> Rope
node Rope
after TextLines
c Rope
r)
    | Position
len Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
llc -> case Position -> TextLines -> Maybe (TextLines, TextLines)
Utf16.splitAtPosition Position
len' TextLines
c of
      Maybe (TextLines, TextLines)
Nothing -> Maybe (Rope, Rope)
forall a. Maybe a
Nothing
      Just (TextLines
before, TextLines
after)
        | TextLines -> Bool
Utf16.null TextLines
after -> case Position -> Rope -> Maybe (Rope, Rope)
utf16SplitAtPosition Position
len'' Rope
r of
          Maybe (Rope, Rope)
Nothing -> Maybe (Rope, Rope)
forall a. Maybe a
Nothing
          Just (Rope
r', Rope
r'') -> (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just ((Rope
l Rope -> TextLines -> Rope
|> TextLines
c) Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
r', Rope
r'')
        | Bool
otherwise -> (Rope, Rope) -> Maybe (Rope, Rope)
forall a. a -> Maybe a
Just (Rope
l Rope -> TextLines -> Rope
|> TextLines
before, TextLines
after TextLines -> Rope -> Rope
<| Rope
r)
    | Bool
otherwise -> case Position -> Rope -> Maybe (Rope, Rope)
utf16SplitAtPosition Position
len'' 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 -> Rope -> Rope
node Rope
l TextLines
c Rope
before, Rope
after)
    where
      ll :: Position
ll = Rope -> Position
utf16LengthAsPosition Rope
l
      lc :: Position
lc = TextLines -> Position
Utf16.lengthAsPosition TextLines
c
      llc :: Position
llc = Position
ll Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> Position
lc
      len' :: Position
len' = Rope -> Position -> Position -> Position
utf16SubOnRope Rope
l Position
len Position
ll
      len'' :: Position
len'' = TextLines -> Position -> Position -> Position
utf16SubOnLines TextLines
c Position
len' Position
lc