content: -- |This module provides a ''button'' widget type which has a
  -- button-like appearance and generates ''press'' events.  'Button's
  -- are pressed when a user presses Enter while the button has focus.
  module Graphics.Vty.Widgets.Button
      ( Button
      , newButton
      , buttonWidget
      , onButtonPressed
      , pressButton
      , setButtonText
      )
  where
  
  import qualified Data.Text as T
  import Graphics.Vty.Widgets.Core
  import Graphics.Vty.Widgets.Text
  import Graphics.Vty.Widgets.Padding
  import Graphics.Vty.Widgets.Events
  import Graphics.Vty.Widgets.Util
  import Graphics.Vty hiding (Button)
  
  data Button = Button { buttonWidget :: Widget Padded
                       -- ^Get a reference to the button's widget to lay
                       -- it out.
                       , buttonText :: Widget FormattedText
                       , buttonPressedHandlers :: Handlers Button
                       }
  
  -- |Register a handler for the button press event.
  onButtonPressed :: Button -> (Button -> IO ()) -> IO ()
  onButtonPressed = addHandler (return . buttonPressedHandlers)
  
  -- |Programmatically press a button to trigger its event handlers.
  pressButton :: Button -> IO ()
  pressButton b = fireEvent b (return . buttonPressedHandlers) b
  
  -- |Set the text label on a button.
  setButtonText :: Button -> T.Text -> IO ()
  setButtonText b s = setText (buttonText b) s
  
  instance HasNormalAttr Button where
      setNormalAttribute b a = setNormalAttribute (buttonWidget b) a
  
  instance HasFocusAttr Button where
      setFocusAttribute b a = setFocusAttribute (buttonWidget b) a
  
  -- |Create a button.  Get its underlying widget with 'buttonWidget'.
  newButton :: T.Text -> IO Button
  newButton msg = do
    t <- plainText msg
    setTextAppearFocused t True
  
    w <- return t >>=
         withPadding (padLeftRight 3) >>=
         withNormalAttribute (white `on` black) >>=
         withFocusAttribute (blue `on` white)
  
    updateWidget w $ \st -> st { getCursorPosition_ = const $ return Nothing }
  
    hs <- newHandlers
  
    let b = Button w t hs
  
    w `onKeyPressed` \_ k _ ->
        do
          case k of
            KEnter -> pressButton b
            _ -> return ()
          return False
  
    return b
  