Permalink
Browse files

Experimental bindings to the ji library.

  • Loading branch information...
1 parent 7ac5ebd commit 1019f14aa9901235ce0d7886f3519a9cb5e307b7 @HeinrichApfelmus committed Oct 31, 2012
@@ -0,0 +1 @@
+/dist/
View
@@ -0,0 +1,30 @@
+Copyright (c)2012, Heinrich Apfelmus
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Heinrich Apfelmus nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
@@ -0,0 +1,43 @@
+Name: reactive-banana-ji
+Version: 0.7.1.0
+Synopsis: Examples for the reactive-banana library, using ji.
+Description:
+ This library provides some GUI examples for the @reactive-banana@ library,
+ using ji and the web browser.
+Homepage: http://haskell.org/haskellwiki/Reactive-banana
+License: BSD3
+License-file: LICENSE
+Author: Heinrich Apfelmus
+Maintainer: Heinrich Apfelmus <apfelmus quantentunnel de>
+Category: FRP, GUI
+Cabal-version: >=1.8
+
+
+Build-type: Simple
+Extra-source-files: Makefile
+
+flag buildExamples
+ description: Build example executables
+ default: True
+
+Library
+ hs-source-dirs: src
+ build-depends: base >= 4.2 && < 5,
+ reactive-banana >= 0.7.1.0 && < 0.8,
+ ji == 0.1.*
+ extensions: ExistentialQuantification
+ exposed-modules: Reactive.Banana.Ji
+
+Source-repository head
+ type: git
+ location: git://github.com/HeinrichApfelmus/reactive-banana.git
+ subdir: reactive-banana-ji
+
+
+Executable reactive-banana-ji-CurrencyConverter
+ if flag(buildExamples)
+ build-depends: reactive-banana, base, ji
+ else
+ buildable: False
+ hs-source-dirs: src
+ main-is: CurrencyConverter.hs
@@ -0,0 +1,2 @@
+EXE=reactive-banana-ji-CurrencyConverter
+dist/build/$EXE/$EXE
@@ -0,0 +1,53 @@
+{-----------------------------------------------------------------------------
+ reactive-banana-ji
+
+ Example: Currency Converter
+------------------------------------------------------------------------------}
+{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t"
+{-# LANGUAGE RecursiveDo #-}
+
+import Data.Bits
+import Data.Maybe
+import Text.Printf
+
+import Graphics.UI.Ji
+import Reactive.Banana
+import Reactive.Banana.Ji
+
+{-----------------------------------------------------------------------------
+ Main
+------------------------------------------------------------------------------}
+main = serve Config
+ { jiPort = 10001
+ , jiRun = runJiIO
+ , jiWorker = setup >> handleEvents
+ , jiInitHTML = "CurrencyConverter.html"
+ , jiStatic = "wwwroot"
+ }
+
+
+setup = do
+ [dollar, euro] <- getElementsByTagName "input"
+
+ let networkDescription :: forall t. Frameworks t => Moment t ()
+ networkDescription = do
+
+ euroIn <- behaviorValue euro "0"
+ dollarIn <- behaviorValue dollar "0"
+
+ let rate = 0.7 :: Double
+ withString f s
+ = maybe "-" (printf "%.2f") . fmap f
+ $ listToMaybe [x | (x,"") <- reads s]
+
+ -- define output values in terms of input values
+ dollarOut, euroOut :: Behavior t String
+ dollarOut = withString (/ rate) <$> euroIn
+ euroOut = withString (* rate) <$> dollarIn
+
+ sinkValue euro euroOut
+ sinkValue dollar dollarOut
+
+ network <- compile networkDescription
+ actuate network
+
@@ -0,0 +1,72 @@
+{-----------------------------------------------------------------------------
+ reactive-banana-wx
+------------------------------------------------------------------------------}
+{-# LANGUAGE EmptyDataDecls, FlexibleInstances, Rank2Types #-}
+module Reactive.Banana.Ji (
+ -- * Synopsis
+ -- | Utility functions for interfacing with Ji.
+ --
+ -- Note: This is a prototype only.
+
+ -- * General
+ module Reactive.Banana.Frameworks,
+ runJiIO,
+
+ -- * Specific widgets
+ eventValue, behaviorValue, sinkValue,
+ ) where
+
+import Data.IORef
+import Control.Monad
+import System.IO.Unsafe
+
+import Reactive.Banana
+import Reactive.Banana.Frameworks
+
+import Graphics.UI.Ji
+
+{-----------------------------------------------------------------------------
+ Deal with the Ji monad
+------------------------------------------------------------------------------}
+sessionRef :: IORef (Session IO)
+sessionRef = unsafePerformIO $ newIORef undefined
+
+instance MonadJi IO where
+ askSession = readIORef sessionRef
+
+runJiIO :: Session IO -> IO a -> IO a
+runJiIO s m = writeIORef sessionRef s >> m
+
+{-----------------------------------------------------------------------------
+ Specific widgets
+------------------------------------------------------------------------------}
+-- | Event that occurs when the /user/ changed
+-- the text in text edit widget.
+eventValue :: Frameworks t =>
+ Element -> Moment t (Event t String)
+eventValue w = do
+ (addHandler, fire) <- liftIO $ newAddHandler
+ liftIO $ onKeyDown w $ \_ -> do
+ s <- getValue w
+ fire s
+ fromAddHandler addHandler
+
+onKeyDown = bind "keydown"
+
+-- | Behavior corresponding to user input the text field.
+behaviorValue :: Frameworks t =>
+ Element -> String -> Moment t (Behavior t String)
+behaviorValue w s = stepper s <$> eventValue w
+
+-- | Set the value of an input field.
+sinkValue :: Frameworks t =>
+ Element -> Behavior t String -> Moment t ()
+sinkValue w b = do
+ x <- initial b
+ e <- changes b
+ liftIOLater $ setValue w x
+ reactimate $ setValue w <$> e
+ where
+ setValue w x = setAttr "value" x w >> return ()
+
+
@@ -0,0 +1,17 @@
+<!doctype html>
+<head>
+ <title>Currency Converter</title>
+ <script src="static/js/jquery.js"></script>
+ <script src="static/js/jquery.cookie.js"></script>
+ <script src="static/js/x.js"></script>
+</head>
+<body>
+<form>
+<table>
+<tr><td>Dollar:<td><input type="text" name="dollar">
+<tr><td>Euro: <td><input type="text" name="euro">
+</table>
+Amount updates while typing.
+</form>
+</body>
+</html>
@@ -0,0 +1,56 @@
+/**
+ * jQuery Cookie plugin
+ *
+ * Copyright (c) 2010 Klaus Hartl (stilbuero.de)
+ * Dual licensed under the MIT and GPL licenses:
+ * http://www.opensource.org/licenses/mit-license.php
+ * http://www.gnu.org/licenses/gpl.html
+ *
+ */
+(function($) {
+ $.cookie = function(key, value, options) {
+
+ // key and at least value given, set cookie...
+ if (arguments.length > 1 && (!/Object/.test(Object.prototype.toString.call(value)) || value === null || value === undefined)) {
+ options = $.extend({}, options);
+
+ if (value === null || value === undefined) {
+ options.expires = -1;
+ }
+
+ if (typeof options.expires === 'number') {
+ var days = options.expires, t = options.expires = new Date();
+ t.setDate(t.getDate() + days);
+ }
+
+ value = String(value);
+
+ return (document.cookie = [
+ encodeURIComponent(key), '=', options.raw ? value : encodeURIComponent(value),
+ options.expires ? '; expires=' + options.expires.toUTCString() : '', // use expires attribute, max-age is not supported by IE
+ options.path ? '; path=' + options.path : '',
+ options.domain ? '; domain=' + options.domain : '',
+ options.secure ? '; secure' : ''
+ ].join(''));
+ }
+
+ // key and possibly options given, get cookie...
+ options = value || {};
+ var decode = options.raw ? function(s) { return s; } : decodeURIComponent;
+
+ var pairs = document.cookie.split('; ');
+ for (var i = 0, pair; pair = pairs[i] && pairs[i].split('='); i++) {
+ if (decode(pair[0]) === key) return decode(pair[1] || ''); // IE saves cookies with empty string as "c; ", e.g. without "=" as opposed to EOMB, thus pair[1] may be undefined
+ }
+ return null;
+ };
+
+ $.setSimpleCookie = function(name,value,f) {
+ $.cookie(name,value,{
+ path: '/',
+ expire: 999 // TODO:
+ });
+ f();
+ };
+
+})(jQuery);

Large diffs are not rendered by default.

Oops, something went wrong.
Oops, something went wrong.

0 comments on commit 1019f14

Please sign in to comment.