{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
-- | This module provides a simple dialog widget. You get to pick the
-- dialog title, if any, as well as its body and buttons.
--
-- Note that this dialog is really for simple use cases where you want
-- to get the user's answer to a question, such as "Would you like to
-- save changes before quitting?" As is typical in such cases, we assume
-- that this dialog box is used modally, meaning that while it is open
-- it is has exclusive input focus until it is closed.
--
-- If you require something more sophisticated, you'll need to build it
-- yourself. You might also consider seeing the 'Brick.Forms' module for
-- help with input management and see the implementation of this module
-- to see how to reproduce a dialog-style UI.
module Brick.Widgets.Dialog
  ( Dialog
  , dialogTitle
  , dialogButtons
  , dialogWidth
  -- * Construction and rendering
  , dialog
  , renderDialog
  , getDialogFocus
  , setDialogFocus
  -- * Handling events
  , handleDialogEvent
  -- * Getting a dialog's current value
  , dialogSelection
  -- * Attributes
  , dialogAttr
  , buttonAttr
  , buttonSelectedAttr
  -- * Lenses
  , dialogButtonsL
  , dialogWidthL
  , dialogTitleL
  )
where

import Lens.Micro
import Lens.Micro.Mtl ((%=))
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import Data.List (intersperse, find)
import Graphics.Vty.Input (Event(..), Key(..))

import Brick.Focus
import Brick.Types
import Brick.Widgets.Core
import Brick.Widgets.Center
import Brick.Widgets.Border
import Brick.AttrMap

-- | Dialogs present a window with a title (optional), a body, and
-- buttons (optional). Dialog buttons are labeled with strings and map
-- to values of type 'a', which you choose.
--
-- Dialogs handle the following events by default with
-- handleDialogEvent:
--
-- * Tab or Right Arrow: select the next button
-- * Shift-tab or Left Arrow: select the previous button
data Dialog a n =
    Dialog { forall a n. Dialog a n -> Maybe (Widget n)
dialogTitle :: Maybe (Widget n)
           -- ^ The dialog title
           , forall a n. Dialog a n -> [(String, n, a)]
dialogButtons :: [(String, n, a)]
           -- ^ The dialog buttons' labels, resource names, and values
           , forall a n. Dialog a n -> Int
dialogWidth :: Int
           -- ^ The maximum width of the dialog
           , forall a n. Dialog a n -> FocusRing n
dialogFocus :: FocusRing n
           -- ^ The focus ring for the dialog's buttons
           }

suffixLenses ''Dialog

handleDialogEvent :: Event -> EventM n (Dialog a n) ()
handleDialogEvent :: forall n a. Event -> EventM n (Dialog a n) ()
handleDialogEvent Event
ev = do
    case Event
ev of
        EvKey (KChar Char
'\t') [] -> forall a n. Lens' (Dialog a n) (FocusRing n)
dialogFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusNext
        EvKey Key
KRight []       -> forall a n. Lens' (Dialog a n) (FocusRing n)
dialogFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusNext
        EvKey Key
KBackTab []     -> forall a n. Lens' (Dialog a n) (FocusRing n)
dialogFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusPrev
        EvKey Key
KLeft []        -> forall a n. Lens' (Dialog a n) (FocusRing n)
dialogFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusPrev
        Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Set the focused button of a dialog.
setDialogFocus :: (Eq n) => n -> Dialog a n -> Dialog a n
setDialogFocus :: forall n a. Eq n => n -> Dialog a n -> Dialog a n
setDialogFocus n
n Dialog a n
d = Dialog a n
d { dialogFocus :: FocusRing n
dialogFocus = forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent n
n forall a b. (a -> b) -> a -> b
$ forall a n. Dialog a n -> FocusRing n
dialogFocus Dialog a n
d }

-- | Get the focused button of a dialog.
getDialogFocus :: Dialog a n -> Maybe n
getDialogFocus :: forall a n. Dialog a n -> Maybe n
getDialogFocus = forall n. FocusRing n -> Maybe n
focusGetCurrent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a n. Dialog a n -> FocusRing n
dialogFocus

-- | Create a dialog.
dialog :: (Eq n)
       => Maybe (Widget n)
       -- ^ The dialog title
       -> Maybe (n, [(String, n, a)])
       -- ^ The currently-selected button resource name and the button
       -- labels, resource names, and values to use for each button,
       -- respectively
       -> Int
       -- ^ The maximum width of the dialog
       -> Dialog a n
dialog :: forall n a.
Eq n =>
Maybe (Widget n)
-> Maybe (n, [(String, n, a)]) -> Int -> Dialog a n
dialog Maybe (Widget n)
title Maybe (n, [(String, n, a)])
buttonData Int
w =
    let (FocusRing n
r, [(String, n, a)]
buttons) = case Maybe (n, [(String, n, a)])
buttonData of
            Maybe (n, [(String, n, a)])
Nothing ->
                (forall n. [n] -> FocusRing n
focusRing [], [])
            Just (n
focName, [(String, n, a)]
entries) ->
                let ns :: [n]
ns = (\(String
_, n
n, a
_) -> n
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, n, a)]
entries
                in (forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent n
focName forall a b. (a -> b) -> a -> b
$ forall n. [n] -> FocusRing n
focusRing [n]
ns, [(String, n, a)]
entries)
    in forall a n.
