{-# LANGUAGE TemplateHaskell #-}

{-|
Module      : Client.State.EditBox
Description : Console-mode text box
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides support for the text operations important for
providing a text input in the IRC client. It tracks user input
history, tab completion history, and provides many update operations
which are mapped to the keyboard in "Client.EventLoop".

-}

module Client.State.EditBox
  ( -- * Edit box type
    EditBox
  , defaultEditBox
  , content
  , lastOperation

    -- * Line type
  , Line(Line)
  , singleLine
  , endLine
  , HasLine(..)

  -- * Content type
  , Content
  , shift
  , above
  , below

  -- * Operations
  , delete
  , backspace
  , home
  , end
  , killHome
  , killEnd
  , killWordBackward
  , killWordForward
  , yank
  , toggle
  , left
  , right
  , leftWord
  , rightWord
  , insert
  , insertPaste
  , insertString
  , earlier
  , later
  , success
  , insertDigraph

  -- * Last operation
  , LastOperation(..)

  ) where

import           Client.State.EditBox.Content
import           Control.Lens hiding (below)
import           Data.List.NonEmpty (NonEmpty)
import           Digraphs (Digraph)
import           Data.Map (Map)
import           Data.Text (Text)


data EditBox = EditBox
  { EditBox -> Content
_content       :: !Content
  , EditBox -> [NonEmpty String]
_history       :: ![NonEmpty String]
  , EditBox -> Int
_historyPos    :: !Int
  , EditBox -> String
_yankBuffer    :: String
  , EditBox -> LastOperation
_lastOperation :: !LastOperation
  }
  deriving (ReadPrec [EditBox]
ReadPrec EditBox
Int -> ReadS EditBox
ReadS [EditBox]
(Int -> ReadS EditBox)
-> ReadS [EditBox]
-> ReadPrec EditBox
-> ReadPrec [EditBox]
-> Read EditBox
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EditBox]
$creadListPrec :: ReadPrec [EditBox]
readPrec :: ReadPrec EditBox
$creadPrec :: ReadPrec EditBox
readList :: ReadS [EditBox]
$creadList :: ReadS [EditBox]
readsPrec :: Int -> ReadS EditBox
$creadsPrec :: Int -> ReadS EditBox
Read, Int -> EditBox -> ShowS
[EditBox] -> ShowS
EditBox -> String
(Int -> EditBox -> ShowS)
-> (EditBox -> String) -> ([EditBox] -> ShowS) -> Show EditBox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditBox] -> ShowS
$cshowList :: [EditBox] -> ShowS
show :: EditBox -> String
$cshow :: EditBox -> String
showsPrec :: Int -> EditBox -> ShowS
$cshowsPrec :: Int -> EditBox -> ShowS
Show)

data LastOperation
  = TabOperation String
  | KillOperation
  | OtherOperation
  deriving (ReadPrec [LastOperation]
ReadPrec LastOperation
Int -> ReadS LastOperation
ReadS [LastOperation]
(Int -> ReadS LastOperation)
-> ReadS [LastOperation]
-> ReadPrec LastOperation
-> ReadPrec [LastOperation]
-> Read LastOperation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LastOperation]
$creadListPrec :: ReadPrec [LastOperation]
readPrec :: ReadPrec LastOperation
$creadPrec :: ReadPrec LastOperation
readList :: ReadS [LastOperation]
$creadList :: ReadS [LastOperation]
readsPrec :: Int -> ReadS LastOperation
$creadsPrec :: Int -> ReadS LastOperation
Read, Int -> LastOperation -> ShowS
[LastOperation] -> ShowS
LastOperation -> String
(Int -> LastOperation -> ShowS)
-> (LastOperation -> String)
-> ([LastOperation] -> ShowS)
-> Show LastOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LastOperation] -> ShowS
$cshowList :: [LastOperation] -> ShowS
show :: LastOperation -> String
$cshow :: LastOperation -> String
showsPrec :: Int -> LastOperation -> ShowS
$cshowsPrec :: Int -> LastOperation -> ShowS
Show)

