{-# 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?" 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
  , dialogSelectedIndex
  , dialogWidth
  -- * Construction and rendering
  , dialog
  , renderDialog
  -- * Handling events
  , handleDialogEvent
  -- * Getting a dialog's current value
  , dialogSelection
  -- * Attributes
  , dialogAttr
  , buttonAttr
  , buttonSelectedAttr
  -- * Lenses
  , dialogButtonsL
  , dialogSelectedIndexL
  , dialogWidthL
  , dialogTitleL
  )
where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

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

import Brick.Util (clamp)
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 =
    Dialog { Dialog a -> Maybe String
dialogTitle :: Maybe String
           -- ^ The dialog title
           , Dialog a -> [(String, a)]
dialogButtons :: [(String, a)]
           -- ^ The dialog button labels and values
           , Dialog a -> Maybe Int
dialogSelectedIndex :: Maybe Int
           -- ^ The currently selected dialog button index (if any)
           , Dialog a -> Int
dialogWidth :: Int
           -- ^ The maximum width of the dialog
           }

suffixLenses ''Dialog

handleDialogEvent :: Event -> Dialog a -> EventM n (Dialog a)
handleDialogEvent :: Event -> Dialog a -> EventM n (Dialog a)
handleDialogEvent Event
ev Dialog a
d =
    Dialog a -> EventM n (Dialog a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Dialog a -> EventM n (Dialog a))
-> Dialog a -> EventM n (Dialog a)
forall a b. (a -> b) -> a -> b
$ case Event
ev of
        EvKey (KChar Char
'\t') [] -> Int -> Bool -> Dialog a -> Dialog a
forall a. Int -> Bool -> Dialog a -> Dialog a
nextButtonBy Int
1 Bool
True Dialog a
d
        EvKey Key
KBackTab [] -> Int -> Bool -> Dialog a -> Dialog a
forall a. Int -> Bool -> Dialog a -> Dialog a
nextButtonBy (-Int
1) Bool
True Dialog a
d
        EvKey Key
KRight [] -> Int -> Bool -> Dialog a -> Dialog a
forall a. Int -> Bool -> Dialog a -> Dialog a
nextButtonBy Int
1 Bool
False Dialog a
d
        EvKey Key
KLeft [] -> Int -> Bool -> Dialog a -> Dialog a
forall a. Int -> Bool -> Dialog a -> Dialog a
nextButtonBy (-Int
1) Bool
False Dialog a
d
        Event
_ -> Dialog a
d

-- | Create a dialog.
dialog :: Maybe String
       -- ^ The dialog title
       -> Maybe (Int, [(String, a)])
       -- ^ The currently-selected button index (starting at zero) and
       -- the button labels and values to use
       -> Int
       -- ^ The maximum width of the dialog
       -> Dialog a
dialog :: Maybe String -> Maybe (Int, [(String, a)]) -> Int -> Dialog a
dialog Maybe String
title Maybe (Int, [(String, a)])
buttonData Int
w =
    let ([(String, a)]
buttons, Maybe Int
idx) = case Maybe (Int, [(String, a)])
buttonData of
          Maybe (Int, [(String, a)])
Nothing -> ([], Maybe Int
forall a. Maybe a
Nothing)
          Just (Int
_, []) -> ([], Maybe Int
forall a. Maybe a
Nothing)
          Just (Int
i, [(String, a)]
bs) -> ([(String, a)]
bs, Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 ([(String, a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, a)]
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
i)
    in Maybe String -> [(String, a)] -> Maybe Int -> Int -> Dialog a
forall a.
Maybe String -> [(String, a)] -> Maybe Int -> Int -> Dialog a
Dialog Maybe String
title [(String, a)]
buttons Maybe Int
idx Int
w

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

-- | The default attribute for all dialog buttons
buttonAttr :: AttrName
buttonAttr :: AttrName
buttonAttr = AttrName
"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
<> AttrName
"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 :: Dialog a -> Widget n -> Widget n
renderDialog :: Dialog a -> Widget n -> Widget n
renderDialog Dialog a
d Widget n
body =
    let buttonPadding :: Widget n
buttonPadding = String -> Widget n
forall n. String -> Widget n
str String
"   "
        mkButton :: (Int, (String, b)) -> Widget n
mkButton (Int
i, (String
s, b
_)) = let att :: AttrName
att = if Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Dialog a
dDialog a -> Getting (Maybe Int) (Dialog a) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (Dialog a) (Maybe Int)
forall a. Lens' (Dialog a) (Maybe Int)
dialogSelectedIndexL
                                         then AttrName
buttonSelectedAttr
                                         else AttrName
buttonAttr
                               in 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
$
                         (Int, (String, a)) -> Widget n
forall b n. (Int, (String, b)) -> Widget n
mkButton ((Int, (String, a)) -> Widget n)
-> [(Int, (String, a))] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Int] -> [(String, a)] -> [(Int, (String, a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Dialog a
dDialog a
-> Getting [(String, a)] (Dialog a) [(String, a)] -> [(String, a)]
forall s a. s -> Getting a s a -> a
^.Getting [(String, a)] (Dialog a) [(String, a)]
forall a a. Lens (Dialog a) (Dialog a) [(String, a)] [(String, a)]
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 (String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> Maybe String -> Maybe (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dialog a
dDialog a
-> Getting (Maybe String) (Dialog a) (Maybe String) -> Maybe String
forall s a. s -> Getting a s a -> a
^.Getting (Maybe String) (Dialog a) (Maybe String)
forall a. Lens' (Dialog a) (Maybe String)
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
dDialog a -> Getting Int (Dialog a) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Dialog a) Int
forall a. Lens' (Dialog a) Int
dialogWidthL) (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
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
forall n. Widget n
buttons
            ]

nextButtonBy :: Int -> Bool -> Dialog a -> Dialog a
nextButtonBy :: Int -> Bool -> Dialog a -> Dialog a
nextButtonBy Int
amt Bool
wrapCycle Dialog a
d =
    let numButtons :: Int
numButtons = [(String, a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(String, a)] -> Int) -> [(String, a)] -> Int
forall a b. (a -> b) -> a -> b
$ Dialog a
dDialog a
-> Getting [(String, a)] (Dialog a) [(String, a)] -> [(String, a)]
forall s a. s -> Getting a s a -> a
^.Getting [(String, a)] (Dialog a) [(String, a)]
forall a a. Lens (Dialog a) (Dialog a) [(String, a)] [(String, a)]
dialogButtonsL
    in if Int
numButtons Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Dialog a
d
       else case Dialog a
dDialog a -> Getting (Maybe Int) (Dialog a) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (Dialog a) (Maybe Int)
forall a. Lens' (Dialog a) (Maybe Int)
dialogSelectedIndexL of
           Maybe Int
Nothing -> Dialog a
d Dialog a -> (Dialog a -> Dialog a) -> Dialog a
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> Dialog a -> Identity (Dialog a)
forall a. Lens' (Dialog a) (Maybe Int)
dialogSelectedIndexL ((Maybe Int -> Identity (Maybe Int))
 -> Dialog a -> Identity (Dialog a))
-> Maybe Int -> Dialog a -> Dialog a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
           Just Int
i -> Dialog a
d Dialog a -> (Dialog a -> Dialog a) -> Dialog a
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> Dialog a -> Identity (Dialog a)
forall a. Lens' (Dialog a) (Maybe Int)
dialogSelectedIndexL ((Maybe Int -> Identity (Maybe Int))
 -> Dialog a -> Identity (Dialog a))
-> Maybe Int -> Dialog a -> Dialog a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
newIndex)
               where
                   addedIndex :: Int
addedIndex = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amt
                   newIndex :: Int
newIndex = if Bool
wrapCycle
                              then Int
addedIndex Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
numButtons
                              else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
addedIndex (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
numButtons Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Obtain the value associated with the dialog's currently-selected
-- button, if any. This function is probably what you want when someone
-- presses 'Enter' in a dialog.
dialogSelection :: Dialog a -> Maybe a
dialogSelection :: Dialog a -> Maybe a
dialogSelection Dialog a
d =
    case Dialog a
dDialog a -> Getting (Maybe Int) (Dialog a) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (Dialog a) (Maybe Int)
forall a. Lens' (Dialog a) (Maybe Int)
dialogSelectedIndexL of
        Maybe Int
Nothing -> Maybe a
forall a. Maybe a
Nothing
        Just Int
i -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ ((Dialog a
dDialog a
-> Getting [(String, a)] (Dialog a) [(String, a)] -> [(String, a)]
forall s a. s -> Getting a s a -> a
^.Getting [(String, a)] (Dialog a) [(String, a)]
forall a a. Lens (Dialog a) (Dialog a) [(String, a)] [(String, a)]
dialogButtonsL) [(String, a)] -> Int -> (String, a)
forall a. [a] -> Int -> a
!! Int
i)(String, a) -> Getting a (String, a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (String, a) a
forall s t a b. Field2 s t a b => Lens s t a b
_2