dingo-example (empty) → 0.0.3.4
raw patch · 5 files changed
+228/−0 lines, 5 filesdep +aesondep +basedep +blaze-htmlsetup-changed
Dependencies added: aeson, base, blaze-html, bytestring, dingo-core, dingo-widgets, fclabels, shakespeare-js, template-haskell, text, transformers
Files
- LICENSE +19/−0
- Setup.lhs +4/−0
- dingo-example.cabal +34/−0
- src/Main.hs +81/−0
- src/TownWidget.hs +90/−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-example.cabal view
@@ -0,0 +1,34 @@+Name: dingo-example+Version: 0.0.3.4+Synopsis: Dingo Example+Description: Example application for the Dingo Rich Internet Application platform.+License: MIT+License-file: LICENSE+Category: Web+Cabal-version: >=1.6.0.1+Build-type: Simple+Author: Bardur Arantsson+Maintainer: Bardur Arantsson <bardur@scientician.net>++Executable dingo-example+ Build-Depends: base == 4.*+ , aeson >= 0.3.2.12 && <0.4+ , bytestring >= 0.9.0.1+ , blaze-html >= 0.4.1.6 && < 0.5+ , dingo-core >= 0.0.3.4 && < 0.1+ , dingo-widgets >= 0.0.3.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+ GeneralizedNewtypeDeriving+ MultiParamTypeClasses+ OverloadedStrings+ QuasiQuotes+ TemplateHaskell+ ghc-options: -Wall -threaded+ hs-source-dirs: src+ Main-is: Main.hs+ Other-modules: TownWidget
+ src/Main.hs view
@@ -0,0 +1,81 @@+module Main where++import Control.Monad.IO.Class (MonadIO(..))+import Dingo.Event (Event(..))+import Dingo.Callback (CallbackM)+import Dingo.ResourceBundle.JqueryUI.Lightness (jqueryUIStyleResourceBundle)+import Dingo.Server (DingoSettings(..), defaultDingoSettings, runApplication)+import Dingo.Widget.Application+import Dingo.Widget.DataTables (mkTable, setTableData, onTableBodyEvent)+import qualified Dingo.Widget.Button as WB+import qualified Dingo.Widget.Input as WI+import qualified Dingo.Widget.Panel as WP+import qualified Dingo.Widget.Select as WS+import qualified TownWidget as TSW++-- Test application+app :: Application -> CallbackM ()+app pw = do++ panel <- WP.mkPanel pw++ -- Add a button widget.+ btn <- WB.mkButton panel "Click Me!"+ WB.onClick btn $ do+ liftIO $ putStrLn "Button was clicked!"+ setApplicationTitle pw "Hello, world!"+ -- Add select field.+ sel <- WS.mkSelect panel [ ("K1", "V1")+ , ("K2", "V2")+ ]+ WS.onChange sel $ do+ liftIO $ putStrLn "Select field changed!"+ WS.setValue sel "K1"+ liftIO $ putStrLn "Select field reset!"+ -- Add an input field.+ inp <- WI.mkInput panel+ WI.onChange inp $ do+ liftIO $ putStrLn "Input field changed!"+ v <- WI.getValue inp+ liftIO $ putStrLn $ "INPUT FIELD NEW VALUE: " ++ show v+ -- Reset the field value to something else.+ WI.setValue inp "CHANGED!"+ v' <- WI.getValue inp+ liftIO $ putStrLn $ "INPUT FIELD NEW VALUE*: " ++ show v'+ -- Also change selector.+ WS.setValue sel "K2"++ -- Add a little table.+ table <- mkTable panel ["Task", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"]+ [ ["Frob the Gib", "(0,0)", "(1,0)", "(2,0)", "(3,0)", "(4,0)", "(5,0)", "(6,0)" ]+ , ["Knead It", "(0,1)", "(1,1)", "(2,1)", "(3,1)", "(4,1)", "(5,1)", "(6,1)" ]+ , ["Empty Trash", "(0,2)", "(1,2)", "(2,2)", "(3,2)", "(4,2)", "(5,2)", "(6,2)" ]+ , ["Choose Knob", "(0,3)", "(1,3)", "(2,3)", "(3,3)", "(4,3)", "(5,3)", "(6,3)" ]+ , ["Frotz Nitz", "(0,4)", "(1,4)", "(2,4)", "(3,4)", "(4,4)", "(5,4)", "(6,4)"]+ ]++ onTableBodyEvent table OnDblClick $ liftIO $ putStrLn "CLICKED TABLE!"++ -- Add town selector widget.+ townSel <- TSW.mkTownWidget panel+ TSW.onChange townSel $ do+ liftIO $ putStrLn "TOWN SELECTOR CHANGE EVENT FIRED!"+ v <- TSW.getSelectedTown townSel+ liftIO $ putStrLn $ "TOWN: " ++ show v+ v' <- TSW.getSelectedCountry townSel+ liftIO $ putStrLn $ "COUNTRY: " ++ show v'+ -- Change a cell in the table.+ setTableData table (2,1) "Hello!"++ return ()++main :: IO ()+main = do+ putStrLn "Starting server"+ runApplication dingoSettings "Dingo Example App" app+ where+ dingoSettings =+ defaultDingoSettings+ { dsPort = 3000+ , dsResourceBundles = [jqueryUIStyleResourceBundle]+ }
+ src/TownWidget.hs view
@@ -0,0 +1,90 @@+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