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
data Button = Button { buttonId :: WidgetId
}
deriving (Show, Typeable)
data ButtonState = ButtonState Text
deriving (Show, Typeable)
instance FromJSON ButtonState where
parseJSON (String s) = return $ ButtonState s
parseJSON _ = mzero
instance ToJSON ButtonState where
toJSON (ButtonState s) = String s
instance Widget Button ButtonState where
getWidgetId = buttonId
renderWidget w =
H.button ! A.id (toValue $ buttonId w) $ mempty
showWidget button state = show button ++ "->" ++ show state
encodeClientStateJs _ =
[julius| function () { return $(this).html(); } |]
decodeClientStateJs _ =
[julius| function (s) { $(this).html(s); } |]
mkButton :: Widget w s => w -> Text -> CallbackM Button
mkButton pw l = addWidget pw (\i -> return (Button i, ButtonState l))
onClick :: Button -> CallbackM () -> CallbackM ()
onClick btn = onEvent (widgetSelector btn) OnClick
getLabel :: Button -> CallbackM Text
getLabel w = fmap f (getWidgetState w)
where f Nothing = ""
f (Just (ButtonState l)) = l
setLabel :: Button -> Text -> CallbackM ()
setLabel w l = setWidgetState w (ButtonState l)