dingo-widgets (empty) → 0.0.2
raw patch · 10 files changed
+449/−0 lines, 10 filesdep +aesondep +basedep +blaze-htmlsetup-changed
Dependencies added: aeson, base, blaze-html, bytestring, containers, dingo-core, fclabels, file-embed, shakespeare-js, template-haskell, text, transformers
Files
- LICENSE +19/−0
- Setup.lhs +4/−0
- dingo-widgets.cabal +39/−0
- src/Dingo/ResourceBundle/JqueryUI.hs +11/−0
- src/Dingo/ResourceBundle/JqueryUI/Lightness.hs +11/−0
- src/Dingo/Widget/Button.hs +69/−0
- src/Dingo/Widget/DataTables.hs +96/−0
- src/Dingo/Widget/Input.hs +71/−0
- src/Dingo/Widget/Panel.hs +47/−0
- src/Dingo/Widget/Select.hs +82/−0
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2011 Bardur Arantsson++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ dingo-widgets.cabal view
@@ -0,0 +1,39 @@+Name: dingo-widgets+Version: 0.0.2+Synopsis: Dingo Widgets+Description: This package contains a set of widgets for the Dingo Rich Internet Application platform.+License: MIT+License-file: LICENSE+Category: WWW+Cabal-version: >=1.6.0.1+Build-type: Simple+Author: Bardur Arantsson+Maintainer: Bardur Arantsson <bardur@scientician.net>++Library+ Build-Depends: base == 4.*+ , aeson == 0.3.*+ , bytestring >= 0.9.0.1+ , blaze-html >= 0.4.1.6 && < 0.5+ , containers >= 0.4+ , dingo-core >= 0 && < 0.1+ , file-embed >= 0.0.4 && < 0.1+ , fclabels == 1.0.*+ , shakespeare-js >= 0.10 && < 0.11+ , template-haskell+ , text == 0.11.*+ , transformers >= 0.2.2 && < 0.3+ Extensions: DeriveDataTypeable+ MultiParamTypeClasses+ OverloadedStrings+ QuasiQuotes+ TemplateHaskell+ ghc-options: -Wall+ hs-source-dirs: src+ Exposed-modules: Dingo.ResourceBundle.JqueryUI+ Dingo.ResourceBundle.JqueryUI.Lightness+ Dingo.Widget.Button+ Dingo.Widget.Input+ Dingo.Widget.Panel+ Dingo.Widget.Select+ Dingo.Widget.DataTables
+ src/Dingo/ResourceBundle/JqueryUI.hs view
@@ -0,0 +1,11 @@+module Dingo.ResourceBundle.JqueryUI+ ( jqueryUIResourceBundle+ ) where++import Dingo.ResourceBundle++jqueryUIDirectory :: ResourceDirectory+jqueryUIDirectory = $(embedDir "bundles/jquery-ui")++jqueryUIResourceBundle :: ResourceBundle+jqueryUIResourceBundle = makeResourceBundle jqueryUIDirectory
+ src/Dingo/ResourceBundle/JqueryUI/Lightness.hs view
@@ -0,0 +1,11 @@+module Dingo.ResourceBundle.JqueryUI.Lightness+ ( jqueryUIStyleResourceBundle+ ) where++import Dingo.ResourceBundle++resourceDirectory :: ResourceDirectory+resourceDirectory = $(embedDir "bundles/jquery-ui-css/lightness")++jqueryUIStyleResourceBundle :: ResourceBundle+jqueryUIStyleResourceBundle = makeResourceBundle resourceDirectory
+ src/Dingo/Widget/Button.hs view
@@ -0,0 +1,69 @@+module Dingo.Widget.Button ( Button+ , mkButton+ , getLabel+ , onClick+ , setLabel+ ) where++import Control.Monad (mzero)+import Data.Aeson (FromJSON(..), ToJSON(..), Value(..))+import Data.Monoid (mempty)+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++-- Button type.+data Button = Button { buttonId :: WidgetId+ }+ deriving (Show, Typeable)++-- Button state.+data ButtonState = ButtonState Text+ deriving (Show, Typeable)++instance FromJSON ButtonState where+ parseJSON (String s) = return $ ButtonState s+ parseJSON _ = mzero -- Failure++instance ToJSON ButtonState where+ toJSON (ButtonState s) = String s++-- Button is a widget.+instance Widget Button ButtonState where+ -- Get the widget ID.+ getWidgetId = buttonId+ -- Render button to HTML.+ renderWidget w =+ H.button ! A.id (toValue $ buttonId w) $ mempty+ -- Show button widget+ showWidget button state = show button ++ "->" ++ show state+ -- Client state handling.+ encodeClientStateJs _ =+ [julius| function () { return $(this).html(); } |]+ decodeClientStateJs _ =+ [julius| function (s) { $(this).html(s); } |]++-- Make a new button.+mkButton :: Widget w s => w -> Text -> CallbackM Button+mkButton pw l = addWidget pw (\i -> return (Button i, ButtonState l))++-- Register an OnClick handler.+onClick :: Button -> CallbackM () -> CallbackM ()+onClick btn = onEvent (widgetSelector btn) OnClick+++-- Get the label of the button.+getLabel :: Button -> CallbackM Text+getLabel w = fmap f (getWidgetState w)+ where f Nothing = ""+ f (Just (ButtonState l)) = l++-- Set the value contained in the input field.+setLabel :: Button -> Text -> CallbackM ()+setLabel w l = setWidgetState w (ButtonState l)
+ src/Dingo/Widget/DataTables.hs view
@@ -0,0 +1,96 @@+module Dingo.Widget.DataTables+ ( Table+ , mkTable+ , onTableBodyEvent+ , setTableData+ ) where++import Control.Monad (forM_)+import Data.Aeson (FromJSON(..), ToJSON(..), Value(..))+import Data.Text (Text)+import Data.Typeable (Typeable)+import Dingo.Callback+import Dingo.Event+import Dingo.ResourceBundle.JqueryUI (jqueryUIResourceBundle)+import Dingo.ResourceBundle.DataTables (dataTablesResourceBundle)+import Dingo.Selector+import Dingo.Widget+import Text.Blaze ((!), toValue, toHtml)+import Text.Julius (julius)+import qualified Text.Blaze.Html4.Strict as H+import qualified Text.Blaze.Html4.Strict.Attributes as A++-- Table type.+data Table = Table { tableId :: WidgetId+ , tableHeadings :: [Text]+ , tableData :: [[Text]]+ }+ deriving (Show, Typeable)++-- State associated with table widget.+data TableState = TableState ()+ deriving (Show, Typeable)++instance FromJSON TableState where+ parseJSON _ = return $ TableState ()++instance ToJSON TableState where+ toJSON (TableState ()) = Null++-- Table is a widget.+instance Widget Table TableState where+ -- Get the widget ID.+ getWidgetId = tableId+ -- Render table to HTML.+ renderWidget w =+ H.table ! A.id (toValue $ tableId w) $ do+ H.thead $ do+ H.tr $ do+ mapM_ (H.th ! A.width (toValue aWidth)) $ map toHtml $ tableHeadings w+ H.tbody $ do+ forM_ (tableData w) $ \rowData ->+ H.tr $ do+ mapM_ H.td $ map toHtml $ rowData+ where+ aWidth :: Int+ aWidth = 150+ -- Show widget.+ showWidget w s =+ show w ++ "->" ++ show s+ -- Client state handling.+ encodeClientStateJs _ =+ [julius| null |]+ decodeClientStateJs _ =+ [julius| null |]++ widgetResources _ =+ [ jqueryUIResourceBundle, dataTablesResourceBundle ]++-- Make a new table.+mkTable :: Widget w s => w -> [Text] -> [[Text]] -> CallbackM Table+mkTable pw headings data_ = do+ table <- addWidget pw (\i -> return (Table i headings data_, TableState ()))+ sendJavascript+ [julius| $(document).ready(function () {+ $('#i#{getWidgetId table}').dataTable({+ "bJQueryUI" : true,+ "sPaginationType" : "full_numbers"+ });+ }); |]+ return table++-- Change value in a table cell.+setTableData :: Table -> (Integer,Integer) -> Text -> CallbackM ()+setTableData table (row,col) data_ =+ sendJavascript+ [julius| $('#i#{getWidgetId table}').dataTable().fnUpdate('#{data_}', #{show row}, #{show col}); |]++-- Set up event handler.+onTableBodyEvent :: Table -> Event -> CallbackM () -> CallbackM ()+onTableBodyEvent table event callback =+ onEvent (tableRowsSelector table) event callback+ where+ tableRowsSelector :: Table -> Selector+ tableRowsSelector w =+ widgetSelector w .>*. element "tbody" .>*. element "tr"+
+ src/Dingo/Widget/Input.hs view
@@ -0,0 +1,71 @@+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
+ src/Dingo/Widget/Panel.hs view
@@ -0,0 +1,47 @@+module Dingo.Widget.Panel ( Panel+ , mkPanel+ ) where++import Data.Aeson (FromJSON(..), ToJSON(..), Value(..))+import Data.Monoid (mempty)+import Data.Typeable (Typeable)+import Dingo.Callback+import Dingo.Widget+import Text.Blaze ((!), toValue)+import Text.Julius (julius)+import qualified Data.Map as M+import qualified Text.Blaze.Html4.Strict as H+import qualified Text.Blaze.Html4.Strict.Attributes as A++-- Panel type.+data Panel =+ Panel { panelId :: WidgetId+ }+ deriving (Show, Typeable)++data PanelState = PanelState ()+ deriving (Show, Typeable)++instance FromJSON PanelState where+ parseJSON _ = return $ PanelState ()++instance ToJSON PanelState where+ toJSON (PanelState ()) = Object M.empty++-- Panel is a widget.+instance Widget Panel PanelState where+ -- Get the widget ID.+ getWidgetId = panelId+ -- Render panel to HTML.+ renderWidget w =+ H.div ! A.id (toValue $ panelId w) $ do+ mempty+ -- Show widget.+ showWidget w s = show w ++ "->" ++ show s+ -- Client state handling.+ encodeClientStateJs _ = [julius| null |]+ decodeClientStateJs _ = [julius| null |]++-- Make a new panel.+mkPanel :: Widget w s => w -> CallbackM Panel+mkPanel pw = addWidget pw (\i -> return (Panel i, PanelState ()))
+ src/Dingo/Widget/Select.hs view
@@ -0,0 +1,82 @@+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