{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}

module Cursor.Text
  ( TextCursor (..),
    emptyTextCursor,
    makeTextCursor,
    makeTextCursorWithSelection,
    rebuildTextCursor,
    textCursorNull,
    textCursorLength,
    textCursorIndex,
    textCursorSelectPrev,
    textCursorSelectNext,
    textCursorSelectIndex,
    textCursorSelectStart,
    textCursorSelectEnd,
    textCursorPrevChar,
    textCursorNextChar,
    textCursorSelectBeginWord,
    textCursorSelectEndWord,
    textCursorSelectNextWord,
    textCursorSelectPrevWord,
    textCursorInsert,
    textCursorAppend,
    textCursorInsertString,
    textCursorAppendString,
    textCursorInsertText,
    textCursorAppendText,
    textCursorRemove,
    textCursorDelete,
    textCursorSplit,
    textCursorCombine,
  )
where

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

-- | A cursor for single-line texts
newtype TextCursor = TextCursor
  { TextCursor -> ListCursor Char
textCursorList :: ListCursor Char
  }
  deriving (Int -> TextCursor -> ShowS
[TextCursor] -> ShowS
TextCursor -> String
(Int -> TextCursor -> ShowS)
-> (TextCursor -> String)
-> ([TextCursor] -> ShowS)
-> Show TextCursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextCursor] -> ShowS
$cshowList :: [TextCursor] -> ShowS
show :: TextCursor -> String
$cshow :: TextCursor -> String
showsPrec :: Int -> TextCursor -> ShowS
$cshowsPrec :: Int -> TextCursor -> ShowS
Show, TextCursor -> TextCursor -> Bool
(TextCursor -> TextCursor -> Bool)
-> (TextCursor -> TextCursor -> Bool) -> Eq TextCursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextCursor -> TextCursor -> Bool
$c/= :: TextCursor -> TextCursor -> Bool
== :: TextCursor -> TextCursor -> Bool
$c== :: TextCursor -> TextCursor -> Bool
Eq, (forall x. TextCursor -> Rep TextCursor x)
-> (forall x. Rep TextCursor x -> TextCursor) -> Generic TextCursor
forall x. Rep TextCursor x -> TextCursor
forall x. TextCursor -> Rep TextCursor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextCursor x -> TextCursor
$cfrom :: forall x. TextCursor -> Rep TextCursor x
Generic)

instance Validity TextCursor where
  validate :: TextCursor -> Validation
validate (TextCursor ListCursor Char
lc) =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ ListCursor Char -> Validation
forall a. (Generic a, GValidity (Rep a)) => a -> Validation
genericValidate ListCursor Char
lc,
        String -> (Char -> Validation) -> Validation
forall a. [a] -> (a -> Validation) -> Validation
decorateList (ListCursor Char -> String
forall a. ListCursor a -> [a]
rebuildListCursor ListCursor Char
lc) ((Char -> Validation) -> Validation)
-> (Char -> Validation) -> Validation
forall a b. (a -> b) -> a -> b
$ \Char
c ->
          [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
            [ String -> Bool -> Validation
declare String
"The character is not a newline character" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$ Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n',
              String -> Bool -> Validation
declare String
"The character is a safe character" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSafeChar Char
c
            ]
      ]

instance NFData TextCursor

emptyTextCursor :: TextCursor
emptyTextCursor :: TextCursor
emptyTextCursor = ListCursor Char -> TextCursor
TextCursor ListCursor Char
forall a. ListCursor a
emptyListCursor

makeTextCursor :: Text -> Maybe TextCursor
makeTextCursor :: Text -> Maybe TextCursor
makeTextCursor Text
t = Int -> Text -> Maybe TextCursor
makeTextCursorWithSelection (Text -> Int
T.length Text
t) Text
t

makeTextCursorWithSelection :: Int -> Text -> Maybe TextCursor
makeTextCursorWithSelection :: Int -> Text -> Maybe TextCursor
makeTextCursorWithSelection Int
i Text
t =
  case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
t of
    [Text
l] -> ListCursor Char -> TextCursor
TextCursor (ListCursor Char -> TextCursor)
-> Maybe (ListCursor Char) -> Maybe TextCursor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> String -> Maybe (ListCursor Char)
forall a. Int -> [a] -> Maybe (ListCursor a)
makeListCursorWithSelection Int
i (Text -> String
T.unpack Text
l)
    [Text]
