{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

module Cursor.TextField
  ( TextFieldCursor (..),
    makeTextFieldCursor,
    makeTextFieldCursorWithSelection,
    rebuildTextFieldCursorLines,
    rebuildTextFieldCursor,
    emptyTextFieldCursor,
    nullTextFieldCursor,
    textFieldCursorSelection,
    textFieldCursorNonEmptyCursorL,
    textFieldCursorSelectedL,
    textFieldCursorSelectPrevLine,
    textFieldCursorSelectNextLine,
    textFieldCursorSelectFirstLine,
    textFieldCursorSelectLastLine,
    textFieldCursorSelectPrevChar,
    textFieldCursorSelectNextChar,
    textFieldCursorSelectPrevWord,
    textFieldCursorSelectNextWord,
    textFieldCursorSelectBeginWord,
    textFieldCursorSelectEndWord,
    textFieldCursorIndexOnLine,
    textFieldCursorSelectIndexOnLine,
    textFieldCursorInsertChar,
    textFieldCursorAppendChar,
    textFieldCursorInsertNewline,
    textFieldCursorAppendNewline,
    textFieldCursorRemove,
    textFieldCursorDelete,
    textFieldCursorSelectStartOfLine,
    textFieldCursorSelectEndOfLine,
  )
where

import Control.DeepSeq
import Control.Monad
import Cursor.List.NonEmpty
import Cursor.Text
import Cursor.Types
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Data.Validity
import Data.Validity.Text ()
import GHC.Generics (Generic)
import Lens.Micro

newtype TextFieldCursor = TextFieldCursor
  { TextFieldCursor -> NonEmptyCursor TextCursor Text
textFieldCursorNonEmpty :: NonEmptyCursor TextCursor Text
  }
  deriving (Int -> TextFieldCursor -> ShowS
[TextFieldCursor] -> ShowS
TextFieldCursor -> String
(Int -> TextFieldCursor -> ShowS)
-> (TextFieldCursor -> String)
-> ([TextFieldCursor] -> ShowS)
-> Show TextFieldCursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextFieldCursor] -> ShowS
$cshowList :: [TextFieldCursor] -> ShowS
show :: TextFieldCursor -> String
$cshow :: TextFieldCursor -> String
showsPrec :: Int -> TextFieldCursor -> ShowS
$cshowsPrec :: Int -> TextFieldCursor -> ShowS
Show, TextFieldCursor -> TextFieldCursor -> Bool
(TextFieldCursor -> TextFieldCursor -> Bool)
-> (TextFieldCursor -> TextFieldCursor -> Bool)
-> Eq TextFieldCursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextFieldCursor -> TextFieldCursor -> Bool
$c/= :: TextFieldCursor -> TextFieldCursor -> Bool
== :: TextFieldCursor -> TextFieldCursor -> Bool
$c== :: TextFieldCursor -> TextFieldCursor -> Bool
Eq, (forall x. TextFieldCursor -> Rep TextFieldCursor x)
-> (forall x. Rep TextFieldCursor x -> TextFieldCursor)
-> Generic TextFieldCursor
forall x. Rep TextFieldCursor x -> TextFieldCursor
forall x. TextFieldCursor -> Rep TextFieldCursor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextFieldCursor x -> TextFieldCursor
$cfrom :: forall x. TextFieldCursor -> Rep TextFieldCursor x
Generic)

instance Validity TextFieldCursor where
  validate :: TextFieldCursor -> Validation
validate tfc :: TextFieldCursor
tfc@TextFieldCursor {NonEmptyCursor TextCursor Text
textFieldCursorNonEmpty :: NonEmptyCursor TextCursor Text
textFieldCursorNonEmpty :: TextFieldCursor -> NonEmptyCursor TextCursor Text
..} =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ TextFieldCursor -> Validation
forall a. (Generic a, GValidity (Rep a)) => a -> Validation
genericValidate TextFieldCursor
tfc,
        String -> Validation -> Validation
decorate String
"None of the texts contain newlines" (Validation -> Validation) -> Validation -> Validation
forall a b. (a -> b) -> a -> b
$
          [Text] -> (Text -> Validation) -> Validation
forall a. [a] -> (a -> Validation) -> Validation
decorateList (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (TextCursor -> Text)
-> NonEmptyCursor TextCursor Text -> NonEmpty Text
forall a b. (a -> b) -> NonEmptyCursor a b -> NonEmpty b
rebuildNonEmptyCursor TextCursor -> Text
rebuildTextCursor NonEmptyCursor TextCursor Text
textFieldCursorNonEmpty) ((Text -> Validation) -> Validation)
-> (Text -> Validation) -> Validation
forall a b. (a -> b) -> a -> b
$
            \Text
tc ->
              String -> Bool -> Validation
declare String
"The text of this line does not contain any newlines" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
tc
      ]

instance NFData TextFieldCursor

makeTextFieldCursor :: Text -> TextFieldCursor
makeTextFieldCursor :: Text -> TextFieldCursor
makeTextFieldCursor = Maybe TextFieldCursor -> TextFieldCursor
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe TextFieldCursor -> TextFieldCursor)
-> (Text -> Maybe TextFieldCursor) -> Text -> TextFieldCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Text -> Maybe TextFieldCursor
makeTextFieldCursorWithSelection Int
0 Int
0

makeTextFieldCursorWithSelection :: Int -> Int -> Text -> Maybe TextFieldCursor
makeTextFieldCursorWithSelection :: Int -> Int -> Text -> Maybe TextFieldCursor
makeTextFieldCursorWithSelection Int
x Int
y Text
t = do
  NonEmpty Text
