{-# 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 Data.Map (Map)
import Data.Text (Text)
import Digraphs (Digraph)


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]
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
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]
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
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 :: 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 :: Lens' EditBox Line
line = Lens' EditBox Content
content forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' EditBox LastOperation
lastOperation EditBox
e of
    LastOperation
_ | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str  -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation EditBox
e -- failed kill interrupts kill sequence
    LastOperation
KillOperation ->
      case KillDirection
dir of
        KillDirection
KillForward  -> forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' EditBox String
yankBuffer (forall a. [a] -> [a] -> [a]
++ String
str) EditBox
e
        KillDirection
KillBackward -> forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' EditBox String
yankBuffer (String
str forall a. [a] -> [a] -> [a]
++) EditBox
e
    LastOperation
_ -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' EditBox String
yankBuffer String
str
       forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set 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
  = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' EditBox [NonEmpty String]
history (forall s a. Cons s s a a => a -> s -> s
cons (forall (f :: * -> *) a. Applicative f => a -> f a
pure String
sent))
  forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set  Lens' EditBox Content
content Content
c
  forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set  Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation
  forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set  Lens' EditBox Int
historyPos (-Int
1)
  forall a b. (a -> b) -> a -> b
$ EditBox
e
 where
 (String
sent, Content
c) = Content -> (String, Content)
shift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' EditBox Content
content EditBox
e

replaceList :: Int -> [a] -> [a] -> [a]
replaceList :: forall a. Int -> [a] -> [a] -> [a]
replaceList Int
i [a]
rpl [a]
xs =
  case forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs of
    ([a]
a, [a]
b) -> [a]
a forall a. [a] -> [a] -> [a]
++ [a]
rpl forall a. [a] -> [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 <- forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Lens' EditBox [NonEmpty String]
history forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Int
iforall a. Num a => a -> a -> a
+Int
1)) EditBox
e
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' EditBox Content
content (NonEmpty String -> Content
fromStrings NonEmpty String
x)
            forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation
            forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' EditBox Int
historyPos Int
i'
            forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' EditBox [NonEmpty String]
history [NonEmpty String] -> [NonEmpty String]
updateHistory EditBox
e
  where
    i :: Int
i = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' EditBox Int
historyPos EditBox
e

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

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

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

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

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

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

    updateHistory :: [NonEmpty String] -> [NonEmpty String]
updateHistory [NonEmpty String]
h
      | Int
i forall a. Ord a => a -> a -> Bool
< Int
0     = [NonEmpty String]
txt forall a. [a] -> [a] -> [a]
++ [NonEmpty String]
h
      | Bool
otherwise = 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
  = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' EditBox Content
content Content -> Content
jumpLeft

-- | Jump the cursor to the end of the input.
end :: EditBox -> EditBox
end :: EditBox -> EditBox
end
  = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over 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
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
kill
  = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' EditBox Content
content forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Content [String]
below) EditBox
e of
      []   -> EditBox
e
      String
b:[String]
bs -> forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' EditBox Content
content forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Content [String]
below) [String]
bs
            forall a b. (a -> b) -> a -> b
$ KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillForward (Char
'\n'forall a. a -> [a] -> [a]
:String
b) EditBox
e
  | Bool
otherwise
  = forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasLine c => Lens' c Line
line (String -> Line
endLine String
keep)
  forall a b. (a -> b) -> a -> b
$ KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillForward String
kill EditBox
e
  where
  Line Int
n String
txt = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall c. HasLine c => Lens' c Line
line EditBox
e
  (String
keep,String
kill) = 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
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
kill
  = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' EditBox Content
content forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Content [String]
above) EditBox
e of
      []   -> EditBox
e
      String
a:[String]
as -> forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' EditBox Content
content forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Content [String]
above) [String]
as
            forall a b. (a -> b) -> a -> b
$ KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillBackward (String
aforall a. [a] -> [a] -> [a]
++String
"\n") EditBox
e

  | Bool
otherwise
  = forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasLine c => Lens' c Line
line (Int -> String -> Line
Line Int
0 String
keep)
  forall a b. (a -> b) -> a -> b
$ KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillBackward String
kill EditBox
e
  where
  Line Int
n String
txt = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall c. HasLine c => Lens' c Line
line EditBox
e
  (String
kill,String
keep) = 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
  = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' EditBox Content
content (String -> Content -> Content
insertString (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' EditBox String
yankBuffer EditBox
e))
  forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set 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
  forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasLine c => Lens' c Line
line (Int -> String -> Line
Line (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l') (String
l'forall a. [a] -> [a] -> [a]
++String
r))
  forall a b. (a -> b) -> a -> b
$ EditBox
e
  where
  Line Int
n String
txt = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall c. HasLine c => Lens' c Line
line EditBox
e
  (String
l,String
r) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
txt
  (String
sp,String
l1) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span  Char -> Bool
p (forall a. [a] -> [a]
reverse String
l)
  (String
wd,String
l2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p String
l1
  l' :: String
l' = forall a. [a] -> [a]
reverse String
l2
  yanked :: String
yanked = forall a. [a] -> [a]
reverse (String
spforall a. [a] -> [a] -> [a]
++String
wd)

  sometimesUpdateYank :: EditBox -> EditBox
sometimesUpdateYank
    | Bool
saveKill  = KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillBackward String
yanked
    | Bool
otherwise = 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
  forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasLine c => Lens' c Line
line (Int -> String -> Line
Line (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l) (String
lforall a. [a] -> [a] -> [a]
++String
r2))
  forall a b. (a -> b) -> a -> b
$ EditBox
e
  where
  Line Int
n String
txt = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall c. HasLine c => Lens' c Line
line EditBox
e
  (String
l,String
r) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
txt
  (String
sp,String
r1) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span  Char -> Bool
p String
r
  (String
wd,String
r2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p String
r1
  yanked :: String
yanked = String
spforall a. [a] -> [a] -> [a]
++String
wd

  sometimesUpdateYank :: EditBox -> EditBox
sometimesUpdateYank
    | Bool
saveKill  = KillDirection -> String -> EditBox -> EditBox
updateYankBuffer KillDirection
KillForward String
yanked
    | Bool
otherwise = 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
  = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' EditBox Content
content (Char -> Content -> Content
insertChar Char
c)


insertPaste :: String -> EditBox -> EditBox
insertPaste :: String -> EditBox -> EditBox
insertPaste String
paste
  = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' EditBox Content
content (String -> Content -> Content
insertPastedString String
paste)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set 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
  = Lens' EditBox Content
content (Map Digraph Text -> Content -> Maybe Content
digraph Map Digraph Text
extras)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' EditBox LastOperation
lastOperation LastOperation
OtherOperation