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