{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Brick.Widgets.CommentDialog
( CommentWidget
, commentWidget
, renderCommentWidget
, commentDialogComment
, CommentAction(..)
, handleCommentEvent
) where
import Brick
import Brick.Widgets.Dialog
import Brick.Widgets.Center
import Data.Text.Zipper
import Graphics.Vty.Input
import qualified Data.Text as T
import Data.Text (Text)
import Lens.Micro
import Lens.Micro.TH
import Lens.Micro.Mtl
import Brick.Widgets.Edit.EmacsBindings
data n =
{ :: Text
, forall n. CommentWidget n -> Editor n
_textArea :: Editor n
, forall n. CommentWidget n -> Dialog () n
_dialogWidget :: Dialog () n
, forall n. CommentWidget n -> Text
_promptPrefix :: Text
}
commentWidget :: Eq n => n -> Text -> Text -> CommentWidget n
n
name Text
prompt Text
comment =
let
title :: Widget n
title = Text -> Widget n
forall n. Text -> Widget n
txt Text
"ESC: cancel, RET: accept, Alt-RET: New line"
maxWidth :: Int
maxWidth = Int
80
diag :: Dialog a n
diag = Maybe (Widget n)
-> Maybe (n, [(String, n, a)]) -> Int -> Dialog a n
forall n a.
Eq n =>
Maybe (Widget n)
-> Maybe (n, [(String, n, a)]) -> Int -> Dialog a n
dialog (Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just Widget n
forall {n}. Widget n
title) Maybe (n, [(String, n, a)])
forall a. Maybe a
Nothing Int
maxWidth
edit :: Editor n
edit = n -> ([Text] -> Widget n) -> Maybe Int -> Text -> Editor n
forall n.
n -> ([Text] -> Widget n) -> Maybe Int -> Text -> Editor n
editorText n
name (Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> ([Text] -> Text) -> [Text] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines) Maybe Int
forall a. Maybe a
Nothing Text
comment
in
CommentWidget
{ _origComment :: Text
_origComment = Text
comment
, _textArea :: Editor n
_textArea = (TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
forall n.
(TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
gotoEnd Editor n
edit
, _dialogWidget :: Dialog () n
_dialogWidget = Dialog () n
forall {a}. Dialog a n
diag
, _promptPrefix :: Text
_promptPrefix = Text
prompt
}
data = | Text
handleCommentEvent :: Eq n => Event -> EventM n (CommentWidget n) CommentAction
handleCommentEvent :: forall n. Eq n => Event -> EventM n (CommentWidget n) CommentAction
handleCommentEvent Event
ev = case Event
ev of
EvKey Key
KEsc [] -> Text -> CommentAction
CommentFinished (Text -> CommentAction)
-> EventM n (CommentWidget n) Text
-> EventM n (CommentWidget n) CommentAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Text (CommentWidget n) Text
-> EventM n (CommentWidget n) Text
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Text (CommentWidget n) Text
forall n (f :: * -> *).
Functor f =>
(Text -> f Text) -> CommentWidget n -> f (CommentWidget n)
origComment
EvKey Key
KEnter [] -> Text -> CommentAction
CommentFinished (Text -> CommentAction)
-> EventM n (CommentWidget n) Text
-> EventM n (CommentWidget n) CommentAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CommentWidget n -> Text) -> EventM n (CommentWidget n) Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CommentWidget n -> Text
forall n. CommentWidget n -> Text
commentDialogComment
EvKey Key
KEnter [Modifier
MMeta] -> do
LensLike'
(Zoomed (EventM n (Editor n)) ()) (CommentWidget n) (Editor n)
-> EventM n (Editor n) () -> EventM n (CommentWidget n) ()
forall c.
LensLike'
(Zoomed (EventM n (Editor n)) c) (CommentWidget n) (Editor n)
-> EventM n (Editor n) c -> EventM n (CommentWidget n) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Editor n -> Focusing (StateT (EventState n) IO) () (Editor n))
-> CommentWidget n
-> Focusing (StateT (EventState n) IO) () (CommentWidget n)
LensLike'
(Zoomed (EventM n (Editor n)) ()) (CommentWidget n) (Editor n)
forall n (f :: * -> *).
Functor f =>
(Editor n -> f (Editor n))
-> CommentWidget n -> f (CommentWidget n)
textArea (EventM n (Editor n) () -> EventM n (CommentWidget n) ())
-> EventM n (Editor n) () -> EventM n (CommentWidget n) ()
forall a b. (a -> b) -> a -> b
$ (TextZipper Text -> TextZipper Text) -> EventM n (Editor n) ()
forall n.
(TextZipper Text -> TextZipper Text) -> EventM n (Editor n) ()
applyEditM TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
breakLine
CommentAction -> EventM n (CommentWidget n) CommentAction
forall a. a -> EventM n (CommentWidget n) a
forall (m :: * -> *) a. Monad m => a -> m a
return CommentAction
CommentContinue
Event
_ -> do
LensLike'
(Zoomed (EventM n (Editor n)) ()) (CommentWidget n) (Editor n)
-> EventM n (Editor n) () -> EventM n (CommentWidget n) ()
forall c.
LensLike'
(Zoomed (EventM n (Editor n)) c) (CommentWidget n) (Editor n)
-> EventM n (Editor n) c -> EventM n (CommentWidget n) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (Editor n -> Focusing (StateT (EventState n) IO) () (Editor n))
-> CommentWidget n
-> Focusing (StateT (EventState n) IO) () (CommentWidget n)
LensLike'
(Zoomed (EventM n (Editor n)) ()) (CommentWidget n) (Editor n)
forall n (f :: * -> *).
Functor f =>
(Editor n -> f (Editor n))
-> CommentWidget n -> f (CommentWidget n)
textArea (EventM n (Editor n) () -> EventM n (CommentWidget n) ())
-> EventM n (Editor n) () -> EventM n (CommentWidget n) ()
forall a b. (a -> b) -> a -> b
$ Event -> EventM n (Editor n) ()
forall n. Eq n => Event -> EventM n (Editor n) ()
handleEditorEvent Event
ev
CommentAction -> EventM n (CommentWidget n) CommentAction
forall a. a -> EventM n (CommentWidget n) a
forall (m :: * -> *) a. Monad m => a -> m a
return CommentAction
CommentContinue
renderCommentWidget :: (Ord n, Show n) => CommentWidget n -> Widget n
CommentWidget n
widget =
let
height :: Int
height = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Editor n -> [Text]
forall n. Editor n -> [Text]
getEditContents (CommentWidget n
widgetCommentWidget n
-> Getting (Editor n) (CommentWidget n) (Editor n) -> Editor n
forall s a. s -> Getting a s a -> a
^.Getting (Editor n) (CommentWidget n) (Editor n)
forall n (f :: * -> *).
Functor f =>
(Editor n -> f (Editor n))
-> CommentWidget n -> f (CommentWidget n)
textArea)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
24
textArea' :: Widget n
textArea' = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Text -> Widget n
forall n. Text -> Widget n
txt (CommentWidget n
widgetCommentWidget n -> Getting Text (CommentWidget n) Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text (CommentWidget n) Text
forall n (f :: * -> *).
Functor f =>
(Text -> f Text) -> CommentWidget n -> f (CommentWidget n)
promptPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ") Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Bool -> Editor n -> Widget n
forall n. (Ord n, Show n) => Bool -> Editor n -> Widget n
renderEditor Bool
True (CommentWidget n
widgetCommentWidget n
-> Getting (Editor n) (CommentWidget n) (Editor n) -> Editor n
forall s a. s -> Getting a s a -> a
^.Getting (Editor n) (CommentWidget n) (Editor n)
forall n (f :: * -> *).
Functor f =>
(Editor n -> f (Editor n))
-> CommentWidget n -> f (CommentWidget n)
textArea)
in
Widget n -> Widget n
forall n. Widget n -> Widget n
vCenterLayer (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
height (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Dialog () n -> Widget n -> Widget n
forall n a. Ord n => Dialog a n -> Widget n -> Widget n
renderDialog (CommentWidget n
widgetCommentWidget n
-> Getting (Dialog () n) (CommentWidget n) (Dialog () n)
-> Dialog () n
forall s a. s -> Getting a s a -> a
^.Getting (Dialog () n) (CommentWidget n) (Dialog () n)
forall n (f :: * -> *).
Functor f =>
(Dialog () n -> f (Dialog () n))
-> CommentWidget n -> f (CommentWidget n)
dialogWidget) Widget n
textArea'
commentDialogComment :: CommentWidget n -> Text
= Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text)
-> (CommentWidget n -> [Text]) -> CommentWidget n -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Editor n -> [Text]
forall n. Editor n -> [Text]
getEditContents (Editor n -> [Text])
-> (CommentWidget n -> Editor n) -> CommentWidget n -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentWidget n -> Editor n
forall n. CommentWidget n -> Editor n
_textArea
gotoEnd :: Monoid a => TextZipper a -> TextZipper a
gotoEnd :: forall a. Monoid a => TextZipper a -> TextZipper a
gotoEnd TextZipper a
zipper =
let
lengths :: [Int]
lengths = TextZipper a -> [Int]
forall a. Monoid a => TextZipper a -> [Int]
lineLengths TextZipper a
zipper
(Int
row, Int
col) = ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lengths, [Int] -> Int
forall a. HasCallStack => [a] -> a
last [Int]
lengths)
in
(Int, Int) -> TextZipper a -> TextZipper a
forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
moveCursor (Int
rowInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
col) TextZipper a
zipper