diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/dingo-example.cabal b/dingo-example.cabal new file mode 100644 --- /dev/null +++ b/dingo-example.cabal @@ -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 + +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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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] + } diff --git a/src/TownWidget.hs b/src/TownWidget.hs new file mode 100644 --- /dev/null +++ b/src/TownWidget.hs @@ -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