ls <- [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([Text] -> Maybe (NonEmpty Text))
-> [Text] -> Maybe (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
t
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< NonEmpty Text -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty Text
ls)
  NonEmptyCursor (Maybe TextCursor) Text
nec <- (Text -> Maybe TextCursor)
-> Int
-> NonEmpty Text
-> Maybe (NonEmptyCursor (Maybe TextCursor) Text)
forall b a.
(b -> a) -> Int -> NonEmpty b -> Maybe (NonEmptyCursor a b)
makeNonEmptyCursorWithSelection (Int -> Text -> Maybe TextCursor
makeTextCursorWithSelection Int
y) Int
x NonEmpty Text
ls
  Maybe TextCursor -> Maybe ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe TextCursor -> Maybe ()) -> Maybe TextCursor -> Maybe ()
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor (Maybe TextCursor) Text -> Maybe TextCursor
forall a b. NonEmptyCursor a b -> a
nonEmptyCursorCurrent NonEmptyCursor (Maybe TextCursor) Text
nec
  -- This is safe because we already checked that it would work above
  TextFieldCursor -> Maybe TextFieldCursor
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextFieldCursor -> Maybe TextFieldCursor)
-> TextFieldCursor -> Maybe TextFieldCursor
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor TextCursor Text -> TextFieldCursor
TextFieldCursor (NonEmptyCursor (Maybe TextCursor) Text
nec NonEmptyCursor (Maybe TextCursor) Text
-> (NonEmptyCursor (Maybe TextCursor) Text
    -> NonEmptyCursor TextCursor Text)
-> NonEmptyCursor TextCursor Text
forall a b. a -> (a -> b) -> b
& (Maybe TextCursor -> Identity TextCursor)
-> NonEmptyCursor (Maybe TextCursor) Text
-> Identity (NonEmptyCursor TextCursor Text)
forall a c b. Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b
nonEmptyCursorElemL ((Maybe TextCursor -> Identity TextCursor)
 -> NonEmptyCursor (Maybe TextCursor) Text
 -> Identity (NonEmptyCursor TextCursor Text))
-> (Maybe TextCursor -> TextCursor)
-> NonEmptyCursor (Maybe TextCursor) Text
-> NonEmptyCursor TextCursor Text
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe TextCursor -> TextCursor
forall a. HasCallStack => Maybe a -> a
fromJust)

rebuildTextFieldCursorLines :: TextFieldCursor -> NonEmpty Text
rebuildTextFieldCursorLines :: TextFieldCursor -> NonEmpty Text
rebuildTextFieldCursorLines = (TextCursor -> Text)
-> NonEmptyCursor TextCursor Text -> NonEmpty Text
forall a b. (a -> b) -> NonEmptyCursor a b -> NonEmpty b
rebuildNonEmptyCursor TextCursor -> Text
rebuildTextCursor (NonEmptyCursor TextCursor Text -> NonEmpty Text)
-> (TextFieldCursor -> NonEmptyCursor TextCursor Text)
-> TextFieldCursor
-> NonEmpty Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextFieldCursor -> NonEmptyCursor TextCursor Text
textFieldCursorNonEmpty

rebuildTextFieldCursor :: TextFieldCursor -> Text
rebuildTextFieldCursor :: TextFieldCursor -> Text
rebuildTextFieldCursor = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text)
-> (TextFieldCursor -> [Text]) -> TextFieldCursor -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Text -> [Text])
-> (TextFieldCursor -> NonEmpty Text) -> TextFieldCursor -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextFieldCursor -> NonEmpty Text
rebuildTextFieldCursorLines

emptyTextFieldCursor :: TextFieldCursor
emptyTextFieldCursor :: TextFieldCursor
emptyTextFieldCursor =
  TextFieldCursor :: NonEmptyCursor TextCursor Text -> TextFieldCursor
TextFieldCursor {textFieldCursorNonEmpty :: NonEmptyCursor TextCursor Text
textFieldCursorNonEmpty = TextCursor -> NonEmptyCursor TextCursor Text
forall a b. a -> NonEmptyCursor a b
singletonNonEmptyCursor TextCursor
emptyTextCursor}

nullTextFieldCursor :: TextFieldCursor -> Bool
nullTextFieldCursor :: TextFieldCursor -> Bool
nullTextFieldCursor = (TextFieldCursor -> TextFieldCursor -> Bool
forall a. Eq a => a -> a -> Bool
== TextFieldCursor
emptyTextFieldCursor)

textFieldCursorSelection :: TextFieldCursor -> (Int, Int)
textFieldCursorSelection :: TextFieldCursor -> (Int, Int)
textFieldCursorSelection TextFieldCursor
tfc =
  ( NonEmptyCursor TextCursor Text -> Int
forall a b. NonEmptyCursor a b -> Int
nonEmptyCursorSelection (NonEmptyCursor TextCursor Text -> Int)
-> NonEmptyCursor TextCursor Text -> Int
forall a b. (a -> b) -> a -> b
$ TextFieldCursor -> NonEmptyCursor TextCursor Text
textFieldCursorNonEmpty TextFieldCursor
tfc,
    TextCursor -> Int
textCursorIndex (TextCursor -> Int) -> TextCursor -> Int
forall a b. (a -> b) -> a -> b
$ TextFieldCursor -> NonEmptyCursor TextCursor Text
textFieldCursorNonEmpty TextFieldCursor
tfc NonEmptyCursor TextCursor Text
-> Getting TextCursor (NonEmptyCursor TextCursor Text) TextCursor
-> TextCursor
forall s a. s -> Getting a s a -> a
^. Getting TextCursor (NonEmptyCursor TextCursor Text) TextCursor
forall a c b. Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b
nonEmptyCursorElemL
  )

textFieldCursorNonEmptyCursorL :: Lens' TextFieldCursor (NonEmptyCursor TextCursor Text)
textFieldCursorNonEmptyCursorL :: (NonEmptyCursor TextCursor Text
 -> f (NonEmptyCursor TextCursor Text))
-> TextFieldCursor -> f TextFieldCursor
textFieldCursorNonEmptyCursorL =
  (TextFieldCursor -> NonEmptyCursor TextCursor Text)
-> (TextFieldCursor
    -> NonEmptyCursor TextCursor Text -> TextFieldCursor)
-> Lens
     TextFieldCursor
     TextFieldCursor
     (NonEmptyCursor TextCursor Text)
     (NonEmptyCursor TextCursor Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TextFieldCursor -> NonEmptyCursor TextCursor Text
textFieldCursorNonEmpty ((TextFieldCursor
  -> NonEmptyCursor TextCursor Text -> TextFieldCursor)
 -> Lens
      TextFieldCursor
      TextFieldCursor
      (NonEmptyCursor TextCursor Text)
      (NonEmptyCursor TextCursor Text))
-> (TextFieldCursor
    -> NonEmptyCursor TextCursor Text -> TextFieldCursor)
-> Lens
     TextFieldCursor
     TextFieldCursor
     (NonEmptyCursor TextCursor Text)
     (NonEmptyCursor TextCursor Text)
forall a b. (a -> b) -> a -> b
$ \TextFieldCursor
tfc NonEmptyCursor TextCursor Text
lec -> TextFieldCursor
tfc {textFieldCursorNonEmpty :: NonEmptyCursor TextCursor Text
textFieldCursorNonEmpty = NonEmptyCursor TextCursor Text
lec}

textFieldCursorSelectedL :: Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL :: (TextCursor -> f TextCursor)
-> TextFieldCursor -> f TextFieldCursor
textFieldCursorSelectedL = (NonEmptyCursor TextCursor Text
 -> f (NonEmptyCursor TextCursor Text))
-> TextFieldCursor -> f TextFieldCursor
Lens
  TextFieldCursor
  TextFieldCursor
  (NonEmptyCursor TextCursor Text)
  (NonEmptyCursor TextCursor Text)
textFieldCursorNonEmptyCursorL ((NonEmptyCursor TextCursor Text
  -> f (NonEmptyCursor TextCursor Text))
 -> TextFieldCursor -> f TextFieldCursor)
-> ((TextCursor -> f TextCursor)
    -> NonEmptyCursor TextCursor Text
    -> f (NonEmptyCursor TextCursor Text))
-> (TextCursor -> f TextCursor)
-> TextFieldCursor
-> f TextFieldCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextCursor -> f TextCursor)
-> NonEmptyCursor TextCursor Text
-> f (NonEmptyCursor TextCursor Text)
forall a c b. Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b
nonEmptyCursorElemL

textFieldCursorSelectPrevLine :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectPrevLine :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectPrevLine =
  (NonEmptyCursor TextCursor Text
 -> Maybe (NonEmptyCursor TextCursor Text))
-> TextFieldCursor -> Maybe TextFieldCursor
moveMWhileKeepingSelection ((NonEmptyCursor TextCursor Text
  -> Maybe (NonEmptyCursor TextCursor Text))
 -> TextFieldCursor -> Maybe TextFieldCursor)
-> (NonEmptyCursor TextCursor Text
    -> Maybe (NonEmptyCursor TextCursor Text))
-> TextFieldCursor
-> Maybe TextFieldCursor
forall a b. (a -> b) -> a -> b
$ (TextCursor -> Text)
-> (Text -> TextCursor)
-> NonEmptyCursor TextCursor Text
-> Maybe (NonEmptyCursor TextCursor Text)
forall a b.
(a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectPrev TextCursor -> Text
rebuildTextCursor Text -> TextCursor
unsafeMakeTextCursor

textFieldCursorSelectNextLine :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectNextLine :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectNextLine =
  (NonEmptyCursor TextCursor Text
 -> Maybe (NonEmptyCursor TextCursor Text))
-> TextFieldCursor -> Maybe TextFieldCursor
moveMWhileKeepingSelection ((NonEmptyCursor TextCursor Text
  -> Maybe (NonEmptyCursor TextCursor Text))
 -> TextFieldCursor -> Maybe TextFieldCursor)
-> (NonEmptyCursor TextCursor Text
    -> Maybe (NonEmptyCursor TextCursor Text))
-> TextFieldCursor
-> Maybe TextFieldCursor
forall a b. (a -> b) -> a -> b
$ (TextCursor -> Text)
-> (Text -> TextCursor)
-> NonEmptyCursor TextCursor Text
-> Maybe (NonEmptyCursor TextCursor Text)
forall a b.
(a -> b)
-> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)
nonEmptyCursorSelectNext TextCursor -> Text
rebuildTextCursor Text -> TextCursor
unsafeMakeTextCursor

moveMWhileKeepingSelection ::
  (NonEmptyCursor TextCursor Text -> Maybe (NonEmptyCursor TextCursor Text)) ->
  TextFieldCursor ->
  Maybe TextFieldCursor
moveMWhileKeepingSelection :: (NonEmptyCursor TextCursor Text
 -> Maybe (NonEmptyCursor TextCursor Text))
-> TextFieldCursor -> Maybe TextFieldCursor
moveMWhileKeepingSelection NonEmptyCursor TextCursor Text
-> Maybe (NonEmptyCursor TextCursor Text)
movement TextFieldCursor
tfc = do
  let i :: Int
i = TextFieldCursor -> Int
textFieldCursorIndexOnLine TextFieldCursor
tfc
  let tfc' :: TextFieldCursor
tfc' = Int -> TextFieldCursor -> TextFieldCursor
textFieldCursorSelectIndexOnLine Int
0 TextFieldCursor
tfc
  TextFieldCursor
tfc'' <- (NonEmptyCursor TextCursor Text
 -> Maybe (NonEmptyCursor TextCursor Text))
-> TextFieldCursor -> Maybe TextFieldCursor
Lens
  TextFieldCursor
  TextFieldCursor
  (NonEmptyCursor TextCursor Text)
  (NonEmptyCursor TextCursor Text)
textFieldCursorNonEmptyCursorL NonEmptyCursor TextCursor Text
-> Maybe (NonEmptyCursor TextCursor Text)
movement TextFieldCursor
tfc'
  TextFieldCursor -> Maybe TextFieldCursor
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextFieldCursor -> Maybe TextFieldCursor)
-> TextFieldCursor -> Maybe TextFieldCursor
forall a b. (a -> b) -> a -> b
$ Int -> TextFieldCursor -> TextFieldCursor
textFieldCursorSelectIndexOnLine Int
i TextFieldCursor
tfc''

textFieldCursorSelectFirstLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectFirstLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectFirstLine =
  (NonEmptyCursor TextCursor Text -> NonEmptyCursor TextCursor Text)
-> TextFieldCursor -> TextFieldCursor
moveWhileKeepingSelection ((NonEmptyCursor TextCursor Text -> NonEmptyCursor TextCursor Text)
 -> TextFieldCursor -> TextFieldCursor)
-> (NonEmptyCursor TextCursor Text
    -> NonEmptyCursor TextCursor Text)
