{-# 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 = 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 = forall n a.
Eq n =>
Maybe (Widget n)
-> Maybe (n, [(String, n, a)]) -> Int -> Dialog a n
dialog (forall a. a -> Maybe a
Just forall {n}. Widget n
title) forall a. Maybe a
Nothing Int
maxWidth
    edit :: Editor n
edit = forall n.
n -> ([Text] -> Widget n) -> Maybe Int -> Text -> Editor n
editorText n
name (forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines) forall a. Maybe a
Nothing Text
comment
  in
    CommentWidget
      { _origComment :: Text
_origComment = Text
comment
      , _textArea :: Editor n
_textArea = forall n.
(TextZipper Text -> TextZipper Text) -> Editor n -> Editor n
applyEdit forall a. Monoid a => TextZipper a -> TextZipper a
gotoEnd Editor n
edit
      , _dialogWidget :: Dialog () n
_dialogWidget = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall n. Lens' (CommentWidget n) Text
origComment
  EvKey Key
KEnter [] -> Text -> CommentAction
CommentFinished forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. CommentWidget n -> Text
commentDialogComment
  EvKey Key
KEnter [Modifier
MMeta] -> do
    forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom forall n. Lens' (CommentWidget n) (Editor n)
textArea forall a b. (a -> b) -> a -> b
$ forall n.
(TextZipper Text -> TextZipper Text) -> EventM n (Editor n) ()
applyEditM forall a. Monoid a => TextZipper a -> TextZipper a
breakLine
    forall (m :: * -> *) a. Monad m => a -> m a
return CommentAction
CommentContinue
  Event
_ -> do
    forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom forall n. Lens' (CommentWidget n) (Editor n)
textArea forall a b. (a -> b) -> a -> b
$ forall n. Eq n => Event -> EventM n (Editor n) ()
handleEditorEvent Event
ev
    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 = forall a. Ord a => a -> a -> a
min (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall n. Editor n -> [Text]
getEditContents (CommentWidget n
widgetforall s a. s -> Getting a s a -> a
^.forall n. Lens' (CommentWidget n) (Editor n)
textArea)) forall a. Num a => a -> a -> a
+ Int
4) Int
24
    textArea' :: Widget n
textArea' =  forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$
      forall n. Text -> Widget n
txt (CommentWidget n
widgetforall s a. s -> Getting a s a -> a
^.forall n. Lens' (CommentWidget n) Text
promptPrefix forall a. Semigroup a => a -> a -> a
<> Text
": ") forall n. Widget n -> Widget n -> Widget n
<+> forall n. (Ord n, Show n) => Bool -> Editor n -> Widget n
renderEditor Bool
True (CommentWidget n
widgetforall s a. s -> Getting a s a -> a
^.forall n. Lens' (CommentWidget n) (Editor n)
textArea)
  in
    forall n. Widget n -> Widget n
vCenterLayer forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
height forall a b. (a -> b) -> a -> b
$ forall n a. Ord n => Dialog a n -> Widget n -> Widget n
renderDialog (CommentWidget n
widgetforall s a. s -> Getting a s a -> a
^.forall n. Lens' (CommentWidget n) (Dialog () n)
dialogWidget) Widget n
textArea'

commentDialogComment :: CommentWidget n -> Text
commentDialogComment :: forall n. CommentWidget n -> Text
commentDialogComment = Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Editor n -> [Text]
getEditContents forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Monoid a => TextZipper a -> [Int]
lineLengths TextZipper a
zipper
    (Int
row, Int
col) = (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lengths, forall a. [a] -> a
last [Int]
lengths)
  in
    forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
moveCursor (Int
rowforall a. Num a => a -> a -> a
-Int
1, Int
col) TextZipper a
zipper