Maybe (Widget n)
-> [(String, n, a)] -> Int -> FocusRing n -> Dialog a n
Dialog Maybe (Widget n)
title [(String, n, a)]
buttons Int
w FocusRing n
r

-- | The default attribute of the dialog
dialogAttr :: AttrName
dialogAttr :: AttrName
dialogAttr = String -> AttrName
attrName String
"dialog"

-- | The default attribute for all dialog buttons
buttonAttr :: AttrName
buttonAttr :: AttrName
buttonAttr = String -> AttrName
attrName String
"button"

-- | The attribute for the selected dialog button (extends 'dialogAttr')
buttonSelectedAttr :: AttrName
buttonSelectedAttr :: AttrName
buttonSelectedAttr = AttrName
buttonAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected"

-- | Render a dialog with the specified body widget. This renders the
-- dialog as a layer, which makes this suitable as a top-level layer in
-- your rendering function to be rendered on top of the rest of your
-- interface.
renderDialog :: (Ord n) => Dialog a n -> Widget n -> Widget n
renderDialog :: forall n a. Ord n => Dialog a n -> Widget n -> Widget n
renderDialog Dialog a n
d Widget n
body =
    let buttonPadding :: Widget n
buttonPadding = forall n. String -> Widget n
str String
"   "
        foc :: Maybe n
foc = forall n. FocusRing n -> Maybe n
focusGetCurrent forall a b. (a -> b) -> a -> b
$ forall a n. Dialog a n -> FocusRing n
dialogFocus Dialog a n
d
        mkButton :: (String, n, c) -> Widget n
mkButton (String
s, n
n, c
_) =
            let att :: AttrName
att = if forall a. a -> Maybe a
Just n
n forall a. Eq a => a -> a -> Bool
== Maybe n
foc
                      then AttrName
buttonSelectedAttr
                      else AttrName
buttonAttr
                csr :: Widget n -> Widget n
csr = if forall a. a -> Maybe a
Just n
n forall a. Eq a => a -> a -> Bool
== Maybe n
foc
                      then forall n. n -> Location -> Widget n -> Widget n
putCursor n
n ((Int, Int) -> Location
Location (Int
1,Int
0))
                      else forall a. a -> a
id
            in Widget n -> Widget n
csr forall a b. (a -> b) -> a -> b
$
               forall n. Ord n => n -> Widget n -> Widget n
clickable n
n forall a b. (a -> b) -> a -> b
$
               forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
att forall a b. (a -> b) -> a -> b
$
               forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ String
"  " forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<> String
"  "
        buttons :: Widget n
buttons = forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse forall {n}. Widget n
buttonPadding forall a b. (a -> b) -> a -> b
$
                         forall {c}. (String, n, c) -> Widget n
mkButton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dialog a n
dforall s a. s -> Getting a s a -> a
^.forall a n a.
Lens (Dialog a n) (Dialog a n) [(String, n, a)] [(String, n, a)]
dialogButtonsL)

        doBorder :: Widget n -> Widget n
doBorder = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall n. Widget n -> Widget n
border forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Dialog a n
dforall s a. s -> Getting a s a -> a
^.forall a n. Lens' (Dialog a n) (Maybe (Widget n))
dialogTitleL)
    in forall n. Widget n -> Widget n
centerLayer forall a b. (a -> b) -> a -> b
$
       forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dialogAttr forall a b. (a -> b) -> a -> b
$
       forall n. Int -> Widget n -> Widget n
hLimit (Dialog a n
dforall s a. s -> Getting a s a -> a
^.forall a n. Lens' (Dialog a n) Int
dialogWidthL) forall a b. (a -> b) -> a -> b
$
       Widget n -> Widget n
doBorder forall a b. (a -> b) -> a -> b
$
       forall n. [Widget n] -> Widget n
vBox [ Widget n
body
            , forall n. Widget n -> Widget n
hCenter Widget n
buttons
            ]

-- | Obtain the resource name and value associated with the dialog's
-- currently-selected button, if any. The result of this function is
-- probably what you want when someone presses 'Enter' in a dialog.
dialogSelection :: (Eq n) => Dialog a n -> Maybe (n, a)
dialogSelection :: forall n a. Eq n => Dialog a n -> Maybe (n, a)
dialogSelection Dialog a n
d = do
    n
n' <- forall n. FocusRing n -> Maybe n
focusGetCurrent forall a b. (a -> b) -> a -> b
$ forall a n. Dialog a n -> FocusRing n
dialogFocus Dialog a n
d
    let matches :: (a, n, c) -> Bool
matches (a
_, n
n, c
_) = n
n forall a. Eq a => a -> a -> Bool
== n
n'
    (String
_, n
n, a
a) <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find forall {a} {c}. (a, n, c) -> Bool
matches (Dialog a n
dforall s a. s -> Getting a s a -> a
^.forall a n a.
Lens (Dialog a n) (Dialog a n) [(String, n, a)] [(String, n, a)]
dialogButtonsL)
    forall (m :: * -> *) a. Monad m => a -> m a
return (n
n, a
a)