{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
module Brick.Widgets.Edit
( Editor(editContents, editorName)
, editor
, editorText
, getEditContents
, getCursorPosition
, handleEditorEvent
, applyEdit
, editContentsL
, renderEditor
, editAttr
, editFocusedAttr
, DecodeUtf8(..)
)
where
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import Lens.Micro
import Graphics.Vty (Event(..), Key(..), Modifier(..))
import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Zipper as Z hiding ( textZipper )
import qualified Data.Text.Zipper.Generic as Z
import qualified Data.Text.Zipper.Generic.Words as Z
import Data.Tuple (swap)
import Brick.Types
import Brick.Widgets.Core
import Brick.AttrMap
data Editor t n =
Editor { forall t n. Editor t n -> TextZipper t
editContents :: Z.TextZipper t
, forall t n. Editor t n -> n
editorName :: n
}
suffixLenses ''Editor
instance (Show t, Show n) => Show (Editor t n) where
show :: Editor t n -> String
show Editor t n
e =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Editor { "
, String
"editContents = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TextZipper t -> String
forall a. Show a => a -> String
show (Editor t n -> TextZipper t
forall t n. Editor t n -> TextZipper t
editContents Editor t n
e)
, String
", editorName = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> n -> String
forall a. Show a => a -> String
show (Editor t n -> n
forall t n. Editor t n -> n
editorName Editor t n
e)
, String
"}"
]
instance Named (Editor t n) n where
getName :: Editor t n -> n
getName = Editor t n -> n
forall t n. Editor t n -> n
editorName
class DecodeUtf8 t where
decodeUtf8 :: BS.ByteString -> Either String t
instance DecodeUtf8 T.Text where
decodeUtf8 :: ByteString -> Either String Text
decodeUtf8 ByteString
bs = case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
bs of
Left UnicodeException
e -> String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e
Right Text
t -> Text -> Either String Text
forall a b. b -> Either a b
Right Text
t
instance DecodeUtf8 String where
decodeUtf8 :: ByteString -> Either String String
decodeUtf8 ByteString
bs = Text -> String
T.unpack (Text -> String) -> Either String Text -> Either String String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String Text
forall t. DecodeUtf8 t => ByteString -> Either String t
decodeUtf8 ByteString
bs
handleEditorEvent :: (Eq n, DecodeUtf8 t, Eq t, Z.GenericTextZipper t)
=> BrickEvent n e
-> EventM n (Editor t n) ()
handleEditorEvent :: forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent BrickEvent n e
e = do
Editor t n
ed <- EventM n (Editor t n) (Editor t n)
forall s (m :: * -> *). MonadState s m => m s
get
let f :: TextZipper t -> TextZipper t
f = case BrickEvent n e
e of
VtyEvent Event
ev ->
Event -> TextZipper t -> TextZipper t
forall {a}.
(DecodeUtf8 a, GenericTextZipper a, Eq a) =>
Event -> TextZipper a -> TextZipper a
handleVtyEvent Event
ev
MouseDown n
n Button
_ [Modifier]
_ (Location (Int, Int)
pos) | n
n n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== Editor t n -> n
forall a n. Named a n => a -> n
getName Editor t n
ed ->
(Int, Int) -> TextZipper t -> TextZipper t
forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
Z.moveCursorClosest ((Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap (Int, Int)
pos)
BrickEvent n e
_ -> TextZipper t -> TextZipper t
forall a. a -> a
id
handleVtyEvent :: Event -> TextZipper a -> TextZipper a
handleVtyEvent Event
ev = case Event
ev of
EvPaste ByteString
bs -> case ByteString -> Either String a
forall t. DecodeUtf8 t => ByteString -> Either String t
decodeUtf8 ByteString
bs of
Left String
_ -> TextZipper a -> TextZipper a
forall a. a -> a
id
Right a
t -> a -> TextZipper a -> TextZipper a
forall a. Monoid a => a -> TextZipper a -> TextZipper a
Z.insertMany a
t
EvKey (KChar Char
'a') [Modifier
MCtrl] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoBOL
EvKey (KChar Char
'e') [Modifier
MCtrl] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoEOL
EvKey (KChar Char
'd') [Modifier
MCtrl] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.deleteChar
EvKey (KChar Char
'd') [Modifier
MMeta] -> TextZipper a -> TextZipper a
forall a. GenericTextZipper a => TextZipper a -> TextZipper a
Z.deleteWord
EvKey (KChar Char
'k') [Modifier
MCtrl] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.killToEOL
EvKey (KChar Char
'u') [Modifier
MCtrl] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.killToBOL
EvKey Key
KEnter [] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.breakLine
EvKey Key
KDel [] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.deleteChar
EvKey (KChar Char
c) [] | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\t' -> Char -> TextZipper a -> TextZipper a
forall a. Monoid a => Char -> TextZipper a -> TextZipper a
Z.insertChar Char
c
EvKey Key
KUp [] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveUp
EvKey Key
KDown [] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveDown
EvKey Key
KLeft [] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveLeft
EvKey Key
KRight [] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveRight
EvKey (KChar Char
'b') [Modifier
MCtrl] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveLeft
EvKey (KChar Char
'f') [Modifier
MCtrl] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.moveRight
EvKey (KChar Char
'b') [Modifier
MMeta] -> TextZipper a -> TextZipper a
forall a. GenericTextZipper a => TextZipper a -> TextZipper a
Z.moveWordLeft
EvKey (KChar Char
'f') [Modifier
MMeta] -> TextZipper a -> TextZipper a
forall a. GenericTextZipper a => TextZipper a -> TextZipper a
Z.moveWordRight
EvKey Key
KBS [] -> TextZipper a -> TextZipper a
forall a. (Eq a, Monoid a) => TextZipper a -> TextZipper a
Z.deletePrevChar
EvKey (KChar Char
't') [Modifier
MCtrl] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.transposeChars
EvKey Key
KHome [] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoBOL
EvKey Key
KEnd [] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoEOL
EvKey (KChar Char
'<') [Modifier
MMeta] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoBOF
EvKey (KChar Char
'>') [Modifier
MMeta] -> TextZipper a -> TextZipper a
forall a. Monoid a => TextZipper a -> TextZipper a
Z.gotoEOF
Event
_ -> TextZipper a -> TextZipper a
forall a. a -> a
id
Editor t n -> EventM n (Editor t n) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Editor t n -> EventM n (Editor t n) ())
-> Editor t n -> EventM n (Editor t n) ()
forall a b. (a -> b) -> a -> b
$ (TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper t -> TextZipper t
f Editor t n
ed
editorText :: n
-> Maybe Int
-> T.Text
-> Editor T.Text n
editorText :: forall n. n -> Maybe Int -> Text -> Editor Text n
editorText = n -> Maybe Int -> Text -> Editor Text n
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor
editor :: Z.GenericTextZipper a
=> n
-> Maybe Int
-> a
-> Editor a n
editor :: forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor n
name Maybe Int
limit a
s = TextZipper a -> n -> Editor a n
forall t n. TextZipper t -> n -> Editor t n
Editor ([a] -> Maybe Int -> TextZipper a
forall a. GenericTextZipper a => [a] -> Maybe Int -> TextZipper a
Z.textZipper (a -> [a]
forall a. GenericTextZipper a => a -> [a]
Z.lines a
s) Maybe Int
limit) n
name
applyEdit :: (Z.TextZipper t -> Z.TextZipper t)
-> Editor t n
-> Editor t n
applyEdit :: forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper t -> TextZipper t
f Editor t n
e = Editor t n
e Editor t n -> (Editor t n -> Editor t n) -> Editor t n
forall a b. a -> (a -> b) -> b
& (TextZipper t -> Identity (TextZipper t))
-> Editor t n -> Identity (Editor t n)
forall t n t (f :: * -> *).
Functor f =>
(TextZipper t -> f (TextZipper t)) -> Editor t n -> f (Editor t n)
editContentsL ((TextZipper t -> Identity (TextZipper t))
-> Editor t n -> Identity (Editor t n))
-> (TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TextZipper t -> TextZipper t
f
editAttr :: AttrName
editAttr :: AttrName
editAttr = String -> AttrName
attrName String
"edit"
editFocusedAttr :: AttrName
editFocusedAttr :: AttrName
editFocusedAttr = AttrName
editAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"focused"
getEditContents :: Monoid t => Editor t n -> [t]
getEditContents :: forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor t n
e = TextZipper t -> [t]
forall a. Monoid a => TextZipper a -> [a]
Z.getText (TextZipper t -> [t]) -> TextZipper t -> [t]
forall a b. (a -> b) -> a -> b
$ Editor t n
eEditor t n
-> Getting (TextZipper t) (Editor t n) (TextZipper t)
-> TextZipper t
forall s a. s -> Getting a s a -> a
^.Getting (TextZipper t) (Editor t n) (TextZipper t)
forall t n t (f :: * -> *).
Functor f =>
(TextZipper t -> f (TextZipper t)) -> Editor t n -> f (Editor t n)
editContentsL
getCursorPosition :: Editor t n -> (Int, Int)
getCursorPosition :: forall t n. Editor t n -> (Int, Int)
getCursorPosition Editor t n
e = TextZipper t -> (Int, Int)
forall a. TextZipper a -> (Int, Int)
Z.cursorPosition (TextZipper t -> (Int, Int)) -> TextZipper t -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Editor t n
eEditor t n
-> Getting (TextZipper t) (Editor t n) (TextZipper t)
-> TextZipper t
forall s a. s -> Getting a s a -> a
^.Getting (TextZipper t) (Editor t n) (TextZipper t)
forall t n t (f :: * -> *).
Functor f =>
(TextZipper t -> f (TextZipper t)) -> Editor t n -> f (Editor t n)
editContentsL
renderEditor :: (Ord n, Show n, Monoid t, TextWidth t, Z.GenericTextZipper t)
=> ([t] -> Widget n)
-> Bool
-> Editor t n
-> Widget n
renderEditor :: forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor [t] -> Widget n
draw Bool
foc Editor t n
e =
let cp :: (Int, Int)
cp = TextZipper t -> (Int, Int)
forall a. TextZipper a -> (Int, Int)
Z.cursorPosition TextZipper t
z
z :: TextZipper t
z = Editor t n
eEditor t n
-> Getting (TextZipper t) (Editor t n) (TextZipper t)
-> TextZipper t
forall s a. s -> Getting a s a -> a
^.Getting (TextZipper t) (Editor t n) (TextZipper t)
forall t n t (f :: * -> *).
Functor f =>
(TextZipper t -> f (TextZipper t)) -> Editor t n -> f (Editor t n)
editContentsL
toLeft :: t
toLeft = Int -> t -> t
forall a. GenericTextZipper a => Int -> a -> a
Z.take ((Int, Int)
cp(Int, Int) -> Getting Int (Int, Int) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Int, Int) Int
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Int, Int) (Int, Int) Int Int
_2) (TextZipper t -> t
forall a. Monoid a => TextZipper a -> a
Z.currentLine TextZipper t
z)
cursorLoc :: Location
cursorLoc = (Int, Int) -> Location
Location (t -> Int
forall a. TextWidth a => a -> Int
textWidth t
toLeft, (Int, Int)
cp(Int, Int) -> Getting Int (Int, Int) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Int, Int) Int
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Int, Int) (Int, Int) Int Int
_1)
limit :: Widget n -> Widget n
limit = case Editor t n
eEditor t n
-> Getting (Maybe Int) (Editor t n) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.(TextZipper t -> Const (Maybe Int) (TextZipper t))
-> Editor t n -> Const (Maybe Int) (Editor t n)
forall t n t (f :: * -> *).
Functor f =>
(TextZipper t -> f (TextZipper t)) -> Editor t n -> f (Editor t n)
editContentsL((TextZipper t -> Const (Maybe Int) (TextZipper t))
-> Editor t n -> Const (Maybe Int) (Editor t n))
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
-> TextZipper t -> Const (Maybe Int) (TextZipper t))
-> Getting (Maybe Int) (Editor t n) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TextZipper t -> Maybe Int)
-> SimpleGetter (TextZipper t) (Maybe Int)
forall s a. (s -> a) -> SimpleGetter s a
to TextZipper t -> Maybe Int
forall a. TextZipper a -> Maybe Int
Z.getLineLimit of
Maybe Int
Nothing -> Widget n -> Widget n
forall a. a -> a
id
Just Int
lim -> Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
lim
atChar :: Maybe t
atChar = TextZipper t -> Maybe t
forall t. GenericTextZipper t => TextZipper t -> Maybe t
charAtCursor (TextZipper t -> Maybe t) -> TextZipper t -> Maybe t
forall a b. (a -> b) -> a -> b
$ Editor t n
eEditor t n
-> Getting (TextZipper t) (Editor t n) (TextZipper t)
-> TextZipper t
forall s a. s -> Getting a s a -> a
^.Getting (TextZipper t) (Editor t n) (TextZipper t)
forall t n t (f :: * -> *).
Functor f =>
(TextZipper t -> f (TextZipper t)) -> Editor t n -> f (Editor t n)
editContentsL
atCharWidth :: Int
atCharWidth = Int -> (t -> Int) -> Maybe t -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 t -> Int
forall a. TextWidth a => a -> Int
textWidth Maybe t
atChar
in AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (if Bool
foc then AttrName
editFocusedAttr else AttrName
editAttr) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Widget n -> Widget n
forall {n}. Widget n -> Widget n
limit (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
n -> ViewportType -> Widget n -> Widget n
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (Editor t n
eEditor t n -> Getting n (Editor t n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (Editor t n) n
forall t n n (f :: * -> *).
Functor f =>
(n -> f n) -> Editor t n -> f (Editor t n)
editorNameL) ViewportType
Both (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
(if Bool
foc then n -> Location -> Widget n -> Widget n
forall n. n -> Location -> Widget n -> Widget n
showCursor (Editor t n
eEditor t n -> Getting n (Editor t n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (Editor t n) n
forall t n n (f :: * -> *).
Functor f =>
(n -> f n) -> Editor t n -> f (Editor t n)
editorNameL) Location
cursorLoc else Widget n -> Widget n
forall a. a -> a
id) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Location -> (Int, Int) -> Widget n -> Widget n
forall n. Location -> (Int, Int) -> Widget n -> Widget n
visibleRegion Location
cursorLoc (Int
atCharWidth, Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
[t] -> Widget n
draw ([t] -> Widget n) -> [t] -> Widget n
forall a b. (a -> b) -> a -> b
$
Editor t n -> [t]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor t n
e
charAtCursor :: (Z.GenericTextZipper t) => Z.TextZipper t -> Maybe t
charAtCursor :: forall t. GenericTextZipper t => TextZipper t -> Maybe t
charAtCursor TextZipper t
z =
let col :: Int
col = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ TextZipper t -> (Int, Int)
forall a. TextZipper a -> (Int, Int)
Z.cursorPosition TextZipper t
z
curLine :: t
curLine = TextZipper t -> t
forall a. Monoid a => TextZipper a -> a
Z.currentLine TextZipper t
z
toRight :: t
toRight = Int -> t -> t
forall a. GenericTextZipper a => Int -> a -> a
Z.drop Int
col t
curLine
in if t -> Int
forall a. GenericTextZipper a => a -> Int
Z.length t
toRight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then t -> Maybe t
forall a. a -> Maybe a
Just (t -> Maybe t) -> t -> Maybe t
forall a b. (a -> b) -> a -> b
$ Int -> t -> t
forall a. GenericTextZipper a => Int -> a -> a
Z.take Int
1 t
toRight
else Maybe t
forall a. Maybe a
Nothing