module Dingo.Widget.Select ( Select , mkSelect , getValue , onChange , setValue , setChoices ) where import Control.Monad (mzero) import Data.Aeson (FromJSON(..), ToJSON(..), Value(..)) import Data.Foldable (forM_) import Data.Text (Text) import Data.Typeable (Typeable) import Dingo.Callback import Dingo.Event import Dingo.Widget import Text.Blaze ((!), toHtml, toValue) import Text.Julius (julius) import qualified Text.Blaze.Html4.Strict as H import qualified Text.Blaze.Html4.Strict.Attributes as A -- Select type. data Select = Select { selectId :: WidgetId , selectChoices :: [(Text,Text)] } deriving (Show, Typeable) -- State associated with an Select widget. data SelectState = SelectState { selectValue :: Text } deriving (Show, Typeable) instance FromJSON SelectState where parseJSON (String s) = return $ SelectState s parseJSON _ = mzero instance ToJSON SelectState where toJSON (SelectState s) = String s -- Select is a widget. instance Widget Select SelectState where -- Get the widget ID. getWidgetId = selectId -- Render select to HTML. renderWidget w = H.select ! A.id (toValue $ selectId w) $ do forM_ (selectChoices w) $ \(v,dv) -> do H.option ! A.value (toValue v) $ toHtml dv -- 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 select. mkSelect :: Widget w s => w -> [(Text,Text)] -> CallbackM Select mkSelect pw choices = addWidget pw (\i -> return (Select i choices, SelectState "")) -- Get the value contained in the select field. getValue :: Select -> CallbackM Text getValue w = do ms <- getWidgetState w case ms of Nothing -> return "" Just s -> return $ selectValue s -- Set the value contained in the select field. setValue :: Select -> Text -> CallbackM () setValue w v = setWidgetState w (SelectState v) -- Register a callback for the OnChange event. onChange :: Select -> CallbackM () -> CallbackM () onChange s = onEvent (widgetSelector s) OnChange -- Change the set of choices to display. setChoices :: Select -> [(Text,Text)] -> CallbackM () setChoices w choices = setWidgetContents w $ do forM_ choices $ \(v,dv) -> H.option ! A.value (toValue v) $ toHtml dv