-> TextFieldCursor
-> TextFieldCursor
forall a b. (a -> b) -> a -> b
$ (TextCursor -> Text)
-> (Text -> TextCursor)
-> NonEmptyCursor TextCursor Text
-> NonEmptyCursor TextCursor Text
forall a b.
(a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectFirst TextCursor -> Text
rebuildTextCursor Text -> TextCursor
unsafeMakeTextCursor

textFieldCursorSelectLastLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectLastLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectLastLine =
  (NonEmptyCursor TextCursor Text -> NonEmptyCursor TextCursor Text)
-> TextFieldCursor -> TextFieldCursor
moveWhileKeepingSelection ((NonEmptyCursor TextCursor Text -> NonEmptyCursor TextCursor Text)
 -> TextFieldCursor -> TextFieldCursor)
-> (NonEmptyCursor TextCursor Text
    -> NonEmptyCursor TextCursor Text)
-> TextFieldCursor
-> TextFieldCursor
forall a b. (a -> b) -> a -> b
$ (TextCursor -> Text)
-> (Text -> TextCursor)
-> NonEmptyCursor TextCursor Text
-> NonEmptyCursor TextCursor Text
forall a b.
(a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
nonEmptyCursorSelectLast TextCursor -> Text
rebuildTextCursor Text -> TextCursor
unsafeMakeTextCursor

moveWhileKeepingSelection ::
  (NonEmptyCursor TextCursor Text -> NonEmptyCursor TextCursor Text) ->
  TextFieldCursor ->
  TextFieldCursor
moveWhileKeepingSelection :: (NonEmptyCursor TextCursor Text -> NonEmptyCursor TextCursor Text)
-> TextFieldCursor -> TextFieldCursor
moveWhileKeepingSelection NonEmptyCursor TextCursor Text -> NonEmptyCursor TextCursor Text
movement TextFieldCursor
tfc =
  let i :: Int
i = TextFieldCursor -> Int
textFieldCursorIndexOnLine TextFieldCursor
tfc
      tfc' :: TextFieldCursor
tfc' = Int -> TextFieldCursor -> TextFieldCursor
textFieldCursorSelectIndexOnLine Int
0 TextFieldCursor
tfc
      tfc'' :: TextFieldCursor
tfc'' = TextFieldCursor
tfc' TextFieldCursor
-> (TextFieldCursor -> TextFieldCursor) -> TextFieldCursor
forall a b. a -> (a -> b) -> b
& (NonEmptyCursor TextCursor Text
 -> Identity (NonEmptyCursor TextCursor Text))
-> TextFieldCursor -> Identity TextFieldCursor
Lens
  TextFieldCursor
  TextFieldCursor
  (NonEmptyCursor TextCursor Text)
  (NonEmptyCursor TextCursor Text)
textFieldCursorNonEmptyCursorL ((NonEmptyCursor TextCursor Text
  -> Identity (NonEmptyCursor TextCursor Text))
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (NonEmptyCursor TextCursor Text
    -> NonEmptyCursor TextCursor Text)
-> TextFieldCursor
-> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ NonEmptyCursor TextCursor Text -> NonEmptyCursor TextCursor Text
movement
   in Int -> TextFieldCursor -> TextFieldCursor
textFieldCursorSelectIndexOnLine Int
i TextFieldCursor
tfc''

textFieldCursorSelectPrevChar :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectPrevChar :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectPrevChar = (TextCursor -> Maybe TextCursor)
-> TextFieldCursor -> Maybe TextFieldCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL TextCursor -> Maybe TextCursor
textCursorSelectPrev

textFieldCursorSelectNextChar :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectNextChar :: TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorSelectNextChar = (TextCursor -> Maybe TextCursor)
-> TextFieldCursor -> Maybe TextFieldCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL TextCursor -> Maybe TextCursor
textCursorSelectNext

textFieldCursorSelectBeginWord :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectBeginWord :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectBeginWord = (TextCursor -> Identity TextCursor)
-> TextFieldCursor -> Identity TextFieldCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL ((TextCursor -> Identity TextCursor)
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (TextCursor -> TextCursor) -> TextFieldCursor -> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TextCursor -> TextCursor
textCursorSelectBeginWord

textFieldCursorSelectEndWord :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectEndWord :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectEndWord = (TextCursor -> Identity TextCursor)
-> TextFieldCursor -> Identity TextFieldCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL ((TextCursor -> Identity TextCursor)
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (TextCursor -> TextCursor) -> TextFieldCursor -> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TextCursor -> TextCursor
textCursorSelectEndWord

textFieldCursorSelectPrevWord :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectPrevWord :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectPrevWord = (TextCursor -> Identity TextCursor)
-> TextFieldCursor -> Identity TextFieldCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL ((TextCursor -> Identity TextCursor)
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (TextCursor -> TextCursor) -> TextFieldCursor -> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TextCursor -> TextCursor
textCursorSelectPrevWord

textFieldCursorSelectNextWord :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectNextWord :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectNextWord = (TextCursor -> Identity TextCursor)
-> TextFieldCursor -> Identity TextFieldCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL ((TextCursor -> Identity TextCursor)
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (TextCursor -> TextCursor) -> TextFieldCursor -> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TextCursor -> TextCursor
textCursorSelectNextWord

textFieldCursorIndexOnLine :: TextFieldCursor -> Int
textFieldCursorIndexOnLine :: TextFieldCursor -> Int
textFieldCursorIndexOnLine TextFieldCursor
tfc = TextCursor -> Int
textCursorIndex (TextCursor -> Int) -> TextCursor -> Int
forall a b. (a -> b) -> a -> b
$ TextFieldCursor
tfc TextFieldCursor
-> Getting TextCursor TextFieldCursor TextCursor -> TextCursor
forall s a. s -> Getting a s a -> a
^. Getting TextCursor TextFieldCursor TextCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL

textFieldCursorSelectIndexOnLine :: Int -> TextFieldCursor -> TextFieldCursor
textFieldCursorSelectIndexOnLine :: Int -> TextFieldCursor -> TextFieldCursor
textFieldCursorSelectIndexOnLine Int
ix_ = (TextCursor -> Identity TextCursor)
-> TextFieldCursor -> Identity TextFieldCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL ((TextCursor -> Identity TextCursor)
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (TextCursor -> TextCursor) -> TextFieldCursor -> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> TextCursor -> TextCursor
textCursorSelectIndex Int
ix_

-- |
--
-- returns 'Nothing' when given unsafe characters.
textFieldCursorInsertChar :: Char -> Maybe TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorInsertChar :: Char -> Maybe TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorInsertChar Char
c Maybe TextFieldCursor
mtfc =
  case Char
c of
    Char
'\n' -> TextFieldCursor -> Maybe TextFieldCursor
forall a. a -> Maybe a
Just (TextFieldCursor -> Maybe TextFieldCursor)
-> TextFieldCursor -> Maybe TextFieldCursor
forall a b. (a -> b) -> a -> b
$ Maybe TextFieldCursor -> TextFieldCursor
textFieldCursorInsertNewline Maybe TextFieldCursor
mtfc
    Char
_
      | Char -> Bool
isSafeChar Char
c ->
        TextFieldCursor -> Maybe TextFieldCursor
forall a. a -> Maybe a
Just (TextFieldCursor -> Maybe TextFieldCursor)
-> TextFieldCursor -> Maybe TextFieldCursor
forall a b. (a -> b) -> a -> b
$
          TextFieldCursor -> Maybe TextFieldCursor -> TextFieldCursor
forall a. a -> Maybe a -> a
fromMaybe TextFieldCursor
emptyTextFieldCursor Maybe TextFieldCursor
mtfc
            TextFieldCursor
-> (TextFieldCursor -> TextFieldCursor) -> TextFieldCursor
forall a b. a -> (a -> b) -> b
& (TextCursor -> Identity TextCursor)
-> TextFieldCursor -> Identity TextFieldCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL ((TextCursor -> Identity TextCursor)
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (TextCursor -> TextCursor) -> TextFieldCursor -> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe TextCursor -> TextCursor
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe TextCursor -> TextCursor)
-> (TextCursor -> Maybe TextCursor) -> TextCursor -> TextCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> TextCursor -> Maybe TextCursor
textCursorInsert Char
c)
      | Bool
otherwise -> Maybe TextFieldCursor
forall a. Maybe a
Nothing

-- |
--
-- returns 'Nothing' when given unsafe characters.
textFieldCursorAppendChar :: Char -> Maybe TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorAppendChar :: Char -> Maybe TextFieldCursor -> Maybe TextFieldCursor
textFieldCursorAppendChar Char
c Maybe TextFieldCursor
mtfc =
  case Char
c of
    Char
'\n' -> TextFieldCursor -> Maybe TextFieldCursor
forall a. a -> Maybe a
Just (TextFieldCursor -> Maybe TextFieldCursor)
-> TextFieldCursor -> Maybe TextFieldCursor
forall a b. (a -> b) -> a -> b
$ Maybe TextFieldCursor -> TextFieldCursor
textFieldCursorAppendNewline Maybe TextFieldCursor
mtfc
    Char
_
      | Char -> Bool
isSafeChar Char
c ->
        TextFieldCursor -> Maybe TextFieldCursor
forall a. a -> Maybe a
Just (TextFieldCursor -> Maybe TextFieldCursor)
-> TextFieldCursor -> Maybe TextFieldCursor
forall a b. (a -> b) -> a -> b
$
          TextFieldCursor -> Maybe TextFieldCursor -> TextFieldCursor
forall a. a -> Maybe a -> a
fromMaybe TextFieldCursor
emptyTextFieldCursor Maybe TextFieldCursor
mtfc
            TextFieldCursor
-> (TextFieldCursor -> TextFieldCursor) -> TextFieldCursor
forall a b. a -> (a -> b) -> b
& (TextCursor -> Identity TextCursor)
-> TextFieldCursor -> Identity TextFieldCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL ((TextCursor -> Identity TextCursor)
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (TextCursor -> TextCursor) -> TextFieldCursor -> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe TextCursor -> TextCursor
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe TextCursor -> TextCursor)
-> (TextCursor -> Maybe TextCursor) -> TextCursor -> TextCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> TextCursor -> Maybe TextCursor
textCursorAppend Char
c)
      | Bool
otherwise -> Maybe TextFieldCursor
forall a. Maybe a
Nothing

textFieldCursorInsertNewline :: Maybe TextFieldCursor -> TextFieldCursor
textFieldCursorInsertNewline :: Maybe TextFieldCursor -> TextFieldCursor
textFieldCursorInsertNewline Maybe TextFieldCursor
mtfc =
  let tfc :: TextFieldCursor
tfc = TextFieldCursor -> Maybe TextFieldCursor -> TextFieldCursor
forall a. a -> Maybe a -> a
fromMaybe TextFieldCursor
emptyTextFieldCursor Maybe TextFieldCursor
mtfc
   in TextFieldCursor
tfc
        TextFieldCursor
-> (TextFieldCursor -> TextFieldCursor) -> TextFieldCursor
forall a b. a -> (a -> b) -> b
& (NonEmptyCursor TextCursor Text
 -> Identity (NonEmptyCursor TextCursor Text))
-> TextFieldCursor -> Identity TextFieldCursor
Lens
  TextFieldCursor
  TextFieldCursor
  (NonEmptyCursor TextCursor Text)
  (NonEmptyCursor TextCursor Text)
textFieldCursorNonEmptyCursorL
        ((NonEmptyCursor TextCursor Text
  -> Identity (NonEmptyCursor TextCursor Text))
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (NonEmptyCursor TextCursor Text
    -> NonEmptyCursor TextCursor Text)
-> TextFieldCursor
-> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \lec :: NonEmptyCursor TextCursor Text
lec@NonEmptyCursor {[Text]
TextCursor
nonEmptyCursorNext :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorNext :: [Text]
nonEmptyCursorCurrent :: TextCursor
nonEmptyCursorPrev :: [Text]
nonEmptyCursorCurrent :: forall a b. NonEmptyCursor a b -> a
..} ->
               let (TextCursor
tc1, TextCursor
tc2) = TextCursor -> (TextCursor, TextCursor)
textCursorSplit TextCursor
nonEmptyCursorCurrent
                in NonEmptyCursor TextCursor Text
lec
                     { nonEmptyCursorPrev :: [Text]
nonEmptyCursorPrev = TextCursor -> Text
rebuildTextCursor TextCursor
tc1 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
nonEmptyCursorPrev,
                       nonEmptyCursorCurrent :: TextCursor
nonEmptyCursorCurrent = TextCursor
tc2
                     }
           )

textFieldCursorAppendNewline :: Maybe TextFieldCursor -> TextFieldCursor
textFieldCursorAppendNewline :: Maybe TextFieldCursor -> TextFieldCursor
textFieldCursorAppendNewline Maybe TextFieldCursor
mtfc =
  let tfc :: TextFieldCursor
tfc = TextFieldCursor -> Maybe TextFieldCursor -> TextFieldCursor
forall a. a -> Maybe a -> a
fromMaybe TextFieldCursor
emptyTextFieldCursor Maybe TextFieldCursor
mtfc
   in TextFieldCursor
tfc
        TextFieldCursor
-> (TextFieldCursor -> TextFieldCursor) -> TextFieldCursor
forall a b. a -> (a -> b) -> b
& (NonEmptyCursor TextCursor Text
 -> Identity (NonEmptyCursor TextCursor Text))
-> TextFieldCursor -> Identity TextFieldCursor
Lens
  TextFieldCursor
  TextFieldCursor
  (NonEmptyCursor TextCursor Text)
  (NonEmptyCursor TextCursor Text)
textFieldCursorNonEmptyCursorL
        ((NonEmptyCursor TextCursor Text
  -> Identity (NonEmptyCursor TextCursor Text))
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (NonEmptyCursor TextCursor Text
    -> NonEmptyCursor TextCursor Text)
-> TextFieldCursor
-> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \lec :: NonEmptyCursor TextCursor Text
lec@NonEmptyCursor {[Text]
TextCursor
nonEmptyCursorNext :: [Text]
nonEmptyCursorCurrent :: TextCursor
nonEmptyCursorPrev :: [Text]
nonEmptyCursorNext :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorCurrent :: forall a b. NonEmptyCursor a b -> a
..} ->
               let (TextCursor
tc1, TextCursor
tc2) = TextCursor -> (TextCursor, TextCursor)
textCursorSplit TextCursor
nonEmptyCursorCurrent
                in NonEmptyCursor TextCursor Text
lec
                     { nonEmptyCursorCurrent :: TextCursor
nonEmptyCursorCurrent = TextCursor
tc1,
                       nonEmptyCursorNext :: [Text]
nonEmptyCursorNext = TextCursor -> Text
rebuildTextCursor TextCursor
tc2 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
nonEmptyCursorNext
                     }
           )

textFieldCursorRemove :: TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor)
textFieldCursorRemove :: TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor)
textFieldCursorRemove TextFieldCursor
tfc =
  if TextFieldCursor -> Bool
nullTextFieldCursor TextFieldCursor
tfc
    then DeleteOrUpdate TextFieldCursor
-> Maybe (DeleteOrUpdate TextFieldCursor)
forall a. a -> Maybe a
Just DeleteOrUpdate TextFieldCursor
forall a. DeleteOrUpdate a
Deleted
    else
      Lens
  TextFieldCursor
  TextFieldCursor
  (NonEmptyCursor TextCursor Text)
  (NonEmptyCursor TextCursor Text)
-> (NonEmptyCursor TextCursor Text
    -> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text)))
-> TextFieldCursor
-> Maybe (DeleteOrUpdate TextFieldCursor)
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate
        Lens
  TextFieldCursor
  TextFieldCursor
  (NonEmptyCursor TextCursor Text)
  (NonEmptyCursor TextCursor Text)
textFieldCursorNonEmptyCursorL
        ( \lec :: NonEmptyCursor TextCursor Text
lec@NonEmptyCursor {[Text]
TextCursor
nonEmptyCursorNext :: [Text]
nonEmptyCursorCurrent :: TextCursor
nonEmptyCursorPrev :: [Text]
nonEmptyCursorNext :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorCurrent :: forall a b. NonEmptyCursor a b -> a
..} ->
            case TextCursor -> Maybe (DeleteOrUpdate TextCursor)
textCursorRemove TextCursor
nonEmptyCursorCurrent of
              Just (Updated TextCursor
ctc) -> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
-> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text))
forall a. a -> Maybe a
Just (DeleteOrUpdate (NonEmptyCursor TextCursor Text)
 -> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text)))
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
-> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text))
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor TextCursor Text
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
forall a. a -> DeleteOrUpdate a
Updated (NonEmptyCursor TextCursor Text
 -> DeleteOrUpdate (NonEmptyCursor TextCursor Text))