_ -> Maybe TextCursor
forall a. Maybe a
Nothing

rebuildTextCursor :: TextCursor -> Text
rebuildTextCursor :: TextCursor -> Text
rebuildTextCursor = String -> Text
T.pack (String -> Text) -> (TextCursor -> String) -> TextCursor -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListCursor Char -> String
forall a. ListCursor a -> [a]
rebuildListCursor (ListCursor Char -> String)
-> (TextCursor -> ListCursor Char) -> TextCursor -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextCursor -> ListCursor Char
textCursorList

textCursorListCursorL ::
  Functor f => (ListCursor Char -> f (ListCursor Char)) -> TextCursor -> f TextCursor
textCursorListCursorL :: (ListCursor Char -> f (ListCursor Char))
-> TextCursor -> f TextCursor
textCursorListCursorL = (TextCursor -> ListCursor Char)
-> (TextCursor -> ListCursor Char -> TextCursor)
-> Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TextCursor -> ListCursor Char
textCursorList (\TextCursor
tc ListCursor Char
lc -> TextCursor
tc {textCursorList :: ListCursor Char
textCursorList = ListCursor Char
lc})

textCursorNull :: TextCursor -> Bool
textCursorNull :: TextCursor -> Bool
textCursorNull = ListCursor Char -> Bool
forall a. ListCursor a -> Bool
listCursorNull (ListCursor Char -> Bool)
-> (TextCursor -> ListCursor Char) -> TextCursor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextCursor -> ListCursor Char
textCursorList

textCursorLength :: TextCursor -> Int
textCursorLength :: TextCursor -> Int
textCursorLength = ListCursor Char -> Int
forall a. ListCursor a -> Int
listCursorLength (ListCursor Char -> Int)
-> (TextCursor -> ListCursor Char) -> TextCursor -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextCursor -> ListCursor Char
textCursorList

textCursorIndex :: TextCursor -> Int
textCursorIndex :: TextCursor -> Int
textCursorIndex = ListCursor Char -> Int
forall a. ListCursor a -> Int
listCursorIndex (ListCursor Char -> Int)
-> (TextCursor -> ListCursor Char) -> TextCursor -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextCursor -> ListCursor Char
textCursorList

textCursorSelectPrev :: TextCursor -> Maybe TextCursor
textCursorSelectPrev :: TextCursor -> Maybe TextCursor
textCursorSelectPrev = (ListCursor Char -> Maybe (ListCursor Char))
-> TextCursor -> Maybe TextCursor
Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
textCursorListCursorL ListCursor Char -> Maybe (ListCursor Char)
forall a. ListCursor a -> Maybe (ListCursor a)
listCursorSelectPrev

textCursorSelectNext :: TextCursor -> Maybe TextCursor
textCursorSelectNext :: TextCursor -> Maybe TextCursor
textCursorSelectNext = (ListCursor Char -> Maybe (ListCursor Char))
-> TextCursor -> Maybe TextCursor
Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
textCursorListCursorL ListCursor Char -> Maybe (ListCursor Char)
forall a. ListCursor a -> Maybe (ListCursor a)
listCursorSelectNext

textCursorSelectIndex :: Int -> TextCursor -> TextCursor
textCursorSelectIndex :: Int -> TextCursor -> TextCursor
textCursorSelectIndex Int
ix_ = (ListCursor Char -> Identity (ListCursor Char))
-> TextCursor -> Identity TextCursor
Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
textCursorListCursorL ((ListCursor Char -> Identity (ListCursor Char))
 -> TextCursor -> Identity TextCursor)
-> (ListCursor Char -> ListCursor Char) -> TextCursor -> TextCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> ListCursor Char -> ListCursor Char
forall a. Int -> ListCursor a -> ListCursor a
listCursorSelectIndex Int
ix_

textCursorSelectStart :: TextCursor -> TextCursor
textCursorSelectStart :: TextCursor -> TextCursor
textCursorSelectStart = (ListCursor Char -> Identity (ListCursor Char))
-> TextCursor -> Identity TextCursor
Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
textCursorListCursorL ((ListCursor Char -> Identity (ListCursor Char))
 -> TextCursor -> Identity TextCursor)
-> (ListCursor Char -> ListCursor Char) -> TextCursor -> TextCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ListCursor Char -> ListCursor Char
forall a. ListCursor a -> ListCursor a
listCursorSelectStart

