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)