-> NonEmptyCursor TextCursor Text
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor TextCursor Text
lec NonEmptyCursor TextCursor Text
-> (NonEmptyCursor TextCursor Text
    -> NonEmptyCursor TextCursor Text)
-> NonEmptyCursor TextCursor Text
forall a b. a -> (a -> b) -> b
& (TextCursor -> Identity TextCursor)
-> NonEmptyCursor TextCursor Text
-> Identity (NonEmptyCursor TextCursor Text)
forall a c b. Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b
nonEmptyCursorElemL ((TextCursor -> Identity TextCursor)
 -> NonEmptyCursor TextCursor Text
 -> Identity (NonEmptyCursor TextCursor Text))
-> TextCursor
-> NonEmptyCursor TextCursor Text
-> NonEmptyCursor TextCursor Text
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TextCursor
ctc
              Maybe (DeleteOrUpdate TextCursor)
_ ->
                case [Text]
nonEmptyCursorPrev of
                  [] -> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text))
forall a. Maybe a
Nothing
                  (Text
pl : [Text]
pls) ->
                    DeleteOrUpdate (NonEmptyCursor TextCursor Text)
-> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text))
forall a. a -> Maybe a
Just (DeleteOrUpdate (NonEmptyCursor TextCursor Text)
 -> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text)))
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
-> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text))
forall a b. (a -> b) -> a -> b
$
                      NonEmptyCursor TextCursor Text
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
forall a. a -> DeleteOrUpdate a
Updated (NonEmptyCursor TextCursor Text
 -> DeleteOrUpdate (NonEmptyCursor TextCursor Text))
-> NonEmptyCursor TextCursor Text
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
forall a b. (a -> b) -> a -> b
$
                        NonEmptyCursor TextCursor Text
lec
                          { nonEmptyCursorPrev :: [Text]
nonEmptyCursorPrev = [Text]
pls,
                            nonEmptyCursorCurrent :: TextCursor
nonEmptyCursorCurrent =
                              TextCursor -> TextCursor -> TextCursor
textCursorCombine (Text -> TextCursor
unsafeMakeTextCursor Text
pl) TextCursor
nonEmptyCursorCurrent
                          }
        )
        TextFieldCursor
tfc

textFieldCursorDelete :: TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor)
textFieldCursorDelete :: TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor)
textFieldCursorDelete TextFieldCursor
tfc =
  if TextFieldCursor -> Bool
nullTextFieldCursor TextFieldCursor
tfc
    then DeleteOrUpdate TextFieldCursor
-> Maybe (DeleteOrUpdate TextFieldCursor)
forall a. a -> Maybe a
Just DeleteOrUpdate TextFieldCursor
forall a. DeleteOrUpdate a
Deleted
    else
      Lens
  TextFieldCursor
  TextFieldCursor
  (NonEmptyCursor TextCursor Text)
  (NonEmptyCursor TextCursor Text)