textCursorSelectEnd :: TextCursor -> TextCursor
textCursorSelectEnd :: TextCursor -> TextCursor
textCursorSelectEnd = (ListCursor Char -> Identity (ListCursor Char))
-> TextCursor -> Identity TextCursor
Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
textCursorListCursorL ((ListCursor Char -> Identity (ListCursor Char))
 -> TextCursor -> Identity TextCursor)
-> (ListCursor Char -> ListCursor Char) -> TextCursor -> TextCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ListCursor Char -> ListCursor Char
forall a. ListCursor a -> ListCursor a
listCursorSelectEnd

textCursorPrevChar :: TextCursor -> Maybe Char
textCursorPrevChar :: TextCursor -> Maybe Char
textCursorPrevChar = ListCursor Char -> Maybe Char
forall a. ListCursor a -> Maybe a
listCursorPrevItem (ListCursor Char -> Maybe Char)
-> (TextCursor -> ListCursor Char) -> TextCursor -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextCursor -> ListCursor Char
textCursorList

textCursorNextChar :: TextCursor -> Maybe Char
textCursorNextChar :: TextCursor -> Maybe Char
textCursorNextChar = ListCursor Char -> Maybe Char
forall a. ListCursor a -> Maybe a
listCursorNextItem (ListCursor Char -> Maybe Char)
-> (TextCursor -> ListCursor Char) -> TextCursor -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextCursor -> ListCursor Char
textCursorList

-- | Move to the beginning of the word
--
-- * @"hell|o"@ -> @"|hello"@
-- * @"hello   | world"@ -> @"|hello    world"@
-- * @"hello |world"@ -> @"hello |world"@
-- * @"| hello"@ -> @"| hello"@
textCursorSelectBeginWord :: TextCursor -> TextCursor
textCursorSelectBeginWord :: TextCursor -> TextCursor
textCursorSelectBeginWord TextCursor
tc =
  let goLeft :: TextCursor
goLeft = TextCursor
-> (TextCursor -> TextCursor) -> Maybe TextCursor -> TextCursor
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextCursor
tc TextCursor -> TextCursor
textCursorSelectBeginWord (TextCursor -> Maybe TextCursor
textCursorSelectPrev TextCursor
tc)
   in case TextCursor -> Maybe Char
textCursorPrevChar TextCursor
tc of
        Maybe Char
Nothing -> TextCursor
tc
        Just Char
p
          | Char -> Bool
isSpace Char
p -> case TextCursor -> Maybe Char
textCursorNextChar TextCursor
tc of
            Maybe Char
Nothing -> TextCursor
goLeft
            Just Char
n
              | Char -> Bool
isSpace Char
n -> TextCursor
goLeft
              | Bool
otherwise -> TextCursor
tc
          | Bool
otherwise -> TextCursor
goLeft

-- | Move to the end of the word
--
-- * @"hell|o"@ -> @"hello|"@
-- * @"hello   | world"@ -> @"hello    world|"@
-- * @"hello| world"@ -> @"hello| world"@
-- * @"hello |"@ -> @"hello |"@
textCursorSelectEndWord :: TextCursor -> TextCursor
textCursorSelectEndWord :: TextCursor -> TextCursor
textCursorSelectEndWord TextCursor
tc =
  let goRight :: TextCursor
goRight = TextCursor
-> (TextCursor -> TextCursor) -> Maybe TextCursor -> TextCursor
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TextCursor
tc TextCursor -> TextCursor
textCursorSelectEndWord (TextCursor -> Maybe TextCursor
textCursorSelectNext TextCursor
tc)
   in case TextCursor -> Maybe Char
textCursorNextChar TextCursor
tc of
        Maybe Char
Nothing -> TextCursor
tc
        Just Char
p
          | Char -> Bool
isSpace Char
p -> case TextCursor -> Maybe Char
textCursorPrevChar TextCursor
tc of
            Maybe Char
Nothing -> TextCursor
goRight
            Just Char
n
              | Char -> Bool
isSpace Char
n -> TextCursor
goRight
              | Bool
otherwise -> TextCursor
tc
          | Bool
otherwise -> TextCursor
goRight