makeLenses ''EditBox

-- | Default 'EditBox' value
defaultEditBox :: EditBox
defaultEditBox :: EditBox
defaultEditBox = EditBox :: Content
-> [NonEmpty String] -> Int -> String -> LastOperation -> EditBox
EditBox
  { _content :: Content
_content       = Content
noContent
  , _history :: [NonEmpty String]
_history       = []
  , _historyPos :: Int
_historyPos    = -Int
1
  , _yankBuffer :: String
_yankBuffer    = String
""
  , _lastOperation :: LastOperation
_lastOperation = LastOperation
OtherOperation
  }

instance HasLine EditBox where
  line :: (Line -> f Line) -> EditBox -> f EditBox
line = (Content -> f Content) -> EditBox -> f EditBox
Lens' EditBox Content
content ((Content -> f Content) -> EditBox -> f EditBox)
-> ((Line -> f Line) -> Content -> f Content)
-> (Line -> f Line)
-> EditBox
-> f EditBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line -> f Line) -> Content -> f Content
forall c. HasLine c => Lens' c Line
line

data KillDirection = KillForward | KillBackward

-- | Sets the given string to the yank buffer unless the string is empty.
updateYankBuffer :: KillDirection -> String -> EditBox -> EditBox
updateYankBuffer :: KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
dir String
str EditBox
e =
  case Getting LastOperation EditBox LastOperation
-> EditBox -> LastOperation
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LastOperation EditBox LastOperation
Lens' EditBox LastOperation
lastOperation EditBox
e of
    LastOperation
_ | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str  -> ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation EditBox
e -- failed kill interrupts kill sequence
    LastOperation
KillOperation ->
      case KillDirection
dir of
        KillDirection
KillForward  -> ASetter EditBox EditBox String String
-> ShowS -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EditBox EditBox String String
Lens' EditBox String
yankBuffer (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str) EditBox
e
        KillDirection
KillBackward -> ASetter EditBox EditBox String String
-> ShowS -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EditBox EditBox String String
Lens' EditBox String
yankBuffer (String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++) EditBox
e
    LastOperation
