threepenny-gui 0.4.2.0 → 0.5.0.0

raw patch · 23 files changed

+1052/−193 lines, 23 filesdep +network-uridep ~aesondep ~textdep ~websocketsPVP ok

version bump matches the API change (PVP)

Dependencies added: network-uri

Dependency ranges changed: aeson, text, websockets, websockets-snap

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• README.md +64/−0
• samples/Paths.hs +6/−1
• samples/README.md +28/−0
• samples/Tidings.hs +0/−37
• src/Foreign/Coupon.hs +1/−1
• src/Graphics/UI/Threepenny.hs +11/−11
• src/Graphics/UI/Threepenny/Attributes.hs +12/−12
• src/Graphics/UI/Threepenny/Canvas.hs +246/−4
• src/Graphics/UI/Threepenny/Core.hs +40/−11
• src/Graphics/UI/Threepenny/Elements.hs +6/−6
• src/Graphics/UI/Threepenny/Internal/Driver.hs +31/−27
• src/Graphics/UI/Threepenny/Internal/FFI.hs +14/−2
• src/Graphics/UI/Threepenny/Internal/Resources.hs +1/−1
• src/Graphics/UI/Threepenny/Internal/Types.hs +14/−15
• src/Graphics/UI/Threepenny/JQuery.hs +11/−21
• src/Graphics/UI/Threepenny/SVG.hs +18/−0
• src/Graphics/UI/Threepenny/SVG/Attributes.hs +360/−0
• src/Graphics/UI/Threepenny/SVG/Elements.hs +124/−0
• src/Graphics/UI/Threepenny/Widgets.hs +1/−2
• src/Graphics/UI/driver.js +33/−35
• src/Reactive/Threepenny.hs +4/−0
• threepenny-gui.cabal +18/−7

@@ -1,5 +1,14 @@ ## Changelog for the `threepenny-gui` package +**0.5.0.0** -- Snapshot release.++* Possibility to specify IP address to bind the server to.+* FFI now supports callbacks into Haskell. Remove `callDeferredFunction` function.+* `Graphics.UI.Threepenny.Canvas.SVG` for creating SVG elements and attributes.+* 2D graphics API in `Graphics.UI.Threepenny.Canvas` is beginning to grow.+* `Bool` is now correctly marshalled to JavaScript.+* `Text` can now be marshalled to JavaScrtip.+ **0.4.2.0** -- Maintenance release.  * Dependency `bytestring >=0.9.2` is now implemented correctly.

