{-# 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') [] -> (FocusRing n -> Identity (FocusRing n))
-> Dialog a n -> Identity (Dialog a n)
forall a n (f :: * -> *).
Functor f =>
(FocusRing n -> f (FocusRing n)) -> Dialog a n -> f (Dialog a n)
dialogFocusL ((FocusRing n -> Identity (FocusRing n))
 -> Dialog a n -> Identity (Dialog a n))
-> (FocusRing n -> FocusRing n) -> EventM n (Dialog a n) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing n -> FocusRing n
forall n. FocusRing n -> FocusRing n
focusNext
        EvKey Key
KRight []       -> (FocusRing n -> Identity (FocusRing n))
-> Dialog a n -> Identity (Dialog a n)
forall a n (f :: * -> *).
Functor f =>
(FocusRing n -> f (FocusRing n)) -> Dialog a n -> f (Dialog a n)
dialogFocusL ((FocusRing n -> Identity (FocusRing n))
 -> Dialog a n -> Identity (Dialog a n))
-> (FocusRing n -> FocusRing n) -> EventM n (Dialog a n) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing n -> FocusRing n
forall n. FocusRing n -> FocusRing n
focusNext
        EvKey Key
KBackTab []     -> (FocusRing n -> Identity (FocusRing n))
-> Dialog a n -> Identity (Dialog a n)
forall a n (f :: * -> *).
Functor f =>
(FocusRing n -> f (FocusRing n)) -> Dialog a n -> f (Dialog a n)
dialogFocusL ((FocusRing n -> Identity (FocusRing n))
 -> Dialog a n -> Identity (Dialog a n))
-> (FocusRing n -> FocusRing n) -> EventM n (Dialog a n) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing n -> FocusRing n
forall n. FocusRing n -> FocusRing n
focusPrev
        EvKey Key
KLeft []        -> (FocusRing n -> Identity (FocusRing n))
-> Dialog a n -> Identity (Dialog a n)
forall a n (f :: * -> *).
Functor f =>
(FocusRing n -> f (FocusRing n)) -> Dialog a n -> f (Dialog a n)
dialogFocusL ((FocusRing n -> Identity (FocusRing n))
 -> Dialog a n -> Identity (Dialog a n))
-> (FocusRing n -> FocusRing n) -> EventM n (Dialog a n) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing n -> FocusRing n
forall n. FocusRing n -> FocusRing n
focusPrev
        Event
_ -> () -> EventM n (Dialog a n) ()
forall a. a -> EventM n (Dialog a n) a
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 = focusSetCurrent n $ dialogFocus d }

-- | Get the focused button of a dialog.
getDialogFocus :: Dialog a n -> Maybe n
getDialogFocus :: forall a n. Dialog a n -> Maybe n
getDialogFocus = FocusRing n -> Maybe n
forall n. FocusRing n -> Maybe n
focusGetCurrent (FocusRing n -> Maybe n)
-> (Dialog a n -> FocusRing n) -> Dialog a n -> Maybe n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dialog a n -> FocusRing n
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 ->
                ([n] -> FocusRing n
forall n. [n] -> FocusRing n
focusRing [], [])
            Just (n
focName, [(String, n, a)]
entries) ->
                let ns :: [n]
ns = (\(String
_, n
n, a
_) -> n
n) ((String, n, a) -> n) -> [(String, n, a)] -> [n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, n, a)]
entries
                in (n -> FocusRing n -> FocusRing n
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent n
focName (FocusRing n -> FocusRing n) -> FocusRing n -> FocusRing n
forall a b. (a -> b) -> a -> b
$ [n] -> FocusRing n
forall n. [n] -> FocusRing n
focusRing [n]
ns, [(String, n, a)]
entries)
    in Maybe (Widget n)
-> [(String, n, a)] -> Int -> FocusRing n -> Dialog a n
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 AttrName -> AttrName -> AttrName
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 = String -> Widget n
forall n. String -> Widget n
str String
"   "
        foc :: Maybe n
