module Dingo.Widget.Button ( Button , mkButton , getLabel , onClick , setLabel ) where import Control.Monad (mzero) import Data.Aeson (FromJSON(..), ToJSON(..), Value(..)) import Data.Monoid (mempty) import Data.Text (Text) import Data.Typeable (Typeable) import Dingo.Callback import Dingo.Event import Dingo.Widget import Text.Blaze ((!), toValue) import Text.Julius (julius) import qualified Text.Blaze.Html4.Strict as H import qualified Text.Blaze.Html4.Strict.Attributes as A -- Button type. data Button = Button { buttonId :: WidgetId } deriving (Show, Typeable) -- Button state. data ButtonState = ButtonState Text deriving (Show, Typeable) instance FromJSON ButtonState where parseJSON (String s) = return $ ButtonState s parseJSON _ = mzero -- Failure instance ToJSON ButtonState where toJSON (ButtonState s) = String s -- Button is a widget. instance Widget Button ButtonState where -- Get the widget ID. getWidgetId = buttonId -- Render button to HTML. renderWidget w = H.button ! A.id (toValue $ buttonId w) $ mempty -- Show button widget showWidget button state = show button ++ "->" ++ show state -- Client state handling. encodeClientStateJs _ = [julius| function () { return $(this).html(); } |] decodeClientStateJs _ = [julius| function (s) { $(this).html(s); } |] -- Make a new button. mkButton :: Widget w s => w -> Text -> CallbackM Button mkButton pw l = addWidget pw (\i -> return (Button i, ButtonState l)) -- Register an OnClick handler. onClick :: Button -> CallbackM () -> CallbackM () onClick btn = onEvent (widgetSelector btn) OnClick -- Get the label of the button. getLabel :: Button -> CallbackM Text getLabel w = fmap f (getWidgetState w) where f Nothing = "" f (Just (ButtonState l)) = l -- Set the value contained in the input field. setLabel :: Button -> Text -> CallbackM () setLabel w l = setWidgetState w (ButtonState l)