{-# 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

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

suffixLenses ''Dialog

handleDialogEvent :: Event -> EventM n (Dialog a) ()
handleDialogEvent :: forall n a. Event -> EventM n (Dialog a) ()
handleDialogEvent Event
ev = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \Dialog a
d -> case Event
ev of
        EvKey (KChar Char
'\t') [] -> forall a. Int -> Bool -> Dialog a -> Dialog a
nextButtonBy Int
1 Bool
True Dialog a
d
        EvKey Key
KBackTab [] -> forall a. Int -> Bool -> Dialog a -> Dialog a
nextButtonBy (-Int
1) Bool
True Dialog a
d
        EvKey Key
KRight [] -> forall a. Int -> Bool -> Dialog a -> Dialog a
nextButtonBy Int
1 Bool
False Dialog a
d
        EvKey Key
KLeft [] -> 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 :: forall a.
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 -> ([], forall a. Maybe a
Nothing)
          Just (Int
_, []) -> ([], forall a. Maybe a
Nothing)
          Just (Int
i, [(String, a)]
bs) -> ([(String, a)]
bs, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a -> a
clamp Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, a)]
bs forall a. Num a => a -> a -> a
- Int
1) Int
i)
    in 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 = 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 :: Dialog a -> Widget n -> Widget n
renderDialog :: forall a n. Dialog a -> Widget n -> Widget n
renderDialog Dialog a
d Widget n
body =
    let buttonPadding :: Widget n
buttonPadding = forall n. String -> Widget n
str String
"   "
        mkButton :: (Int, (String, b)) -> Widget n
mkButton (Int
i, (String
s, b
_)) = let att :: AttrName
att = if forall a. a -> Maybe a
Just Int
i forall a. Eq a => a -> a -> Bool
== Dialog a
dforall s a. s -> Getting a s a -> a
^.forall a. Lens' (Dialog a) (Maybe Int)
dialogSelectedIndexL
                                         then AttrName
buttonSelectedAttr
                                         else AttrName
buttonAttr
                               in 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 {b} {n}. (Int, (String, b)) -> Widget n
mkButton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Dialog a
dforall s a. s -> Getting a s a -> a
^.forall a a. Lens (Dialog a) (Dialog a) [(String, a)] [(String, 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 (forall n. String -> Widget n
str forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dialog a
dforall s a. s -> Getting a s a -> a
^.forall a. Lens' (Dialog a) (Maybe String)
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
dforall s a. s -> Getting a s a -> a
^.forall a. Lens' (Dialog a) Int
dialogWidthL) forall a b. (a -> b) -> a -> b
$
       forall n. 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 forall {n}. Widget n
buttons
            ]

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