-- |
-- 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
  ( Rope
  , fromText
  , fromTextLines
  , toText
  , toTextLines
  , null
  -- * Lines
  , lines
  , lengthInLines
  , splitAtLine
  -- * UTF-16 code units
  , 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, (<), (<=), 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.Utf16.Lines (Position(..))
import qualified Data.Text.Utf16.Lines as TL
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 UTF-16 code units.
-- Use "Data.Text.Rope", if you need code points,
-- or "Data.Text.Utf16.Rope.Mixed", if you need both interfaces.
data Rope
  = Empty
  | Node
    { Rope -> Rope
_ropeLeft          :: !Rope
    , Rope -> TextLines
_ropeMiddle        :: !TL.TextLines
    , Rope -> Rope
_ropeRight         :: !Rope
    , Rope -> Word
_ropeUtf16Len      :: !Word
    , Rope -> Position
_ropeUtf16LenAsPos :: !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
_) = 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 UTF-16 code units, O(1).
--
-- >>> :set -XOverloadedStrings
-- >>> length "fя𐀀"
-- 4
-- >>> Data.Text.Rope.length "fя𐀀"
-- 3
length :: Rope -> Word
length :: Rope -> Word
length = \case
  Rope
Empty -> Word
0
  Node Rope
_ TextLines
_ Rope
_ Word
w Position
_ -> Word
w

-- | Measure text length as an amount of lines and columns, O(1).
--
-- >>> :set -XOverloadedStrings
-- >>> lengthAsPosition "f𐀀"
-- Position {posLine = 0, posColumn = 3}
-- >>> lengthAsPosition "f\n𐀀"
-- Position {posLine = 1, posColumn = 2}
-- >>> lengthAsPosition "f\n𐀀\n"
-- Position {posLine = 2, posColumn = 0}
--
lengthAsPosition :: Rope -> Position
lengthAsPosition :: Rope -> Position
lengthAsPosition = \case
  Rope
Empty -> Position
forall a. Monoid a => a
mempty
  Node Rope
_ TextLines
_ Rope
_ 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 <> Node Rope
l2 TextLines
c2 Rope
r2 Word
u2 Position
p2 = Rope -> TextLines -> Rope -> Word -> Position -> Rope
defragment
    Rope
l1
    TextLines
c1
    (Rope -> TextLines -> Rope -> Word -> Position -> Rope
Node (Rope
r1 Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
l2) TextLines
c2 Rope
r2 (Rope -> Word
length Rope
r1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
u2) (Rope -> Position
lengthAsPosition 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)

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 -> Word -> Position -> Rope
defragment :: Rope -> TextLines -> Rope -> Word -> Position -> Rope
defragment !Rope
l !TextLines
c !Rope
r !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 -> Rope
Node Rope
Empty (Rope -> TextLines
toTextLines Rope
rp) Rope
Empty Word
u Position
p
  | Bool
otherwise
  = Rope
rp
  where
    rp :: Rope
rp = Rope -> TextLines -> Rope -> Word -> Position -> Rope
Node Rope
l TextLines
c Rope
r Word
u Position
p

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

node :: HasCallStack => Rope -> TL.TextLines -> Rope -> Rope
node :: Rope -> TextLines -> Rope -> Rope
node Rope
l TextLines
c Rope
r = Rope -> TextLines -> Rope -> Word -> Position -> Rope
defragment Rope
l TextLines
c Rope
r Word
totalLength Position
totalLengthAsPosition
  where
    totalLength :: Word
totalLength = Rope -> Word
length Rope
l Word -> Word -> Word
forall a. Num a => a -> a -> a
+ TextLines -> Word
TL.length TextLines
c Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Rope -> Word
length Rope
r
    totalLengthAsPosition :: Position
totalLengthAsPosition = Rope -> Position
lengthAsPosition Rope
l Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> TextLines -> Position
TL.lengthAsPosition TextLines
c Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
<> Rope -> Position
lengthAsPosition Rope
r

(|>) :: Rope -> TL.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

(<|) :: TL.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 => (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 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
_ -> 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
_ -> 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 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 -> splitAt c "fя𐀀") [0..4]
-- [Just ("","fя𐀀"),Just ("f","я𐀀"),Just ("fя","𐀀"),Nothing,Just ("fя𐀀","")]
--
splitAt :: HasCallStack => Word -> Rope -> Maybe (Rope, Rope)
splitAt :: Word -> Rope -> Maybe (Rope, Rope)
splitAt !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
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
ll -> case Word -> Rope -> Maybe (Rope, Rope)
splitAt 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)
TL.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)
splitAt (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
length Rope
l
      llc :: Word
llc = Word
ll Word -> Word -> Word
forall a. Num a => a -> a -> a
+ TextLines -> Word
TL.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
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
      ll :: Word
ll = Position -> Word
TL.posLine (Rope -> Position
lengthAsPosition Rope
l)
      llc :: Word
llc = Word
ll Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Position -> Word
TL.posLine (TextLines -> Position
TL.lengthAsPosition TextLines
c)

subOnRope :: Rope -> Position -> Position -> Position
subOnRope :: Rope -> Position -> Position -> Position
subOnRope Rope
rp (Position Word
xl Word
xc) (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
Position (Word
xl Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yl) Word
xc
  Ordering
EQ -> Word -> Word -> Position
Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yc)
  Ordering
LT -> Word -> Word -> Position
Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Rope -> Word
length Rope
rp')
  where
    (Rope
_, Rope
rp') = Word -> Rope -> (Rope, Rope)
splitAtLine Word
xl Rope
rp

subOnLines :: TL.TextLines -> Position -> Position -> Position
subOnLines :: TextLines -> Position -> Position -> Position
subOnLines TextLines
tl (Position Word
xl Word
xc) (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
Position (Word
xl Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yl) Word
xc
  Ordering
EQ -> Word -> Word -> Position
Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
yc)
  Ordering
LT -> Word -> Word -> Position
Position Word
0 (Word
xc Word -> Word -> Word
forall a. Num a => a -> a -> a
- TextLines -> Word
TL.length TextLines
tl')
  where
    (TextLines
_, TextLines
tl') = Word -> TextLines -> (TextLines, TextLines)
TL.splitAtLine Word
xl TextLines
tl

-- | Combination of 'splitAtLine' and subsequent 'splitAt'.
-- Time is linear in 'posColumn' and logarithmic in 'posLine'.
--
-- >>> :set -XOverloadedStrings
-- >>> splitAtPosition (Position 1 0) "f\n𐀀я"
-- Just ("f\n","𐀀я")
-- >>> splitAtPosition (Position 1 1) "f\n𐀀я"
-- Nothing
-- >>> splitAtPosition (Position 1 2) "f\n𐀀я"
-- Just ("f\n𐀀","я")
-- >>> splitAtPosition (Position 0 2) "f\n𐀀я"
-- Just ("f\n","𐀀я")
-- >>> splitAtPosition (Position 0 3) "f\n𐀀я"
-- Nothing
-- >>> splitAtPosition (Position 0 4) "f\n𐀀я"
-- Just ("f\n𐀀","я")
--
splitAtPosition :: HasCallStack => Position -> Rope -> Maybe (Rope, Rope)
splitAtPosition :: Position -> Rope -> Maybe (Rope, Rope)
splitAtPosition (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,)
splitAtPosition !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
_
    | Position
len Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
ll -> case Position -> Rope -> Maybe (Rope, Rope)
splitAtPosition 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)
splitAtPosition 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)
TL.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
TL.null TextLines
after -> case Position -> Rope -> Maybe (Rope, Rope)
splitAtPosition 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)
splitAtPosition 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
lengthAsPosition Rope
l
      lc :: Position
lc = TextLines -> Position
TL.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
subOnRope Rope
l Position
len Position
ll
      len'' :: Position
len'' = TextLines -> Position -> Position -> Position
subOnLines TextLines
c Position
len' Position
lc