foc = FocusRing n -> Maybe n
forall n. FocusRing n -> Maybe n
focusGetCurrent (FocusRing n -> Maybe n) -> FocusRing n -> Maybe n
forall a b. (a -> b) -> a -> b
$ Dialog a n -> FocusRing n
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 n -> Maybe n
forall a. a -> Maybe a
Just n
n Maybe n -> Maybe n -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe n
foc
                      then AttrName
buttonSelectedAttr
                      else AttrName
buttonAttr
                csr :: Widget n -> Widget n
csr = if n -> Maybe n
forall a. a -> Maybe a
Just n
n Maybe n -> Maybe n -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe n
foc
                      then n -> Location -> Widget n -> Widget n
forall n. n -> Location -> Widget n -> Widget n
putCursor n
n ((Int, Int) -> Location
Location (Int
1,Int
0))
                      else Widget n -> Widget n
forall a. a -> a
id
            in Widget n -> Widget n
csr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
               n -> Widget n -> Widget n
forall n. Ord n => n -> Widget n -> Widget n
clickable n
n (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
               AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
att (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
               String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"  "
        buttons :: Widget n
buttons = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
intersperse Widget n
forall {n}. Widget n
buttonPadding ([Widget n] -> [Widget n]) -> [Widget n] -> [Widget n]
forall a b. (a -> b) -> a -> b
$
                         (String, n, a) -> Widget n
forall {c}. (String, n, c) -> Widget n
mkButton ((String, n, a) -> Widget n) -> [(String, n, a)] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Dialog a n
dDialog a n
-> Getting [(String, n, a)] (Dialog a n) [(String, n, a)]
-> [(String, n, a)]
forall s a. s -> Getting a s a -> a
^.Getting [(String, n, a)] (Dialog a n) [(String, n, a)]
forall a n a (f :: * -> *).
Functor f =>
([(String, n, a)] -> f [(String, n, a)])
-> Dialog a n -> f (Dialog a n)
dialogButtonsL)

        doBorder :: Widget n -> Widget n
doBorder = (Widget n -> Widget n)
-> (Widget n -> Widget n -> Widget n)
-> Maybe (Widget n)
-> Widget n
-> Widget n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget n -> Widget n
forall n. Widget n -> Widget n
border Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Dialog a n
dDialog a n
-> Getting (Maybe (Widget n)) (Dialog a n) (Maybe (Widget n))
-> Maybe (Widget n)
forall s a. s -> Getting a s a -> a
^.Getting (Maybe (Widget n)) (Dialog a n) (Maybe (Widget n))
forall a n (f :: * -> *).
Functor f =>
(Maybe (Widget n) -> f (Maybe (Widget n)))
-> Dialog a n -> f (Dialog a n)
dialogTitleL)
    in Widget n -> Widget n
forall n. Widget n -> Widget n
centerLayer (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
       AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dialogAttr (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
hLimit (Dialog a n
dDialog a n -> Getting Int (Dialog a n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Dialog a n) Int
forall a n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Dialog a n -> f (Dialog a n)
dialogWidthL) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
       Widget n -> Widget n
doBorder (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
       [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox [ Widget n
body
            , Widget n -> Widget n
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' <- FocusRing n -> Maybe n
forall n. FocusRing n -> Maybe n
focusGetCurrent (FocusRing n -> Maybe n) -> FocusRing n -> Maybe n
forall a b. (a -> b) -> a -> b
$ Dialog a n -> FocusRing n
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 n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
n'
    (String
_, n
n, a
a) <- ((String, n, a) -> Bool)
-> [(String, n, a)] -> Maybe (String, n, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String, n, a) -> Bool
forall {a} {c}. (a, n, c) -> Bool
matches (Dialog a n
dDialog a n
-> Getting [(String, n, a)] (Dialog a n) [(String, n, a)]
-> [(String, n, a)]
forall s a. s -> Getting a s a -> a
^.Getting [(String, n, a)] (Dialog a n) [(String, n, a)]
forall a n a (f :: * -> *).
Functor f =>
([(String, n, a)] -> f [(String, n, a)])
-> Dialog a n -> f (Dialog a n)
dialogButtonsL)
    (n, a) -> Maybe (n, a)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (n
n, a
a)