{-# LANGUAGE TemplateHaskell #-}
module Client.State.EditBox
(
EditBox
, defaultEditBox
, content
, lastOperation
, Line(Line)
, singleLine
, endLine
, HasLine(..)
, Content
, shift
, above
, below
, delete
, backspace
, home
, end
, killHome
, killEnd
, killWordBackward
, killWordForward
, yank
, toggle
, left
, right
, leftWord
, rightWord
, insert
, insertPaste
, insertString
, earlier
, later
, success
, insertDigraph
, 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
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
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
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
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
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
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
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
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
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
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
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
killWordBackward :: (Char -> Bool) -> Bool -> 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
killWordForward :: (Char -> Bool) -> Bool -> 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
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