-> (NonEmptyCursor TextCursor Text
    -> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text)))
-> TextFieldCursor
-> Maybe (DeleteOrUpdate TextFieldCursor)
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate
        Lens
  TextFieldCursor
  TextFieldCursor
  (NonEmptyCursor TextCursor Text)
  (NonEmptyCursor TextCursor Text)
textFieldCursorNonEmptyCursorL
        ( \lec :: NonEmptyCursor TextCursor Text
lec@NonEmptyCursor {[Text]
TextCursor
nonEmptyCursorNext :: [Text]
nonEmptyCursorCurrent :: TextCursor
nonEmptyCursorPrev :: [Text]
nonEmptyCursorNext :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorPrev :: forall a b. NonEmptyCursor a b -> [b]
nonEmptyCursorCurrent :: forall a b. NonEmptyCursor a b -> a
..} ->
            case TextCursor -> Maybe (DeleteOrUpdate TextCursor)
textCursorDelete TextCursor
nonEmptyCursorCurrent of
              Just (Updated TextCursor
ctc) -> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
-> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text))
forall a. a -> Maybe a
Just (DeleteOrUpdate (NonEmptyCursor TextCursor Text)
 -> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text)))
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
-> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text))
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor TextCursor Text
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
forall a. a -> DeleteOrUpdate a
Updated (NonEmptyCursor TextCursor Text
 -> DeleteOrUpdate (NonEmptyCursor TextCursor Text))
-> NonEmptyCursor TextCursor Text
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
forall a b. (a -> b) -> a -> b
$ NonEmptyCursor TextCursor Text
lec NonEmptyCursor TextCursor Text
-> (NonEmptyCursor TextCursor Text
    -> NonEmptyCursor TextCursor Text)
-> NonEmptyCursor TextCursor Text
forall a b. a -> (a -> b) -> b
& (TextCursor -> Identity TextCursor)
-> NonEmptyCursor TextCursor Text
-> Identity (NonEmptyCursor TextCursor Text)
forall a c b. Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b
nonEmptyCursorElemL ((TextCursor -> Identity TextCursor)
 -> NonEmptyCursor TextCursor Text
 -> Identity (NonEmptyCursor TextCursor Text))
-> TextCursor
-> NonEmptyCursor TextCursor Text
-> NonEmptyCursor TextCursor Text
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TextCursor
ctc
              Maybe (DeleteOrUpdate TextCursor)
_ ->
                case [Text]
nonEmptyCursorNext of
                  [] -> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text))
forall a. Maybe a
Nothing
                  (Text
pl : [Text]
pls) ->
                    DeleteOrUpdate (NonEmptyCursor TextCursor Text)
-> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text))
forall a. a -> Maybe a
Just (DeleteOrUpdate (NonEmptyCursor TextCursor Text)
 -> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text)))
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
-> Maybe (DeleteOrUpdate (NonEmptyCursor TextCursor Text))
forall a b. (a -> b) -> a -> b
$
                      NonEmptyCursor TextCursor Text
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
forall a. a -> DeleteOrUpdate a
Updated (NonEmptyCursor TextCursor Text
 -> DeleteOrUpdate (NonEmptyCursor TextCursor Text))
-> NonEmptyCursor TextCursor Text
-> DeleteOrUpdate (NonEmptyCursor TextCursor Text)
forall a b. (a -> b) -> a -> b
$
                        NonEmptyCursor TextCursor Text
lec
                          { nonEmptyCursorCurrent :: TextCursor
nonEmptyCursorCurrent =
                              TextCursor -> TextCursor -> TextCursor
textCursorCombine TextCursor
nonEmptyCursorCurrent (Text -> TextCursor
unsafeMakeTextCursor Text
pl),
                            nonEmptyCursorNext :: [Text]
nonEmptyCursorNext = [Text]
pls
                          }
        )
        TextFieldCursor
tfc

textFieldCursorSelectStartOfLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectStartOfLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectStartOfLine = (TextCursor -> Identity TextCursor)
-> TextFieldCursor -> Identity TextFieldCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL ((TextCursor -> Identity TextCursor)
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (TextCursor -> TextCursor) -> TextFieldCursor -> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TextCursor -> TextCursor
textCursorSelectStart

textFieldCursorSelectEndOfLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectEndOfLine :: TextFieldCursor -> TextFieldCursor
textFieldCursorSelectEndOfLine = (TextCursor -> Identity TextCursor)
-> TextFieldCursor -> Identity TextFieldCursor
Lens' TextFieldCursor TextCursor
textFieldCursorSelectedL ((TextCursor -> Identity TextCursor)
 -> TextFieldCursor -> Identity TextFieldCursor)
-> (TextCursor -> TextCursor) -> TextFieldCursor -> TextFieldCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TextCursor -> TextCursor
textCursorSelectEnd

-- Unsafe: only use for movements.
unsafeMakeTextCursor :: Text -> TextCursor
unsafeMakeTextCursor :: Text -> TextCursor
unsafeMakeTextCursor = Maybe TextCursor -> TextCursor
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe TextCursor -> TextCursor)
-> (Text -> Maybe TextCursor) -> Text -> TextCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe TextCursor
makeTextCursor