{-# LANGUAGE OverloadedStrings #-}

module Brick.Widgets.CommentDialog
  ( CommentWidget
  , commentWidget
  , renderCommentWidget
  , commentDialogComment
  , CommentAction(..)
  , handleCommentEvent
  ) where

import           Data.Semigroup ((<>))

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           Brick.Widgets.Edit.EmacsBindings

data CommentWidget n = CommentWidget
  { CommentWidget n -> Text
origComment :: Text
  , CommentWidget n -> Editor n
textArea :: Editor n
  , CommentWidget n -> Dialog ()
dialogWidget :: Dialog ()
  , CommentWidget n -> Text
promptPrefix :: Text
  }

commentWidget :: n -> Text -> Text -> CommentWidget n
commentWidget :: n -> Text -> Text -> CommentWidget n
commentWidget n
name Text
prompt Text
comment =
  let
    title :: String
title = String
"ESC: cancel, RET: accept, Alt-RET: New line"
    maxWidth :: Int
maxWidth = Int
80
    diag :: Dialog a
diag = Maybe String -> Maybe (Int, [(String, a)]) -> Int -> Dialog a
forall a.
Maybe String -> Maybe (Int, [(String, a)]) -> Int -> Dialog a
dialog (String -> Maybe String
forall a. a -> Maybe a
Just String
title) Maybe (Int, [(String, 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 :: forall n. Text -> Editor n -> Dialog () -> Text -> CommentWidget n
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 ()
dialogWidget = Dialog ()
forall a. Dialog a
diag
      , promptPrefix :: Text
promptPrefix = Text
prompt
      }

data CommentAction n = CommentContinue (CommentWidget n)
                     | CommentFinished Text

handleCommentEvent :: Event -> CommentWidget n -> EventM n (CommentAction n)
handleCommentEvent :: Event -> CommentWidget n -> EventM n (CommentAction n)
handleCommentEvent Event
ev CommentWidget n
widget = case Event
ev of
  EvKey Key
KEsc [] -> CommentAction n -> EventM n (CommentAction n)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommentAction n -> EventM n (CommentAction n))
-> CommentAction n -> EventM n (CommentAction n)
forall a b. (a -> b) -> a -> b
$ Text -> CommentAction n
forall n. Text -> CommentAction n
CommentFinished (CommentWidget n -> Text
forall n. CommentWidget n -> Text
origComment CommentWidget n
widget)
  EvKey Key
KEnter [] -> CommentAction n -> EventM n (CommentAction n)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommentAction n -> EventM n (CommentAction n))
-> CommentAction n -> EventM n (CommentAction n)
forall a b. (a -> b) -> a -> b
$ Text -> CommentAction n
forall n. Text -> CommentAction n
CommentFinished (CommentWidget n -> Text
forall n. CommentWidget n -> Text
commentDialogComment CommentWidget n
widget)
  EvKey Key
KEnter [Modifier
MMeta] -> CommentAction n -> EventM n (CommentAction n)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommentAction n -> EventM n (CommentAction n))
-> CommentAction n -> EventM n (CommentAction n)
forall a b. (a -> b) -> a -> b
$ CommentWidget n -> CommentAction n
forall n. CommentWidget n -> CommentAction n
CommentContinue (CommentWidget n -> CommentAction n)
-> CommentWidget n -> CommentAction n
forall a b. (a -> b) -> a -> b
$
    CommentWidget n
widget { 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
breakLine (CommentWidget n -> Editor n
forall n. CommentWidget n -> Editor n
textArea CommentWidget n
widget) }
  Event
_ -> do
    Editor n
textArea' <- Event -> Editor n -> EventM n (Editor n)
forall n. Event -> Editor n -> EventM n (Editor n)
handleEditorEvent Event
ev (CommentWidget n -> Editor n
forall n. CommentWidget n -> Editor n
textArea CommentWidget n
widget)
    CommentAction n -> EventM n (CommentAction n)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommentAction n -> EventM n (CommentAction n))
-> CommentAction n -> EventM n (CommentAction n)
forall a b. (a -> b) -> a -> b
$ CommentWidget n -> CommentAction n
forall n. CommentWidget n -> CommentAction n
CommentContinue (CommentWidget n -> CommentAction n)
-> CommentWidget n -> CommentAction n
forall a b. (a -> b) -> a -> b
$
      Text -> Editor n -> Dialog () -> Text -> CommentWidget n
forall n. Text -> Editor n -> Dialog () -> Text -> CommentWidget n
CommentWidget (CommentWidget n -> Text
forall n. CommentWidget n -> Text
origComment CommentWidget n
widget) Editor n
textArea' (CommentWidget n -> Dialog ()
forall n. CommentWidget n -> Dialog ()
dialogWidget CommentWidget n
widget) (CommentWidget n -> Text
forall n. CommentWidget n -> Text
promptPrefix CommentWidget n
widget)

renderCommentWidget :: (Ord n, Show n) => CommentWidget n -> Widget n
renderCommentWidget :: 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 (t :: * -> *) a. Foldable t => t a -> Int
length (Editor n -> [Text]
forall n. Editor n -> [Text]
getEditContents (CommentWidget n -> Editor n
forall n. CommentWidget n -> Editor n
textArea CommentWidget n
widget)) 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 -> Text
forall n. CommentWidget n -> Text
promptPrefix CommentWidget n
widget 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 -> Editor n
forall n. CommentWidget n -> Editor n
textArea CommentWidget n
widget)
  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 () -> Widget n -> Widget n
forall a n. Dialog a -> Widget n -> Widget n
renderDialog (CommentWidget n -> Dialog ()
forall n. CommentWidget n -> Dialog ()
dialogWidget CommentWidget n
widget) Widget n
textArea'

commentDialogComment :: CommentWidget n -> Text
commentDialogComment :: 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 :: 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 (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lengths, [Int] -> Int
forall a. [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