-- | Move to the beginning of the next word
--
-- * @"|hello"@ -> @"hello|"@
-- * @"hell|o world"@ -> @"hello |world"@
-- * @"hello| world"@ -> @"hello |world"@
-- * @"hello |"@ -> @"hello |"@
textCursorSelectNextWord :: TextCursor -> TextCursor
textCursorSelectNextWord :: TextCursor -> TextCursor
textCursorSelectNextWord TextCursor
tc =
  case (TextCursor -> Maybe Char
textCursorPrevChar TextCursor
tc, TextCursor -> Maybe Char
textCursorNextChar TextCursor
tc) of
    (Maybe Char
_, Maybe Char
Nothing) -> TextCursor
tc
    (Just Char
p, Just Char
n) ->
      case (Char -> Bool
isSpace Char
p, Char -> Bool
isSpace Char
n) of
        (Bool
_, Bool
True) -> ListCursor Char -> TextCursor
TextCursor (ListCursor Char -> TextCursor) -> ListCursor Char -> TextCursor
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ListCursor Char -> ListCursor Char
forall a. (a -> Bool) -> ListCursor a -> ListCursor a
listCursorNextUntil (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) ListCursor Char
lc
        (Bool, Bool)
_ -> TextCursor -> TextCursor
textCursorSelectNextWord (TextCursor -> TextCursor)
-> (ListCursor Char -> TextCursor) -> ListCursor Char -> TextCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListCursor Char -> TextCursor
TextCursor (ListCursor Char -> TextCursor) -> ListCursor Char -> TextCursor
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ListCursor Char -> ListCursor Char
forall a. (a -> Bool) -> ListCursor a -> ListCursor a
listCursorNextUntil Char -> Bool
isSpace ListCursor Char
lc
    (Maybe Char, Maybe Char)
_ -> TextCursor -> TextCursor
textCursorSelectNextWord (TextCursor -> TextCursor) -> TextCursor -> TextCursor
forall a b. (a -> b) -> a -> b
$ ListCursor Char -> TextCursor
TextCursor (ListCursor Char -> TextCursor) -> ListCursor Char -> TextCursor
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ListCursor Char -> ListCursor Char
forall a. (a -> Bool) -> ListCursor a -> ListCursor a
listCursorNextUntil Char -> Bool
isSpace ListCursor Char
lc
  where
    lc :: ListCursor Char
lc = TextCursor -> ListCursor Char
textCursorList TextCursor
tc

-- | Move to the end of the previous word
--
-- * @"hello|"@ -> @"|hello"@
-- * @"hello w|orld"@ -> @"hello| world"@
-- * @"hello |world"@ -> @"hello| world"@
-- * @" h|ello"@ -> @"| hello"@
textCursorSelectPrevWord :: TextCursor -> TextCursor
textCursorSelectPrevWord :: TextCursor -> TextCursor
textCursorSelectPrevWord TextCursor
tc =
  case (TextCursor -> Maybe Char
textCursorPrevChar TextCursor
tc, TextCursor -> Maybe Char
textCursorNextChar TextCursor
tc) of
    (Maybe Char
Nothing, Maybe Char
_) -> TextCursor
tc
    (Just Char
p, Just Char
n) ->
      case (Char -> Bool
isSpace Char
p, Char -> Bool
isSpace Char
n) of
        (Bool
True, Bool
_) -> ListCursor Char -> TextCursor
TextCursor (ListCursor Char -> TextCursor) -> ListCursor Char -> TextCursor
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ListCursor Char -> ListCursor Char
forall a. (a -> Bool) -> ListCursor a -> ListCursor a
listCursorPrevUntil (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) ListCursor Char
lc
        (Bool, Bool)
_ -> TextCursor -> TextCursor
textCursorSelectPrevWord (TextCursor -> TextCursor)
-> (ListCursor Char -> TextCursor) -> ListCursor Char -> TextCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListCursor Char -> TextCursor
TextCursor (ListCursor Char -> TextCursor) -> ListCursor Char -> TextCursor
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ListCursor Char -> ListCursor Char
forall a. (a -> Bool) -> ListCursor a -> ListCursor a
listCursorPrevUntil Char -> Bool
isSpace ListCursor Char
lc
    (Maybe Char, Maybe Char)
