{-# LANGUAGE BangPatterns #-}

-- | A text document as a finger tree of lines with a cursor. Every change is
-- a 'TextEdit': replace the text at a position with other text. An edit
-- touches only the lines it spans, so edits, cursor moves and line lookups
-- cost O(log lines) plus the size of the lines involved, however long the
-- document is.
module NanoUI.Widgets.TextBuffer
  ( -- * Types
    TextBuffer (..)
  , Cursor (..)
  , TextEdit (..)

    -- * Construction & Conversion
  , empty
  , fromText
  , toText
  , toLines
  , lineAt

    -- * Cursor & Metrics
  , getCursor
  , getLineCount
  , withCursor
  , clampCursor
  , changedLines
  , markLinesSeen

    -- * Navigation
  , moveLeft
  , moveRight
  , moveUp
  , moveDown
  , moveToBOL
  , moveToEOL
  , moveToTop
  , moveToBottom
  , moveWordLeft
  , moveWordRight

    -- * Selection
  , selectionRange
  , selectedText
  , textRange
  , documentEnd

    -- * Edits
  , applyEdit
  , invertEdit
  , replaceEdit
  , insertableText
  )
where

import Control.Monad (when)
import Control.Monad.ST (runST)
import Data.Char (isPrint, isSpace)
import Data.Foldable (toList)
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Array qualified as A
import Data.Text.Internal (Text (..))

-- | Zero-indexed logical (row, column) position in the buffer. Fields are
-- row then column, so the derived 'Ord' is document order.
data Cursor = Cursor
  { Cursor -> Int
cursorRow :: {-# UNPACK #-} !Int
  , Cursor -> Int
cursorCol :: {-# UNPACK #-} !Int
  }
  deriving (Cursor -> Cursor -> Bool
(Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool) -> Eq Cursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cursor -> Cursor -> Bool
== :: Cursor -> Cursor -> Bool
$c/= :: Cursor -> Cursor -> Bool
/= :: Cursor -> Cursor -> Bool
Eq, Eq Cursor
Eq Cursor =>
(Cursor -> Cursor -> Ordering)
-> (Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Cursor)
-> (Cursor -> Cursor -> Cursor)
-> Ord Cursor
Cursor -> Cursor -> Bool
Cursor -> Cursor -> Ordering
Cursor -> Cursor -> Cursor
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Cursor -> Cursor -> Ordering
compare :: Cursor -> Cursor -> Ordering
$c< :: Cursor -> Cursor -> Bool
< :: Cursor -> Cursor -> Bool
$c<= :: Cursor -> Cursor -> Bool
<= :: Cursor -> Cursor -> Bool
$c> :: Cursor -> Cursor -> Bool
> :: Cursor -> Cursor -> Bool
$c>= :: Cursor -> Cursor -> Bool
>= :: Cursor -> Cursor -> Bool
$cmax :: Cursor -> Cursor -> Cursor
max :: Cursor -> Cursor -> Cursor
$cmin :: Cursor -> Cursor -> Cursor
min :: Cursor -> Cursor -> Cursor
Ord, Int -> Cursor -> ShowS
[Cursor] -> ShowS
Cursor -> String
(Int -> Cursor -> ShowS)
-> (Cursor -> String) -> ([Cursor] -> ShowS) -> Show Cursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cursor -> ShowS
showsPrec :: Int -> Cursor -> ShowS
$cshow :: Cursor -> String
show :: Cursor -> String
$cshowList :: [Cursor] -> ShowS
showList :: [Cursor] -> ShowS
Show)

-- | Lines (never empty, and without their newlines) and the cursor.
data TextBuffer = TextBuffer
  { TextBuffer -> Seq Text
bufferLines :: !(Seq Text)
  , TextBuffer -> Cursor
bufferCursor :: {-# UNPACK #-} !Cursor
  , TextBuffer -> Int
preferredCol :: {-# UNPACK #-} !Int
  -- ^ The column vertical motion aims for, kept while moving through
  -- shorter lines.
  , TextBuffer -> Int
bufferSeenHead :: {-# UNPACK #-} !Int
  , TextBuffer -> Int
bufferSeenTail :: {-# UNPACK #-} !Int
  -- ^ Lines at the start and the end that no edit has touched since
  -- 'markLinesSeen', so what was derived from them (their measured widths)
  -- still holds. See 'changedLines'.
  }
  deriving (TextBuffer -> TextBuffer -> Bool
(TextBuffer -> TextBuffer -> Bool)
-> (TextBuffer -> TextBuffer -> Bool) -> Eq TextBuffer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextBuffer -> TextBuffer -> Bool
== :: TextBuffer -> TextBuffer -> Bool
$c/= :: TextBuffer -> TextBuffer -> Bool
/= :: TextBuffer -> TextBuffer -> Bool
Eq, Int -> TextBuffer -> ShowS
[TextBuffer] -> ShowS
TextBuffer -> String
(Int -> TextBuffer -> ShowS)
-> (TextBuffer -> String)
-> ([TextBuffer] -> ShowS)
-> Show TextBuffer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextBuffer -> ShowS
showsPrec :: Int -> TextBuffer -> ShowS
$cshow :: TextBuffer -> String
show :: TextBuffer -> String
$cshowList :: [TextBuffer] -> ShowS
showList :: [TextBuffer] -> ShowS
Show)

-- | Replace 'editRemoved' at 'editAt' with 'editInserted'. Both texts may
-- span lines. An edit carries what it removes, so it can be inverted without
-- looking at the document.
data TextEdit = TextEdit
  { TextEdit -> Cursor
editAt :: {-# UNPACK #-} !Cursor
  , TextEdit -> Text
editRemoved :: !Text
  , TextEdit -> Text
editInserted :: !Text
  }
  deriving (TextEdit -> TextEdit -> Bool
(TextEdit -> TextEdit -> Bool)
-> (TextEdit -> TextEdit -> Bool) -> Eq TextEdit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextEdit -> TextEdit -> Bool
== :: TextEdit -> TextEdit -> Bool
$c/= :: TextEdit -> TextEdit -> Bool
/= :: TextEdit -> TextEdit -> Bool
Eq, Int -> TextEdit -> ShowS
[TextEdit] -> ShowS
TextEdit -> String
(Int -> TextEdit -> ShowS)
-> (TextEdit -> String) -> ([TextEdit] -> ShowS) -> Show TextEdit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextEdit -> ShowS
showsPrec :: Int -> TextEdit -> ShowS
$cshow :: TextEdit -> String
show :: TextEdit -> String
$cshowList :: [TextEdit] -> ShowS
showList :: [TextEdit] -> ShowS
Show)

-- | A TextBuffer containing a single blank line.
empty :: TextBuffer
empty :: TextBuffer
empty = Seq Text -> Cursor -> Int -> Int -> Int -> TextBuffer
TextBuffer (Text -> Seq Text
forall a. a -> Seq a
Seq.singleton Text
T.empty) (Int -> Int -> Cursor
Cursor Int
0 Int
0) Int
0 Int
0 Int
0

-- | Construct a TextBuffer from raw Text. Cursor is always (0, 0).
fromText :: Text -> TextBuffer
fromText :: Text -> TextBuffer
fromText Text
t = Seq Text -> Cursor -> Int -> Int -> Int -> TextBuffer
TextBuffer ([Text] -> Seq Text
forall a. [a] -> Seq a
Seq.fromList (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"\n" Text
t)) (Int -> Int -> Cursor
Cursor Int
0 Int
0) Int
0 Int
0 Int
0

-- | All lines joined with newlines, copied once into a new text.
toText :: TextBuffer -> Text
toText :: TextBuffer -> Text
toText TextBuffer
buf =
  let lns :: Seq Text
lns = TextBuffer -> Seq Text
bufferLines TextBuffer
buf
      !total :: Int
total = (Int -> Text -> Int) -> Int -> Seq Text -> Int
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
acc (Text Array
_ Int
_ Int
len) -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (-Int
1) Seq Text
lns
   in if Int
total Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        then Text
T.empty
        else (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
          dest <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
total
          let copyLine (Text Array
arr Int
start Int
len) Int -> ST s ()
next !Int
off = do
                Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
A.copyI Int
len MArray s
dest Int
off Array
arr Int
start
                Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
total) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ MArray s -> Int -> Word8 -> ST s ()
forall s. MArray s -> Int -> Word8 -> ST s ()
A.unsafeWrite MArray s
dest (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) Word8
10
                Int -> ST s ()
next (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          foldr copyLine (\Int
_ -> () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) lns 0
          frozen <- A.unsafeFreeze dest
          pure (Text frozen 0 total)

toLines :: TextBuffer -> [Text]
toLines :: TextBuffer -> [Text]
toLines = Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Text -> [Text])
-> (TextBuffer -> Seq Text) -> TextBuffer -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBuffer -> Seq Text
bufferLines

-- | The text of a row, or empty outside the document.
lineAt :: Int -> TextBuffer -> Text
lineAt :: Int -> TextBuffer -> Text
lineAt Int
row TextBuffer
buf = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
T.empty (Int -> Seq Text -> Maybe Text
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
row (TextBuffer -> Seq Text
bufferLines TextBuffer
buf))

getCursor :: TextBuffer -> Cursor
getCursor :: TextBuffer -> Cursor
getCursor = TextBuffer -> Cursor
bufferCursor

getLineCount :: TextBuffer -> Int
getLineCount :: TextBuffer -> Int
getLineCount = Seq Text -> Int
forall a. Seq a -> Int
Seq.length (Seq Text -> Int) -> (TextBuffer -> Seq Text) -> TextBuffer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextBuffer -> Seq Text
bufferLines

-- | How many lines at the start and at the end are the ones there at the last
-- 'markLinesSeen'; the lines between may have changed. Whatever was derived
-- per line from the marked document can be kept for those lines and
-- rederived for the rest.
changedLines :: TextBuffer -> (Int, Int)
changedLines :: TextBuffer -> (Int, Int)
changedLines TextBuffer
buf = (TextBuffer -> Int
bufferSeenHead TextBuffer
buf, TextBuffer -> Int
bufferSeenTail TextBuffer
buf)

-- | Record that every line has been seen, for 'changedLines'.
markLinesSeen :: TextBuffer -> TextBuffer
markLinesSeen :: TextBuffer -> TextBuffer
markLinesSeen TextBuffer
buf = let n :: Int
n = TextBuffer -> Int
getLineCount TextBuffer
buf in TextBuffer
buf {bufferSeenHead = n, bufferSeenTail = n}

-- | The nearest position inside the document.
clampCursor :: TextBuffer -> Cursor -> Cursor
clampCursor :: TextBuffer -> Cursor -> Cursor
clampCursor TextBuffer
buf (Cursor Int
row Int
col) =
  let !r :: Int
r = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (TextBuffer -> Int
getLineCount TextBuffer
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
row)
      !c :: Int
c = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Text -> Int
T.length (Int -> TextBuffer -> Text
lineAt Int
r TextBuffer
buf)) Int
col)
   in Int -> Int -> Cursor
Cursor Int
r Int
c

-- | Move to a position, clamped into the document, without changing text.
withCursor :: Cursor -> TextBuffer -> TextBuffer
withCursor :: Cursor -> TextBuffer -> TextBuffer
withCursor Cursor
cur TextBuffer
buf =
  let c :: Cursor
c = TextBuffer -> Cursor -> Cursor
clampCursor TextBuffer
buf Cursor
cur
   in TextBuffer
buf {bufferCursor = c, preferredCol = cursorCol c}

--------------------------------------------------------------------------------
-- Navigation
--------------------------------------------------------------------------------

moveLeft :: TextBuffer -> TextBuffer
moveLeft :: TextBuffer -> TextBuffer
moveLeft TextBuffer
buf = Cursor -> TextBuffer -> TextBuffer
withCursor (TextBuffer -> Cursor -> Cursor
positionLeft TextBuffer
buf (TextBuffer -> Cursor
getCursor TextBuffer
buf)) TextBuffer
buf

moveRight :: TextBuffer -> TextBuffer
moveRight :: TextBuffer -> TextBuffer
moveRight TextBuffer
buf = Cursor -> TextBuffer -> TextBuffer
withCursor (TextBuffer -> Cursor -> Cursor
positionRight TextBuffer
buf (TextBuffer -> Cursor
getCursor TextBuffer
buf)) TextBuffer
buf

positionLeft :: TextBuffer -> Cursor -> Cursor
positionLeft :: TextBuffer -> Cursor -> Cursor
positionLeft TextBuffer
buf (Cursor Int
row Int
col)
  | Int
col Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Int -> Cursor
Cursor Int
row (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  | Int
row Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Int -> Cursor
Cursor (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Text -> Int
T.length (Int -> TextBuffer -> Text
lineAt (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) TextBuffer
buf))
  | Bool
otherwise = Int -> Int -> Cursor
Cursor Int
0 Int
0

positionRight :: TextBuffer -> Cursor -> Cursor
positionRight :: TextBuffer -> Cursor -> Cursor
positionRight TextBuffer
buf (Cursor Int
row Int
col)
  | Int
col Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
T.length (Int -> TextBuffer -> Text
lineAt Int
row TextBuffer
buf) = Int -> Int -> Cursor
Cursor Int
row (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  | Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< TextBuffer -> Int
getLineCount TextBuffer
buf = Int -> Int -> Cursor
Cursor (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0
  | Bool
otherwise = Int -> Int -> Cursor
Cursor Int
row Int
col

moveUp :: TextBuffer -> TextBuffer
moveUp :: TextBuffer -> TextBuffer
moveUp = Int -> TextBuffer -> TextBuffer
moveByRow (-Int
1)

moveDown :: TextBuffer -> TextBuffer
moveDown :: TextBuffer -> TextBuffer
moveDown = Int -> TextBuffer -> TextBuffer
moveByRow Int
1

moveByRow :: Int -> TextBuffer -> TextBuffer
moveByRow :: Int -> TextBuffer -> TextBuffer
moveByRow Int
d TextBuffer
buf =
  let Cursor Int
row Int
_ = TextBuffer -> Cursor
getCursor TextBuffer
buf
      goal :: Int
goal = TextBuffer -> Int
preferredCol TextBuffer
buf
   in TextBuffer
buf {bufferCursor = clampCursor buf (Cursor (row + d) goal)}

moveToBOL :: TextBuffer -> TextBuffer
moveToBOL :: TextBuffer -> TextBuffer
moveToBOL TextBuffer
buf = Cursor -> TextBuffer -> TextBuffer
withCursor (Int -> Int -> Cursor
Cursor (Cursor -> Int
cursorRow (TextBuffer -> Cursor
getCursor TextBuffer
buf)) Int
0) TextBuffer
buf

moveToEOL :: TextBuffer -> TextBuffer
moveToEOL :: TextBuffer -> TextBuffer
moveToEOL TextBuffer
buf =
  let row :: Int
row = Cursor -> Int
cursorRow (TextBuffer -> Cursor
getCursor TextBuffer
buf)
   in Cursor -> TextBuffer -> TextBuffer
withCursor (Int -> Int -> Cursor
Cursor Int
row (Text -> Int
T.length (Int -> TextBuffer -> Text
lineAt Int
row TextBuffer
buf))) TextBuffer
buf

moveToTop :: TextBuffer -> TextBuffer
moveToTop :: TextBuffer -> TextBuffer
moveToTop = Cursor -> TextBuffer -> TextBuffer
withCursor (Int -> Int -> Cursor
Cursor Int
0 Int
0)

moveToBottom :: TextBuffer -> TextBuffer
moveToBottom :: TextBuffer -> TextBuffer
moveToBottom TextBuffer
buf = Cursor -> TextBuffer -> TextBuffer
withCursor (TextBuffer -> Cursor
documentEnd TextBuffer
buf) TextBuffer
buf

-- | Back over spaces (line breaks count), then over the word before them.
moveWordLeft :: TextBuffer -> TextBuffer
moveWordLeft :: TextBuffer -> TextBuffer
moveWordLeft TextBuffer
buf = Cursor -> TextBuffer -> TextBuffer
withCursor (TextBuffer -> Cursor -> Cursor
wordLeft TextBuffer
buf (TextBuffer -> Cursor
getCursor TextBuffer
buf)) TextBuffer
buf

-- | Forward over spaces (line breaks count), then over the word after them.
moveWordRight :: TextBuffer -> TextBuffer
moveWordRight :: TextBuffer -> TextBuffer
moveWordRight TextBuffer
buf = Cursor -> TextBuffer -> TextBuffer
withCursor (TextBuffer -> Cursor -> Cursor
wordRight TextBuffer
buf (TextBuffer -> Cursor
getCursor TextBuffer
buf)) TextBuffer
buf

wordLeft :: TextBuffer -> Cursor -> Cursor
wordLeft :: TextBuffer -> Cursor -> Cursor
wordLeft TextBuffer
buf (Cursor Int
row Int
col) =
  let before :: Text
before = Int -> Text -> Text
T.take Int
col (Int -> TextBuffer -> Text
lineAt Int
row TextBuffer
buf)
      spaces :: Int
spaces = Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.takeWhileEnd Char -> Bool
isSpace Text
before)
      inWord :: Int
inWord = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
spaces
   in if Int
inWord Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
row Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        -- Only spaces back to the line start: the line break is one more.
        then TextBuffer -> Cursor -> Cursor
wordLeft TextBuffer
buf (Int -> Int -> Cursor
Cursor (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Text -> Int
T.length (Int -> TextBuffer -> Text
lineAt (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) TextBuffer
buf)))
        else Int -> Int -> Cursor
Cursor Int
row (Int
inWord Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.takeWhileEnd (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (Int -> Text -> Text
T.take Int
inWord Text
before)))

wordRight :: TextBuffer -> Cursor -> Cursor
wordRight :: TextBuffer -> Cursor -> Cursor
wordRight TextBuffer
buf (Cursor Int
row Int
col) =
  let after :: Text
after = Int -> Text -> Text
T.drop Int
col (Int -> TextBuffer -> Text
lineAt Int
row TextBuffer
buf)
      spaces :: Int
spaces = Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace Text
after)
      rest :: Text
rest = Int -> Text -> Text
T.drop Int
spaces Text
after
   in if Text -> Bool
T.null Text
rest Bool -> Bool -> Bool
&& Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< TextBuffer -> Int
getLineCount TextBuffer
buf
        then TextBuffer -> Cursor -> Cursor
wordRight TextBuffer
buf (Int -> Int -> Cursor
Cursor (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0)
        else Int -> Int -> Cursor
Cursor Int
row (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spaces Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
rest))

--------------------------------------------------------------------------------
-- Edits
--------------------------------------------------------------------------------

-- | Apply an edit and leave the cursor after the inserted text. The removed
-- text decides how far the edit reaches, so an edit recorded against this
-- document (or undone from one) is applied without reading the text it
-- removes.
applyEdit :: TextEdit -> TextBuffer -> TextBuffer
applyEdit :: TextEdit -> TextBuffer -> TextBuffer
applyEdit (TextEdit Cursor
at Text
removed Text
inserted) TextBuffer
buf =
  let Cursor Int
row Int
col = TextBuffer -> Cursor -> Cursor
clampCursor TextBuffer
buf Cursor
at
      Cursor Int
endRow Int
endCol = Cursor -> Text -> Cursor
advance (Int -> Int -> Cursor
Cursor Int
row Int
col) Text
removed
      lns :: Seq Text
lns = TextBuffer -> Seq Text
bufferLines TextBuffer
buf
      first :: Text
first = Int -> TextBuffer -> Text
lineAt Int
row TextBuffer
buf
      lastLine :: Text
lastLine = Int -> TextBuffer -> Text
lineAt Int
endRow TextBuffer
buf
      prefix :: Text
prefix = Int -> Text -> Text
T.take Int
col Text
first
      suffix :: Text
suffix = Int -> Text -> Text
T.drop Int
endCol Text
lastLine
      newLines :: Seq Text
newLines = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"\n" Text
inserted of
        Text
firstPiece : rest :: [Text]
rest@(Text
_ : [Text]
_) ->
          [Text] -> Seq Text
forall a. [a] -> Seq a
Seq.fromList ((Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
firstPiece) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
init [Text]
rest [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [[Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
rest Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix])
        [Text]
_ -> Text -> Seq Text
forall a. a -> Seq a
Seq.singleton (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inserted Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix)
      spliced :: Seq Text
spliced = Int -> Seq Text -> Seq Text
forall a. Int -> Seq a -> Seq a
Seq.take Int
row Seq Text
lns Seq Text -> Seq Text -> Seq Text
forall a. Semigroup a => a -> a -> a
<> Seq Text
newLines Seq Text -> Seq Text -> Seq Text
forall a. Semigroup a => a -> a -> a
<> Int -> Seq Text -> Seq Text
forall a. Int -> Seq a -> Seq a
Seq.drop (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Seq Text -> Int
forall a. Seq a -> Int
Seq.length Seq Text
lns) (Int
endRow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Seq Text
lns
      end :: Cursor
end = Cursor -> Text -> Cursor
advance (Int -> Int -> Cursor
Cursor Int
row Int
col) Text
inserted
      untouchedTail :: Int
untouchedTail = Seq Text -> Int
forall a. Seq a -> Int
Seq.length Seq Text
spliced Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq Text -> Int
forall a. Seq a -> Int
Seq.length Seq Text
newLines)
   in Seq Text -> Cursor -> Int -> Int -> Int -> TextBuffer
TextBuffer Seq Text
spliced Cursor
end (Cursor -> Int
cursorCol Cursor
end) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
row (TextBuffer -> Int
bufferSeenHead TextBuffer
buf)) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
untouchedTail (TextBuffer -> Int
bufferSeenTail TextBuffer
buf))

-- | The position after walking over @txt@ from @cur@.
advance :: Cursor -> Text -> Cursor
advance :: Cursor -> Text -> Cursor
advance (Cursor Int
row Int
col) Text
txt =
  case HasCallStack => Text -> Text -> Int
Text -> Text -> Int
T.count Text
"\n" Text
txt of
    Int
0 -> Int -> Int -> Cursor
Cursor Int
row (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
txt)
    Int
breaks -> Int -> Int -> Cursor
Cursor (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
breaks) (Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.takeWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
txt))

-- | The edit that takes the document back.
invertEdit :: TextEdit -> TextEdit
invertEdit :: TextEdit -> TextEdit
invertEdit (TextEdit Cursor
at Text
removed Text
inserted) = Cursor -> Text -> Text -> TextEdit
TextEdit Cursor
at Text
inserted Text
removed

-- | The edit replacing the text between two positions.
replaceEdit :: Text -> Cursor -> Cursor -> TextBuffer -> TextEdit
replaceEdit :: Text -> Cursor -> Cursor -> TextBuffer -> TextEdit
replaceEdit Text
inserted Cursor
a Cursor
b TextBuffer
buf =
  let (Cursor
lo, Cursor
hi) = Cursor -> Cursor -> (Cursor, Cursor)
selectionRange (TextBuffer -> Cursor -> Cursor
clampCursor TextBuffer
buf Cursor
a) (TextBuffer -> Cursor -> Cursor
clampCursor TextBuffer
buf Cursor
b)
   in Cursor -> Text -> Text -> TextEdit
TextEdit Cursor
lo (Cursor -> Cursor -> TextBuffer -> Text
textRange Cursor
lo Cursor
hi TextBuffer
buf) Text
inserted

-- | Text as it can enter the document: printable characters, tabs and line
-- breaks, with Windows line ends folded.
insertableText :: Text -> Text
insertableText :: Text -> Text
insertableText = (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char -> Bool
isPrint Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\r\n" Text
"\n"

--------------------------------------------------------------------------------
-- Selection
--------------------------------------------------------------------------------

selectionRange :: Cursor -> Cursor -> (Cursor, Cursor)
selectionRange :: Cursor -> Cursor -> (Cursor, Cursor)
selectionRange Cursor
a Cursor
b = (Cursor -> Cursor -> Cursor
forall a. Ord a => a -> a -> a
min Cursor
a Cursor
b, Cursor -> Cursor -> Cursor
forall a. Ord a => a -> a -> a
max Cursor
a Cursor
b)

selectedText :: Cursor -> Cursor -> TextBuffer -> Text
selectedText :: Cursor -> Cursor -> TextBuffer -> Text
selectedText Cursor
a Cursor
b TextBuffer
buf =
  let (Cursor
lo, Cursor
hi) = Cursor -> Cursor -> (Cursor, Cursor)
selectionRange (TextBuffer -> Cursor -> Cursor
clampCursor TextBuffer
buf Cursor
a) (TextBuffer -> Cursor -> Cursor
clampCursor TextBuffer
buf Cursor
b)
   in Cursor -> Cursor -> TextBuffer -> Text
textRange Cursor
lo Cursor
hi TextBuffer
buf

-- | The text between two positions in document order, reading only the lines
-- between them.
textRange :: Cursor -> Cursor -> TextBuffer -> Text
textRange :: Cursor -> Cursor -> TextBuffer -> Text
textRange (Cursor Int
loRow Int
loCol) (Cursor Int
hiRow Int
hiCol) TextBuffer
buf
  | Int
loRow Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
hiRow = Int -> Text -> Text
T.take (Int
hiCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
loCol) (Int -> Text -> Text
T.drop Int
loCol (Int -> TextBuffer -> Text
lineAt Int
loRow TextBuffer
buf))
  | Bool
otherwise =
      let middle :: [Text]
middle = Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Int -> Seq Text -> Seq Text
forall a. Int -> Seq a -> Seq a
Seq.take (Int
hiRow Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
loRow Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Seq Text -> Seq Text
forall a. Int -> Seq a -> Seq a
Seq.drop (Int
loRow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (TextBuffer -> Seq Text
bufferLines TextBuffer
buf)))
       in Text -> [Text] -> Text
T.intercalate Text
"\n" (Int -> Text -> Text
T.drop Int
loCol (Int -> TextBuffer -> Text
lineAt Int
loRow TextBuffer
buf) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
middle [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Int -> Text -> Text
T.take Int
hiCol (Int -> TextBuffer -> Text
lineAt Int
hiRow TextBuffer
buf)])

documentEnd :: TextBuffer -> Cursor
documentEnd :: TextBuffer -> Cursor
documentEnd TextBuffer
buf =
  let row :: Int
row = TextBuffer -> Int
getLineCount TextBuffer
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
   in Int -> Int -> Cursor
Cursor Int
row (Text -> Int
T.length (Int -> TextBuffer -> Text
lineAt Int
row TextBuffer
buf))