{-# 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 CommentWidget n = CommentWidget
  { forall n. CommentWidget n -> Text
_origComment :: 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
  }

makeLenses ''CommentWidget

commentWidget :: Eq n => n -> Text -> Text -> CommentWidget n
commentWidget :: forall n. Eq n => n -> Text -> Text -> CommentWidget n
commentWidget 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 CommentAction = CommentContinue | CommentFinished 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
renderCommentWidget :: forall n. (Ord n, Show n) => CommentWidget n -> Widget n
renderCommentWidget 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
commentDialogComment :: forall n. CommentWidget n -> Text
commentDialogComment = 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