_ -> TextCursor -> TextCursor
textCursorSelectPrevWord (TextCursor -> TextCursor)
-> (ListCursor Char -> TextCursor) -> ListCursor Char -> TextCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListCursor Char -> TextCursor
TextCursor (ListCursor Char -> TextCursor) -> ListCursor Char -> TextCursor
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ListCursor Char -> ListCursor Char
forall a. (a -> Bool) -> ListCursor a -> ListCursor a
listCursorPrevUntil Char -> Bool
isSpace ListCursor Char
lc
  where
    lc :: ListCursor Char
lc = TextCursor -> ListCursor Char
textCursorList TextCursor
tc

textCursorInsert :: Char -> TextCursor -> Maybe TextCursor
textCursorInsert :: Char -> TextCursor -> Maybe TextCursor
textCursorInsert Char
'\n' TextCursor
_ = Maybe TextCursor
forall a. Maybe a
Nothing
textCursorInsert Char
c TextCursor
tc =
  if Char -> Bool
isSafeChar Char
c
    then TextCursor -> Maybe TextCursor
forall a. a -> Maybe a
Just (TextCursor
tc TextCursor -> (TextCursor -> TextCursor) -> TextCursor
forall a b. a -> (a -> b) -> b
& (ListCursor Char -> Identity (ListCursor Char))
-> TextCursor -> Identity TextCursor
Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
textCursorListCursorL ((ListCursor Char -> Identity (ListCursor Char))
 -> TextCursor -> Identity TextCursor)
-> (ListCursor Char -> ListCursor Char) -> TextCursor -> TextCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Char -> ListCursor Char -> ListCursor Char
forall a. a -> ListCursor a -> ListCursor a
listCursorInsert Char
c)
    else Maybe TextCursor
forall a. Maybe a
Nothing

textCursorAppend :: Char -> TextCursor -> Maybe TextCursor
textCursorAppend :: Char -> TextCursor -> Maybe TextCursor
textCursorAppend Char
'\n' TextCursor
_ = Maybe TextCursor
forall a. Maybe a
Nothing
textCursorAppend Char
c TextCursor
tc =
  if Char -> Bool
isSafeChar Char
c
    then TextCursor -> Maybe TextCursor
forall a. a -> Maybe a
Just (TextCursor
tc TextCursor -> (TextCursor -> TextCursor) -> TextCursor
forall a b. a -> (a -> b) -> b
& (ListCursor Char -> Identity (ListCursor Char))
-> TextCursor -> Identity TextCursor
Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
textCursorListCursorL ((ListCursor Char -> Identity (ListCursor Char))
 -> TextCursor -> Identity TextCursor)
-> (ListCursor Char -> ListCursor Char) -> TextCursor -> TextCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Char -> ListCursor Char -> ListCursor Char
forall a. a -> ListCursor a -> ListCursor a
listCursorAppend Char
c)
    else Maybe TextCursor
forall a. Maybe a
Nothing

textCursorInsertString :: String -> TextCursor -> Maybe TextCursor
textCursorInsertString :: String -> TextCursor -> Maybe TextCursor
textCursorInsertString String
s TextCursor
tc =
  if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isSafeChar Char
c)) String
s
    then Maybe TextCursor
forall a. Maybe a
Nothing
    else TextCursor -> Maybe TextCursor
forall a. a -> Maybe a
Just (TextCursor -> Maybe TextCursor) -> TextCursor -> Maybe TextCursor
forall a b. (a -> b) -> a -> b
$ TextCursor
tc TextCursor -> (TextCursor -> TextCursor) -> TextCursor
forall a b. a -> (a -> b) -> b
& (ListCursor Char -> Identity (ListCursor Char))
-> TextCursor -> Identity TextCursor
Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
textCursorListCursorL ((ListCursor Char -> Identity (ListCursor Char))
 -> TextCursor -> Identity TextCursor)
-> (ListCursor Char -> ListCursor Char) -> TextCursor -> TextCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ String -> ListCursor Char -> ListCursor Char
forall a. [a] -> ListCursor a -> ListCursor a
listCursorInsertList String
s

textCursorAppendString :: String -> TextCursor -> Maybe TextCursor
textCursorAppendString :: String -> TextCursor -> Maybe TextCursor
textCursorAppendString String
s TextCursor
tc =
  if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isSafeChar Char
c)) String
s
    then Maybe TextCursor
forall a. Maybe a
Nothing
    else TextCursor -> Maybe TextCursor