@@ -0,0 +1,64 @@+[![Build Status](https://travis-ci.org/HeinrichApfelmus/threepenny-gui.png)](https://travis-ci.org/HeinrichApfelmus/threepenny-gui)++Threepenny-gui is a GUI framework written in Haskell that uses the web browser as a display. It's very easy to install. See the++  [**Project homepage**](http://www.haskell.org/haskellwiki/Threepenny-gui)++for more information on what it does and can do for you as a library user.++## Examples++The library comes with many examples, which can be found in the [samples](https://github.com/HeinrichApfelmus/threepenny-gui/blob/master/samples/) folder. Follow the link for more information on how to run them.++## Technical overview++### Latency++The frequent communication between browser and server+means that Threepenny is best used as a GUI server running on localhost.++The communication is done over a persistent connection using WebSockets.++If you want to reduce latency, the best option is to generate JavaScript+code and run it on the client. Consider this approach similar to [a+shading language.](http://en.wikipedia.org/wiki/Shading_language). Some means of producing JavaScript from Haskell might be:++* Fay+* HJScript+* GHCJS+* UHC++Alternatively, the JS can be written by the user directly and invoked via the JavaScript FFI from Threepenny.++## Future ideas++### HTML rendering mode++It might be nice in the case of search engines to merely generate a DOM and render it, so that search engines can read the pages.++### UI libraries++[qooxdoo](http://qooxdoo.org/demo) — provides a feature-complete widget set. One could wrap this in a type-safe API from Threepenny and get a complete, stable UI framework for free. Most of the "immediate feedback" like dragging things here, switching tabs there, are taken care of by the framework. All that would be left would be to provide the domain configuration and business/presentation logic.++There are plenty more like this, but this is the first that springs to+mind that is good.++## Contributors++Many thanks to everyone who contributed, provided feedback or simply wrote an application using Threepenny!++* *Heinrich Apfelmus*+* *Daniel Austin*+* Daniel Díaz+* Yuval Langer+* *Ken Friis Larsen*+* *Daniel Mlot*+* JP Moresmau+* Luke Palmer+* Jens Petersen+* rnons+* Michael Snoyman+* *Steve Bigham*+* tailcalled++Special thanks to *Chris Done* for starting the precursor project Ji.

@@ -4,12 +4,17 @@ import Control.Monad import System.FilePath -#if CABAL+#if defined(CABAL) -- using cabal import qualified Paths_threepenny_gui (getDataDir)  getStaticDir :: IO FilePath getStaticDir = (</> "wwwroot") `liftM` Paths_threepenny_gui.getDataDir++#elif defined(FPCOMPLETE)++getStaticDir :: IO FilePath+getStaticDir = return "wwwroot"  #else -- using GHCi

@@ -0,0 +1,28 @@+## Examples++This folder contains the code examples for the Threepenny-GUI library.++Run run the examples, use the provided `runhaskell` and `ghci` scripts:++    cd samples+    ./runhaskell Chat.hs++The scripts take care of setting up the necessary paths. However, they assume that you have set up a *[cabal sandbox][] in the project root folder*.++  [cabal sandbox]: http://coldwa.st/e/blog/2013-08-20-Cabal-sandbox.html++Here a description of the currently maintained examples. The others are probably experimental or bitrotted.++* [BarTab.hs](BarTab.hs) — Dynamic creation of widgets.+* [Buttons.hs](Buttons.hs) — Simple buttons to click on.+* [Chat.hs](Chat.hs) — Multi-user chat.+* [CRUD.hs](CRUD.hs) — A CRUD example showcasing functional reactice programming (FRP).+* [CurrencyConverter.hs](CurrencyConverter.hs) — Simple demonstration of two reactive input elements.+* [DragNDropExample.hs](DragNDropExample.hs) — Simple drag'N'drop demo.+* [DrumMachine.hs](DrumMachine.hs) — Specify rhythm by activating and deactivating checkboxes.+* [FadeInFadeOut.hs](FadeInFadeOut.hs) — Calling Haskell functions from the browser.+* [MissingDollars.hs](MissingDollars.hs) — Text with configurable values.+* [Mouse.hs](Mouse.hs) — Test of the `mousemove` event.+* [Pie.hs](Pie.hs) — Draws a pie chart using the HTML 5 canvas element.+* [Svg.hs](Svg.hs) — Test of the SVG elements.+* [UseWords.hs](UseWords.hs)  — Text with configurable words. (Apologies for the male-centric story.)

@@ -1,37 +0,0 @@-module Tidings (-    -- * Synopsis-    -- The 'Tidings' data type for composing user events.-    ---    -- See <http://apfelmus.nfshost.com/blog/2012/03/29-frp-three-principles-bidirectional-gui.html>-    -- for more information.-    -    -- * Documentation-    Tidings, tidings, facts, rumors,-    ) where--import Reactive.Threepenny---- | Data type representing a behavior 'facts'--- and suggestions to change it 'rumors'.-data Tidings a = T { facts :: Behavior a, rumors :: Event a }---- | Smart constructor. Combine facts and rumors into 'Tidings'.-tidings :: Behavior a -> Event a -> Tidings a-tidings b e = T b e--instance Functor Tidings where-    fmap f (T b e) = T (fmap f b) (fmap f e)---- | The applicative instance combines 'rumors'--- and uses 'facts' when some of the 'rumors' are not available.-instance Applicative Tidings where-    pure x  = T (pure x) never-    f <*> x = uncurry ($) <$> pair f x--pair :: Tidings a -> Tidings b -> Tidings (a,b)-pair (T bx ex) (T by ey) = T b e-    where-    b = (,) <$> bx <*> by-    x = flip (,) <$> by <@> ex-    y = (,) <$> bx <@> ey-    e = unionWith (\(x,_) (_,y) -> (x,y)) x y

@@ -36,7 +36,7 @@ mkWeakIORefValue r@(GHC.IORef (GHC.STRef r#)) v f = GHC.IO $ \s ->   case GHC.mkWeak# r# v f s of (# s1, w #) -> (# s1, GHC.Weak w #) -#if CABAL+#if defined(CABAL) || defined(FPCOMPLETE) #if MIN_VERSION_base(4,6,0) #else atomicModifyIORef' = atomicModifyIORef

@@ -4,7 +4,7 @@      -- * Example     -- $example-    +     -- * Modules     module Graphics.UI.Threepenny.Attributes,     module Graphics.UI.Threepenny.Core,@@ -17,15 +17,15 @@     module Graphics.UI.Threepenny.Widgets,     ) where -import Graphics.UI.Threepenny.Attributes-import Graphics.UI.Threepenny.Core-import Graphics.UI.Threepenny.Canvas-import Graphics.UI.Threepenny.DragNDrop-import Graphics.UI.Threepenny.Elements-import Graphics.UI.Threepenny.Events-import Graphics.UI.Threepenny.JQuery-import Graphics.UI.Threepenny.Timer-import Graphics.UI.Threepenny.Widgets+import           Graphics.UI.Threepenny.Attributes+import           Graphics.UI.Threepenny.Canvas+import           Graphics.UI.Threepenny.Core+import           Graphics.UI.Threepenny.DragNDrop+import           Graphics.UI.Threepenny.Elements+import           Graphics.UI.Threepenny.Events+import           Graphics.UI.Threepenny.JQuery+import           Graphics.UI.Threepenny.Timer+import           Graphics.UI.Threepenny.Widgets  {- $intro @@ -79,7 +79,7 @@  Then create a button element ->     button <- UI.button # set UI.text "Click me!s"+>     button <- UI.button # set UI.text "Click me!"  DOM elements can be accessed much in the same way they are accessed from JavaScript; they can be searched, updated, moved and

@@ -1,10 +1,10 @@ module Graphics.UI.Threepenny.Attributes (     -- * Synopsis     -- | Element attributes.-    +     -- * Input elements     checked, selection, enabled,-    +     -- * HTML attributes     action, align, alink, alt, altcode, archive,     background, base, bgcolor, border, bordercolor,@@ -15,37 +15,37 @@     name, nohref, noresize, noshade, nowrap,     rel, rev, rows, rowspan, rules,     scrolling, selected, shape, size, src,-    target, text_, type_, usemap, valign, version, vlink, vspace, width,+    target, text_, title__, type_, usemap, valign, version, vlink, vspace, width,     ) where -import qualified Data.Aeson       as JSON-import Graphics.UI.Threepenny.Core+import qualified Data.Aeson                  as JSON+import           Graphics.UI.Threepenny.Core  {-----------------------------------------------------------------------------     Attributes ------------------------------------------------------------------------------} -- | The @checked@ status of an input element of type checkbox. checked :: Attr Element Bool-checked = fromProp "checked" (== JSON.Bool True) JSON.Bool+checked = fromJQueryProp "checked" (== JSON.Bool True) JSON.Bool  -- | The @enabled@ status of an input element enabled :: Attr Element Bool-enabled = fromProp "disabled" (== JSON.Bool False) (JSON.Bool . not)+enabled = fromJQueryProp "disabled" (== JSON.Bool False) (JSON.Bool . not)  -- | Index of the currently selected option of a @<select>@ element. -- -- The index starts at @0@. -- If no option is selected, then the selection is 'Nothing'. selection :: Attr Element (Maybe Int)-selection = fromProp "selectedIndex" from (JSON.toJSON . maybe (-1) id)+selection = fromJQueryProp "selectedIndex" from (JSON.toJSON . maybe (-1) id)     where-    from s = let JSON.Success x = JSON.fromJSON s in +    from s = let JSON.Success x = JSON.fromJSON s in         if x == -1 then Nothing else Just x   {-----------------------------------------------------------------------------     HTML atributes-    +     Taken from the HTML library (BSD3 license)     http://hackage.haskell.org/package/html ------------------------------------------------------------------------------}@@ -60,7 +60,7 @@     where     f True  = "1"     f False = "0"-    + action              =   strAttr "action" align               =   strAttr "align" alink               =   strAttr "alink"@@ -118,7 +118,7 @@ text_               =   strAttr "text" class_              =   strAttr "class" type_               =   strAttr "type"-title               =   strAttr "title"+title__             =   strAttr "title" -- ugly, but necessary to avoid conflicts with the window title and the title element usemap              =   strAttr "usemap" valign              =   strAttr "valign" version             =   strAttr "version"

@@ -1,28 +1,270 @@ module Graphics.UI.Threepenny.Canvas (     -- * Synopsis     -- | Partial binding to the HTML5 canvas API.-    +     -- * Documentation-    Canvas,-    Vector, drawImage, clearCanvas,+    Canvas+    , Vector, Point+    , Color(..), ColorStop, Gradient, FillStyle+    , drawImage, clearCanvas+    , solidColor, htmlColor+    , linearGradient, horizontalLinearGradient, verticalLinearGradient+    , fillRect, fillStyle, strokeStyle, lineWidth, textFont+    , TextAlign(..), textAlign+    , beginPath, moveTo, lineTo, closePath, arc, arc'+    , fill, stroke, fillText, strokeText     ) where +import Data.Char (toUpper)+import Data.List(intercalate)+import Numeric (showHex)+ import Graphics.UI.Threepenny.Core+import qualified Data.Aeson as JSON  {-----------------------------------------------------------------------------     Canvas ------------------------------------------------------------------------------} type Canvas = Element -type Vector = (Int,Int)+type Vector = Point+type Point  = (Double, Double)+data Color  = RGB  { red :: Int, green :: Int, blue :: Int }+            | RGBA { red :: Int, green :: Int, blue :: Int, alpha :: Double }+            deriving (Eq, Show) +type ColorStop = (Double,  Color)++data Gradient  +    -- | defines a linear gradient +    -- see <http://www.w3schools.com/tags/canvas_createlineargradient.asp> +    = LinearGradient +      { upperLeft  :: Vector -- ^ the left-upper point where the gradient should begin+      , gradWidth  :: Double -- ^ the width of the gradient+      , gradHeight :: Double -- ^ the height of the gradient+      , colorStops :: [ColorStop] -- ^ the gradients color stops+      } deriving (Show, Eq)++data FillStyle+    = SolidColor Color+    | HtmlColor String    -- Html representation of a color+    | Gradient Gradient+    deriving (Show, Eq) +++{-----------------------------------------------------------------------------+    Image drawing+------------------------------------------------------------------------------}+ -- | Draw the image of an image element onto the canvas at a specified position. drawImage :: Element -> Vector -> Canvas -> UI () drawImage image (x,y) canvas =     runFunction $ ffi "%1.getContext('2d').drawImage(%2,%3,%4)" canvas image x y +{-----------------------------------------------------------------------------+    Fill Styles+------------------------------------------------------------------------------}++-- | creates a solid-color fillstyle+solidColor :: Color -> FillStyle+solidColor rgb = SolidColor rgb++-- | Solid color represented as a HTML string.+htmlColor :: String -> FillStyle+htmlColor = HtmlColor++-- | creates a linear gradient fill style+linearGradient :: Point       -- ^ The upper-left coordinate of the gradient+               -> Double      -- ^ The width of the gradient+               -> Double      -- ^ The height of the gradient+               -> [ColorStop] -- ^ the color-stops for the gradient+               -> FillStyle+linearGradient (x0, y0) w h sts = Gradient $ LinearGradient (x0,y0) w h sts++-- | creates a simple horizontal gradient+horizontalLinearGradient:: Point  -- ^ The upper-left coordinate of the gradient+                        -> Double -- ^ The width of the gradient+                        -> Color  -- ^ The starting color of the gradient+                        -> Color  -- ^ The ending color of the gradient+                        -> FillStyle+horizontalLinearGradient pt w c0 c1 = linearGradient pt w 0 [(0, c0), (1, c1)]++-- | creates a simple vertical gradient+verticalLinearGradient:: Point  -- ^ The upper-left coordinate of the gradient+                      -> Double -- ^ The height of the gradient+                      -> Color  -- ^ The starting color of the gradient+                      -> Color  -- ^ The ending color of the gradient+                      -> FillStyle+verticalLinearGradient pt h c0 c1 = linearGradient pt 0 h [(0, c0), (1, c1)]++{-----------------------------------------------------------------------------+    general+------------------------------------------------------------------------------}+ -- | Clear the canvas clearCanvas :: Canvas -> UI () clearCanvas = runFunction . ffi "%1.getContext('2d').clear()"  +{-----------------------------------------------------------------------------+    fill primitives+------------------------------------------------------------------------------}+++-- | Draw a filled rectangle.+--+-- The 'fillStyle' attribute determines the color.+fillRect+    :: Point    -- ^ upper left corner+    -> Double   -- ^ width in pixels+    -> Double   -- ^ height in pixels+    -> Canvas -> UI ()+fillRect (x,y) w h canvas =+  runFunction $ ffi "%1.getContext('2d').fillRect(%2, %3, %4, %5)" canvas x y w h++-- | The Fillstyle to use inside shapes.+-- write-only as I could not find how to consistently read the fillstyle+fillStyle :: WriteAttr Canvas FillStyle+fillStyle = mkWriteAttr assignFillStyle++-- | sets the current fill style of the canvas context+assignFillStyle :: FillStyle -> Canvas -> UI ()+assignFillStyle (Gradient fs) canvas =+    runFunction $ ffi cmd canvas+        where cmd = "var ctx=%1.getContext('2d'); var grd=" ++ fsStr fs ++ cStops fs ++ "ctx.fillStyle=grd;"+              fsStr (LinearGradient (x0, y0) w h _) +                                                = "ctx.createLinearGradient(" ++ pStr [x0, y0, x0+w, y0+h] ++ ");"+              cStops (LinearGradient _ _ _ sts) = concatMap addStop sts+              addStop (p,c)                     = "grd.addColorStop(" ++ show p ++ ",'" ++ rgbString c ++ "');"+              pStr                              = intercalate "," . map show+assignFillStyle (SolidColor color) canvas =+    runFunction $ ffi "%1.getContext('2d').fillStyle=%2" canvas (rgbString color)+assignFillStyle (HtmlColor  color) canvas =+    runFunction $ ffi "%1.getContext('2d').fillStyle=%2" canvas color++-- | The color or style to use for the lines around shapes.+-- Default is @#000@ (black).+strokeStyle :: Attr Canvas String+strokeStyle = fromObjectProperty "getContext('2d').strokeStyle"++-- | The width of lines. Default is @1@.+lineWidth :: Attr Canvas Double+lineWidth = fromObjectProperty "getContext('2d').lineWidth"++-- | The font used for 'fillText' and 'strokeText'.+-- Default is @10px sans-serif@.+textFont :: Attr Canvas String+textFont = fromObjectProperty "getContext('2d').font"++data TextAlign = Start | End | LeftAligned | RightAligned | Center+               deriving (Eq, Show, Read)++aToS :: TextAlign -> String+aToS algn =+  case algn of+    Start -> "start"+    End -> "end"+    LeftAligned -> "left"+    RightAligned -> "right"+    Center -> "center"++sToA :: String -> TextAlign+sToA algn =+  case algn of+    "start" -> Start+    "end" -> End+    "left" -> LeftAligned+    "right" -> RightAligned+    "center" -> Center+    _ -> Start++-- | The alignment for 'fillText' and 'strokeText'. Default is 'Start'.+textAlign :: Attr Canvas TextAlign+textAlign = bimapAttr aToS sToA $ textAlignStr+    where+    textAlignStr :: Attr Canvas String+    textAlignStr = fromObjectProperty "getContext('2d').textAlign"++-- | Starts a new path by resetting the list of sub-paths.+-- Call this function when you want to create a new path.+beginPath :: Canvas -> UI()+beginPath = runFunction . ffi "%1.getContext('2d').beginPath()"++-- | Moves the starting point of a new subpath to the @(x,y)@ coordinate.+moveTo :: Point -> Canvas -> UI()+moveTo (x,y) canvas =+  runFunction $ ffi "%1.getContext('2d').moveTo(%2, %3)" canvas x y++-- | Connects the last point in the subpath to the @(x,y)@ coordinates+-- with a straight line.+lineTo :: Point -> Canvas -> UI()+lineTo (x,y) canvas =+  runFunction $ ffi "%1.getContext('2d').lineTo(%2, %3)" canvas x y++-- | Draw a straight line from the current point to the start of the+-- path. If the shape has already been closed or has only one point,+-- this function does nothing.+closePath :: Canvas -> UI()+closePath = runFunction . ffi "%1.getContext('2d').closePath()"++-- | Add a circular arc to the current path.+arc+    :: Point    -- ^ Center of the circle of which the arc is a part.+    -> Double   -- ^ Radius of the circle of which the arc is a part.+    -> Double   -- ^ Starting angle, in radians.+    -> Double   -- ^ Ending angle, in radians.+    -> Canvas -> UI ()+arc (x,y) radius startAngle endAngle canvas =+    runFunction $ ffi "%1.getContext('2d').arc(%2, %3, %4, %5, %6)"+        canvas x y radius startAngle endAngle++-- | Like 'arc', but with an extra argument that indicates whether+-- we go in counter-clockwise ('True') or clockwise ('False') direction.+arc' :: Point -> Double -> Double -> Double -> Bool -> Canvas -> UI ()+arc' (x,y) radius startAngle endAngle anti canvas =+    runFunction $ ffi "%1.getContext('2d').arc(%2, %3, %4, %5, %6, %7)"+        canvas x y radius startAngle endAngle anti++-- | Fills the subpaths with the current fill style.+fill :: Canvas -> UI ()+fill = runFunction . ffi "%1.getContext('2d').fill()"++-- | Strokes the subpaths with the current stroke style.+stroke :: Canvas -> UI ()+stroke = runFunction . ffi "%1.getContext('2d').stroke()"++-- | Render a text in solid color at a certain point on the canvas.+-- +-- The 'fillStyle' attribute determines the color.+-- The 'textFont' attribute determines the font used.+-- The 'textAlign' attributes determines the position of the text+-- relative to the point.+fillText :: String -> Point -> Canvas -> UI ()+fillText text (x,y) canvas =+  runFunction $ ffi "%1.getContext('2d').fillText(%2, %3, %4)" canvas text x y++-- | Render the outline of a text at a certain point on the canvas.+-- +-- The 'strokeStyle' attribute determines the color of the outline.+-- The 'textFont' attribute determines the font used.+-- The 'textAlign' attributes determines the position of the text+-- relative to the point.+strokeText :: String -> Point -> Canvas -> UI ()+strokeText text (x,y) canvas =+  runFunction $ ffi "%1.getContext('2d').strokeText(%2, %3, %4)" canvas text x y++{-----------------------------------------------------------------------------+    helper functions+------------------------------------------------------------------------------}++rgbString :: Color -> String+rgbString color =+  case color of+    (RGB r g b) -> "#" ++ sh r ++ sh g ++ sh b+    (RGBA r g b a) -> "rgba(" ++ show r ++ "," ++ show g ++ "," ++ show b ++ "," ++ show a ++ ")"+    where sh i  = pad . map toUpper $ showHex i ""+          pad s+            | length s  == 0 = "00"+            | length s  == 1 = '0' : s+            | length s  == 2 = s+            | otherwise      =  take 2 s

@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} {-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE FlexibleContexts #-} module Graphics.UI.Threepenny.Core (     -- * Synopsis     -- | Core functionality of the Threepenny GUI library.@@ -41,6 +42,7 @@     (#), (#.),     Attr, WriteAttr, ReadAttr, ReadWriteAttr(..),     set, sink, get, mkReadWriteAttr, mkWriteAttr, mkReadAttr,+    bimapAttr, fromObjectProperty,          -- * Widgets     Widget(..), element, widget,@@ -48,11 +50,13 @@     -- * JavaScript FFI     -- | Direct interface to JavaScript in the browser window.     debug,-    ToJS, FFI, ffi, JSFunction, runFunction, callFunction,-    callDeferredFunction, atomic,+    ToJS, FFI,+    JSFunction, ffi, runFunction, callFunction,+    HsFunction, ffiExport,+    atomic,          -- * Internal and oddball functions-    fromProp, toElement,+    fromJQueryProp, toElement,     audioPlay, audioStop,          ) where@@ -80,7 +84,7 @@ import qualified Graphics.UI.Threepenny.Internal.Driver  as Core import           Graphics.UI.Threepenny.Internal.Driver     ( getRequestLocation-    , callDeferredFunction, atomic, )+    , atomic, ) import           Graphics.UI.Threepenny.Internal.FFI import           Graphics.UI.Threepenny.Internal.Types   as Core     ( Window, Config, defaultConfig, Events, EventData@@ -343,6 +347,14 @@     window <- askWindow     liftIO $ Core.callFunction window fun +-- | Export the given Haskell function so that it can be called+-- from JavaScript code.+--+-- TODO: At the moment, the function is not garbage collected.+ffiExport :: IO () -> UI (HsFunction (IO ()))+ffiExport fun = do+    window <- askWindow+    liftIO $ Core.newHsFunction window fun  {-----------------------------------------------------------------------------     Oddball@@ -359,13 +371,6 @@ audioStop :: Element -> UI () audioStop el = runFunction $ ffi "prim_audio_stop(%1)" el --- Turn a jQuery property @.prop()@ into an attribute.-fromProp :: String -> (JSON.Value -> a) -> (a -> JSON.Value) -> Attr Element a-fromProp name from to = mkReadWriteAttr get set-    where-    set v el = runFunction $ ffi "$(%1).prop(%2,%3)" el name (to v)-    get   el = fmap from $ callFunction $ ffi "$(%1).prop(%2)" el name- {-----------------------------------------------------------------------------     Layout ------------------------------------------------------------------------------}@@ -495,6 +500,17 @@     , set' :: i -> x -> UI ()     } +instance Functor (ReadWriteAttr x i) where+    fmap f = bimapAttr id f++-- | Map input and output type of an attribute.+bimapAttr :: (i' -> i) -> (o -> o')+          -> ReadWriteAttr x i o -> ReadWriteAttr x i' o'+bimapAttr from to attr = attr+    { get' = fmap to . get' attr+    , set' = \i' -> set' attr (from i')+    }+ -- | Set value of an attribute in the 'UI' monad. -- Best used in conjunction with '#'. set :: ReadWriteAttr x i o -> i -> UI x -> UI x@@ -533,6 +549,19 @@ mkWriteAttr :: (i -> x -> UI ()) -> WriteAttr x i mkWriteAttr set = mkReadWriteAttr (\_ -> return ()) set +-- | Turn a jQuery property @.prop()@ into an attribute.+fromJQueryProp :: String -> (JSON.Value -> a) -> (a -> JSON.Value) -> Attr Element a+fromJQueryProp name from to = mkReadWriteAttr get set+    where+    set v el = runFunction $ ffi "$(%1).prop(%2,%3)" el name (to v)+    get   el = fmap from $ callFunction $ ffi "$(%1).prop(%2)" el name++-- | Turn a JavaScript object property @.prop = ...@ into an attribute.+fromObjectProperty :: (ToJS a, FFI (JSFunction a)) => String -> Attr Element a+fromObjectProperty name = mkReadWriteAttr get set+    where+    set v el = runFunction  $ ffi ("%1." ++ name ++ " = %2") el v    +    get   el = callFunction $ ffi ("%1." ++ name) el  {-----------------------------------------------------------------------------     Widget class

@@ -4,7 +4,7 @@     addStyleSheet,     -- text,     new,-    +     -- * Primitive HTML elements     address, a, anchor, applet, area, audio,     basefont, big, blockquote, body, bold, br, button,@@ -21,10 +21,10 @@     underline, variable, video,     ) where -import Control.Monad-import Control.Monad.Trans.Reader-import Prelude hiding (span,div,map)-import Graphics.UI.Threepenny.Core+import           Control.Monad+import           Control.Monad.Trans.Reader+import           Graphics.UI.Threepenny.Core+import           Prelude                     hiding (div, map, span)  {-----------------------------------------------------------------------------     Combinations@@ -52,7 +52,7 @@  {-----------------------------------------------------------------------------     Primitives-    +     Taken from the HTML library (BSD3 license)     http://hackage.haskell.org/package/html ------------------------------------------------------------------------------}

@@ -40,12 +40,12 @@      -- * Utilities   ,debug-  ,callDeferredFunction   ,atomic    -- * JavaScript FFI   ,ToJS, FFI, ffi, JSFunction   ,runFunction, callFunction+  ,newHsFunction      -- * Types   ,Window@@ -100,6 +100,19 @@ import qualified System.Mem  {-----------------------------------------------------------------------------+    Import #ifdefs+------------------------------------------------------------------------------}+#if defined(CABAL) || defined(FPCOMPLETE)+#if MIN_VERSION_bytestring(0,10,0)+fromStrictBS = LBS.fromStrict+#else+fromStrictBS = LBS.fromChunks . (:[])+#endif+#else+fromStrictBS = LBS.fromStrict+#endif++{-----------------------------------------------------------------------------     Server and and session management ------------------------------------------------------------------------------} newServerState :: IO ServerState@@ -114,10 +127,12 @@ serve Config{..} worker = do     env    <- getEnvironment     let portEnv = Safe.readMay =<< Prelude.lookup "PORT" env+    let addrEnv = Safe.readMay =<< Prelude.lookup "ADDR" env          server <- newServerState     _      <- forkIO $ custodian 30 (sSessions server)     let config = Snap.setPort      (maybe defaultPort id (tpPort `mplus` portEnv))+               $ Snap.setBind      (maybe defaultAddr id (tpAddr `mplus` addrEnv))                $ Snap.setErrorLog  (Snap.ConfigIoLog tpLog)                $ Snap.setAccessLog (Snap.ConfigIoLog tpLog)                $ Snap.defaultConfig@@ -225,9 +240,10 @@ -- | Respond to poll requests. poll :: Session -> Snap () poll Session{..} = do-    let setDisconnected = do-        now <- getCurrentTime-        modifyMVar_ sConnectedState (const (return (Disconnected now)))+    let+        setDisconnected = do+            now <- getCurrentTime+            modifyMVar_ sConnectedState (const (return (Disconnected now)))          instructions <- liftIO $ do         modifyMVar_ sConnectedState (const (return Connected))@@ -350,17 +366,6 @@ run (Session{..}) instruction =     writeChan sInstructions $!! instruction  -- see note [Instruction strictness] --- | Call the given function with the given continuation. Doesn't block.-callDeferredFunction-  :: Window                    -- ^ Browser window-  -> String                    -- ^ The function name.-  -> [String]                  -- ^ Parameters.-  -> ([Maybe String] -> IO ()) -- ^ The continuation to call if/when the function completes.-  -> IO ()-callDeferredFunction window fun params thunk = do-    closure <- newClosure window fun $ \(EventData xs) -> thunk xs-    run window $ CallDeferredFunction (closure,fun,params)- -- | Run the given JavaScript function and carry on. Doesn't block. -- -- The client window uses JavaScript's @eval()@ function to run the code.@@ -379,21 +384,20 @@                 Error   _ -> return Nothing             _ -> return Nothing - -- | Package a Haskell function such that it can be called from JavaScript.--- +-- -- At the moment, we implement this as an event handler that is--- attached to the @head@ element.-newClosure-    :: Window               -- ^ Browser window context-    -> String               -- ^ Function name (for debugging).-    -> (EventData -> IO ()) -- ^ Function to call-    -> IO Closure-newClosure window@(Session{..}) fun thunk = do+-- attached to the @head@ element. In particular, it is not garbage+-- collected as long as the head element is alive.+newHsFunction+    :: Window       -- ^ Browser window context+    -> IO ()        -- ^ Haskell function+    -> IO (HsFunction (IO ()))+newHsFunction window@(Session{..}) fun = do     cid <- modifyMVar sClosures $ \(x:xs) -> return (xs,x)-    let eventId = fun ++ "-" ++ show cid-    attachClosure sHeadElement eventId thunk-    return $ Closure (unprotectedGetElementId sHeadElement, eventId)+    let eventId = "callback-" ++ show cid+    attachClosure sHeadElement eventId (const $ fun)+    return $ HsFunction (unprotectedGetElementId sHeadElement) eventId   {-----------------------------------------------------------------------------

@@ -7,7 +7,7 @@     -- * Documentation     ffi,     FFI(..), ToJS(..),-    JSFunction,+    JSFunction, HsFunction,          showJSON,     @@ -22,6 +22,7 @@ import           Data.Functor import           Data.Maybe import           Data.String           (fromString)+import           Data.Text             (Text) import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Builder @@ -52,14 +53,21 @@     render :: a -> JSCode  instance ToJS String     where render   = render . JSON.String . fromString+instance ToJS Text       where render   = render . JSON.String+instance ToJS Float      where render   = JSCode . showJSON+instance ToJS Double     where render   = JSCode . showJSON instance ToJS Int        where render   = JSCode . show-instance ToJS Bool       where render b = JSCode $ if b then "false" else "true"+instance ToJS Bool       where render b = JSCode $ if b then "true" else "false" instance ToJS JSON.Value where render   = JSCode . showJSON -- TODO: ByteString instance may be wrong. Only needed for ElementId right now. instance ToJS ByteString where render   = JSCode . show instance ToJS ElementId  where     render (ElementId x) = apply "elidToElement(%1)" [render x] instance ToJS Element    where render = render . unprotectedGetElementId+-- Haskell function with no parameters+instance ToJS (HsFunction (IO ())) where+    render (HsFunction (ElementId elid) name) =+        apply "callback(%1,%2)" [render elid, render name]   -- | A JavaScript function with a given output type @a@.@@ -99,7 +107,11 @@  instance FFI (JSFunction ())          where fancy f = fromJSCode $ f [] instance FFI (JSFunction String)      where fancy   = mkResult "%1.toString()"+instance FFI (JSFunction Text)        where fancy   = mkResult "%1.toString()" instance FFI (JSFunction JSON.Value)  where fancy   = mkResult "%1"+instance FFI (JSFunction Int)         where fancy   = mkResult "%1"+instance FFI (JSFunction Double)      where fancy   = mkResult "%1"+instance FFI (JSFunction Float)       where fancy   = mkResult "%1" instance FFI (JSFunction [ElementId]) where fancy   = mkResult "elementsToElids(%1)"  -- FIXME: We need access to IO in order to turn a Coupon into an Element.

@@ -1,7 +1,7 @@ {-# LANGUAGE QuasiQuotes, CPP #-} module Graphics.UI.Threepenny.Internal.Resources where -import           Data.Text                               (Text)+import           Data.Text                                       (Text) import qualified Data.Text                               as Text import           Graphics.UI.Threepenny.Internal.Include 

@@ -141,16 +141,10 @@                          -- since when.   deriving (Show) ---- | An opaque reference to a closure that the event manager uses to---   trigger events signalled by the client.-data Closure = Closure (ElementId,EventId)-    deriving (Typeable,Data,Show)--instance NFData Closure where rnf (Closure x) = rnf x--instance ToJSON Closure where-    toJSON (Closure (x,y)) = toJSON [toJSON x, toJSON y]+-- | A Haskell value/function of type 'a',+-- presented in a form that can be called from JavaScript.+data HsFunction a = HsFunction ElementId EventId+    deriving (Typeable, Data, Show)   {-----------------------------------------------------------------------------@@ -169,6 +163,12 @@         -- @Nothing@ means that the port number is         -- read from the environment variable @PORT@.         -- Alternatively, port @8023@ is used if this variable is not set.+    , tpAddr       :: Maybe ByteString+        -- ^ Bind address.+        -- @Nothing@ means that the bind address is+        -- read from the environment variable @ADDR@.+        -- Alternatively, address @127.0.0.1@ is+        -- used if this variable is not set.     , tpCustomHTML :: Maybe FilePath         -- ^ Custom HTML file to replace the default one.     , tpStatic     :: Maybe FilePath@@ -180,6 +180,9 @@ defaultPort :: Int defaultPort = 8023 +defaultAddr :: ByteString+defaultAddr = "127.0.0.1"+ -- | Default configuration. -- -- Port from environment variable or @8023@,@@ -187,6 +190,7 @@ defaultConfig :: Config defaultConfig = Config     { tpPort       = Nothing+    , tpAddr       = Nothing     , tpCustomHTML = Nothing     , tpStatic     = Nothing     , tpLog        = \s -> BS.hPut stderr s >> BS.hPut stderr "\n"@@ -204,7 +208,6 @@   | GetValues [ElementId]   | RunJSFunction String   | CallJSFunction String-  | CallDeferredFunction (Closure,String,[String])   | Delete ElementId   deriving (Typeable,Data,Show) @@ -221,9 +224,6 @@                                        , "contents" .= x]     toJSON (CallJSFunction x) = object [ "tag" .= ("CallJSFunction" :: Text)                                        , "contents" .= x]-    toJSON (CallDeferredFunction (x,y,z))-                              = object [ "tag" .= ("CallDeferredFunction" :: Text)-                                       , "contents" .= [toJSON x, toJSON y, toJSON z]]     toJSON (Delete x)         = object [ "tag" .= ("Delete" :: Text)                                        , "contents" .= x] @@ -234,7 +234,6 @@     rnf (GetValues xs) = rnf xs     rnf (RunJSFunction  x) = rnf x     rnf (CallJSFunction x) = rnf x-    rnf (CallDeferredFunction x) = rnf x     rnf (Delete x)     = rnf x  -- | A signal (mostly events) that are sent from the client to the server.

@@ -2,13 +2,11 @@ module Graphics.UI.Threepenny.JQuery where  import Control.Arrow-import           Data.Aeson                 as JSON import Data.String import Data.Char import Data.Default import Data.Maybe import Graphics.UI.Threepenny.Core-import Graphics.UI.Threepenny.Internal.FFI    (showJSON) import qualified Graphics.UI.Threepenny.Internal.Driver as Core import qualified Graphics.UI.Threepenny.Internal.Types  as Core import Reactive.Threepenny@@ -17,29 +15,21 @@ data Easing = Swing | Linear   deriving (Eq,Enum,Show) -instance Default Easing where-  def = Linear---- | Animate property changes of a function.-animate :: Element -> [(String,String)] -> Int -> Easing -> IO () -> IO ()-animate el props duration easing complete =-    Core.withElement (toElement el) $ \elid window ->-        callDeferredFunction window-            "jquery_animate"-            [showJSON elid,showJSON propsJSON,show duration,map toLower (show easing)]-            (const complete)-    where-    propsJSON = JSON.object [fromString name .= val | (name,val) <- props]+instance Default Easing where def = Linear  -- | Fade in an element.-fadeIn :: Element -> Int -> Easing -> IO () -> IO ()-fadeIn el duration easing complete =-    animate el [("opacity","1")] duration easing complete+fadeIn :: Element -> Int -> Easing -> IO () -> UI ()+fadeIn el duration easing complete = do+    callback <- ffiExport complete+    runFunction $ ffi "$(%1).animate({opacity: 1}, %2 * 1, %3, %4)"+        el duration (map toLower (show easing)) callback  -- | Fade out an element.-fadeOut :: Element -> Int -> Easing -> IO () -> IO ()-fadeOut el duration easing complete =-    animate el [("opacity","0")] duration easing complete+fadeOut :: Element -> Int -> Easing -> IO () -> UI ()+fadeOut el duration easing complete = do+    callback <- ffiExport complete+    runFunction $ ffi "$(%1).animate({opacity: 0}, %2 * 1, %3, %4)"+        el duration (map toLower (show easing)) callback  -- | Do something on return. sendValue :: Element -> Event String

@@ -0,0 +1,18 @@+module Graphics.UI.Threepenny.SVG (+  -- * Synopsis+  -- | SVG elements and attributes.+  --+  -- It is recommended that you import this module qualified, i.e.+  --+  -- > import qualified Graphics.UI.Threepenny.SVG as SVG+  --+  -- Note that some SVG attributes and elements have the same name.+  -- In this case, only the most common of either has been imported.+  -- If you need the other version, you have to import the individual modules.+  +  module Graphics.UI.Threepenny.SVG.Attributes,+  module Graphics.UI.Threepenny.SVG.Elements+  ) where++import Graphics.UI.Threepenny.SVG.Attributes hiding (path, title, glyphRef)+import Graphics.UI.Threepenny.SVG.Elements   hiding (cursor, filter, mask, style)

@@ -0,0 +1,360 @@+module Graphics.UI.Threepenny.SVG.Attributes (+    -- * Synopsis+    -- | SVG attributes as defined by W3C, Scalable Vector Graphics (SVG) 1.1+    --   (Second Edition) Appendix M <http://www.w3.org/TR/2011/REC-SVG11-20110816/>.+    -- +    -- Whenever possible, the Haskell identifier for an attribute is the +    -- same as the attribute name. However, sometimes changes are necessary:+    --+    --     1. Hyphens @-@ are replaced by underscores @_@, e.g. 'stroke_width'.+    --+    --     2. An underscore is used whenever the attribute name conflicts with +    --       a reserved word in Haskell, e.g. 'class_'.+    +    -- * Regular attributes+    accent_height, accumulate, additive, alphabetic, amplitude,+    arabic_form, ascent, attributeName, attributeType, azimuth,+    baseFrequency, baseProfile, bbox, begin, bias, by,+    calcMode, cap_height, class_, clipPathUnits, contentScriptType,+    contentStyleType, cx, cy,+    d, descent, diffuseConstant, divisor, dur, dx, dy,+    edgeMode, elevation, end, exponent, externalResourcesRequired,+    filterRes, filterUnits, format, from, fx, fy,+    g1, g2, glyph_name, glyphRef, gradientTransform, gradientUnits,+    hanging, height, horiz_adv_x, horiz_origin_x, horiz_origin_y,+    id, ideographic, in_, in2, intercept,+    k, k1, k2, k3, k4, kernelMatrix, kernelUnitLength,+    keyPoints, keySplines, keyTimes,+    lang, lengthAdjust, limitingConeAngle, local,+    markerHeight, markerUnits, markerWidth, maskContentUnits, maskUnits,+    mathematical, max, media, method, min, mode,+    name, numOctaves,+    offset,+    onabort, onactivate, onbegin, onclick, onend, onerror, onfocusin, onfocusout,+    onload, onmousedown, onmousemove, onmouseout, onmouseover, onmouseup,+    onrepeat, onresize, onscroll, onunload, onzoom,+    operator, order, orient, orientation, origin,+    overline_position, overline_thickness,+    panose_1, path, pathLength, patternContentUnits,+    patternTransform, patternUnits, points, pointsAtX, pointsAtY, pointsAtZ,+    preserveAlpha, preserveAspectRatio, primitiveUnits,+    r, radius, refx, refy, rendering_intent, repeatCount, repeatDur,+    requiredExtensions, requiredFeatures, restart, result, rotate, rx, ry,+    scale, seed, slope, spacing, specularConstant, specularExponent, spreadMethod,+    startOffset, stdDeviation, stemh, stemv, stitchTiles,+    strikethrough_position, strikethrough_thickness,+    string, style, surfaceScale, systemLanguage,+    tableValues, target, targetX, targetY, textLength, title, to, transform, type_,+    u1, u2, underline_position, underline_thickness, unicode, unicode_range, units_per_em,+    v_alphabetic, v_hanging, v_ideographic, v_mathematical, values, version,+    vert_adv_y, vert_origin_x, vert_origin_y, viewBox, viewTarget,+    width, widths,+    x, x_height, x1, x2, xChannelSelector,+    xlink_actuate, xlink_arcrole, xlink_href, xlink_role, xlink_show, xlink_title, xlink_type,+    xml_base, xml_lang, xml_space,+    y, y1, y2, yChannelSelector,+    z, zoomAndPan,++    -- * Presentation attributes+    alignment_baseline, baseline_shift,+    clip_path, clip_rule, clip, color_interpolation_filters, color_interpolation,+    color_profile, color_rendering, color, cursor,+    direction, display, dominant_baseline,+    enable_background,+    fill_opacity, fill_rule, fill, filter, flood_color,flood_opacity,+    font_family, font_size_adjust, font_size, font_stretch, font_style, font_variant,+    font_weight,+    glyph_orientation_horizontal, glyph_orientation_vertical,+    image_rendering, kerning,+    letter_spacing, lighting_color,+    marker_end, marker_mid, marker_start, mask,+    opacity, overflow, pointer_events,+    shape_rendering, stop_color, stop_opacity,+    stroke_dasharray, stroke_dashoffset, stroke_linecap, stroke_linejoin,+    stroke_miterlimit, stroke_opacity, stroke_width, stroke,+    text_anchor, text_decoration, text_rendering,+    unicode_bidi, visibility, word_spacing, writing_mode+    ) where+++import           Graphics.UI.Threepenny.Core (Element, WriteAttr, attr,+                                              mkWriteAttr, set')+import           Prelude                     hiding (exponent, filter, id, max,+                                              min)++strAttr :: String -> WriteAttr Element String+strAttr n = mkWriteAttr (set' (attr n))++intAttr :: String -> WriteAttr Element Int+intAttr n = mkWriteAttr (set' (attr n) . show)++fltAttr :: String -> WriteAttr Element Float+fltAttr n = mkWriteAttr (set' (attr n) . show)++accent_height                =  fltAttr "accent-height"+accumulate                   =  strAttr "accumulate"+additive                     =  strAttr "additive"+alignment_baseline           =  strAttr "alignment-baseline"+alphabetic                   =  fltAttr "alphabetic"+amplitude                    =  fltAttr "amplitude"+arabic_form                  =  strAttr "arabic-form"+ascent                       =  fltAttr "ascent"+attributeName                =  strAttr "attributeName"+attributeType                =  strAttr "attributeType"+azimuth                      =  fltAttr "azimuth"+baseFrequency                =  strAttr "baseFrequency"+baseProfile                  =  strAttr "baseProfile"+baseline_shift               =  strAttr "baseline-shift"+bbox                         =  strAttr "bbox"+begin                        =  strAttr "begin"+bias                         =  fltAttr "bias"+by                           =  fltAttr "by"+calcMode                     =  strAttr "calcMode"+cap_height                   =  fltAttr "cap-height"+class_                       =  strAttr "class"+clip                         =  strAttr "clip"+clip_path                    =  strAttr "clip-path"+clip_rule                    =  strAttr "clip-rule"+clipPathUnits                =  strAttr "clipPathUnits"+color                        =  strAttr "color"+color_interpolation          =  strAttr "color-interpolation"+color_interpolation_filters  =  strAttr "color-interpolation-filters"+color_profile                =  strAttr "color-profile"+color_rendering              =  strAttr "color-rendering"+contentScriptType            =  strAttr "contentScriptType"+contentStyleType             =  strAttr "contentStyleType"+cursor                       =  strAttr "cursor"+cx                           =  strAttr "cx"+cy                           =  strAttr "cy"+d                            =  strAttr "d"+descent                      =  fltAttr "descent"+diffuseConstant              =  fltAttr "diffuseConstant"+direction                    =  strAttr "direction"+display                      =  strAttr "display"+divisor                      =  fltAttr "divisor"+dominant_baseline            =  strAttr "dominant-baseline"+dur                          =  strAttr "dur"+dx                           =  strAttr "dx"+dy                           =  strAttr "dy"+edgeMode                     =  strAttr "edgeMode"+elevation                    =  fltAttr "elevation"+enable_background            =  strAttr "enable-background"+end                          =  strAttr "end"+exponent                     =  fltAttr "exponent"+externalResourcesRequired    =  strAttr "externalResourcesRequired"+fill                         =  strAttr "fill"+fill_opacity                 =  strAttr "fill-opacity"+fill_rule                    =  strAttr "fill-rule"+filter                       =  strAttr "filter"+filterRes                    =  strAttr "filterRes"+filterUnits                  =  strAttr "filterUnits"+flood_color                  =  strAttr "flood-color"+flood_opacity                =  strAttr "flood-opacity"+font_family                  =  strAttr "font-family"+font_size                    =  strAttr "font-size"+font_size_adjust             =  strAttr "font-size-adjust"+font_stretch                 =  strAttr "font-stretch"+font_style                   =  strAttr "font-style"+font_variant                 =  strAttr "font-variant"+font_weight                  =  strAttr "font-weight"+format                       =  strAttr "format"+from                         =  fltAttr "from"+fx                           =  strAttr "fx"+fy                           =  strAttr "fy"+g1                           =  strAttr "g1"+g2                           =  strAttr "g2"+glyph_name                   =  strAttr "glyph-name"+glyph_orientation_horizontal =  strAttr "glyph-orientation-horizontal"+glyph_orientation_vertical   =  strAttr "glyph-orientation-vertical"+glyphRef                     =  strAttr "glyphRef"+gradientTransform            =  strAttr "gradientTransform"+gradientUnits                =  strAttr "gradientUnits"+hanging                      =  fltAttr "hanging"+height                       =  strAttr "height"+horiz_adv_x                  =  fltAttr "horiz-adv-x"+horiz_origin_x               =  fltAttr "horiz-origin-x"+horiz_origin_y               =  fltAttr "horiz-origin-y"+id                           =  strAttr "id"+ideographic                  =  fltAttr "ideographic"+image_rendering              =  strAttr "image-rendering"+in_                          =  strAttr "in"+in2                          =  strAttr "in2"+intercept                    =  fltAttr "intercept"+k                            =  fltAttr "k"+k1                           =  fltAttr "k1"+k2                           =  fltAttr "k2"+k3                           =  fltAttr "k3"+k4                           =  fltAttr "k4"+kernelMatrix                 =  strAttr "kernelMatrix"+kernelUnitLength             =  strAttr "kernelUnitLength"+kerning                      =  strAttr "kerning"+keyPoints                    =  strAttr "keyPoints"+keySplines                   =  strAttr "keySplines"+keyTimes                     =  strAttr "keyTimes"+lang                         =  strAttr "lang"+lengthAdjust                 =  strAttr "lengthAdjust"+letter_spacing               =  strAttr "letter-spacing"+lighting_color               =  strAttr "lighting-color"+limitingConeAngle            =  fltAttr "limitingConeAngle"+local                        =  strAttr "local"+marker_end                   =  strAttr "marker-end"+marker_mid                   =  strAttr "marker-mid"+marker_start                 =  strAttr "marker-start"+markerHeight                 =  strAttr "markerHeight"+markerUnits                  =  strAttr "markerUnits"+markerWidth                  =  strAttr "markerWidth"+mask                         =  strAttr "mask"+maskContentUnits             =  strAttr "maskContentUnits"+maskUnits                    =  strAttr "maskUnits"+mathematical                 =  fltAttr "mathematical"+max                          =  strAttr "max"+media                        =  strAttr "media"+method                       =  strAttr "method"+min                          =  strAttr "min"+mode                         =  strAttr "mode"+name                         =  strAttr "name"+numOctaves                   =  intAttr "numOctaves"+offset                       =  fltAttr "offset"+onabort                      =  strAttr "onabort"+onactivate                   =  strAttr "onactivate"+onbegin                      =  strAttr "onbegin"+onclick                      =  strAttr "onclick"+onend                        =  strAttr "onend"+onerror                      =  strAttr "onerror"+onfocusin                    =  strAttr "onfocusin"+onfocusout                   =  strAttr "onfocusout"+onload                       =  strAttr "onload"+onmousedown                  =  strAttr "onmousedown"+onmousemove                  =  strAttr "onmousemove"+onmouseout                   =  strAttr "onmouseout"+onmouseover                  =  strAttr "onmouseover"+onmouseup                    =  strAttr "onmouseup"+onrepeat                     =  strAttr "onrepeat"+onresize                     =  strAttr "onresize"+onscroll                     =  strAttr "onscroll"+onunload                     =  strAttr "onunload"+onzoom                       =  strAttr "onzoom"+opacity                      =  strAttr "opacity"+operator                     =  strAttr "operator"+order                        =  strAttr "order"+orient                       =  strAttr "orient"+orientation                  =  strAttr "orientation"+origin                       =  strAttr "origin"+overflow                     =  strAttr "overflow"+overline_position            =  fltAttr "overline-position"+overline_thickness           =  fltAttr "overline-thickness"+panose_1                     =  intAttr "panose-1"+path                         =  "path"+-- path                         =  strAttr "path"+pathLength                   =  fltAttr "pathLength"+patternContentUnits          =  strAttr "patternContentUnits"+patternTransform             =  strAttr "patternTransform"+patternUnits                 =  strAttr "patternUnits"+pointer_events               =  strAttr "pointer-events"+points                       =  strAttr "points"+pointsAtX                    =  fltAttr "pointsAtX"+pointsAtY                    =  fltAttr "pointsAtY"+pointsAtZ                    =  fltAttr "pointsAtZ"+preserveAlpha                =  strAttr "preserveAlpha"+preserveAspectRatio          =  strAttr "preserveAspectRatio"+primitiveUnits               =  strAttr "primitiveUnits"+r                            =  strAttr "r"+radius                       =  strAttr "radius"+refx                         =  strAttr "refx"+refy                         =  strAttr "refy"+rendering_intent             =  strAttr "rendering-intent"+repeatCount                  =  strAttr "repeatCount"+repeatDur                    =  strAttr "repeatDur"+requiredExtensions           =  strAttr "requiredExtensions"+requiredFeatures             =  strAttr "requiredFeatures"+restart                      =  strAttr "restart"+result                       =  strAttr "result"+rotate                       =  strAttr "rotate"+rx                           =  strAttr "rx"+ry                           =  strAttr "ry"+scale                        =  fltAttr "scale"+seed                         =  fltAttr "seed"+shape_rendering              =  strAttr "shape-rendering"+slope                        =  fltAttr "slope"+spacing                      =  strAttr "spacing"+specularConstant             =  fltAttr "specularConstant"+specularExponent             =  fltAttr "specularExponent"+spreadMethod                 =  strAttr "spreadMethod"+startOffset                  =  strAttr "startOffset"+stdDeviation                 =  strAttr "stdDeviation"+stemh                        =  fltAttr "stemh"+stemv                        =  fltAttr "stemv"+stitchTiles                  =  strAttr "stitchTiles"+stop_color                   =  strAttr "stop-color"+stop_opacity                 =  strAttr "stop-opacity"+strikethrough_position       =  fltAttr "strikethrough-position"+strikethrough_thickness      =  fltAttr "strikethrough-thickness"+string                       =  strAttr "string"+stroke                       =  strAttr "stroke"+stroke_dasharray             =  strAttr "stroke-dasharray"+stroke_dashoffset            =  strAttr "stroke-dashoffset"+stroke_linecap               =  strAttr "stroke-linecap"+stroke_linejoin              =  strAttr "stroke-linejoin"+stroke_miterlimit            =  strAttr "stroke-miterlimit"+stroke_opacity               =  strAttr "stroke-opacity"+stroke_width                 =  strAttr "stroke-width"+style                        =  strAttr "style"+surfaceScale                 =  fltAttr "surfaceScale"+systemLanguage               =  strAttr "systemLanguage"+tableValues                  =  strAttr "tableValues"+target                       =  strAttr "target"+targetX                      =  fltAttr "targetX"+targetY                      =  fltAttr "targetY"+text_anchor                  =  strAttr "text-anchor"+text_decoration              =  strAttr "text-decoration"+text_rendering               =  strAttr "text-rendering"+textLength                   =  strAttr "textLength"+title                        =  strAttr "title"+to                           =  fltAttr "to"+transform                    =  strAttr "transform"+type_                        =  strAttr "type"+u1                           =  strAttr "u1"+u2                           =  strAttr "u2"+underline_position           =  fltAttr "underline-position"+underline_thickness          =  fltAttr "underline-thickness"+unicode                      =  strAttr "unicode"+unicode_bidi                 =  strAttr "unicode-bidi"+unicode_range                =  strAttr "unicode-range"+units_per_em                 =  fltAttr "units-per-em"+v_alphabetic                 =  fltAttr "v-alphabetic"+v_hanging                    =  fltAttr "v-hanging"+v_ideographic                =  fltAttr "v-ideographic"+v_mathematical               =  fltAttr "v-mathematical"+values                       =  strAttr "values"+version                      =  fltAttr "version"+vert_adv_y                   =  fltAttr "vert-adv-y"+vert_origin_x                =  fltAttr "vert-origin-x"+vert_origin_y                =  fltAttr "vert-origin-y"+viewBox                      =  strAttr "viewBox"+viewTarget                   =  strAttr "viewTarget"+visibility                   =  strAttr "visibility"+width                        =  strAttr "width"+widths                       =  strAttr "widths"+word_spacing                 =  strAttr "word-spacing"+writing_mode                 =  strAttr "writing-mode"+x                            =  strAttr "x"+x_height                     =  fltAttr "x-height"+x1                           =  strAttr "x1"+x2                           =  strAttr "x2"+xChannelSelector             =  strAttr "xChannelSelector"+xlink_actuate                =  strAttr "xlink:actuate"+xlink_arcrole                =  strAttr "xlink:acrole"+xlink_href                   =  strAttr "xlink:href"+xlink_role                   =  strAttr "xlink:role"+xlink_show                   =  strAttr "xlink:show"+xlink_title                  =  strAttr "xlink:title"+xlink_type                   =  strAttr "xlink:type"+xml_base                     =  strAttr "xml:base"+xml_lang                     =  strAttr "xml:lang"+xml_space                    =  strAttr "xml:space"+y                            =  strAttr "y"+y1                           =  strAttr "y1"+y2                           =  strAttr "y2"+yChannelSelector             =  strAttr "yChannelSelector"+z                            =  fltAttr "z"+zoomAndPan                   =  strAttr "zoomAndPan"

@@ -0,0 +1,124 @@+module Graphics.UI.Threepenny.SVG.Elements (+    -- * Synopsis+    -- | SVG elements as defined by W3C, Scalable Vector Graphics (SVG) 1.1+    --   (Second Edition) Appendix M <http://www.w3.org/TR/2011/REC-SVG11-20110816/>.+    -- +    -- Whenever possible, the Haskell identifier for an element is the +    -- same as the attribute name. However, sometimes changes are necessary:+    --+    --     1. Hyphens @-@ are replaced by underscores @_@, e.g. 'font_face'.++    -- * SVG Elements+    a, altGlyph, altGlyphDef, altGlyphItem,+    animate, animateColor, animateMotion, animateTransform,+    circle, clipPath, colorProfile, cursor,+    defs, desc,+    ellipse,+    feBlend, feColorMatrix, feComponentTransfer, feComposite, feConvolveMatrix,+    feDiffuseLighting, feDisplacementMap, feDistantLight, feFlood,+    feFuncA, feFuncB, feFuncG, feFuncR,+    feGaussianBlur, feImage, feMerge, feMergeNode, feMorphology, feOffset,+    fePointLight, feSpecularLighting, feSpotLight, feTile, feTurbulence,+    filter, font,+    font_face, font_face_format, font_face_name, font_face_srv, font_face_uri,+    foreignObject,+    g, glyph, glyphRef,+    hkern,+    image,+    line, linearGradient,+    marker, mask, metadata, missing_glyph, mpath,+    path, pattern, polygon, polyline,+    radialGradient, rect,+    script, set, stop, style, svg, switch, symbol,+    text, textPath, title, tref, tspan,+    use,+    view, vkern,+    ) where++import Prelude ()+import Graphics.UI.Threepenny.Core (mkElement)+++tag    = mkElement+itag   = mkElement++a                     =  tag "svg:a"+altGlyph              =  tag "svg:altGlyph"+altGlyphDef           = itag "svg:altGlyphDef"+altGlyphItem          = itag "svg:altGlyphItem"+animate               =  tag "svg:animate"+animateColor          =  tag "svg:animateColor"+animateMotion         =  tag "svg:animateMotion"+animateTransform      = itag "svg:animateTransform"+circle                = itag "svg:circle"+clipPath              =  tag "svg:clipPath"+colorProfile          = itag "svg:colorProfile"+cursor                = itag "svg:cursor"+defs                  =  tag "svg:defs"+desc                  = itag "svg:desc"+ellipse               =  tag "svg:ellipse"+feBlend               =  tag "svg:feBlend"+feColorMatrix         =  tag "svg:feColorMatrix"+feComponentTransfer   =  tag "svg:feComponentTransfer"+feComposite           =  tag "svg:feComposite"+feConvolveMatrix      =  tag "svg:feConvolveMatrix"+feDiffuseLighting     =  tag "svg:feDiffuseLighting"+feDisplacementMap     =  tag "svg:feDisplacementMap"+feDistantLight        = itag "svg:feDistantLight"+feFlood               =  tag "svg:feFlood"+feFuncA               = itag "svg:feFuncA"+feFuncB               = itag "svg:feFuncB"+feFuncG               = itag "svg:feFuncG"+feFuncR               = itag "svg:feFuncR"+feGaussianBlur        =  tag "svg:feGaussianBlur"+feImage               =  tag "svg:feImage"+feMerge               =  tag "svg:feMerge"+feMergeNode           = itag "svg:feMergeNode"+feMorphology          =  tag "svg:feMorphology"+feOffset              =  tag "svg:feOffset"+fePointLight          = itag "svg:fePointLight"+feSpecularLighting    =  tag "svg:feSpecularLighting"+feSpotLight           = itag "svg:feSpotLight"+feTile                =  tag "svg:feTile"+feTurbulence          =  tag "svg:feTurbulence"+filter                =  tag "svg:filter"+font                  =  tag "svg:font"+font_face             = itag "svg:font-face"+font_face_format      = itag "svg:font-face-format"+font_face_name        = itag "svg:font-face-name"+font_face_srv         = itag "svg:font-face-src"+font_face_uri         = itag "svg:font-face-uri"+foreignObject         =  tag "svg:foreignObject"+g                     =  tag "svg:g"+glyph                 =  tag "svg:glyph"+glyphRef              =  tag "svg:glyphRef"+hkern                 = itag "svg:hkern"+image                 =  tag "svg:image"+line                  =  tag "svg:line"+linearGradient        =  tag "svg:linearGradient"+marker                =  tag "svg:marker"+mask                  =  tag "svg:mask"+metadata              = itag "svg:metadata"+missing_glyph         =  tag "svg:missing-glyph"+mpath                 = itag "svg:mpath"+path                  = itag "svg:path"+pattern               =  tag "svg:pattern"+polygon               =  tag "svg:polygon"+polyline              =  tag "svg:polyline"+radialGradient        =  tag "svg:radialGradient"+rect                  =  tag "svg:rect"+script                = itag "svg:script"+set                   = itag "svg:set"+stop                  =  tag "svg:stop"+style                 = itag "svg:style"+svg                   =  tag "svg:svg"+switch                =  tag "svg:switch"+symbol                =  tag "svg:symbol"+text                  =  tag "svg:text"+textPath              =  tag "svg:textPath"+title                 = itag "svg:title"+tref                  =  tag "svg:tref"+tspan                 =  tag "svg:tspan"+use                   =  tag "svg:use"+view                  = itag "svg:view"+vkern                 = itag "svg:vkern"

@@ -6,8 +6,7 @@     -- with functional reactive programming (FRP).     --      -- For more details and information on how to write your own widgets, see the-    -- <https://github.com/HeinrichApfelmus/threepenny-gui/blob/master/doc/design-widgets.md-    -- widget design guide>.+    -- <https://github.com/HeinrichApfelmus/threepenny-gui/blob/master/doc/design-widgets.md widget design guide>.          -- * Tidings     Tidings, rumors, facts, tidings,

@@ -203,24 +203,14 @@     // reply();      -- Continue without replying to the server.     // reply(value); -- Send  value  back to the server.     // sendEvent     -- Function that sends a message { Event : value } to the server.-  +    +    // FIXME: allow non-zero parameters for the callback function.+    function callback(elid,name) {+      return function() { sendEvent(elid,name,[]); };+    }+         console_log("Event: %s",JSON.stringify(event));     switch(event.tag){--    case "CallDeferredFunction": {-      // FIXME: CallDeferredFunction probably doesn't work right now.-      var call        = event.contents;-      var closure     = call[0];-      var theFunction = eval(call[1]);-      var params      = call[2];-      theFunction.apply(window, params.concat(function(){-        console_log(this);-        var args = Array.prototype.slice.call(arguments,0);-        sendEvent(closure[0],closure[1],args);-      }));-      reply();-      break;-    }     case "RunJSFunction": {         eval(event.contents);         reply();@@ -314,19 +304,35 @@       return document.body;     else if(elid == 'head')       return document.head;-    else if(el_table[elid])-      return el_table[elid];+    else if(elid[0] == '*')+      return newElement(elid);+    else+      throw "Unknown element: " + elid;+  }++  // Function to leverage the DOM2 createElementNS() function that creates DOM+  // elements based on tags defined in HTML 5 namespaces. Elements/elids are cached+  // and returned if subsequently requested. Current implementation supports only +  // HTML and SVG namespaces.+  // TODO: Opportunity to support all HTML 5 namespaces, +  //         http://www.w3.org/TR/2011/WD-html5-20110113/namespaces.html+  function newElement(elid) {+    var create = elid.split(':');+    if( create[1] == "svg"){+      ns    = "http://www.w3.org/2000/svg";+      tag   = create[2];+      elid_ = create[0] + ":" + create[2];+    }     else {-      if(elid[0] == '*'){-        var create = elid.split(':');-        var element = document.createElement(create[1]);-        element.elid   = elid;-        el_table[elid] = element;-        return element;-      } else {-        throw "Unknown element: " + elid;-      }+      ns    = "http://www.w3.org/1999/xhtml";+      tag   = create[1];+      elid_ = elid;     }+    if(el_table[elid_]) return el_table[elid_];+    element         = document.createElementNS(ns, tag);+    element.elid    = elid_;+    el_table[elid_] = element;+    return element;   }     // Get/generate a elid for an element.  This function is used for cases in which the@@ -370,14 +376,6 @@   ////////////////////////////////////////////////////////////////////////////////   // FFI - additional primitive functions   -  window.jquery_animate = function(el_id,props,duration,easing,complete){-    var el = elidToElement(JSON.parse(el_id));-    $(el).animate(JSON.parse(props),-                  duration * 1,-                  easing * 1,-                  complete);-  }-   window.jquery_scrollToBottom = function(el){     $(el).scrollTop(el.scrollHeight);   };

@@ -341,6 +341,10 @@  {-----------------------------------------------------------------------------     Tidings++    Data type for combining user events.+    See <http://apfelmus.nfshost.com/blog/2012/03/29-frp-three-principles-bidirectional-gui.html>+    for more information. ------------------------------------------------------------------------------} -- | Data type representing a behavior ('facts') -- and suggestions to change it ('rumors').

@@ -1,5 +1,5 @@ Name:                threepenny-gui-Version:             0.4.2.0+Version:             0.5.0.0 Synopsis:            GUI framework that uses the web browser as a display. Description:     Threepenny-GUI is a GUI framework that uses the web browser as a display.@@ -30,6 +30,8 @@ Cabal-version:       >=1.8  Extra-Source-Files:  CHANGELOG.md+                    ,README.md+                    ,samples/README.md                     ,src/Graphics/UI/*.html                     ,src/Graphics/UI/*.js                     ,src/Graphics/UI/*.css@@ -46,6 +48,10 @@     description: Build example executables.     default:     False +flag network-uri+    description: Get Network.URI from the network-uri package+    default:     True+ flag rebug     description: The library uses some techniques that are highly                  non-deterministic, for example garbage collection and concurrency.@@ -69,6 +75,9 @@                     ,Graphics.UI.Threepenny.Elements                     ,Graphics.UI.Threepenny.Events                     ,Graphics.UI.Threepenny.JQuery+                    ,Graphics.UI.Threepenny.SVG+                    ,Graphics.UI.Threepenny.SVG.Attributes+                    ,Graphics.UI.Threepenny.SVG.Elements                      ,Graphics.UI.Threepenny.Timer                     ,Graphics.UI.Threepenny.Widgets                     ,Reactive.Threepenny@@ -92,7 +101,7 @@       cpp-options:  -DREBUG       ghc-options:  -O2      build-depends:     base                   >= 4     && < 5-                    ,aeson                  >= 0.6   && < 0.8+                    ,aeson                  >= 0.6   && < 0.9                     ,attoparsec-enumerator  == 0.3.*                     ,bytestring             >= 0.9.2 && < 0.11                     ,containers             >= 0.4.2 && < 0.6@@ -101,20 +110,23 @@                     ,filepath               == 1.3.*                     ,hashable               >= 1.1.0  && < 1.3                     ,MonadCatchIO-transformers == 0.3.*-                    ,network                >= 2.3.0  && < 2.6                     ,safe                   == 0.3.*                     ,snap-server            == 0.9.*                     ,snap-core              == 0.9.*                     ,stm                    >= 2.3    && < 2.5                     ,template-haskell       >= 2.7.0  && < 2.10-                    ,text                   >= 0.11   && < 1.2+                    ,text                   >= 0.11   && < 1.3                     ,time                   == 1.4.*                     ,transformers           >= 0.3.0  && < 0.5                     ,unordered-containers   == 0.2.*                     ,utf8-string            == 0.3.*-                    ,websockets             == 0.8.*-                    ,websockets-snap        == 0.8.*+                    ,websockets             >= 0.8    && < 0.10+                    ,websockets-snap        >= 0.8    && < 0.10                     ,vault                  == 0.3.*+  if flag(network-uri)+      build-depends: network-uri            >= 2.6    && < 2.7+  else+      build-depends: network                >= 2.3.0  && < 2.6                      Executable threepenny-examples-bartab     if flag(buildExamples)@@ -163,7 +175,6 @@     else         buildable: False     main-is:           CRUD.hs-    other-modules:     Tidings     hs-source-dirs:    samples  Executable threepenny-examples-currencyconverter