_ -> ASetter EditBox EditBox String String
-> String -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox String String
Lens' EditBox String
yankBuffer String
str
       (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
lastOperation LastOperation
KillOperation EditBox
e

-- | Indicate that the contents of the text box were successfully used
-- by the program. This clears the first line of the contents and updates
-- the history.
success :: EditBox -> EditBox
success :: EditBox -> EditBox
success EditBox
e
  = ASetter EditBox EditBox [NonEmpty String] [NonEmpty String]
-> ([NonEmpty String] -> [NonEmpty String]) -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EditBox EditBox [NonEmpty String] [NonEmpty String]
Lens' EditBox [NonEmpty String]
history (NonEmpty String -> [NonEmpty String] -> [NonEmpty String]
forall s a. Cons s s a a => a -> s -> s
cons (String -> NonEmpty String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
sent))
  (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox Content Content
-> Content -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set  ASetter EditBox EditBox Content Content
Lens' EditBox Content
content Content
c
  (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set  ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation
  (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox Int Int -> Int -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set  ASetter EditBox EditBox Int Int
Lens' EditBox Int
historyPos (-Int
1)
  (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ EditBox
e
 where
 (String
sent, Content
c) = Content -> (String, Content)
shift (Content -> (String, Content)) -> Content -> (String, Content)
forall a b. (a -> b) -> a -> b
$ Getting Content EditBox Content -> EditBox -> Content
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Content EditBox Content
Lens' EditBox Content
content EditBox
e

replaceList :: Int -> [a] -> [a] -> [a]
replaceList :: Int -> [a] -> [a] -> [a]
replaceList Int
i [a]
rpl [a]
xs =
  case Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs of
    ([a]
a, [a]
b) -> [a]
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rpl [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
b

-- | Update the editbox to reflect the earlier element in the history.
earlier :: EditBox -> Maybe EditBox
earlier :: EditBox -> Maybe EditBox
earlier EditBox
e =
  do NonEmpty String
x <- Getting (First (NonEmpty String)) EditBox (NonEmpty String)
-> EditBox -> Maybe (NonEmpty String)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (([NonEmpty String]
 -> Const (First (NonEmpty String)) [NonEmpty String])
-> EditBox -> Const (First (NonEmpty String)) EditBox
Lens' EditBox [NonEmpty String]
history (([NonEmpty String]
  -> Const (First (NonEmpty String)) [NonEmpty String])
 -> EditBox -> Const (First (NonEmpty String)) EditBox)
-> ((NonEmpty String
     -> Const (First (NonEmpty String)) (NonEmpty String))
    -> [NonEmpty String]
    -> Const (First (NonEmpty String)) [NonEmpty String])
-> Getting (First (NonEmpty String)) EditBox (NonEmpty String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [NonEmpty String]
-> Traversal' [NonEmpty String] (IxValue [NonEmpty String])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) EditBox
e
     EditBox -> Maybe EditBox
forall (m :: * -> *) a. Monad m => a -> m a
return (EditBox -> Maybe EditBox) -> EditBox -> Maybe EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox Content Content
-> Content -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox Content Content
Lens' EditBox Content
content (NonEmpty String -> Content
fromStrings NonEmpty String
x)
            (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation
            (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox Int Int -> Int -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox Int Int
Lens' EditBox Int
historyPos Int
i'
            (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox [NonEmpty String] [NonEmpty String]
-> ([NonEmpty String] -> [NonEmpty String]) -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EditBox EditBox [NonEmpty String] [NonEmpty String]
Lens' EditBox [NonEmpty String]
history [NonEmpty String] -> [NonEmpty String]
updateHistory EditBox
e
  where
    i :: Int
i = Getting Int EditBox Int -> EditBox -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int EditBox Int
Lens' EditBox Int
historyPos EditBox
e

    i' :: Int
i' | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = [NonEmpty String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NonEmpty String]
txt
       | Bool
otherwise = [NonEmpty String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NonEmpty String]
txt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i

    txt :: [NonEmpty String]
txt = (NonEmpty String -> Bool) -> [NonEmpty String] -> [NonEmpty String]
forall a. (a -> Bool) -> [a] -> [a]
filter (NonEmpty String -> NonEmpty String -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> NonEmpty String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"") [Content -> NonEmpty String
toStrings (Getting Content EditBox Content -> EditBox -> Content
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Content EditBox Content
Lens' EditBox Content
content EditBox
e)]

    updateHistory :: [NonEmpty String] -> [NonEmpty String]
updateHistory [NonEmpty String]
h
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = [NonEmpty String]
txt [NonEmpty String] -> [NonEmpty String] -> [NonEmpty String]
forall a. [a] -> [a] -> [a]
++ [NonEmpty String]
h
      | Bool
otherwise = Int -> [NonEmpty String] -> [NonEmpty String] -> [NonEmpty String]
forall a. Int -> [a] -> [a] -> [a]
replaceList Int
i [NonEmpty String]
txt [NonEmpty String]
h

-- | Update the editbox to reflect the later element in the history.
later :: EditBox -> Maybe EditBox
later :: EditBox -> Maybe EditBox
later EditBox
e
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& [NonEmpty String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NonEmpty String]
txt = Maybe EditBox
forall a. Maybe a
Nothing
  | Bool
otherwise = EditBox -> Maybe EditBox
forall a. a -> Maybe a
Just (EditBox -> Maybe EditBox) -> EditBox -> Maybe EditBox
forall a b. (a -> b) -> a -> b
$!
                  ASetter EditBox EditBox Content Content
-> Content -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox Content Content
Lens' EditBox Content
content Content
newContent
                (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation
                (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox Int Int -> Int -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox Int Int
Lens' EditBox Int
historyPos Int
i'
                (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox [NonEmpty String] [NonEmpty String]
-> ([NonEmpty String] -> [NonEmpty String]) -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EditBox EditBox [NonEmpty String] [NonEmpty String]
Lens' EditBox [NonEmpty String]
history [NonEmpty String] -> [NonEmpty String]
updateHistory EditBox
e
  where
    txt :: [NonEmpty String]
txt = (NonEmpty String -> Bool) -> [NonEmpty String] -> [NonEmpty String]
forall a. (a -> Bool) -> [a] -> [a]
filter (NonEmpty String -> NonEmpty String -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> NonEmpty String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"") [Content -> NonEmpty String
toStrings (Getting Content EditBox Content -> EditBox -> Content
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Content EditBox Content
Lens' EditBox Content
content EditBox
e)]

    i :: Int
i = Getting Int EditBox Int -> EditBox -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int EditBox Int
Lens' EditBox Int
historyPos EditBox
e

    i' :: Int
i' | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = -Int
1
       | Bool
otherwise = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

    newContent :: Content
newContent = Content
-> (NonEmpty String -> Content)
-> Maybe (NonEmpty String)
-> Content
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Content
noContent NonEmpty String -> Content
fromStrings
               (Maybe (NonEmpty String) -> Content)
-> Maybe (NonEmpty String) -> Content
forall a b. (a -> b) -> a -> b
$ Getting (First (NonEmpty String)) EditBox (NonEmpty String)
-> EditBox -> Maybe (NonEmpty String)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (([NonEmpty String]
 -> Const (First (NonEmpty String)) [NonEmpty String])
-> EditBox -> Const (First (NonEmpty String)) EditBox
Lens' EditBox [NonEmpty String]
history (([NonEmpty String]
  -> Const (First (NonEmpty String)) [NonEmpty String])
 -> EditBox -> Const (First (NonEmpty String)) EditBox)
-> ((NonEmpty String
     -> Const (First (NonEmpty String)) (NonEmpty String))
    -> [NonEmpty String]
    -> Const (First (NonEmpty String)) [NonEmpty String])
-> Getting (First (NonEmpty String)) EditBox (NonEmpty String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [NonEmpty String]
-> Traversal' [NonEmpty String] (IxValue [NonEmpty String])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) EditBox
e

    updateHistory :: [NonEmpty String] -> [NonEmpty String]
updateHistory [NonEmpty String]
h
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = [NonEmpty String]
txt [NonEmpty String] -> [NonEmpty String] -> [NonEmpty String]
forall a. [a] -> [a] -> [a]
++ [NonEmpty String]
h
      | Bool
otherwise = Int -> [NonEmpty String] -> [NonEmpty String] -> [NonEmpty String]
forall a. Int -> [a] -> [a] -> [a]
replaceList Int
i [NonEmpty String]
txt [NonEmpty String]
h

-- | Jump the cursor to the beginning of the input.
home :: EditBox -> EditBox
home :: EditBox -> EditBox
home
  = ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation
  (EditBox -> EditBox) -> (EditBox -> EditBox) -> EditBox -> EditBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter EditBox EditBox Content Content
-> (Content -> Content) -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EditBox EditBox Content Content
Lens' EditBox Content
content Content -> Content
jumpLeft

-- | Jump the cursor to the end of the input.
end :: EditBox -> EditBox
end :: EditBox -> EditBox
end
  = ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation
  (EditBox -> EditBox) -> (EditBox -> EditBox) -> EditBox -> EditBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter EditBox EditBox Content Content
-> (Content -> Content) -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EditBox EditBox Content Content
Lens' EditBox Content
content Content -> Content
jumpRight

-- | Delete all text from the cursor to the end and store it in
-- the yank buffer.
killEnd :: EditBox -> EditBox
killEnd :: EditBox -> EditBox
killEnd EditBox
e
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
kill
  = case Getting [String] EditBox [String] -> EditBox -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Content -> Const [String] Content)
-> EditBox -> Const [String] EditBox
Lens' EditBox Content
content ((Content -> Const [String] Content)
 -> EditBox -> Const [String] EditBox)
-> (([String] -> Const [String] [String])
    -> Content -> Const [String] Content)
-> Getting [String] EditBox [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Const [String] [String])
-> Content -> Const [String] Content
Lens' Content [String]
below) EditBox
e of
      []   -> EditBox
e
      String
b:[String]
bs -> ASetter EditBox EditBox [String] [String]
-> [String] -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter EditBox EditBox Content Content
Lens' EditBox Content
content ASetter EditBox EditBox Content Content
-> (([String] -> Identity [String]) -> Content -> Identity Content)
-> ASetter EditBox EditBox [String] [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Identity [String]) -> Content -> Identity Content
Lens' Content [String]
below) [String]
bs
            (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillForward (Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:String
b) EditBox
e
  | Bool
otherwise
  = ASetter EditBox EditBox Line Line -> Line -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox Line Line
forall c. HasLine c => Lens' c Line
line (String -> Line
endLine String
keep)
  (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillForward String
kill EditBox
e
  where
  Line Int
n String
txt = Getting Line EditBox Line -> EditBox -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line EditBox Line
forall c. HasLine c => Lens' c Line
line EditBox
e
  (String
keep,String
kill) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
txt

-- | Delete all text from the cursor to the beginning and store it in
-- the yank buffer.
killHome :: EditBox -> EditBox
killHome :: EditBox -> EditBox
killHome EditBox
e
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
kill
  = case Getting [String] EditBox [String] -> EditBox -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Content -> Const [String] Content)
-> EditBox -> Const [String] EditBox
Lens' EditBox Content
content ((Content -> Const [String] Content)
 -> EditBox -> Const [String] EditBox)
-> (([String] -> Const [String] [String])
    -> Content -> Const [String] Content)
-> Getting [String] EditBox [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Const [String] [String])
-> Content -> Const [String] Content
Lens' Content [String]
above) EditBox
e of
      []   -> EditBox
e
      String
a:[String]
as -> ASetter EditBox EditBox [String] [String]
-> [String] -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter EditBox EditBox Content Content
Lens' EditBox Content
content ASetter EditBox EditBox Content Content
-> (([String] -> Identity [String]) -> Content -> Identity Content)
-> ASetter EditBox EditBox [String] [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Identity [String]) -> Content -> Identity Content
Lens' Content [String]
above) [String]
as
            (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillBackward (String
aString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n") EditBox
e

  | Bool
otherwise
  = ASetter EditBox EditBox Line Line -> Line -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox Line Line
forall c. HasLine c => Lens' c Line
line (Int -> String -> Line
Line Int
0 String
keep)
  (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillBackward String
kill EditBox
e
  where
  Line Int
n String
txt = Getting Line EditBox Line -> EditBox -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line EditBox Line
forall c. HasLine c => Lens' c Line
line EditBox
e
  (String
kill,String
keep) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
txt

-- | Insert the yank buffer at the cursor.
yank :: EditBox -> EditBox
yank :: EditBox -> EditBox
yank EditBox
e
  = ASetter EditBox EditBox Content Content
-> (Content -> Content) -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EditBox EditBox Content Content
Lens' EditBox Content
content (String -> Content -> Content
insertString (Getting String EditBox String -> EditBox -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String EditBox String
Lens' EditBox String
yankBuffer EditBox
e))
  (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation EditBox
e

-- | Kill the content from the cursor back to the previous word boundary.
-- When @yank@ is set the yank buffer will be updated.
killWordBackward :: (Char -> Bool) -> Bool {- ^ yank -} -> EditBox -> EditBox
killWordBackward :: (Char -> Bool) -> Bool -> EditBox -> EditBox
killWordBackward Char -> Bool
p Bool
saveKill EditBox
e
  = EditBox -> EditBox
sometimesUpdateYank
  (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox Line Line -> Line -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox Line Line
forall c. HasLine c => Lens' c Line
line (Int -> String -> Line
Line (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l') (String
l'String -> ShowS
forall a. [a] -> [a] -> [a]
++String
r))
  (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ EditBox
e
  where
  Line Int
n String
txt = Getting Line EditBox Line -> EditBox -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line EditBox Line
forall c. HasLine c => Lens' c Line
line EditBox
e
  (String
l,String
r) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
txt
  (String
sp,String
l1) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span  Char -> Bool
p (ShowS
forall a. [a] -> [a]
reverse String
l)
  (String
wd,String
l2) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p String
l1
  l' :: String
l' = ShowS
forall a. [a] -> [a]
reverse String
l2
  yanked :: String
yanked = ShowS
forall a. [a] -> [a]
reverse (String
spString -> ShowS
forall a. [a] -> [a] -> [a]
++String
wd)

  sometimesUpdateYank :: EditBox -> EditBox
sometimesUpdateYank
    | Bool
saveKill  = KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillBackward String
yanked
    | Bool
otherwise = EditBox -> EditBox
forall a. a -> a
id -- don't update operation

-- | Kill the content from the curser forward to the next word boundary.
-- When @yank@ is set the yank buffer will be updated
killWordForward :: (Char -> Bool) -> Bool {- ^ yank -} -> EditBox -> EditBox
killWordForward :: (Char -> Bool) -> Bool -> EditBox -> EditBox
killWordForward Char -> Bool
p Bool
saveKill EditBox
e
  = EditBox -> EditBox
sometimesUpdateYank
  (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ ASetter EditBox EditBox Line Line -> Line -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox Line Line
forall c. HasLine c => Lens' c Line
line (Int -> String -> Line
Line (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l) (String
lString -> ShowS
forall a. [a] -> [a] -> [a]
++String
r2))
  (EditBox -> EditBox) -> EditBox -> EditBox
forall a b. (a -> b) -> a -> b
$ EditBox
e
  where
  Line Int
n String
txt = Getting Line EditBox Line -> EditBox -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line EditBox Line
forall c. HasLine c => Lens' c Line
line EditBox
e
  (String
l,String
r) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
txt
  (String
sp,String
r1) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span  Char -> Bool
p String
r
  (String
wd,String
r2) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p String
r1
  yanked :: String
yanked = String
spString -> ShowS
forall a. [a] -> [a] -> [a]
++String
wd

  sometimesUpdateYank :: EditBox -> EditBox
sometimesUpdateYank
    | Bool
saveKill  = KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillForward String
yanked
    | Bool
otherwise = EditBox -> EditBox
forall a. a -> a
id -- don't update operation

-- | Insert a character at the cursor and advance the cursor.
insert :: Char -> EditBox -> EditBox
insert :: Char -> EditBox -> EditBox
insert Char
c
  = ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation
  (EditBox -> EditBox) -> (EditBox -> EditBox) -> EditBox -> EditBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter EditBox EditBox Content Content
-> (Content -> Content) -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EditBox EditBox Content Content
Lens' EditBox Content
content (Char -> Content -> Content
insertChar Char
c)


insertPaste :: String -> EditBox -> EditBox
insertPaste :: String -> EditBox -> EditBox
insertPaste String
paste
  = ASetter EditBox EditBox Content Content
-> (Content -> Content) -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter EditBox EditBox Content Content
Lens' EditBox Content
content (String -> Content -> Content
insertPastedString String
paste)
  (EditBox -> EditBox) -> (EditBox -> EditBox) -> EditBox -> EditBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation


insertDigraph :: Map Digraph Text -> EditBox -> Maybe EditBox
insertDigraph :: Map Digraph Text -> EditBox -> Maybe EditBox
insertDigraph Map Digraph Text
extras
  = (Content -> Maybe Content) -> EditBox -> Maybe EditBox
Lens' EditBox Content
content (Map Digraph Text -> Content -> Maybe Content
digraph Map Digraph Text
extras)
  (EditBox -> Maybe EditBox)
-> (EditBox -> EditBox) -> EditBox -> Maybe EditBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter EditBox EditBox LastOperation LastOperation
-> LastOperation -> EditBox -> EditBox
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter EditBox EditBox LastOperation LastOperation
Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation