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