Input.hs

module Dingo.Widget.Input ( Input
                          , mkInput
                          , getValue
                          , onChange
                          , setValue
                          ) where

import Control.Monad (mzero)
import Data.Aeson.Types
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

-- Input type.
data Input = Input { inputId :: WidgetId
                   }
             deriving (Show, Typeable)

-- State associated with an Input widget.
data InputState = InputState { inputValue :: Text }
                deriving (Show, Typeable)

instance ToJSON InputState where
  toJSON (InputState v) = String v

instance FromJSON InputState where
  parseJSON (String s) = return $ InputState s
  parseJSON _          = mzero -- Not supported.

-- Input is a widget.
instance Widget Input InputState where
  -- Get the widget ID.
  getWidgetId = inputId
  -- Render input to HTML.
  renderWidget w =
    H.input ! A.id (toValue $ inputId w)
  -- Show widget.
  showWidget w s =
    show w ++ "->" ++ show s
  -- Client state handling.
  encodeClientStateJs _ =
    [julius| function() { return $(this).val(); } |]
  decodeClientStateJs _ =
    [julius| function(s) { $(this).val(s); } |]


-- Make a new input.
mkInput :: Widget w s => w -> CallbackM Input
mkInput = flip addWidget (\i -> return (Input i, InputState ""))

-- Get the value contained in the input field.
getValue :: Input -> CallbackM Text
getValue w = do
  ms <- getWidgetState w
  case ms of
    Nothing -> return ""
    Just s -> return $ inputValue s

-- Set the value contained in the input field.
setValue :: Input -> Text -> CallbackM ()
setValue w v = setWidgetState w (InputState v)

-- Register an onChange callback for the input field.
onChange :: Input -> CallbackM () -> CallbackM ()
onChange i = onEvent (widgetSelector i) OnChange