Commit a8bba358 authored by Sumit Sahrawat's avatar Sumit Sahrawat

Finalize IHaskell.Display.Widgets.Button

* Add explicit export list
* Provide direct access to click handlers
* Rename getButtonText to getButtonLabel
parent 8c2b9a4e
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module IHaskell.Display.Widgets.Button where module IHaskell.Display.Widgets.Button
( -- * The Button Widget
Button
-- * Predefined button styles
, ButtonStyle (..)
-- * Create a new button
, mkButton
-- * Set button properties
, setButtonStyle
, setButtonLabel
, setButtonTooltip
, disableButton
, enableButton
, toggleButtonStatus
-- * Get button properties
, getButtonStyle
, getButtonLabel
, getButtonTooltip
, isDisabled
-- * Click handlers
, setClickHandler
, getClickHandler
, triggerClick
) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when) import Control.Monad (when)
...@@ -13,11 +37,12 @@ import Data.HashMap.Strict as Map ...@@ -13,11 +37,12 @@ import Data.HashMap.Strict as Map
import Data.IORef import Data.IORef
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import System.IO.Unsafe (unsafePerformIO)
import IHaskell.Display import IHaskell.Display
import qualified IHaskell.IPython.Message.UUID as U
import IHaskell.Eval.Widgets import IHaskell.Eval.Widgets
import IHaskell.Types (WidgetMethod (..)) import qualified IHaskell.IPython.Message.UUID as U
import System.IO.Unsafe (unsafePerformIO) import IHaskell.Types (WidgetMethod (..))
-- | ADT for a button -- | ADT for a button
data Button = Button { uuid :: U.UUID data Button = Button { uuid :: U.UUID
...@@ -93,16 +118,16 @@ toggleButtonStatus :: Button -> IO () ...@@ -93,16 +118,16 @@ toggleButtonStatus :: Button -> IO ()
toggleButtonStatus b = do toggleButtonStatus b = do
oldVal <- isDisabled b oldVal <- isDisabled b
let newVal = not oldVal let newVal = not oldVal
modify b disabled newVal modify b disabled newVal
update b [ "disabled" .= newVal ] update b [ "disabled" .= newVal ]
-- | Get the button style -- | Get the button style
getButtonStyle :: Button -> IO ButtonStyle getButtonStyle :: Button -> IO ButtonStyle
getButtonStyle = readIORef . buttonStyle getButtonStyle = readIORef . buttonStyle
-- | Get the button text -- | Get the button label
getButtonText :: Button -> IO Text getButtonLabel :: Button -> IO Text
getButtonText = readIORef . description getButtonLabel = readIORef . description
-- | Get the button tooltip -- | Get the button tooltip
getButtonTooltip :: Button -> IO Text getButtonTooltip :: Button -> IO Text
...@@ -113,13 +138,17 @@ isDisabled :: Button -> IO Bool ...@@ -113,13 +138,17 @@ isDisabled :: Button -> IO Bool
isDisabled = readIORef . disabled isDisabled = readIORef . disabled
-- | Set a function to be activated on click -- | Set a function to be activated on click
onClicked :: Button -> (Button -> IO ()) -> IO () setClickHandler :: Button -> (Button -> IO ()) -> IO ()
onClicked = writeIORef . clickHandler setClickHandler = writeIORef . clickHandler
-- | Get the click handler for a button
getClickHandler :: Button -> IO (Button -> IO ())
getClickHandler = readIORef . clickHandler
-- | Artificially trigger a button click -- | Artificially trigger a button click
triggerClick :: Button -> IO () triggerClick :: Button -> IO ()
triggerClick button = do triggerClick button = do
handler <- readIORef $ clickHandler button handler <- getClickHandler button
handler button handler button
instance ToJSON ButtonStyle where instance ToJSON ButtonStyle where
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment