dingo-example-0.0.3.4: src/TownWidget.hs

module TownWidget ( TownWidget
                  , mkTownWidget
                  , getSelectedCountry
                  , getSelectedTown
                  , onChange
                  ) where

import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON(..), ToJSON(..), Value(..))
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 Dingo.Widget.Panel as P
import qualified Dingo.Widget.Select as S
import qualified Text.Blaze.Html4.Strict as H
import qualified Text.Blaze.Html4.Strict.Attributes as A

-- Town Widget
data TownWidget = TownWidget { twId :: WidgetId
                             , twCountrySelect :: S.Select
                             , twTownSelect :: S.Select
                             , twPanel :: P.Panel
                             }
            deriving (Show, Typeable)

-- State associated with a town widget. The state
-- is contained in the sub-widgets, so we don't need anything here.
data TownWidgetState = TownWidgetState ()
                 deriving (Show, Typeable)

instance FromJSON TownWidgetState where
  parseJSON _ = return $ TownWidgetState ()

instance ToJSON TownWidgetState where
  toJSON (TownWidgetState _) = Null

-- TownWidget is a widget.
instance Widget TownWidget TownWidgetState where

  getWidgetId = twId

  renderWidget w =
    H.span ! A.id (toValue $ twId w) $ do
      renderWidget $ twPanel w

  showWidget w s =
    show w ++ "->" ++ show s

  encodeClientStateJs _ =
    [julius| null |]

  decodeClientStateJs _ =
    [julius| null |]

-- Make a new select.
mkTownWidget :: Widget w s => w -> CallbackM TownWidget
mkTownWidget pw =
  addWidget pw $ \i -> do
    panel <- P.mkPanel pw
    cs <- S.mkSelect panel [ ("Denmark", "DK")
                           , ("Germany", "DE") ]
    ts <- S.mkSelect panel [ ("Copenhagen", "CPH")
                           , ("Hamburg", "HBG") ]
    let tw = TownWidget i cs ts panel

    onEvent (widgetSelector ts) OnChange $ do
      liftIO $ putStrLn "Town select changed!"
      emitEvent tw OnChange
    onEvent (widgetSelector cs) OnChange $ do
      liftIO $ putStrLn "Country select changed!"
      S.setChoices ts [("Hello","Hello"),("World","World")]
      emitEvent tw OnChange
    -- Return the initial widget and state.
    return (tw, TownWidgetState ())

-- Register a callback for the OnChange event.
onChange :: TownWidget -> CallbackM () -> CallbackM ()
onChange w = onEvent (widgetSelector w) OnChange

-- Get the selected town.
getSelectedTown :: TownWidget -> CallbackM Text
getSelectedTown w = S.getValue $ twTownSelect w

-- Get the selected country
getSelectedCountry :: TownWidget -> CallbackM Text
getSelectedCountry w = S.getValue $ twCountrySelect w