forall a. a -> Maybe a
Just (TextCursor -> Maybe TextCursor) -> TextCursor -> Maybe TextCursor
forall a b. (a -> b) -> a -> b
$ TextCursor
tc TextCursor -> (TextCursor -> TextCursor) -> TextCursor
forall a b. a -> (a -> b) -> b
& (ListCursor Char -> Identity (ListCursor Char))
-> TextCursor -> Identity TextCursor
Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
textCursorListCursorL ((ListCursor Char -> Identity (ListCursor Char))
 -> TextCursor -> Identity TextCursor)
-> (ListCursor Char -> ListCursor Char) -> TextCursor -> TextCursor
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ String -> ListCursor Char -> ListCursor Char
forall a. [a] -> ListCursor a -> ListCursor a
listCursorAppendList String
s

textCursorInsertText :: Text -> TextCursor -> Maybe TextCursor
textCursorInsertText :: Text -> TextCursor -> Maybe TextCursor
textCursorInsertText = String -> TextCursor -> Maybe TextCursor
textCursorInsertString (String -> TextCursor -> Maybe TextCursor)
-> (Text -> String) -> Text -> TextCursor -> Maybe TextCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

textCursorAppendText :: Text -> TextCursor -> Maybe TextCursor
textCursorAppendText :: Text -> TextCursor -> Maybe TextCursor
textCursorAppendText = String -> TextCursor -> Maybe TextCursor
textCursorAppendString (String -> TextCursor -> Maybe TextCursor)
-> (Text -> String) -> Text -> TextCursor -> Maybe TextCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

textCursorRemove :: TextCursor -> Maybe (DeleteOrUpdate TextCursor)
textCursorRemove :: TextCursor -> Maybe (DeleteOrUpdate TextCursor)
textCursorRemove = Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
-> (ListCursor Char -> Maybe (DeleteOrUpdate (ListCursor Char)))
-> TextCursor
-> Maybe (DeleteOrUpdate TextCursor)
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
textCursorListCursorL ListCursor Char -> Maybe (DeleteOrUpdate (ListCursor Char))
forall a. ListCursor a -> Maybe (DeleteOrUpdate (ListCursor a))
listCursorRemove

textCursorDelete :: TextCursor -> Maybe (DeleteOrUpdate TextCursor)
textCursorDelete :: TextCursor -> Maybe (DeleteOrUpdate TextCursor)
textCursorDelete = Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
-> (ListCursor Char -> Maybe (DeleteOrUpdate (ListCursor Char)))
-> TextCursor
-> Maybe (DeleteOrUpdate TextCursor)
forall b a.
Lens' b a
-> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b)
focusPossibleDeleteOrUpdate Lens TextCursor TextCursor (ListCursor Char) (ListCursor Char)
textCursorListCursorL ListCursor Char -> Maybe (DeleteOrUpdate (ListCursor Char))
forall a. ListCursor a -> Maybe (DeleteOrUpdate (ListCursor a))
listCursorDelete

textCursorSplit :: TextCursor -> (TextCursor, TextCursor)
textCursorSplit :: TextCursor -> (TextCursor, TextCursor)
textCursorSplit TextCursor
tc =
  let (ListCursor Char
lc1, ListCursor Char
lc2) = ListCursor Char -> (ListCursor Char, ListCursor Char)
forall a. ListCursor a -> (ListCursor a, ListCursor a)
listCursorSplit (ListCursor Char -> (ListCursor Char, ListCursor Char))
-> ListCursor Char -> (ListCursor Char, ListCursor Char)
forall a b. (a -> b) -> a -> b
$ TextCursor -> ListCursor Char
textCursorList TextCursor
tc
   in (ListCursor Char -> TextCursor
TextCursor ListCursor Char
lc1, ListCursor Char -> TextCursor
TextCursor ListCursor Char
lc2)

textCursorCombine :: TextCursor -> TextCursor -> TextCursor
textCursorCombine :: TextCursor -> TextCursor -> TextCursor
textCursorCombine (TextCursor ListCursor Char
lc1) (TextCursor ListCursor Char
lc2) =
  TextCursor :: ListCursor Char -> TextCursor
TextCursor {textCursorList :: ListCursor Char
textCursorList = ListCursor Char -> ListCursor Char -> ListCursor Char
forall a. ListCursor a -> ListCursor a -> ListCursor a
listCursorCombine ListCursor Char
lc1 ListCursor Char
lc2}