packages feed

react-flux (empty) → 0.9.0

raw patch · 34 files changed

+3984/−0 lines, 34 filesdep +aesondep +basedep +deepseqsetup-changedbinary-added

Dependencies added: aeson, base, deepseq, ghcjs-base, mtl, react-flux, text

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# 0.9.0++* Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, John Lenz++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 John Lenz 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.
+ README.md view
@@ -0,0 +1,66 @@+A GHCJS binding to [React](https://facebook.github.io/react/) based on the+[Flux](https://facebook.github.io/flux/) design.  The flux design pushes state and complicated logic+out of the view, allowing the rendering functions and event handlers to be pure Haskell functions.+When combined with React's composable components and the one-way flow of data, React, Flux, and+GHCJS work very well together.++# Docs++The [haddocks](https://hackage.haskell.org/package/react-flux) contain the documentation.++# Build++I am currently using the latest git version of GHCJS with GHC 7.10.2.  To compile and build, I use:++~~~+echo "compiler: ghcjs" > cabal.config+cabal configure+cabal build+~~~++# TODO Example Application++The source contains an [example TODO+application](https://bitbucket.org/wuzzeb/react-flux/src/tip/example/).++~~~+cabal configure -fexample+cabal build+cd example+make+firefox todo.html+~~~++If you don't have closure installed, you can open `example/todo-dev.html`.++# Test Suite++To run the test suite, first you must build both the example application and the test-client.  (The+test-client is a react-flux application which contains everything not contained in the todo+example.)++~~~+echo "compiler: ghcjs" > cabal.config+cabal configure -fexample -ftest-client+cabal build+cd example+make+~~~++The above builds the TODO application, compresses it with closure, and builds the test client.+Next, install [selenium-server-standalone](http://www.seleniumhq.org/download/) (also from+[npm](https://www.npmjs.com/package/selenium-server-standalone-jar)).  Then, build the+[hspec-webdriver](https://hackage.haskell.org/package/hspec-webdriver) test suite using GHC (not+GHCJS).  I use stack for this, although you can use cabal too if you like.++~~~+cd test/spec+stack build+~~~++Finally, start selenium-server-standalone and execute the test suite.  It must be started from the+`test/spec` directory, otherwise it does not find the correct javascript files.++~~~+.stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/react-flux-spec/react-flux-spec+~~~
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/Main.hs view
@@ -0,0 +1,7 @@+module Main where++import React.Flux+import TodoViews++main :: IO ()+main = reactRender "todoapp" todoApp ()
+ example/Makefile view
@@ -0,0 +1,13 @@+js-build/todo.min.js: js-build/todo.js+	closure --compilation_level=ADVANCED_OPTIMIZATIONS js-build/todo.js > js-build/todo.min.js++js-build/todo.js: ../dist/build/todo/todo.jsexe/all.js+	mkdir -p js-build+	echo "(function(global,React) {" > js-build/todo.js+	cat ../dist/build/todo/todo.jsexe/all.js >> js-build/todo.js+	echo "})(this, window['React']);" >> js-build/todo.js+	sed -i 's/goog.provide.*//' js-build/todo.js+	sed -i 's/goog.require.*//' js-build/todo.js++clean:+	rm -rf js-build
+ example/README.md view
@@ -0,0 +1,40 @@+This directory contains an example TODO application.  The design is copied pretty much exactly from the+[flux todo example](https://github.com/facebook/flux/tree/master/examples/flux-todomvc).  It uses+the same actions, same views, and produces the same DOM, so the design overview from the flux+repository covers this example application as well.++When reading the code for the example application, you should start with `TodoStore.hs`.  Next, look+at `TodoDispatcher.hs` and `TodoViews.hs`.  Finally, you can look at `TodoComponents.hs` and+`Main.hs`.++# Build++To build, you must pass the `-fexample` flag to cabal.++~~~+cabal configure -fexample+cabal build+~~~++The result of this build is a file `dist/build/todo/todo.jsexe/all.js`.  There is a file+`example/todo-dev.html` which loads this `all.js` file directly from the `dist` directory, so you+can open `todo-dev.html` after building.++But to deploy a react-flux application, you should minimize it since the size of `all.js` is 1.8+mebibytes.  To do so, there is a `Makefile` which calls closure.  So if you have closure installed+on your path, you can execute++~~~+cd example+make+~~~++This produces a file `js-build/todo.min.js` which is only 500 kibibytes which when compressed with+gzip is 124 kibibytes.++# Testing++Finally, you might be interested to look at+[test/spec/TodoSpec.hs](https://bitbucket.org/wuzzeb/react-flux/src/tip/test/spec/TodoSpec.hs) as it+contains an [hspec-webdriver](https://hackage.haskell.org/package/hspec-webdriver) spec for the TODO+example application.
+ example/TodoComponents.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++-- | The division between a view and a component is arbitrary, but for me components are pieces that+-- are re-used many times for different purposes.  In the TODO app, there is one component for the+-- text box.+module TodoComponents where++import Data.Typeable (Typeable)+import React.Flux++-- | The properties for the text input component.  Note how we can pass anything, including+-- functions, as the properties; the only requirement is an instance of Typeable.+data TextInputArgs = TextInputArgs {+      tiaId :: Maybe String+    , tiaClass :: String+    , tiaPlaceholder :: String+    , tiaOnSave :: String -> [SomeStoreAction]+    , tiaValue :: Maybe String+} deriving (Typeable)++-- | The text input stateful view.  The state is the text that has been typed into the textbox+-- but not yet saved.  The save is triggered either on enter or blur, which resets the state/content+-- of the text box to the empty string.+todoTextInput :: ReactView TextInputArgs+todoTextInput = defineStatefulView "todo text input" "" $ \curText args ->+    input_ $+        maybe [] (\i -> ["id" @= i]) (tiaId args)+        +++        [ "className" @= tiaClass args+        , "placeholder" @= tiaPlaceholder args+        , "value" @= curText -- using value here creates a controlled component: https://facebook.github.io/react/docs/forms.html+        , "autoFocus" @= True++        -- Update the current state with the current text in the textbox, sending no actions+        , onChange $ \evt _ -> ([], Just $ target evt "value")++        -- Produce the save action and reset the current state to the empty string+        , onBlur $ \_ _ curState ->+            if not (null curState)+                then (tiaOnSave args curState, Just "")+                else ([], Nothing)+        , onKeyDown $ \_ evt curState ->+             if keyCode evt == 13 && not (null curState) -- 13 is enter+                 then (tiaOnSave args curState, Just "")+                 else ([], Nothing)+        ]++-- | A combinator suitible for use inside rendering functions.+todoTextInput_ :: TextInputArgs -> ReactElementM eventHandler ()+todoTextInput_ args = view todoTextInput args mempty
+ example/TodoDispatcher.hs view
@@ -0,0 +1,7 @@+module TodoDispatcher (dispatchTodo) where++import React.Flux+import TodoStore++dispatchTodo :: TodoAction -> [SomeStoreAction]+dispatchTodo a = [SomeStoreAction todoStore a]
+ example/TodoStore.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE TypeFamilies, DeriveGeneric, DeriveAnyClass #-}+module TodoStore where++import React.Flux+import Control.DeepSeq+import GHC.Generics (Generic)+import Data.Typeable (Typeable)++data Todo = Todo {+    todoText :: String+  , todoComplete :: Bool+  , todoIsEditing :: Bool+} deriving (Show, Typeable)++newtype TodoState = TodoState {+    todoList :: [(Int, Todo)]+} deriving (Show, Typeable)++data TodoAction = TodoCreate String+                | TodoDelete Int+                | TodoEdit Int+                | UpdateText Int String+                | ToggleAllComplete+                | TodoSetComplete Int Bool+                | ClearCompletedTodos+  deriving (Show, Typeable, Generic, NFData)++instance StoreData TodoState where+    type StoreAction TodoState = TodoAction+    transform action (TodoState todos) = do+        putStrLn $ "Action: " ++ show action+        putStrLn $ "Initial todos: " ++ show todos++        -- Care is taken here to leave the Haskell object for the pair (Int, Todo) unchanged if the todo+        -- itself is unchanged.  This allows React to avoid re-rendering the todo when it does not change.+        -- For more, see the "Performance" section of the React.Flux haddocks.+        newTodos <- return $ case action of+            (TodoCreate txt) -> (maximum (map fst todos) + 1, Todo txt False False) : todos+            (TodoDelete i) -> filter ((/=i) . fst) todos+            (TodoEdit i) -> let f (idx, todo) | idx == i = (idx, todo { todoIsEditing = True })+                                f p = p+                             in map f todos+            (UpdateText newIdx newTxt) ->+                let f (idx, todo) | idx == newIdx = (idx, todo { todoText = newTxt, todoIsEditing = False })+                    f p = p+                 in map f todos+            ToggleAllComplete -> [ (idx, Todo txt True False) | (idx, Todo txt _ _) <- todos ]+            TodoSetComplete newIdx newComplete ->+                let f (idx, todo) | idx == newIdx = (idx, todo { todoComplete = newComplete })+                    f p = p+                 in map f todos+            ClearCompletedTodos -> filter (not . todoComplete . snd) todos++        putStrLn $ "New todos: " ++ show newTodos+        return $ TodoState newTodos++todoStore :: ReactStore TodoState+todoStore = mkStore $ TodoState+    [ (0, Todo "Learn react" True False)+    , (1, Todo "Learn react-flux" False False)+    ]
+ example/TodoViews.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedStrings #-}+-- | The views for the TODO app+module TodoViews where++import Control.Monad (when)+import React.Flux++import TodoDispatcher+import TodoStore+import TodoComponents++-- | The controller view and also the top level of the TODO app.  This controller view registers+-- with the store and will be re-rendered whenever the store changes.+todoApp :: ReactView ()+todoApp = defineControllerView "todo app" todoStore $ \todoState () ->+    div_ $ do+        todoHeader_+        mainSection_ todoState+        todoFooter_ todoState++-- | The TODO header as a React view with no properties.+todoHeader :: ReactView ()+todoHeader = defineView "header" $ \() ->+    header_ ["id" $= "header"] $ do+        h1_ "todos"+        todoTextInput_  TextInputArgs+          { tiaId = Just "new-todo"+          , tiaClass = "new-todo"+          , tiaPlaceholder = "What needs to be done?"+          , tiaOnSave = dispatchTodo . TodoCreate+          , tiaValue = Nothing+          }++-- | A combinator for the header suitable for use inside the 'todoApp' rendering function.+todoHeader_ :: ReactElementM eventHandler ()+todoHeader_ = view todoHeader () mempty++-- | A view that does not use a ReactView and is instead just a Haskell function.+-- Note how we use an underscore to signal that this is directly a combinator that can be used+-- inside the rendering function.+mainSection_ :: TodoState -> ReactElementM ViewEventHandler ()+mainSection_ st = section_ ["id" $= "main"] $ do+    input_ [ "id" $= "toggle-all"+           , "type" $= "checkbox"+           , "checked" $= if all (todoComplete . snd) $ todoList st then "checked" else ""+           , onChange $ \_ -> dispatchTodo ToggleAllComplete+           ]++    label_ [ "htmlFor" $= "toggle-all"] "Mark all as complete"+    ul_ [ "id" $= "todo-list" ] $ mapM_ todoItem_ $ todoList st++-- | A view for each todo item.  We specifically use a ReactView here to take advantage of the+-- ability for React to only re-render the todo items that have changed.  Care is taken in the+-- transform function of the store to not change the Haskell object for the pair (Int, Todo), and+-- in this case React will not re-render the todo item.  For more details, see the "Performance"+-- section of the React.Flux documentation.+todoItem :: ReactView (Int, Todo)+todoItem = defineView "todo item" $ \(todoIdx, todo) ->+    li_ [ "className" @= (unwords $ [ "completed" | todoComplete todo] ++ [ "editing" | todoIsEditing todo ])+        , "key" @= todoIdx+        ] $ do+        +        div_ [ "className" $= "view"] $ do+            input_ [ "className" $= "toggle"+                   , "type" $= "checkbox"+                   , "checked" @= todoComplete todo+                   , onChange $ \_ -> dispatchTodo $ TodoSetComplete todoIdx $ not $ todoComplete todo+                   ]++            label_ [ onDoubleClick $ \_ _ -> dispatchTodo $ TodoEdit todoIdx] $+                elemText $ todoText todo++            button_ [ "className" $= "destroy"+                    , onClick $ \_ _ -> dispatchTodo $ TodoDelete todoIdx+                    ] mempty++        when (todoIsEditing todo) $+            todoTextInput_ TextInputArgs+                { tiaId = Nothing+                , tiaClass = "edit"+                , tiaPlaceholder = ""+                , tiaOnSave = dispatchTodo . UpdateText todoIdx+                , tiaValue = Just $ todoText todo+                }++-- | A combinator for a todo item to use inside rendering functions+todoItem_ :: (Int, Todo) -> ReactElementM eventHandler ()+todoItem_ todo = viewWithKey todoItem (fst todo) todo mempty++-- | A view for the footer, taking the entire state as the properties.  This could alternatively+-- been modeled as a controller-view, attaching directly to the store.+todoFooter :: ReactView TodoState+todoFooter = defineView "footer" $ \(TodoState todos) ->+    let completed = length (filter (todoComplete . snd) todos)+        itemsLeft = length todos - completed+     in footer_ [ "id" $= "footer"] $ do++            span_ [ "id" $= "todo-count" ] $ do+                strong_ $ elemShow itemsLeft+                elemText $ if itemsLeft == 1 then " item left" else " items left"++            when (completed > 0) $ do+                button_ [ "id" $= "clear-completed"+                        , onClick $ \_ _ -> dispatchTodo ClearCompletedTodos+                        ] $+                    elemText $ "Clear completed (" ++ show completed ++ ")"++-- | A render combinator for the footer+todoFooter_ :: TodoState -> ReactElementM eventHandler ()+todoFooter_ s = view todoFooter s mempty
+ example/css/bg.png view

binary file changed (absent → 2126 bytes)

+ example/css/todo.css view
@@ -0,0 +1,564 @@+/* The following CSS was copied from the flux todo example:+ * https://github.com/facebook/flux/tree/master/examples+ */++html,+body {+	margin: 0;+	padding: 0;+}++button {+	margin: 0;+	padding: 0;+	border: 0;+	background: none;+	font-size: 100%;+	vertical-align: baseline;+	font-family: inherit;+	color: inherit;+	-webkit-appearance: none;+	-ms-appearance: none;+	-o-appearance: none;+	appearance: none;+}++body {+	font: 14px 'Helvetica Neue', Helvetica, Arial, sans-serif;+	line-height: 1.4em;+	background: #eaeaea url('bg.png');+	color: #4d4d4d;+	width: 550px;+	margin: 0 auto;+	-webkit-font-smoothing: antialiased;+	-moz-font-smoothing: antialiased;+	-ms-font-smoothing: antialiased;+	-o-font-smoothing: antialiased;+	font-smoothing: antialiased;+}++button,+input[type="checkbox"] {+  outline: none;+}++#todoapp {+	background: #fff;+	background: rgba(255, 255, 255, 0.9);+	margin: 130px 0 40px 0;+	border: 1px solid #ccc;+	position: relative;+	border-top-left-radius: 2px;+	border-top-right-radius: 2px;+	box-shadow: 0 2px 6px 0 rgba(0, 0, 0, 0.2),+				0 25px 50px 0 rgba(0, 0, 0, 0.15);+}++#todoapp:before {+	content: '';+	border-left: 1px solid #f5d6d6;+	border-right: 1px solid #f5d6d6;+	width: 2px;+	position: absolute;+	top: 0;+	left: 40px;+	height: 100%;+}++#todoapp input::-webkit-input-placeholder {+	font-style: italic;+}++#todoapp input::-moz-placeholder {+	font-style: italic;+	color: #a9a9a9;+}++#todoapp h1 {+	position: absolute;+	top: -120px;+	width: 100%;+	font-size: 70px;+	font-weight: bold;+	text-align: center;+	color: #b3b3b3;+	color: rgba(255, 255, 255, 0.3);+	text-shadow: -1px -1px rgba(0, 0, 0, 0.2);+	-webkit-text-rendering: optimizeLegibility;+	-moz-text-rendering: optimizeLegibility;+	-ms-text-rendering: optimizeLegibility;+	-o-text-rendering: optimizeLegibility;+	text-rendering: optimizeLegibility;+}++#header {+	padding-top: 15px;+	border-radius: inherit;+}++#header:before {+	content: '';+	position: absolute;+	top: 0;+	right: 0;+	left: 0;+	height: 15px;+	z-index: 2;+	border-bottom: 1px solid #6c615c;+	background: #8d7d77;+	background: -webkit-gradient(linear, left top, left bottom, from(rgba(132, 110, 100, 0.8)),to(rgba(101, 84, 76, 0.8)));+	background: -webkit-linear-gradient(top, rgba(132, 110, 100, 0.8), rgba(101, 84, 76, 0.8));+	background: linear-gradient(top, rgba(132, 110, 100, 0.8), rgba(101, 84, 76, 0.8));+	filter: progid:DXImageTransform.Microsoft.gradient(GradientType=0,StartColorStr='#9d8b83', EndColorStr='#847670');+	border-top-left-radius: 1px;+	border-top-right-radius: 1px;+}++#new-todo,+.edit {+	position: relative;+	margin: 0;+	width: 100%;+	font-size: 24px;+	font-family: inherit;+	line-height: 1.4em;+	border: 0;+	outline: none;+	color: inherit;+	padding: 6px;+	border: 1px solid #999;+	box-shadow: inset 0 -1px 5px 0 rgba(0, 0, 0, 0.2);+	-moz-box-sizing: border-box;+	-ms-box-sizing: border-box;+	-o-box-sizing: border-box;+	box-sizing: border-box;+	-webkit-font-smoothing: antialiased;+	-moz-font-smoothing: antialiased;+	-ms-font-smoothing: antialiased;+	-o-font-smoothing: antialiased;+	font-smoothing: antialiased;+}++#new-todo {+	padding: 16px 16px 16px 60px;+	border: none;+	background: rgba(0, 0, 0, 0.02);+	z-index: 2;+	box-shadow: none;+}++#main {+	position: relative;+	z-index: 2;+	border-top: 1px dotted #adadad;+}++label[for='toggle-all'] {+	display: none;+}++#toggle-all {+	position: absolute;+	top: -42px;+	left: -4px;+	width: 40px;+	text-align: center;+	/* Mobile Safari */+	border: none;+}++#toggle-all:before {+	content: '»';+	font-size: 28px;+	color: #d9d9d9;+	padding: 0 25px 7px;+}++#toggle-all:checked:before {+	color: #737373;+}++#todo-list {+	margin: 0;+	padding: 0;+	list-style: none;+}++#todo-list li {+	position: relative;+	font-size: 24px;+	border-bottom: 1px dotted #ccc;+}++#todo-list li:last-child {+	border-bottom: none;+}++#todo-list li.editing {+	border-bottom: none;+	padding: 0;+}++#todo-list li.editing .edit {+	display: block;+	width: 506px;+	padding: 13px 17px 12px 17px;+	margin: 0 0 0 43px;+}++#todo-list li.editing .view {+	display: none;+}++#todo-list li .toggle {+	text-align: center;+	width: 40px;+	/* auto, since non-WebKit browsers doesn't support input styling */+	height: auto;+	position: absolute;+	top: 0;+	bottom: 0;+	margin: auto 0;+	/* Mobile Safari */+	border: none;+	-webkit-appearance: none;+	-ms-appearance: none;+	-o-appearance: none;+	appearance: none;+}++#todo-list li .toggle:after {+	content: '✔';+	/* 40 + a couple of pixels visual adjustment */+	line-height: 43px;+	font-size: 20px;+	color: #d9d9d9;+	text-shadow: 0 -1px 0 #bfbfbf;+}++#todo-list li .toggle:checked:after {+	color: #85ada7;+	text-shadow: 0 1px 0 #669991;+	bottom: 1px;+	position: relative;+}++#todo-list li label {+	white-space: pre;+	word-break: break-word;+	padding: 15px 60px 15px 15px;+	margin-left: 45px;+	display: block;+	line-height: 1.2;+	-webkit-transition: color 0.4s;+	transition: color 0.4s;+}++#todo-list li.completed label {+	color: #a9a9a9;+	text-decoration: line-through;+}++#todo-list li .destroy {+	display: none;+	position: absolute;+	top: 0;+	right: 10px;+	bottom: 0;+	width: 40px;+	height: 40px;+	margin: auto 0;+	font-size: 22px;+	color: #a88a8a;+	-webkit-transition: all 0.2s;+	transition: all 0.2s;+}++#todo-list li .destroy:hover {+	text-shadow: 0 0 1px #000,+				 0 0 10px rgba(199, 107, 107, 0.8);+	-webkit-transform: scale(1.3);+	-ms-transform: scale(1.3);+	transform: scale(1.3);+}++#todo-list li .destroy:after {+	content: '✖';+}++#todo-list li:hover .destroy {+	display: block;+}++#todo-list li .edit {+	display: none;+}++#todo-list li.editing:last-child {+	margin-bottom: -1px;+}++#footer {+	color: #777;+	padding: 0 15px;+	position: absolute;+	right: 0;+	bottom: -31px;+	left: 0;+	height: 20px;+	z-index: 1;+	text-align: center;+}++#footer:before {+	content: '';+	position: absolute;+	right: 0;+	bottom: 31px;+	left: 0;+	height: 50px;+	z-index: -1;+	box-shadow: 0 1px 1px rgba(0, 0, 0, 0.3),+				0 6px 0 -3px rgba(255, 255, 255, 0.8),+				0 7px 1px -3px rgba(0, 0, 0, 0.3),+				0 43px 0 -6px rgba(255, 255, 255, 0.8),+				0 44px 2px -6px rgba(0, 0, 0, 0.2);+}++#todo-count {+	float: left;+	text-align: left;+}++#filters {+	margin: 0;+	padding: 0;+	list-style: none;+	position: absolute;+	right: 0;+	left: 0;+}++#filters li {+	display: inline;+}++#filters li a {+	color: #83756f;+	margin: 2px;+	text-decoration: none;+}++#filters li a.selected {+	font-weight: bold;+}++#clear-completed {+	float: right;+	position: relative;+	line-height: 20px;+	text-decoration: none;+	background: rgba(0, 0, 0, 0.1);+	font-size: 11px;+	padding: 0 10px;+	border-radius: 3px;+	box-shadow: 0 -1px 0 0 rgba(0, 0, 0, 0.2);+}++#clear-completed:hover {+	background: rgba(0, 0, 0, 0.15);+	box-shadow: 0 -1px 0 0 rgba(0, 0, 0, 0.3);+}++#info {+	margin: 65px auto 0;+	color: #a6a6a6;+	font-size: 12px;+	text-shadow: 0 1px 0 rgba(255, 255, 255, 0.7);+	text-align: center;+}++#info a {+	color: inherit;+}++/*+	Hack to remove background from Mobile Safari.+	Can't use it globally since it destroys checkboxes in Firefox and Opera+*/++@media screen and (-webkit-min-device-pixel-ratio:0) {+	#toggle-all,+	#todo-list li .toggle {+		background: none;+	}++	#todo-list li .toggle {+		height: 40px;+	}++	#toggle-all {+		top: -56px;+		left: -15px;+		width: 65px;+		height: 41px;+		-webkit-transform: rotate(90deg);+		-ms-transform: rotate(90deg);+		transform: rotate(90deg);+		-webkit-appearance: none;+		appearance: none;+	}+}++.hidden {+	display: none;+}++hr {+	margin: 20px 0;+	border: 0;+	border-top: 1px dashed #C5C5C5;+	border-bottom: 1px dashed #F7F7F7;+}++.learn a {+	font-weight: normal;+	text-decoration: none;+	color: #b83f45;+}++.learn a:hover {+	text-decoration: underline;+	color: #787e7e;+}++.learn h3,+.learn h4,+.learn h5 {+	margin: 10px 0;+	font-weight: 500;+	line-height: 1.2;+	color: #000;+}++.learn h3 {+	font-size: 24px;+}++.learn h4 {+	font-size: 18px;+}++.learn h5 {+	margin-bottom: 0;+	font-size: 14px;+}++.learn ul {+	padding: 0;+	margin: 0 0 30px 25px;+}++.learn li {+	line-height: 20px;+}++.learn p {+	font-size: 15px;+	font-weight: 300;+	line-height: 1.3;+	margin-top: 0;+	margin-bottom: 0;+}++.quote {+	border: none;+	margin: 20px 0 60px 0;+}++.quote p {+	font-style: italic;+}++.quote p:before {+	content: '“';+	font-size: 50px;+	opacity: .15;+	position: absolute;+	top: -20px;+	left: 3px;+}++.quote p:after {+	content: '”';+	font-size: 50px;+	opacity: .15;+	position: absolute;+	bottom: -42px;+	right: 3px;+}++.quote footer {+	position: absolute;+	bottom: -40px;+	right: 0;+}++.quote footer img {+	border-radius: 3px;+}++.quote footer a {+	margin-left: 5px;+	vertical-align: middle;+}++.speech-bubble {+	position: relative;+	padding: 10px;+	background: rgba(0, 0, 0, .04);+	border-radius: 5px;+}++.speech-bubble:after {+	content: '';+	position: absolute;+	top: 100%;+	right: 30px;+	border: 13px solid transparent;+	border-top-color: rgba(0, 0, 0, .04);+}++.learn-bar > .learn {+	position: absolute;+	width: 272px;+	top: 8px;+	left: -300px;+	padding: 10px;+	border-radius: 5px;+	background-color: rgba(255, 255, 255, .6);+	-webkit-transition-property: left;+	transition-property: left;+	-webkit-transition-duration: 500ms;+	transition-duration: 500ms;+}++@media (min-width: 899px) {+	.learn-bar {+		width: auto;+		margin: 0 0 0 300px;+	}++	.learn-bar > .learn {+		left: 8px;+	}++	.learn-bar #todoapp {+		width: 550px;+		margin: 130px auto 40px auto;+	}+}++#todo-list li .edit {+  display: inline;+}
+ example/todo-dev.html view
@@ -0,0 +1,13 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>Todo example</title>+        <link rel="stylesheet" href="css/todo.css"/>+    </head>+    <body>+        <section id="todoapp"/>+        <script src="https://fb.me/react-0.13.3.js"></script>+        <script src="../dist/build/todo/todo.jsexe/all.js"></script>+    </body>+</html>
+ example/todo.html view
@@ -0,0 +1,13 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>Todo example</title>+        <link rel="stylesheet" href="css/todo.css"/>+    </head>+    <body>+        <section id="todoapp"/>+        <script src="https://fb.me/react-0.13.3.js"></script>+        <script src="js-build/todo.min.js"></script>+    </body>+</html>
+ jsbits/export.js view
@@ -0,0 +1,14 @@+//Fake export until we start using the improved-base branch++var hsreact$export = function(x) {+    var o = {+        root: x,+        _key: ++h$extraRootsN+    };+    h$retain(o);+    return o;+};++var hsreact$derefExport = function(o) {+    return o.root;+};
+ jsbits/store.js view
@@ -0,0 +1,13 @@+/* As part of each store, we have a javascript object with two properties:++sdata: holds a value of type @Export storeData@ which is the current data for the store++views: an array of @setState@ functions for component views.  The component views+    add and remove from this property directly inside their lifecycle methods.+*/+function hsreact$transform_store(store, newData) {+    var oldD = store.sdata;+    store.sdata = newData;+    h$release(oldD);+    store.views.map(function(f) { f(store.sdata); });+}
+ jsbits/views.js view
@@ -0,0 +1,132 @@+/* jshint sub:true */++function hsreact$mk_class(name, renderCb, checkState, releaseState) {+    var cl = {+        'displayName': name,+        'componentWillReceiveProps': function() {+            h$release(this['props'].hs);+        },+        _updateAndReleaseState: function(s) {+            h$release(this['state'].hs);+            this['setState']({hs: s});+        },+        _updateState: function(s) {+            this['setState']({hs: s});+        },+        'componentWillUnmount': function() {+            this._currentCallbacks.map(h$release);+            h$release(this['props'].hs);+            if (releaseState) {+                h$release(this['state'].hs);+            }+        },+        'render': function() {+            var arg = {+                newCallbacks: [],+                elem:null+            };+            renderCb(this, arg);+            this._currentCallbacks.map(h$release);+            this._currentCallbacks = arg.newCallbacks;+            return arg.elem;+        },+        _currentCallbacks: []+    };+    if (checkState) {+        cl['shouldComponentUpdate'] = function(newProps, newState) {+            return this['props'].hs.root != newProps.hs.root || this['state'].hs.root != newState.hs.root;+        };+    } else {+        cl['shouldComponentUpdate'] = function(newProps, newState) {+            return this['props'].hs.root != newProps.hs.root;+        };+    }+    +    return cl;+}++function hsreact$mk_ctrl_view(name, store, renderCb) {+    var cl = hsreact$mk_class(name, renderCb, true, false);+    cl['getInitialState'] = function() {+        return {hs: store.sdata};+    };+    cl['componentDidMount'] = function() {+        store.views.push(this._updateState);+    };+    cl['componentWillUnmount'] = function() {+        var idx = store.views.indexOf(this._updateState);+        if (idx >= 0) { store.views.splice(idx, 1); }+        this._currentCallbacks.map(h$release);+        h$release(this['props'].hs);+    };+    return React['createClass'](cl);+}++function hsreact$mk_view(name, renderCb) {+    return React['createClass'](hsreact$mk_class(name, renderCb, false, false));+}++function hsreact$mk_stateful_view(name, initialState, renderCb) {+    var cl = hsreact$mk_class(name, renderCb, true, true);+    cl['getInitialState'] = function() {+        return { hs: initialState };+    };+    return React['createClass'](cl);+}++function hsreact$mk_lifecycle_view(name, initialState, renderCb,+            willMountCb, didMountCb, willRecvPropsCb, willUpdateCb, didUpdateCb, willUnmountCb) {+    var cl = hsreact$mk_class(name, renderCb, true, true);++    cl['getInitialState'] = function() {+        return { hs: initialState };+    };++    if (willMountCb) {+        cl['componentWillMount'] = function() {+            willMountCb(this);+        };+    }++    if (didMountCb) {+        cl['componentDidMount'] = function() {+            didMountCb(this);+        };+    }++    if (willRecvPropsCb) {+        cl['componentWillReceiveProps'] = function(newProps) {+            try {+                willRecvPropsCb(this, newProps.hs);+            } finally {+                h$release(this['props'].hs);+            }+        };+    }++    if (willUpdateCb) {+        cl['componentWillUpdate'] = function(nextProps, nextState) {+            willUpdateCb(this, {'props': nextProps, 'state': nextState});+        };+    }++    if (didUpdateCb) {+        cl['componentDidUpdate'] = function(oldProps, oldState) {+            didUpdateCb(this, {'props': oldProps, 'state': oldState});+        };+    }++    if (willUnmountCb) {+        cl['componentWillUnmount'] = function() {+            try {+                willUnmountCb(this);+            } finally {+                this._currentCallbacks.map(h$release);+                h$release(this['props'].hs);+                h$release(this['state'].hs);+            }+        };+    }++    return React['createClass'](cl);+}
+ react-flux.cabal view
@@ -0,0 +1,103 @@+name:                react-flux+version:             0.9.0+synopsis:            A binding to React based on the Flux application architecture for GHCJS+category:            Web+homepage:            https://bitbucket.org/wuzzeb/react-flux+license:             BSD3+license-file:        LICENSE+author:              John Lenz <wuzzeb@gmail.com>+maintainer:          John Lenz <wuzzeb@gmail.com>+build-type:          Simple+cabal-version:       >=1.10++extra-source-files:+    ChangeLog.md,+    README.md,+    example/README.md,+    example/css/todo.css,+    example/css/bg.png,+    example/Makefile,+    example/*.hs,+    example/*.html,+    test/client/test-client.html,+    test/spec/react-flux-spec.cabal,+    test/spec/Spec.hs,+    test/spec/stack.yaml,+    test/spec/TestClientSpec.hs,+    test/spec/TodoSpec.hs++source-repository head+    type: mercurial+    location: https://bitbucket.org/wuzzeb/react-flux++Flag example+    Description: Build the TODO example application+    Default: False++Flag test-client+    Description: Build the test client application+    Default: False++library+  hs-source-dirs:      src+  ghc-options: -Wall+  default-language: Haskell2010+  js-sources: jsbits/views.js jsbits/store.js jsbits/export.js++  exposed-modules: React.Flux+                   React.Flux.DOM+                   React.Flux.PropertiesAndEvents+                   React.Flux.Lifecycle+                   React.Flux.Internal++  other-modules: React.Flux.Views+                 React.Flux.Store+                 React.Flux.Export++  default-extensions: CPP+                      EmptyDataDecls+                      ExistentialQuantification+                      FlexibleContexts+                      FlexibleInstances+                      FunctionalDependencies+                      GeneralizedNewtypeDeriving+                      MultiParamTypeClasses+                      OverloadedStrings+                      ScopedTypeVariables+                      TypeFamilies++  build-depends: base >=4.8 && < 5+               , deepseq+               , mtl >= 2.1+               , aeson >= 0.8+               , text >= 1.2++  if impl(ghcjs)+      build-depends: ghcjs-base++executable todo+   if !flag(example)+        Buildable: False+   ghc-options: -Wall+   cpp-options: -DGHCJS_BROWSER++   default-language: Haskell2010+   hs-source-dirs: example+   main-is: Main.hs+   build-depends: base+                , react-flux+                , deepseq++executable test-client+   if !flag(test-client)+        Buildable: False+   ghc-options: -Wall+   cpp-options: -DGHCJS_BROWSER++   default-language: Haskell2010+   hs-source-dirs: test/client+   main-is: TestClient.hs+   build-depends: base+                , react-flux+   if impl(ghcjs)+      build-depends: ghcjs-base
+ src/React/Flux.hs view
@@ -0,0 +1,186 @@+-- | A binding to <https://facebook.github.io/react/index.html React> based on the+-- <https://facebook.github.io/flux/docs/overview.html Flux> design.  The flux design pushes state+-- and complicated logic out of the view, allowing the rendering functions and event handlers to be+-- pure Haskell functions.  When combined with React's composable components and the one-way flow of+-- data, React, Flux, and GHCJS work very well together.+--+-- __Prerequisites__: This module assumes you are familiar with the basics of React and Flux.  From+-- the <https://facebook.github.io/react/docs/tutorial.html React documentation>, you should read at+-- least \"Tutorial\", \"Displaying Data\", \"Multiple Components\", and \"Forms\".  Note that+-- instead of JSX we use a Writer monad, but it functions very similarly so the examples in the+-- React documentation are very similar to how you will write code using this module.  The other+-- React documentation you can skim, the Haddocks below link to specific sections of the React+-- documentation when needed.  Finally, you should read the+-- <https://facebook.github.io/flux/docs/overview.html Flux overview>, in particular the central+-- idea of one-way flow of data from actions to stores to views which produce actions.+--+-- __Organization__: Briefly, you should create one module to contain the dispatcher, one module for+-- each store, and modules for the view definitions.  These are then imported into a Main module,+-- which calls 'reactRender' and initializes any AJAX load calls to the backend. The source package+-- contains an example <https://bitbucket.org/wuzzeb/react-flux/src/tip/example/ TODO application>.+--+-- __Deployment__: Care has been taken to make sure closure with ADVANCED_OPTIMIZATIONS correctly+-- minimizes a react-flux application.  No externs are needed, instead all you need to do is provide+-- or protect the @React@ variable.  The TODO example does this as follows:+--+-- >(function(global, React) {+-- >contents of all.js+-- >})(this, window['React']);+--+-- __Testing__:  I use the following approach to test my react-flux application.  First, I use unit+-- testing to test the dispatcher and store 'transform' functions.  Since the dispatcher and the+-- store transform are just data manipulation, existing Haskell tools like hspec, QuickCheck,+-- SmallCheck, etc. work well.  Note that stores and 'dispatch' work in GHC and GHCJS, so this unit+-- testing can be done either in GHC or GHCJS. I don't do any unit testing of the views, because any+-- complicated logic in event handlers is moved into the dispatcher and the+-- rendering function is difficult to test in isolation.  Instead, I test the rendering via+-- end-2-end tests using <https://hackage.haskell.org/package/hspec-webdriver hspec-webdriver>.+-- This tests the React frontend against the real backend and hspec-webdriver has many utilities for+-- easily checking that the DOM is what you expect.  I have found this much easier than trying to+-- unit test each view individually, and you can still obtain the same coverage for equal effort.+-- The file <https://bitbucket.org/wuzzeb/react-flux/src/tip/test/spec/TodoSpec.hs test\/spec\/TodoSpec.hs>+-- in the source code contains a hspec-webdriver test for the TODO example application.++module React.Flux (+  -- * Dispatcher+  -- $dispatcher++  -- * Stores+    ReactStore+  , StoreData(..)+  , mkStore+  , getStoreData+  , alterStore+  , SomeStoreAction(..)+  , executeAction++  -- * Views+  , ReactView+  , defineControllerView+  , defineView+  , defineStatefulView+  , ViewEventHandler+  , StatefulViewEventHandler++  -- * Elements+  , ReactElement+  , ReactElementM(..)+  , elemText+  , elemShow+  , view+  , viewWithKey+  , ReactViewKey+  , childrenPassedToView+  , foreignClass+  , module React.Flux.DOM+  , module React.Flux.PropertiesAndEvents++  -- * Main+  , reactRender++  -- * Performance+  -- $performance+) where++import Data.Typeable (Typeable)++import React.Flux.Views+import React.Flux.DOM+import React.Flux.Internal+import React.Flux.PropertiesAndEvents+import React.Flux.Store++#ifdef __GHCJS__+import GHCJS.Types (JSString)+import GHCJS.Foreign (toJSString)+#endif++----------------------------------------------------------------------------------------------------+-- reactRender has two versions+----------------------------------------------------------------------------------------------------++-- | Render your React application into the DOM.+reactRender :: Typeable props+            => String -- ^ The ID of the HTML element to render the application into.+                      -- (This string is passed to @document.getElementById@)+            -> ReactView props -- ^ A single instance of this view is created+            -> props -- ^ the properties to pass to the view+            -> IO ()++#ifdef __GHCJS__++reactRender htmlId rc props = do+    (e, _) <- mkReactElement id (return []) $ view rc props mempty+    js_ReactRender e (toJSString htmlId)++foreign import javascript unsafe+    "React['render']($1, document.getElementById($2))"+    js_ReactRender :: ReactElementRef -> JSString -> IO ()++#else++reactRender _ _ _ = return ()++#endif++-- $performance +--+-- React obtains high <https://facebook.github.io/react/docs/advanced-performance.html performance> from two techniques: the+-- <https://facebook.github.io/react/docs/reconciliation.html virtual DOM/reconciliation> and +-- <https://facebook.github.io/react/docs/events.html event handlers> registered on the document.+--+-- To support fast reconciliation, React uses key properties (set by 'viewWithKey') and a+-- @shouldComponentUpdate@ lifetime class method.  The React documentation on+-- <https://facebook.github.io/react/docs/advanced-performance.html performance and immutable-js> talks+-- about using persistent data structures, which is exactly what Haskell does.  Therefore, we+-- implement a @shouldComponentUpdate@ method which compares if the javascript object representing+-- the Haskell values for the @props@, @state@, and/or @storeData@ have changed.  Thus if you do not+-- modify a Haskell value that is used for the @props@ or @state@ or @storeData@, React will skip+-- re-rendering that view instance.  Care should be taken in the 'transform' function to not edit or+-- recreate any values that are used as @props@.  For example, instead of something like+--+-- >[ (idx, todo) | (idx, todo) <- todos, idx /= deleteIdx ]+--+-- you should prefer+--+-- >filter ((/=deleteIdx) . fst) todos+-- +-- After either of these transforms, the list of todos has changed so @mainSection@ will be re-rendered by+-- React.  @mainSection@ calls @todoItem@ with the tuple @(idx,todo)@ as the props. In the latter+-- transform snippet above, the tuple value for the entries is kept unchanged, so the+-- @shouldComponentUpdate@ function for @todoItem@ will return false and React will not re-render+-- each todo item.  If instead the tuple had been re-created as in the first snippet, the underlying+-- javascript object will change even though the value is equal.  The @shouldComponentUpdate@+-- function for @todoItem@ will then return true and React will re-render every todo item.  Thus the+-- latter snippet is preferred.  In summary, if you are careful to only update the part of the store+-- data that changed, React will only re-render those part of the page.+--+-- For events, React registers only global event handlers and also keeps event objects (the object+-- passed to the handlers) in a pool and re-uses them for successive events.  We want to parse this+-- event object lazily so that only properties actually accessed are parsed, but this is a problem+-- because lazy access could occur after the event object is reused.  Instead of making a copy of+-- the event, we use the 'NFData' instance on 'SomeStoreAction' to force the evaluation of the store+-- action(s) resulting from the event.  We therefore compute the action before the event object+-- returns to the React pool, and rely on the type system to prevent the leak of the event object+-- outside the handlers.  Thus, you cannot "cheat" in the 'NFData' instance on your store actions;+-- the event objects dilerbertly do not have a 'NFData' instance, so that you must pull all your+-- required data out of the event object and into an action in order to properly implement 'NFData'.+-- Of course, the easiest way to implement 'NFData' is to derive it with Generic and DeriveAnyClass,+-- as @TodoAction@ does above.++-- $dispatcher+-- The dispatcher is the central hub that manages all data flow in a Flux application.  It has no+-- logic of its own and all it does is distribute actions to stores.  There is no special support+-- for a dispatcher in this module, since it can be easily implemented directly using Haskell+-- functions.  The event handlers registered during rendering are expected to produce a list of 'SomeStoreAction'.+-- The dispatcher therefore consists of Haskell functions which produce these lists of+-- 'SomeStoreAction'.  Note that this list of actions is used instead of @waitFor@ to sequence+-- actions to stores: when dispatching, we wait for the 'transform' of each action to complete+-- before moving to the next action.+--+-- In the todo example application there is only a single store, so the dispatcher just+-- passes along the action to the store.  In a larger application, the dispatcher could have its+-- own actions and produce specific actions for each store.+--+-- >dispatchTodo :: TodoAction -> [SomeStoreAction]+-- >dispatchTodo a = [SomeStoreAction todoStore a]
+ src/React/Flux/DOM.hs view
@@ -0,0 +1,342 @@+-- | This module contains combinators for creating DOM React elements.+--+-- The design of creating 'ReactElement's is loosly based on+-- <https://hackage.haskell.org/package/lucid lucid>.+-- Most of the combinators in this module have a type:+--+-- @+-- p_ :: 'Term' eventHandler arg result => arg -> result+-- @+--+-- but you should interpret this as 'p_' having either of the following two types:+--+-- @+-- p_ :: ['PropertyOrHandler' eventHandler] -> 'ReactElementM' eventHandler a -> 'ReactElementM' eventHandler a+-- p_ :: 'ReactElementM' eventHandler a -> 'ReactElementM' eventHandler a+-- @+--+-- In the first, 'p_' takes a list of properties and handlers plus the child element(s).  In the+-- second, the list of properties and handlers is omitted. The 'Term' class allows GHC to+-- automatically select the appropriate type.+--+-- Be aware that in React, there are some+-- <https://facebook.github.io/react/docs/dom-differences.html differences> between the browser DOM+-- objects/properties and the properties and attributes you pass to React, as well as React only+-- supports  <https://facebook.github.io/react/docs/tags-and-attributes.html certian attributes>.+-- Event handlers can be created by the combinators in "React.Flux.PropertiesAndEvents".+--+-- Elements not covered by this module can be created manually using 'el'.  But React+-- only supports <https://facebook.github.io/react/docs/tags-and-attributes.html certian elements>+-- and they should all be covered by this module.+--+-- >ul_ $ do li_ (b_ "Hello")+-- >         li_ "World"+-- >         li_ $+-- >             ul_ (li_ "Nested" <> li_ "List")+--+-- would build something like+--+-- ><ul>+-- >  <li><b>Hello</b><li>+-- >  <li>World</li>+-- >  <li><ul>+-- >    <li>Nested</li>+-- >    <li>List</li>+-- >  </ul></li>+-- ></ul>+module React.Flux.DOM where++import React.Flux.Internal++-- | This class allows the DOM combinators to optionally take a list of properties or handlers, or+-- for the list to be omitted.+class Term eventHandler arg result | result -> arg, result -> eventHandler where+    term :: String -> arg -> result++instance (child ~ ReactElementM eventHandler a) => Term eventHandler [PropertyOrHandler eventHandler] (child -> ReactElementM eventHandler a) where+    term name props = el name props++instance Term eventHandler (ReactElementM eventHandler a) (ReactElementM eventHandler a) where+    term name child = el name [] child++{-+#define node(name) name ## _ :: Term eventHandler arg result => arg -> result; name ## _ = term #name+#define elem(name) name ## _ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler (); name ## _ p = el #name p mempty++-- Copy the elements from react documentation and use :s/ /)^v^Mnode(/g+++-- HTML++node(a)+node(abbr)+node(address)+node(area)+node(article)+node(aside)+node(audio)+node(b)+node(base)+node(bdi)+node(bdo)+node(big)+node(blockquote)+node(body)+elem(br)+node(button)+node(canvas)+node(caption)+node(cite)+node(code)+node(col)+node(colgroup)+node(data)+node(datalist)+node(dd)+node(del)+node(details)+node(dfn)+node(dialog)+node(div)+node(dl)+node(dt)+node(em)+node(embed)+node(fieldset)+node(figcaption)+node(figure)+node(footer)+node(form)+node(h1)+node(h2)+node(h3)+node(h4)+node(h5)+node(h6)+node(head)+node(header)+elem(hr)+node(html)+node(i)+node(iframe)+node(img)+elem(input)+node(ins)+node(kbd)+node(keygen)+node(label)+node(legend)+node(li)+node(link)+node(main)+node(map)+node(mark)+node(menu)+node(menuitem)+node(meta)+node(meter)+node(nav)+node(noscript)+node(object)+node(ol)+node(optgroup)+node(option)+node(output)+node(p)+node(param)+node(picture)+node(pre)+node(progress)+node(q)+node(rp)+node(rt)+node(ruby)+node(s)+node(samp)+node(script)+node(section)+node(select)+node(small)+node(source)+node(span)+node(strong)+node(style)+node(sub)+node(summary)+node(sup)+node(table)+node(tbody)+node(td)+node(textarea)+node(tfoot)+node(th)+node(thead)+node(time)+node(title)+node(tr)+node(track)+node(u)+node(ul)+node(var)+node(video)+node(wbr)+++-- SVG++node(circle)+node(clipPath)+node(defs)+node(ellipse)+node(g)+node(line)+node(linearGradient)+node(mask)+node(path)+node(pattern)+node(polygon)+node(polyline)+node(radialGradient)+node(rect)+node(stop)+node(svg)+node(text)+node(tspan)+-}++-- HTML++a_ :: Term eventHandler arg result => arg -> result; a_ = term "a"+abbr_ :: Term eventHandler arg result => arg -> result; abbr_ = term "abbr"+address_ :: Term eventHandler arg result => arg -> result; address_ = term "address"+area_ :: Term eventHandler arg result => arg -> result; area_ = term "area"+article_ :: Term eventHandler arg result => arg -> result; article_ = term "article"+aside_ :: Term eventHandler arg result => arg -> result; aside_ = term "aside"+audio_ :: Term eventHandler arg result => arg -> result; audio_ = term "audio"+b_ :: Term eventHandler arg result => arg -> result; b_ = term "b"+base_ :: Term eventHandler arg result => arg -> result; base_ = term "base"+bdi_ :: Term eventHandler arg result => arg -> result; bdi_ = term "bdi"+bdo_ :: Term eventHandler arg result => arg -> result; bdo_ = term "bdo"+big_ :: Term eventHandler arg result => arg -> result; big_ = term "big"+blockquote_ :: Term eventHandler arg result => arg -> result; blockquote_ = term "blockquote"+body_ :: Term eventHandler arg result => arg -> result; body_ = term "body"+br_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler (); br_ p = el "br" p mempty+button_ :: Term eventHandler arg result => arg -> result; button_ = term "button"+canvas_ :: Term eventHandler arg result => arg -> result; canvas_ = term "canvas"+caption_ :: Term eventHandler arg result => arg -> result; caption_ = term "caption"+cite_ :: Term eventHandler arg result => arg -> result; cite_ = term "cite"+code_ :: Term eventHandler arg result => arg -> result; code_ = term "code"+col_ :: Term eventHandler arg result => arg -> result; col_ = term "col"+colgroup_ :: Term eventHandler arg result => arg -> result; colgroup_ = term "colgroup"+data_ :: Term eventHandler arg result => arg -> result; data_ = term "data"+datalist_ :: Term eventHandler arg result => arg -> result; datalist_ = term "datalist"+dd_ :: Term eventHandler arg result => arg -> result; dd_ = term "dd"+del_ :: Term eventHandler arg result => arg -> result; del_ = term "del"+details_ :: Term eventHandler arg result => arg -> result; details_ = term "details"+dfn_ :: Term eventHandler arg result => arg -> result; dfn_ = term "dfn"+dialog_ :: Term eventHandler arg result => arg -> result; dialog_ = term "dialog"+div_ :: Term eventHandler arg result => arg -> result; div_ = term "div"+dl_ :: Term eventHandler arg result => arg -> result; dl_ = term "dl"+dt_ :: Term eventHandler arg result => arg -> result; dt_ = term "dt"+em_ :: Term eventHandler arg result => arg -> result; em_ = term "em"+embed_ :: Term eventHandler arg result => arg -> result; embed_ = term "embed"+fieldset_ :: Term eventHandler arg result => arg -> result; fieldset_ = term "fieldset"+figcaption_ :: Term eventHandler arg result => arg -> result; figcaption_ = term "figcaption"+figure_ :: Term eventHandler arg result => arg -> result; figure_ = term "figure"+footer_ :: Term eventHandler arg result => arg -> result; footer_ = term "footer"+form_ :: Term eventHandler arg result => arg -> result; form_ = term "form"+h1_ :: Term eventHandler arg result => arg -> result; h1_ = term "h1"+h2_ :: Term eventHandler arg result => arg -> result; h2_ = term "h2"+h3_ :: Term eventHandler arg result => arg -> result; h3_ = term "h3"+h4_ :: Term eventHandler arg result => arg -> result; h4_ = term "h4"+h5_ :: Term eventHandler arg result => arg -> result; h5_ = term "h5"+h6_ :: Term eventHandler arg result => arg -> result; h6_ = term "h6"+head_ :: Term eventHandler arg result => arg -> result; head_ = term "head"+header_ :: Term eventHandler arg result => arg -> result; header_ = term "header"+hr_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler (); hr_ p = el "hr" p mempty+html_ :: Term eventHandler arg result => arg -> result; html_ = term "html"+i_ :: Term eventHandler arg result => arg -> result; i_ = term "i"+iframe_ :: Term eventHandler arg result => arg -> result; iframe_ = term "iframe"+img_ :: Term eventHandler arg result => arg -> result; img_ = term "img"+input_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler (); input_ p = el "input" p mempty+ins_ :: Term eventHandler arg result => arg -> result; ins_ = term "ins"+kbd_ :: Term eventHandler arg result => arg -> result; kbd_ = term "kbd"+keygen_ :: Term eventHandler arg result => arg -> result; keygen_ = term "keygen"+label_ :: Term eventHandler arg result => arg -> result; label_ = term "label"+legend_ :: Term eventHandler arg result => arg -> result; legend_ = term "legend"+li_ :: Term eventHandler arg result => arg -> result; li_ = term "li"+link_ :: Term eventHandler arg result => arg -> result; link_ = term "link"+main_ :: Term eventHandler arg result => arg -> result; main_ = term "main"+map_ :: Term eventHandler arg result => arg -> result; map_ = term "map"+mark_ :: Term eventHandler arg result => arg -> result; mark_ = term "mark"+menu_ :: Term eventHandler arg result => arg -> result; menu_ = term "menu"+menuitem_ :: Term eventHandler arg result => arg -> result; menuitem_ = term "menuitem"+meta_ :: Term eventHandler arg result => arg -> result; meta_ = term "meta"+meter_ :: Term eventHandler arg result => arg -> result; meter_ = term "meter"+nav_ :: Term eventHandler arg result => arg -> result; nav_ = term "nav"+noscript_ :: Term eventHandler arg result => arg -> result; noscript_ = term "noscript"+object_ :: Term eventHandler arg result => arg -> result; object_ = term "object"+ol_ :: Term eventHandler arg result => arg -> result; ol_ = term "ol"+optgroup_ :: Term eventHandler arg result => arg -> result; optgroup_ = term "optgroup"+option_ :: Term eventHandler arg result => arg -> result; option_ = term "option"+output_ :: Term eventHandler arg result => arg -> result; output_ = term "output"+p_ :: Term eventHandler arg result => arg -> result; p_ = term "p"+param_ :: Term eventHandler arg result => arg -> result; param_ = term "param"+picture_ :: Term eventHandler arg result => arg -> result; picture_ = term "picture"+pre_ :: Term eventHandler arg result => arg -> result; pre_ = term "pre"+progress_ :: Term eventHandler arg result => arg -> result; progress_ = term "progress"+q_ :: Term eventHandler arg result => arg -> result; q_ = term "q"+rp_ :: Term eventHandler arg result => arg -> result; rp_ = term "rp"+rt_ :: Term eventHandler arg result => arg -> result; rt_ = term "rt"+ruby_ :: Term eventHandler arg result => arg -> result; ruby_ = term "ruby"+s_ :: Term eventHandler arg result => arg -> result; s_ = term "s"+samp_ :: Term eventHandler arg result => arg -> result; samp_ = term "samp"+script_ :: Term eventHandler arg result => arg -> result; script_ = term "script"+section_ :: Term eventHandler arg result => arg -> result; section_ = term "section"+select_ :: Term eventHandler arg result => arg -> result; select_ = term "select"+small_ :: Term eventHandler arg result => arg -> result; small_ = term "small"+source_ :: Term eventHandler arg result => arg -> result; source_ = term "source"+span_ :: Term eventHandler arg result => arg -> result; span_ = term "span"+strong_ :: Term eventHandler arg result => arg -> result; strong_ = term "strong"+style_ :: Term eventHandler arg result => arg -> result; style_ = term "style"+sub_ :: Term eventHandler arg result => arg -> result; sub_ = term "sub"+summary_ :: Term eventHandler arg result => arg -> result; summary_ = term "summary"+sup_ :: Term eventHandler arg result => arg -> result; sup_ = term "sup"+table_ :: Term eventHandler arg result => arg -> result; table_ = term "table"+tbody_ :: Term eventHandler arg result => arg -> result; tbody_ = term "tbody"+td_ :: Term eventHandler arg result => arg -> result; td_ = term "td"+textarea_ :: Term eventHandler arg result => arg -> result; textarea_ = term "textarea"+tfoot_ :: Term eventHandler arg result => arg -> result; tfoot_ = term "tfoot"+th_ :: Term eventHandler arg result => arg -> result; th_ = term "th"+thead_ :: Term eventHandler arg result => arg -> result; thead_ = term "thead"+time_ :: Term eventHandler arg result => arg -> result; time_ = term "time"+title_ :: Term eventHandler arg result => arg -> result; title_ = term "title"+tr_ :: Term eventHandler arg result => arg -> result; tr_ = term "tr"+track_ :: Term eventHandler arg result => arg -> result; track_ = term "track"+u_ :: Term eventHandler arg result => arg -> result; u_ = term "u"+ul_ :: Term eventHandler arg result => arg -> result; ul_ = term "ul"+var_ :: Term eventHandler arg result => arg -> result; var_ = term "var"+video_ :: Term eventHandler arg result => arg -> result; video_ = term "video"+wbr_ :: Term eventHandler arg result => arg -> result; wbr_ = term "wbr"+++-- SVG++circle_ :: Term eventHandler arg result => arg -> result; circle_ = term "circle"+clipPath_ :: Term eventHandler arg result => arg -> result; clipPath_ = term "clipPath"+defs_ :: Term eventHandler arg result => arg -> result; defs_ = term "defs"+ellipse_ :: Term eventHandler arg result => arg -> result; ellipse_ = term "ellipse"+g_ :: Term eventHandler arg result => arg -> result; g_ = term "g"+line_ :: Term eventHandler arg result => arg -> result; line_ = term "line"+linearGradient_ :: Term eventHandler arg result => arg -> result; linearGradient_ = term "linearGradient"+mask_ :: Term eventHandler arg result => arg -> result; mask_ = term "mask"+path_ :: Term eventHandler arg result => arg -> result; path_ = term "path"+pattern_ :: Term eventHandler arg result => arg -> result; pattern_ = term "pattern"+polygon_ :: Term eventHandler arg result => arg -> result; polygon_ = term "polygon"+polyline_ :: Term eventHandler arg result => arg -> result; polyline_ = term "polyline"+radialGradient_ :: Term eventHandler arg result => arg -> result; radialGradient_ = term "radialGradient"+rect_ :: Term eventHandler arg result => arg -> result; rect_ = term "rect"+stop_ :: Term eventHandler arg result => arg -> result; stop_ = term "stop"+svg_ :: Term eventHandler arg result => arg -> result; svg_ = term "svg"+text_ :: Term eventHandler arg result => arg -> result; text_ = term "text"+tspan_ :: Term eventHandler arg result => arg -> result; tspan_ = term "tspan"
+ src/React/Flux/Export.hs view
@@ -0,0 +1,28 @@+-- | Replace this with Export from improved-base branch of ghcjs-base once+-- the improved-base branch becomes the default+module React.Flux.Export where++#ifdef __GHCJS__++import Data.Typeable (Typeable)+import Unsafe.Coerce++import GHCJS.Types++newtype Export a = Export (JSRef ())++foreign import javascript unsafe+    "hsreact$export($1)"+    js_export :: Double -> IO (Export a)++export :: Typeable a => a -> IO (Export a)+export = js_export . unsafeCoerce++foreign import javascript unsafe+    "hsreact$derefExport($1)"+    js_deref :: Export a -> IO Double++derefExport :: Typeable a => Export a -> IO (Maybe a)+derefExport e = (Just . unsafeCoerce) <$> js_deref e++#endif
+ src/React/Flux/Internal.hs view
@@ -0,0 +1,286 @@+-- | Internal module for React.Flux+--+-- Normally you should not need to use anything in this module.  This module is only needed if you have+-- complicated interaction with third-party javascript rendering code.+module React.Flux.Internal(+    ReactViewRef(..)+  , ReactViewKey(..)+  , ReactElementRef(..)+  , HandlerArg(..)+  , PropertyOrHandler(..)+  , ReactElement(..)+  , ReactElementM(..)+  , elemText+  , elemShow+  , el+  , childrenPassedToView+  , elementToM+  , mkReactElement+) where++import Data.String (IsString(..))+import Data.Aeson+import Data.Aeson.Types (Pair)+import Data.Typeable (Typeable)+import Control.Monad.Writer+import Control.Monad.Identity (Identity(..))++#ifdef __GHCJS__+import GHCJS.Types (JSRef, castRef, JSString, JSArray, JSObject, JSFun)+import qualified GHCJS.Foreign as Foreign+import GHCJS.Marshal (toJSRef_aeson, ToJSRef(..), fromJSRef)+import React.Flux.Export+#else+type JSRef a = ()+type JSFun a = JSRef a+#endif++type Callback a = JSFun a++-- | This type is for the return value of @React.createClass@+newtype ReactViewRef props = ReactViewRef { reactViewRef :: JSRef () }++-- | This type is for the return value of @React.createElement@+newtype ReactElementRef = ReactElementRef { reactElementRef :: JSRef () }++-- | The first parameter of an event handler registered with React.+newtype HandlerArg = HandlerArg (JSRef ())++instance Show HandlerArg where+    show _ = "HandlerArg"++-- | Either a property or an event handler.+--+-- The combination of all properties and event handlers are used to create the javascript object+-- passed as the second argument to @React.createElement@.+data PropertyOrHandler handler =+   Property Pair+ | EventHandler+      { evtHandlerName :: String+      , evtHandler :: HandlerArg -> handler+      }+ | CallbackProperty+      { callbackName :: String+      , callbackFn :: Value -> handler+      }++instance Functor PropertyOrHandler where+    fmap _ (Property p) = Property p+    fmap f (EventHandler name h) = EventHandler name (f . h)+    fmap f (CallbackProperty name g) = CallbackProperty name (f . g)++-- | Keys in React can either be strings or integers+class ReactViewKey key where+    toKeyRef :: key -> IO (JSRef ())++#if __GHCJS__+instance ReactViewKey String where+    toKeyRef = return . castRef . Foreign.toJSString++instance ReactViewKey Int where+    toKeyRef i = castRef <$> toJSRef i+#else+instance ReactViewKey String where+    toKeyRef = const $ return ()++instance ReactViewKey Int where+    toKeyRef = const $ return ()+#endif++-- | A React element is a node or list of nodes in a virtual tree.  Elements are the output of the+-- rendering functions of classes.  React takes the output of the rendering function (which is a+-- tree of elements) and then reconciles it with the actual DOM elements in the browser.  The+-- 'ReactElement' is a monoid, so dispite its name can represent more than one element.  Multiple+-- elements are rendered into the browser DOM as siblings.+data ReactElement eventHandler+    = ForeignElement+        { fName :: Either String (ReactViewRef Object)+        , fProps :: [PropertyOrHandler eventHandler]+        , fChild :: ReactElement eventHandler+        }+    | forall props key. (Typeable props, ReactViewKey key) => ViewElement+        { ceClass :: ReactViewRef props+        , ceKey :: Maybe key+        -- TODO: ref?  ref support would need to tie into the Class too.+        , ceProps :: props+        , ceChild :: ReactElement eventHandler+        }+    | ChildrenPassedToView+    | Content String+    | Append (ReactElement eventHandler) (ReactElement eventHandler)+    | EmptyElement++instance Monoid (ReactElement eventHandler) where+    mempty = EmptyElement+    mappend x y = Append x y++instance Functor ReactElement where+    fmap f (ForeignElement n p c) = ForeignElement n (map (fmap f) p) (fmap f c)+    fmap f (ViewElement n k p c) = ViewElement n k p (fmap f c)+    fmap _ ChildrenPassedToView = ChildrenPassedToView+    fmap f (Append a b) = Append (fmap f a) (fmap f b)+    fmap _ (Content s) = Content s+    fmap _ EmptyElement = EmptyElement++-- | A writer monad for 'ReactElement's which is used in the rendering function of all views.+--+-- @do@ notation or the 'Monoid' instance is used to sequence sibling elements.+-- Child elements are specified via function application; the combinator creating an element takes+-- the child element as a parameter. The @OverloadedStrings@ extension is used to create plain text.+--+-- >ul_ $ do li_ (b_ "Hello")+-- >         li_ "World"+-- >         li_ $+-- >             ul_ (li_ "Nested" <> li_ "List")+--+-- would build something like+--+-- ><ul>+-- >  <li><b>Hello</b><li>+-- >  <li>World</li>+-- >  <li><ul>+-- >    <li>Nested</li>+-- >    <li>List</li>+-- >  </ul></li>+-- ></ul>+--+-- The "React.Flux.DOM" module contains a large number of combinators for creating HTML elements.+newtype ReactElementM eventHandler a = ReactElementM { runReactElementM :: Writer (ReactElement eventHandler) a }+    deriving (Functor, Applicative, Monad, Foldable)++-- | Create a 'ReactElementM' containing a given 'ReactElement'.+elementToM :: a -> ReactElement eventHandler -> ReactElementM eventHandler a+elementToM a e = ReactElementM (WriterT (Identity (a, e)))++instance (a ~ ()) => Monoid (ReactElementM eventHandler a) where+    mempty = elementToM () EmptyElement+    mappend e1 e2 =+        let ((),e1') = runWriter $ runReactElementM e1+            ((),e2') = runWriter $ runReactElementM e2+         in elementToM () $ Append e1' e2'++instance (a ~ ()) => IsString (ReactElementM eventHandler a) where+    fromString s = elementToM () $ Content s++-- | Create a text element from a string.  This is an alias for 'fromString'.  The text content is+-- escaped to be HTML safe.  If you need to insert HTML, instead use the+-- <https://facebook.github.io/react/tips/dangerously-set-inner-html.html dangerouslySetInnerHTML>+-- property.+elemText :: String -> ReactElementM eventHandler ()+elemText s = elementToM () $ Content s++-- | Create an element containing text which is the result of 'show'ing the argument.+-- Note that the resulting string is then escaped to be HTML safe.+elemShow :: Show a => a -> ReactElementM eventHandler ()+elemShow s = elementToM () $ Content $ show s++-- | Create a React element.+el :: String -- ^ The element name (the first argument to @React.createElement@).+   -> [PropertyOrHandler eventHandler] -- ^ The properties to pass to the element (the second argument to @React.createElement@).+   -> ReactElementM eventHandler a -- ^ The child elements (the third argument to @React.createElement@).+   -> ReactElementM eventHandler a+el name attrs (ReactElementM child) =+    let (a, childEl) = runWriter child+     in elementToM a $ ForeignElement (Left name) attrs childEl++-- | Transclude the children passed into 'React.Flux.view' or 'React.Flux.viewWithKey' into the+-- current rendering.  Use this where you would use @this.props.children@ in a javascript React+-- class.+childrenPassedToView :: ReactElementM eventHandler ()+childrenPassedToView = elementToM () ChildrenPassedToView++----------------------------------------------------------------------------------------------------+-- mkReactElement has two versions+----------------------------------------------------------------------------------------------------++-- | Execute a ReactElementM to create a javascript React element and a list of callbacks attached+-- to nodes within the element.  These callbacks will need to be released with 'releaseCallback'+-- once the class is re-rendered.+mkReactElement :: (eventHandler -> IO ())+               -> IO [ReactElementRef] -- ^ this.props.children+               -> ReactElementM eventHandler ()+               -> IO (ReactElementRef, [Callback (JSRef () -> IO ())])++#ifdef __GHCJS__++mkReactElement runHandler getPropsChildren eM = runWriterT $ do+    let e = execWriter $ runReactElementM eM+    refs <- createElement getPropsChildren $ fmap runHandler e+    case refs of+        [] -> lift $ js_ReactCreateElementNoChildren "div"+        [x] -> return x+        xs -> lift $ do+            emptyObj <- Foreign.newObj+            arr <- Foreign.toArray $ map reactElementRef xs+            js_ReactCreateElementName "div" emptyObj arr++foreign import javascript unsafe+    "React['createElement']($1)"+    js_ReactCreateElementNoChildren :: JSString -> IO ReactElementRef++foreign import javascript unsafe+    "React['createElement']($1, $2, $3)"+    js_ReactCreateElementName :: JSString -> JSObject b -> JSArray c -> IO ReactElementRef++foreign import javascript unsafe+    "React['createElement']($1, $2, $3)"+    js_ReactCreateForeignElement :: ReactViewRef a -> JSObject b -> JSArray c -> IO ReactElementRef++foreign import javascript unsafe+    "React['createElement']($1, {hs:$2}, $3)"+    js_ReactCreateClass :: ReactViewRef a -> Export props -> JSArray b -> IO ReactElementRef++foreign import javascript unsafe+    "React['createElement']($1, {key: $2, hs:$3}, $4)"+    js_ReactCreateKeyedElement :: ReactViewRef a -> JSRef key -> Export props -> JSArray b -> IO ReactElementRef++js_ReactCreateContent :: String -> ReactElementRef+js_ReactCreateContent = ReactElementRef . castRef . Foreign.toJSString++addPropOrHandlerToObj :: JSObject a -> PropertyOrHandler (IO ()) -> WriterT [Callback (JSRef () -> IO ())] IO ()+addPropOrHandlerToObj obj (Property (n, v)) = lift $ do+    vRef <- toJSRef_aeson v+    Foreign.setProp (Foreign.toJSString n) vRef obj+addPropOrHandlerToObj obj (EventHandler str handler) = do+    -- this will be released by the render function of the class (jsbits/class.js)+    cb <- lift $ Foreign.syncCallback1 Foreign.AlwaysRetain True $ \evtRef ->+        handler $ HandlerArg evtRef+    tell [cb]+    lift $ Foreign.setProp (Foreign.toJSString str) cb obj+addPropOrHandlerToObj obj (CallbackProperty str handler) = do+    cb <- lift $ Foreign.syncCallback1 Foreign.AlwaysRetain True $ \argref -> do+        v <- fromJSRef $ castRef argref+        handler $ maybe (error "Unable to decode callback value") id v+    tell [cb]+    lift $ Foreign.setProp (Foreign.toJSString str) cb obj++createElement :: IO [ReactElementRef] -> ReactElement (IO ()) -> WriterT [Callback (JSRef () -> IO ())] IO [ReactElementRef]+createElement _ EmptyElement = return []+createElement c (Append x y) = (++) <$> createElement c x <*> createElement c y+createElement _ (Content s) = return [js_ReactCreateContent s]+createElement c ChildrenPassedToView = lift c+createElement c (f@(ForeignElement{})) = do+    obj <- lift $ Foreign.newObj+    mapM_ (addPropOrHandlerToObj obj) $ fProps f+    childNodes <- createElement c $ fChild f+    childArr <- lift $ Foreign.toArray $ map reactElementRef childNodes+    e <- lift $ case fName f of+        Left s -> js_ReactCreateElementName (Foreign.toJSString s) obj childArr+        Right ref -> js_ReactCreateForeignElement ref obj childArr+    return [e]+createElement c (ViewElement { ceClass = rc, ceProps = props, ceKey = mkey, ceChild = child }) = do+    childNodes <- createElement c child+    propsE <- lift $ export props -- this will be released inside the lifetime events for the class (jsbits/class.js)+    arr <- lift $ Foreign.toArray $ map reactElementRef childNodes+    e <- lift $ case mkey of+        Just key -> do+            keyRef <- toKeyRef key+            js_ReactCreateKeyedElement rc keyRef propsE arr+        Nothing -> js_ReactCreateClass rc propsE arr+    return [e]++#else++mkReactElement _ _ _ = return (ReactElementRef (), [])++#endif
+ src/React/Flux/Lifecycle.hs view
@@ -0,0 +1,187 @@+-- | React has <https://facebook.github.io/react/docs/working-with-the-browser.html lifecycle callbacks and refs>+-- that allows the class to interact with the browser DOM.  React obtains a+-- large performance boost from working with the virtual DOM instead of the browser DOM, so the use+-- of these lifecycle callbacks should be minimized or not used at all (in fact, the example TODO+-- app does not use them at all).  Quoting the+-- <https://facebook.github.io/react/docs/more-about-refs.html React documentation>, "If you have+-- not programmed several apps with React, your first inclination is usually going to be to try to+-- use refs to "make things happen" in your app. If this is the case, take a moment and think more+-- critically about where state should be owned in the component hierarchy. Often, it becomes clear+-- that the proper place to "own" that state is at a higher level in the hierarchy. Placing the+-- state there often eliminates any desire to use refs to "make things happen" – instead, the data+-- flow will usually accomplish your goal."+--+-- Additionally, the way GHCJS callbacks work causes potential problems with the lifecycle+-- callbacks: GHCJS callbacks can block and if that occurs they either abort with an error or+-- continue asyncronously.  Continuing asyncronously cannot work because by their nature these+-- lifecycle events are time-dependent, and by the time a Haskell thread resumes the element could+-- have disappeared.  Therefore, the lifecycle callbacks will abort with an error if one of them+-- blocks.  But because of the way GHCJS works, it is hard to control the possiblity of blocking+-- since a lazily computed value that you just happen to demand might block on a blackhole.+-- Therefore, this lifecycle view should only be used for simple things, such as scrolling to an+-- element when it is mounted.  This isn't a big restriction in my experience, since most of the+-- time you just use views and the rare time you need a lifecycle event, it is to do something+-- simple.+--+-- As an alternative to using this module and its resulting callback blocking complications, you can+-- consider writing the class in javascript\/typescript\/etc. and then using 'foreignClass' to call it+-- from Haskell.++module React.Flux.Lifecycle (+    defineLifecycleView+  , lifecycleConfig+  , LifecycleViewConfig(..)+  , LPropsAndState(..)+  , LDOM(..)+  , LSetStateFn+) where++import Data.Typeable (Typeable)++import React.Flux.Internal+import React.Flux.Views+import React.Flux.DOM (div_)++#ifdef __GHCJS__+import Control.Monad.Writer+import System.IO.Unsafe (unsafePerformIO)++import React.Flux.Export++import GHCJS.Types (JSRef, castRef)+import GHCJS.Foreign (syncCallback1, syncCallback2, toJSString, ForeignRetention(..), jsNull)+#endif++type HTMLElement = JSRef ()++-- | Actions to access the current properties and state.+data LPropsAndState props state = LPropsAndState+  { lGetProps :: IO props+  , lGetState :: IO state+  }++-- | Obtain the browser DOM element for either the component as a whole with 'lThis' or for various+-- nodes with a given <https://facebook.github.io/react/docs/more-about-refs.html ref> property with+-- 'lRef'.+data LDOM = LDOM+  { lThis :: IO HTMLElement+  , lRef :: String -> IO HTMLElement+  }++-- | Set the state of the class.+type LSetStateFn state = state -> IO ()++-- | The class rendering function, together with optional callbacks for the various lifecycle+-- events.  As mentioned above, care must be taken in each callback to write only IO that will not+-- block.+data LifecycleViewConfig props state = LifecycleViewConfig+  { lRender :: state -> props -> ReactElementM (StatefulViewEventHandler state) ()+  , lComponentWillMount :: Maybe (LPropsAndState props state -> LSetStateFn state -> IO ())+  , lComponentDidMount :: Maybe (LPropsAndState props state -> LDOM -> LSetStateFn state -> IO ())+  -- | Receives the new props as an argument.+  , lComponentWillReceiveProps :: Maybe (LPropsAndState props state -> LDOM -> LSetStateFn state -> props -> IO ())+  -- | Receives the new props and state as arguments.  The current props and state can be accessed using+  -- 'LPropsAndState'.+  , lComponentWillUpdate :: Maybe (LPropsAndState props state -> LDOM -> props -> state -> IO ())+  -- | Receives the old props and state as arguments.  The current props and state can be accessed+  -- using 'LPropsAndState'+  , lComponentDidUpdate :: Maybe (LPropsAndState props state -> LDOM -> LSetStateFn state -> props -> state -> IO ())+  , lComponentWillUnmount :: Maybe (LPropsAndState props state -> LDOM -> IO ())+  }++-- | A default configuration, which does not specify any lifecycle events.  You should start with+-- this and override the functions you need.+lifecycleConfig :: LifecycleViewConfig props state+lifecycleConfig = LifecycleViewConfig+    { lRender = \_ _ -> div_ mempty+    , lComponentWillMount = Nothing+    , lComponentDidMount = Nothing+    , lComponentWillReceiveProps = Nothing+    , lComponentWillUpdate = Nothing+    , lComponentDidUpdate = Nothing+    , lComponentWillUnmount = Nothing+    }++-- | Create a lifecycle view from the given configuration.+--+-- >myView :: ReactView String+-- >myVew = defineLifecycleView "my view" (10 :: Int) lifecycleConfig+-- >            { lRender = \state props -> ...+-- >            , lComponentWillMount = \propsAndState setStateFn -> ...+-- >            }+defineLifecycleView :: (Typeable props, Typeable state)+              => String -> state -> LifecycleViewConfig props state -> ReactView props++#ifdef __GHCJS__++defineLifecycleView name initialState cfg = unsafePerformIO $ do+    initialRef <- export initialState++    let render state props = return $ lRender cfg state props+    renderCb <- mkRenderCallback (js_ReactGetState >=> parseExport) runStateViewHandler render++    let dom this = LDOM { lThis = js_ReactFindDOMNode this+                        , lRef = \r -> js_ReactGetRef this $ toJSString r+                        }++        setStateFn this s = export s >>= js_ReactUpdateAndReleaseState this++    willMountCb <- mkLCallback1 (lComponentWillMount cfg) $ \f this ->+        f (setStateFn this)++    didMountCb <- mkLCallback1 (lComponentDidMount cfg) $ \f this ->+        f (dom this) (setStateFn this)++    willRecvPropsCb <- mkLCallback2 (lComponentWillReceiveProps cfg) $ \f this newPropsE -> do+        newProps <- parseExport $ Export $ castRef newPropsE+        f (dom this) (setStateFn this) newProps++    willUpdateCb <- mkLCallback2 (lComponentWillUpdate cfg) $ \f this argRef -> do+        let arg = ReactThis argRef+        nextProps <- js_ReactGetProps arg >>= parseExport+        nextState <- js_ReactGetState arg >>= parseExport+        f (dom this) nextProps nextState++    didUpdateCb <- mkLCallback2 (lComponentDidUpdate cfg) $ \f this argRef -> do+        let arg = ReactThis argRef+        oldProps <- js_ReactGetProps arg >>= parseExport+        oldState <- js_ReactGetState arg >>= parseExport+        f (dom this) (setStateFn this) oldProps oldState++    willUnmountCb <- mkLCallback1 (lComponentWillUnmount cfg) $ \f this ->+        f (dom this)++    ReactView <$> js_makeLifecycleView (toJSString name) initialRef+                    renderCb willMountCb didMountCb willRecvPropsCb willUpdateCb didUpdateCb willUnmountCb++mkLCallback1 :: (Typeable props, Typeable state)+             => Maybe (LPropsAndState props state -> f)+             -> (f -> ReactThis state props -> IO ())+             -> IO (Callback (JSRef () -> IO ()))+mkLCallback1 Nothing _ = return jsNull+mkLCallback1 (Just f) c = syncCallback1 AlwaysRetain False $ \thisRef -> do+    let this = ReactThis thisRef+        ps = LPropsAndState { lGetProps = js_ReactGetProps this >>= parseExport+                            , lGetState = js_ReactGetState this >>= parseExport+                            }+    c (f ps) this++mkLCallback2 :: (Typeable props, Typeable state)+             => Maybe (LPropsAndState props state -> f)+             -> (f -> ReactThis state props -> JSRef a -> IO ())+             -> IO (Callback (JSRef () -> JSRef a -> IO ()))+mkLCallback2 Nothing _ = return jsNull+mkLCallback2 (Just f) c = syncCallback2 AlwaysRetain False $ \thisRef argRef -> do+    let this = ReactThis thisRef+        ps = LPropsAndState { lGetProps = js_ReactGetProps this >>= parseExport+                            , lGetState = js_ReactGetState this >>= parseExport+                            }+    c (f ps) this argRef++#else++defineLifecycleView _ _ _ = ReactView $ ReactViewRef ()++#endif++{-# NOINLINE defineLifecycleView #-}
+ src/React/Flux/PropertiesAndEvents.hs view
@@ -0,0 +1,604 @@+-- | This module contains the definitions for creating properties to pass to elements, as well as+-- the definitions for the+-- <https://facebook.github.io/react/docs/events.html React Event System>.+module React.Flux.PropertiesAndEvents (+    PropertyOrHandler+  , (@=)+  , ($=)+  , callback++  -- * Events+  , Event(..)+  , EventTarget(..)+  , eventTargetProp+  , target+  , preventDefault+  , stopPropagation+  , capturePhase++  -- * Keyboard+  , KeyboardEvent(..)+  , onKeyDown+  , onKeyPress+  , onKeyUp++  -- * Focus+  , FocusEvent(..)+  , onBlur+  , onFocus++  -- * Form+  , onChange+  , onInput+  , onSubmit++  -- * Mouse+  , MouseEvent(..)+  , onClick+  , onContextMenu+  , onDoubleClick+  , onDrag+  , onDragEnd+  , onDragEnter+  , onDragExit+  , onDragLeave+  , onDragOver+  , onDragStart+  , onDrop+  , onMouseDown+  , onMouseEnter+  , onMouseLeave+  , onMouseMove+  , onMouseOut+  , onMouseOver+  , onMouseUp++  -- * Touch+  , initializeTouchEvents+  , Touch(..)+  , TouchEvent(..)+  , onTouchCancel+  , onTouchEnd+  , onTouchMove+  , onTouchStart++  -- * UI+  , onScroll++  -- * Wheel+  , WheelEvent(..)+  , onWheel++  -- * Image+  , onLoad+  , onError+) where++import Control.Monad (forM)+import Control.Concurrent.MVar (newMVar)+import Control.DeepSeq+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.Text as T+import qualified Data.Aeson as A++import React.Flux.Internal+import React.Flux.Store++#ifdef __GHCJS__+import Data.Maybe (fromMaybe)++import GHCJS.Types (JSRef, nullRef, JSString, JSBool)+import GHCJS.Foreign (toJSString, lengthArray, indexArray, fromJSBool)+import GHCJS.Marshal (FromJSRef(..))+#else+type JSRef a = ()+type JSString = String+type JSArray = ()+class FromJSRef a+nullRef :: ()+nullRef = ()+#endif++-- | Create a property.+(@=) :: A.ToJSON a => T.Text -> a -> PropertyOrHandler handler+n @= a = Property (n, A.toJSON a)++-- | Create a text-valued property.  This is here to avoid problems when OverloadedStrings extension+-- is enabled+($=) :: T.Text -> T.Text -> PropertyOrHandler handler+n $= a = Property (n, A.toJSON a)++-- | Create a callback property.  This is primarily intended for foreign React classes which expect+-- callbacks to be passed to them as properties.  For events on DOM elements, you should instead use+-- the handlers below.+callback :: String -> (A.Value -> handler) -> PropertyOrHandler handler+callback = CallbackProperty++----------------------------------------------------------------------------------------------------+--- Generic Event+----------------------------------------------------------------------------------------------------++-- | A reference to the object that dispatched the event.+-- <https://developer.mozilla.org/en-US/docs/Web/API/Event/target>+newtype EventTarget = EventTarget (JSRef ())++instance Show (EventTarget) where+    show _ = "EventTarget"++-- | Access a property in an event target+eventTargetProp :: FromJSRef val => EventTarget -> String -> val+eventTargetProp (EventTarget ref) key = ref .: toJSString key++-- | Every event in React is a synthetic event, a cross-browser wrapper around the native event.+data Event = Event+    { evtType :: String+    , evtBubbles :: Bool+    , evtCancelable :: Bool+    , evtCurrentTarget :: EventTarget+    , evtDefaultPrevented :: Bool+    , evtPhase :: Int+    , evtIsTrusted :: Bool+    -- evtNativeEvent+    , evtTarget :: EventTarget+    , evtTimestamp :: Int+    , evtHandlerArg :: HandlerArg+    } deriving (Show)++-- | A version of 'eventTargetProp' which accesses the property of 'evtTarget' in the event.  This+-- is useful for example:+--+-- >div_ $+-- >    input_ [ "type" @= "checked"+-- >           , onChange $ \evt -> let val = target evt "value" in ...+-- >           ]+--+-- In this case, @val@ would coorespond to the javascript expression @evt.target.value@.+target :: FromJSRef val => Event -> String -> val+target e s = eventTargetProp (evtTarget e) s++parseEvent :: HandlerArg -> Event+parseEvent arg@(HandlerArg o) = Event+    { evtType = o .: "type"+    , evtBubbles = o .: "bubbles"+    , evtCancelable = o .: "cancelable"+    , evtCurrentTarget = EventTarget $ js_getProp o "currentTarget"+    , evtDefaultPrevented = o .: "defaultPrevented"+    , evtPhase = o .: "eventPhase"+    , evtIsTrusted = o .: "isTrusted"+    , evtTarget = EventTarget $ js_getProp o "target"+    , evtTimestamp = o .: "timeStamp"+    , evtHandlerArg = arg+    }++-- | Create an event handler from a name and a handler function.+--+-- This can also be used to pass in arbitrary callbacks to foreign javascript React classes.+-- Indeed, what 'on' does is create a callback and then add a property with key the string passed to+-- 'on' and value the callback.+on :: String -> (HandlerArg -> handler) -> PropertyOrHandler handler+on = EventHandler++-- | Construct a handler from a detail parser, used by the various events below.+mkHandler :: String -- ^ The event name+          -> (HandlerArg -> detail) -- ^ A function parsing the details for the specific event.+          -> (Event -> detail -> handler) -- ^ The function implementing the handler.+          -> PropertyOrHandler handler+mkHandler name parseDetail f = EventHandler+    { evtHandlerName = name+    , evtHandler = \raw -> f (parseEvent raw) (parseDetail raw)+    }+++-- | In a hack, the prevent default and stop propagation are actions since that is the easiest way+-- of allowing users to specify these actions (IO is not available in view event handlers).  We+-- create a fake store to handle these actions.+data FakeEventStoreData = FakeEventStoreData++-- | The fake store, doesn't store any data.  Also, the dispatch function correctly detects+-- nullRef and will not attempt to notify any controller-views.+fakeEventStore :: ReactStore FakeEventStoreData+fakeEventStore = unsafePerformIO (ReactStore (ReactStoreRef nullRef) <$> newMVar FakeEventStoreData)+{-# NOINLINE fakeEventStore #-}++-- | The actions for the fake store+data FakeEventStoreAction = PreventDefault HandlerArg+                          | StopPropagation HandlerArg++instance StoreData FakeEventStoreData where+    type StoreAction FakeEventStoreData = FakeEventStoreAction+    transform _ _ = return FakeEventStoreData++#ifdef __GHCJS__++-- | What a hack!  React re-uses event objects in a pool.  To make sure this is OK, we must perform+-- all computation involving the event object before it is returned to React.  But the callback+-- registered in the handler will return anytime the Haskell thread blocks, and the Haskell thread+-- will continue asynchronously.  If this occurs, the event object is no longer valid.  Thus, inside+-- the event handlers in Views.hs, the handler will use 'deepseq' to force all the actions before+-- starting any of the transforms (which could block).  We rely on this call plus use+-- unsafePerformIO to call the appropriate functions on the event object.+instance NFData FakeEventStoreAction where+    rnf (PreventDefault (HandlerArg ref)) = unsafePerformIO (js_preventDefault ref) `deepseq` ()+    rnf (StopPropagation (HandlerArg ref)) = unsafePerformIO (js_stopProp ref) `deepseq` ()++foreign import javascript unsafe+    "$1['preventDefault']();"+    js_preventDefault :: JSRef () -> IO ()++foreign import javascript unsafe+    "$1['stopPropagation']();"+    js_stopProp :: JSRef () -> IO ()++#else++instance NFData FakeEventStoreAction where+    rnf _ = ()++#endif++-- | Prevent the default browser action from occuring in response to this event.+preventDefault :: Event -> SomeStoreAction+preventDefault = SomeStoreAction fakeEventStore . PreventDefault . evtHandlerArg++-- | Stop propagating this event, either down the DOM tree during the capture phase or up the DOM+-- tree during the bubbling phase.+stopPropagation :: Event -> SomeStoreAction+stopPropagation = SomeStoreAction fakeEventStore . StopPropagation . evtHandlerArg++-- | By default, the handlers below are triggered during the bubbling phase.  Use this to switch+-- them to trigger during the capture phase.+capturePhase :: PropertyOrHandler handler -> PropertyOrHandler handler+capturePhase (EventHandler n h) = EventHandler (n ++ "Capture") h+capturePhase _ = error "You must use React.Flux.PropertiesAndEvents.capturePhase on an event handler"++---------------------------------------------------------------------------------------------------+--- Clipboard+---------------------------------------------------------------------------------------------------+++---------------------------------------------------------------------------------------------------+--- Keyboard+---------------------------------------------------------------------------------------------------++-- | The data for the keyboard events+data KeyboardEvent = KeyboardEvent+  { keyEvtAltKey :: Bool+  , keyEvtCharCode :: Int+  , keyEvtCtrlKey :: Bool+  , keyGetModifierState :: String -> Bool+  , keyKey :: String+  , keyCode :: Int+  , keyLocale :: String+  , keyLocation :: Int+  , keyMetaKey :: Bool+  , keyRepeat :: Bool+  , keyShiftKey :: Bool+  , keyWhich :: Int+  }++instance Show KeyboardEvent where+    show (KeyboardEvent k1 k2 k3 _ k4 k5 k6 k7 k8 k9 k10 k11) =+        show (k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11)++parseKeyboardEvent :: HandlerArg -> KeyboardEvent+parseKeyboardEvent (HandlerArg o) = KeyboardEvent+    { keyEvtAltKey = o .: "altKey"+    , keyEvtCharCode = o .: "charCode"+    , keyEvtCtrlKey = o .: "ctrlKey"+    , keyGetModifierState = getModifierState o+    , keyKey = o .: "key"+    , keyCode = o .: "keyCode"+    , keyLocale = o .: "locale"+    , keyLocation = o .: "location"+    , keyMetaKey = o .: "metaKey"+    , keyRepeat = o .: "repeat"+    , keyShiftKey = o .: "shiftKey"+    , keyWhich = o .: "which"+    }++onKeyDown :: (Event -> KeyboardEvent -> handler) -> PropertyOrHandler handler+onKeyDown = mkHandler "onKeyDown" parseKeyboardEvent++onKeyPress :: (Event -> KeyboardEvent -> handler) -> PropertyOrHandler handler+onKeyPress = mkHandler "onKeyPress" parseKeyboardEvent++onKeyUp :: (Event -> KeyboardEvent -> handler) -> PropertyOrHandler handler+onKeyUp = mkHandler "onKeyUp" parseKeyboardEvent++--------------------------------------------------------------------------------+-- Focus Events+--------------------------------------------------------------------------------++data FocusEvent = FocusEvent {+    focusRelatedTarget :: EventTarget+} deriving (Show)++parseFocusEvent :: HandlerArg -> FocusEvent+parseFocusEvent (HandlerArg ref) = FocusEvent $ EventTarget $ js_getProp ref "relatedTarget"++onBlur :: (Event -> FocusEvent -> handler) -> PropertyOrHandler handler+onBlur = mkHandler "onBlur" parseFocusEvent++onFocus :: (Event -> FocusEvent -> handler) -> PropertyOrHandler handler+onFocus = mkHandler "onFocus" parseFocusEvent++--------------------------------------------------------------------------------+-- Form Events+--------------------------------------------------------------------------------++-- | The onChange event is special in React and should be used for all input change events.  For+-- details, see <https://facebook.github.io/react/docs/forms.html>+onChange :: (Event -> handler) -> PropertyOrHandler handler+onChange f = on "onChange" (f . parseEvent)++onInput :: (Event -> handler) -> PropertyOrHandler handler+onInput f = on "onInput" (f . parseEvent)++onSubmit :: (Event -> handler) -> PropertyOrHandler handler+onSubmit f = on "onSubmit" (f . parseEvent)++--------------------------------------------------------------------------------+-- Mouse Events+--------------------------------------------------------------------------------++data MouseEvent = MouseEvent+  { mouseAltKey :: Bool+  , mouseButton :: Int+  , mouseButtons :: Int+  , mouseClientX :: Int+  , mouseClientY :: Int+  , mouseCtrlKey :: Bool+  , mouseGetModifierState :: String -> Bool+  , mouseMetaKey :: Bool+  , mousePageX :: Int+  , mousePageY :: Int+  , mouseRelatedTarget :: EventTarget+  , mouseScreenX :: Int+  , mouseScreenY :: Int+  , mouseShiftKey :: Bool+  }++instance Show MouseEvent where+    show (MouseEvent m1 m2 m3 m4 m5 m6 _ m7 m8 m9 m10 m11 m12 m13)+        = show (m1, m2, m3, m4, m5, m6, m7, m8, m9, m10, m11, m12, m13)++parseMouseEvent :: HandlerArg -> MouseEvent+parseMouseEvent (HandlerArg o) = MouseEvent+    { mouseAltKey = o .: "altKey"+    , mouseButton = o .: "button"+    , mouseButtons = o .: "buttons"+    , mouseClientX = o .: "clientX"+    , mouseClientY = o .: "clientY"+    , mouseCtrlKey = o .: "ctrlKey"+    , mouseGetModifierState = getModifierState o+    , mouseMetaKey = o .: "metaKey"+    , mousePageX = o .: "pageX"+    , mousePageY = o .: "pageY"+    , mouseRelatedTarget = EventTarget $ js_getProp o "relatedTarget"+    , mouseScreenX = o .: "screenX"+    , mouseScreenY = o .: "screenY"+    , mouseShiftKey = o .: "shiftKey"+    }++onClick :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onClick = mkHandler "onClick" parseMouseEvent++onContextMenu :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onContextMenu = mkHandler "onContextMenu" parseMouseEvent++onDoubleClick :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onDoubleClick = mkHandler "onDoubleClick" parseMouseEvent++onDrag :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onDrag = mkHandler "onDrag" parseMouseEvent++onDragEnd :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onDragEnd = mkHandler "onDragEnd" parseMouseEvent++onDragEnter :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onDragEnter = mkHandler "onDragEnter" parseMouseEvent++onDragExit :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onDragExit = mkHandler "onDragExit" parseMouseEvent++onDragLeave :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onDragLeave = mkHandler "onDragLeave" parseMouseEvent++onDragOver :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onDragOver = mkHandler "onDragOver" parseMouseEvent++onDragStart :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onDragStart = mkHandler "onDragStart" parseMouseEvent++onDrop :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onDrop = mkHandler "onDrop" parseMouseEvent++onMouseDown :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onMouseDown = mkHandler "onMouseDown" parseMouseEvent++onMouseEnter :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onMouseEnter = mkHandler "onMouseEnter" parseMouseEvent++onMouseLeave :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onMouseLeave = mkHandler "onMouseLeave" parseMouseEvent++onMouseMove :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onMouseMove = mkHandler "onMouseMove" parseMouseEvent++onMouseOut :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onMouseOut = mkHandler "onMouseOut" parseMouseEvent++onMouseOver :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onMouseOver = mkHandler "onMouseOver" parseMouseEvent++onMouseUp :: (Event -> MouseEvent -> handler) -> PropertyOrHandler handler+onMouseUp = mkHandler "onMouseUp" parseMouseEvent++--------------------------------------------------------------------------------+-- Touch+--------------------------------------------------------------------------------++#ifdef __GHCJS__+foreign import javascript unsafe+    "React['initializeTouchEvents'](true)"+    initializeTouchEvents :: IO ()+#else+initializeTouchEvents :: IO ()+initializeTouchEvents = return ()+#endif++data Touch = Touch {+    touchIdentifier :: Int+  , touchTarget :: EventTarget+  , touchScreenX :: Int+  , touchScreenY :: Int+  , touchClientX :: Int+  , touchClientY :: Int+  , touchPageX :: Int+  , touchPageY :: Int+} deriving (Show)++data TouchEvent = TouchEvent {+    touchAltKey :: Bool+  , changedTouches :: [Touch]+  , touchCtrlKey :: Bool+  , touchGetModifierState :: String -> Bool+  , touchMetaKey :: Bool+  , touchShiftKey :: Bool+  , touchTargets :: [Touch]+  , touches :: [Touch]+  }++instance Show TouchEvent where+    show (TouchEvent t1 t2 t3 _ t4 t5 t6 t7)+        = show (t1, t2, t3, t4, t5, t6, t7)++parseTouch :: JSRef a -> Touch+parseTouch o = Touch+    { touchIdentifier = o .: "identifier"+    , touchTarget = EventTarget $ js_getProp o "target"+    , touchScreenX = o .: "screenX"+    , touchScreenY = o .: "screenY"+    , touchClientX = o .: "clientX"+    , touchClientY = o .: "clientY"+    , touchPageX = o .: "pageX"+    , touchPageY = o .: "pageY"+    }++parseTouchList :: JSRef a -> JSString -> [Touch]+parseTouchList obj key = unsafePerformIO $ do+    let arr = js_getProp obj key+    len <- lengthArray arr+    forM [0..len-1] $ \idx -> do+        jsref <- indexArray idx arr+        return $ parseTouch jsref+parseTouchEvent :: HandlerArg -> TouchEvent+parseTouchEvent (HandlerArg o) = TouchEvent+    { touchAltKey = o .: "altKey"+    , changedTouches = parseTouchList o "changedTouches"+    , touchCtrlKey = o .: "ctrlKey"+    , touchGetModifierState = getModifierState o+    , touchMetaKey = o .: "metaKey"+    , touchShiftKey = o .: "shiftKey"+    , touchTargets = parseTouchList o "targetTouches"+    , touches = parseTouchList o "touches"+    }++onTouchCancel :: (Event -> TouchEvent -> handler) -> PropertyOrHandler handler+onTouchCancel = mkHandler "onTouchCancel" parseTouchEvent++onTouchEnd :: (Event -> TouchEvent -> handler) -> PropertyOrHandler handler+onTouchEnd = mkHandler "onTouchEnd" parseTouchEvent++onTouchMove :: (Event -> TouchEvent -> handler) -> PropertyOrHandler handler+onTouchMove = mkHandler "onTouchMove" parseTouchEvent++onTouchStart :: (Event -> TouchEvent -> handler) -> PropertyOrHandler handler+onTouchStart = mkHandler "onTouchStart" parseTouchEvent++--------------------------------------------------------------------------------+-- UI Events+--------------------------------------------------------------------------------++onScroll :: (Event -> handler) -> PropertyOrHandler handler+onScroll f = on "onScroll" (f . parseEvent)++--------------------------------------------------------------------------------+-- Wheel+--------------------------------------------------------------------------------++data WheelEvent = WheelEvent {+    wheelDeltaMode :: Int+  , wheelDeltaX :: Int+  , wheelDeltaY :: Int+  , wheelDeltaZ :: Int+} deriving (Show)++parseWheelEvent :: HandlerArg -> WheelEvent+parseWheelEvent (HandlerArg o) = WheelEvent+    { wheelDeltaMode = o .: "deltaMode"+    , wheelDeltaX = o .: "deltaX"+    , wheelDeltaY = o .: "deltaY"+    , wheelDeltaZ = o .: "deltaZ"+    }++onWheel :: (Event -> MouseEvent -> WheelEvent -> handler) -> PropertyOrHandler handler+onWheel f = EventHandler+    { evtHandlerName = "onWheel"+    , evtHandler = \raw -> f (parseEvent raw) (parseMouseEvent raw) (parseWheelEvent raw)+    }++--------------------------------------------------------------------------------+--- Image+--------------------------------------------------------------------------------++onLoad :: (Event -> handler) -> PropertyOrHandler handler+onLoad f = on "onLoad" (f . parseEvent)++onError :: (Event -> handler) -> PropertyOrHandler handler+onError f = on "onError" (f . parseEvent)++--------------------------------------------------------------------------------+--- JS Utils+--------------------------------------------------------------------------------++#ifdef __GHCJS__++foreign import javascript unsafe+    "$1[$2]"+    js_getProp :: JSRef a -> JSString -> JSRef b++-- | Access a property from an object.  Since event objects are immutable, we can use+-- unsafePerformIO without worry.+(.:) :: FromJSRef b => JSRef a -> JSString -> b+obj .: key = fromMaybe (error "Unable to decode event target") $ unsafePerformIO $+    fromJSRef $ js_getProp obj key++foreign import javascript unsafe+    "$1['getModifierState']($2)"+    js_GetModifierState :: JSRef () -> JSString -> JSBool++getModifierState :: JSRef () -> String -> Bool+getModifierState ref = fromJSBool . js_GetModifierState ref . toJSString++#else++js_getProp :: a -> String -> JSRef b+js_getProp _ _ = ()++(.:) :: JSRef () -> String -> b+_ .: _ = undefined++toJSString :: String -> JSString+toJSString = id++getModifierState :: JSRef () -> String -> Bool+getModifierState _ _ = False++lengthArray :: JSArray -> IO Int+lengthArray _ = return 0++indexArray :: Int -> JSArray -> IO (JSRef ())+indexArray _ _ = return ()++#endif
+ src/React/Flux/Store.hs view
@@ -0,0 +1,183 @@+-- | Internal module containing the store definitions.+module React.Flux.Store (+    ReactStoreRef(..)+  , ReactStore(..)+  , StoreData(..)+  , SomeStoreAction(..)+  , mkStore+  , getStoreData+  , alterStore+  , executeAction+) where++import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, readMVar)+import Control.DeepSeq+import Data.Typeable (Typeable)+import System.IO.Unsafe (unsafePerformIO)++#ifdef __GHCJS__+import GHCJS.Types (JSRef, isNull)+import React.Flux.Export (Export, export)+#else+type JSRef a = ()+#endif++-- | This type is used to represent the foreign javascript object part of the store.+newtype ReactStoreRef storeData = ReactStoreRef (JSRef ())++-- | A store contains application state, receives actions from the dispatcher, and notifies+-- component views to re-render themselves.  You can have multiple stores; it should be the case+-- that all of the state required to render the page is contained in the stores.  A store keeps a+-- global reference to a value of type @storeData@, which must be an instance of 'StoreData'.+--+-- Stores also work when compiled with GHC instead of GHCJS.  When compiled with GHC, the store is+-- just an MVar containing the store data and there are no controller views.  'alterStore' can still+-- be used, but it just 'transform's the store and does not notify any controller-views since there+-- are none.  Compiling with GHC instead of GHCJS can be helpful for unit testing, although GHCJS+-- plus node can also be used for unit testing.+--+-- >data Todo = Todo {+-- >    todoText :: String+-- >  , todoComplete :: Bool+-- >  , todoIsEditing :: Bool+-- >} deriving (Show, Typeable)+-- >+-- >newtype TodoState = TodoState {+-- >    todoList :: [(Int, Todo)]+-- >} deriving (Show, Typeable)+-- >+-- >data TodoAction = TodoCreate String+-- >                | TodoDelete Int+-- >                | TodoEdit Int+-- >                | UpdateText Int String+-- >                | ToggleAllComplete+-- >                | TodoSetComplete Int Bool+-- >                | ClearCompletedTodos+-- >  deriving (Show, Typeable, Generic, NFData)+-- >+-- >instance StoreData TodoState where+-- >    type StoreAction TodoState = TodoAction+-- >    transform action (TodoState todos) = ...+-- >+-- >todoStore :: ReactStore TodoState+-- >todoStore = mkStore $ TodoState+-- >    [ (0, Todo "Learn react" True False)+-- >    , (1, Todo "Learn react-flux" False False)+-- >    ]+data ReactStore storeData = ReactStore {+    -- | A reference to the foreign javascript part of the store.+    storeRef :: ReactStoreRef storeData++    -- | An MVar containing the current store data.  Normally, the MVar is full and contains the+    -- current store data.  When applying an action, the MVar is kept empty for the entire operation+    -- of transforming to the new data and sending the new data to all component views.  This+    -- effectively operates as a lock allowing only one thread to modify the store at any one time.+    -- This lock is safe because only the 'alterStore' function ever writes this MVar.+  , storeData :: MVar storeData+}++-- | Obtain the store data from a store.  Note that the store data is stored in an MVar, so+-- 'getStoreData' can block since it uses 'readMVar'.  The 'MVar' is empty exactly when the store is+-- being transformed, so there is a possiblity of deadlock if two stores try and access each other's+-- data during transformation.+getStoreData :: ReactStore storeData -> IO storeData+getStoreData (ReactStore _ mvar) = readMVar mvar++-- | The data in a store must be an instance of this typeclass.+class Typeable storeData => StoreData storeData where+    -- | The actions that this store accepts+    type StoreAction storeData++    -- | Transform the store data according to the action.  This is the only place in your app where+    -- @IO@ should occur.  The transform function should complete quickly, since the UI will not be+    -- re-rendered until the transform is complete.  Therefore, if you need to perform some longer+    -- action, you should fork a thread from inside 'transform'.  The thread can then call 'alterStore'+    -- with another action with the result of its computation.  This is very common to communicate with+    -- the backend using AJAX.+    --+    -- Note that if the transform throws an exception, the transform will be aborted and the old+    -- store data will be kept unchanged.  The exception will then be thrown from 'alterStore'.+    --+    -- For the best performance, care should be taken in only modifying the part of the store data+    -- that changed (see below for more information on performance).+    transform :: StoreAction storeData -> storeData -> IO storeData++-- | An existential type for some store action.  It is used as the output of the dispatcher.+-- The 'NFData' instance is important for performance, for details see below.+data SomeStoreAction = forall storeData. (StoreData storeData, NFData (StoreAction storeData))+    => SomeStoreAction (ReactStore storeData) (StoreAction storeData)++instance NFData SomeStoreAction where+    rnf (SomeStoreAction _ action) = action `deepseq` ()++----------------------------------------------------------------------------------------------------+-- mkStore has two versions+----------------------------------------------------------------------------------------------------++-- | Create a new store from the initial data.+mkStore :: StoreData storeData => storeData -> ReactStore storeData++#ifdef __GHCJS__++mkStore initial = unsafePerformIO $ do+    i <- export initial+    ref <- js_CreateStore i+    storeMVar <- newMVar initial+    return $ ReactStore ref storeMVar++-- | Create the javascript half of the store.+foreign import javascript unsafe+    "{sdata:$1, views: []}"+    js_CreateStore :: Export storeData -> IO (ReactStoreRef storeData)++-- | Perform the update, swapping the old export and the new export and then notifying the component views.+foreign import javascript unsafe+    "hsreact$transform_store($1, $2)"+    js_UpdateStore :: ReactStoreRef storeData -> Export storeData -> IO ()++#else++mkStore initial = unsafePerformIO $ do+    storeMVar <- newMVar initial+    return $ ReactStore (ReactStoreRef ()) storeMVar++#endif++{-# NOINLINE mkStore #-}++----------------------------------------------------------------------------------------------------+-- alterStore has two versions+----------------------------------------------------------------------------------------------------++-- | First, 'transform' the store data according to the given action.  Next, if compiled with GHCJS,+-- notify all registered controller-views to re-render themselves.  (If compiled with GHC, the store+-- data is just transformed since there are no controller-views.)+--+-- Only a single thread can be transforming the store at any one time, so this function will block+-- on an 'MVar' waiting for a previous transform to complete if one is in process.+alterStore :: StoreData storeData => ReactStore storeData -> StoreAction storeData -> IO ()++#ifdef __GHCJS__++alterStore store action = modifyMVar_ (storeData store) $ \oldData -> do+    newData <- transform action oldData++    -- There is a hack in PropertiesAndEvents that the fake event store for propagation and prevent+    -- default does not have a javascript store, so the store is nullRef.+    case storeRef store of+        ReactStoreRef ref | not $ isNull ref -> do+            newDataE <- export newData+            js_UpdateStore (storeRef store) newDataE+        _ -> return ()++    return newData++#else++alterStore store action = modifyMVar_ (storeData store) (transform action)++#endif++-- | Call 'alterStore' on the store and action.+executeAction :: SomeStoreAction -> IO ()+executeAction (SomeStoreAction store action) = alterStore store action
+ src/React/Flux/Views.hs view
@@ -0,0 +1,438 @@+-- | Internal module containing the view definitions+module React.Flux.Views where++import Control.Monad.Writer+import Data.Typeable (Typeable)++import React.Flux.Store+import React.Flux.Internal++#ifdef __GHCJS__+import Control.DeepSeq+import System.IO.Unsafe (unsafePerformIO)+import React.Flux.Export++import GHCJS.Types (JSRef, castRef, JSFun, JSString, JSArray)+import GHCJS.Foreign (syncCallback2, toJSString, ForeignRetention(..), fromArray)+import GHCJS.Marshal (ToJSRef(..))+type Callback a = JSFun a+#else+type JSRef a = ()+#endif+++-- | A view is conceptually a rendering function from @props@ and some internal state to a tree of elements.  The function+-- receives a value of type @props@ from its parent in the virtual DOM.  Additionally, the rendering+-- function can depend on some internal state or store data.  Based on the @props@ and the internal+-- state, the rendering function produces a virtual tree of elements which React then reconciles+-- with the browser DOM.+--+-- This module supports 3 kinds of views.  All of the views provided by this module are pure, in the+-- sense that the rendering function and event handlers cannot perform any IO.  All IO occurs inside+-- the 'transform' function of a store.+newtype ReactView props = ReactView { reactView :: ReactViewRef props }++---------------------------------------------------------------------------------------------------+--- Two versions of defineControllerView+---------------------------------------------------------------------------------------------------++-- | Event handlers in a controller-view and a view transform events into actions, but are not+-- allowed to perform any 'IO'.+type ViewEventHandler = [SomeStoreAction]++-- | A controller view provides the glue between a 'ReactStore' and the DOM.+-- The controller-view registers with the given store, and whenever the store is transformed the+-- controller-view re-renders itself.  Each instance of a controller-view also accepts properties of+-- type @props@ from its parent.  Whenever the parent re-renders itself, the new properties will be+-- passed down to the controller-view causing it to re-render itself.+--+-- Events registered on controller-views are expected to produce lists of 'SomeStoreAction'.  Since+-- lists of 'SomeStoreAction' are the output of the dispatcher, each event handler should just be a+-- call to a dispatcher function.  Once the event fires, the actions are executed causing the+-- store(s) to transform which leads to the controller-view(s) re-rendering.  This one-way flow of+-- data from actions to store to controller-views is central to the flux design.+--+-- It is recommended to have one controller-view for each+-- significant section of the page.  Controller-views deeper in the page tree can cause complexity+-- because data is now flowing into the page in multiple possibly conflicting places.  You must+-- balance the gain of encapsulated components versus the complexity of multiple entry points for+-- data into the page.  Note that multiple controller views can register with the same store.+--+-- >todoApp :: ReactView ()+-- >todoApp = defineControllerView "todo app" todoStore $ \todoState () ->+-- >    div_ $ do+-- >        todoHeader_+-- >        mainSection_ todoState+-- >        todoFooter_ todoState+defineControllerView :: (StoreData storeData, Typeable props)+                 => String -- ^ A name for this view, used only for debugging/console logging+                 -> ReactStore storeData -- ^ The store this controller view should attach to.+                 -> (storeData -> props -> ReactElementM ViewEventHandler ()) -- ^ The rendering function+                 -> ReactView props++#ifdef __GHCJS__++defineControllerView name (ReactStore store _) buildNode = unsafePerformIO $ do+    let render sd props = return $ buildNode sd props+    renderCb <- mkRenderCallback (js_ReactGetState >=> parseExport) runViewHandler render+    ReactView <$> js_createControllerView (toJSString name) store renderCb++-- | Transform a controller view handler to a raw handler.+runViewHandler :: ReactThis state props -> ViewEventHandler -> IO ()+runViewHandler _ handler = handler `deepseq` mapM_ executeAction handler++#else++defineControllerView _ _ _ = ReactView (ReactViewRef ())++#endif++{-# NOINLINE defineControllerView #-}++---------------------------------------------------------------------------------------------------+--- Two versions of defineView+---------------------------------------------------------------------------------------------------++-- | A view is a re-usable component of the page which accepts properties of type @props@ from its+-- parent and re-renders itself whenever the properties change.+--+-- One option to implement views is to just use a Haskell function taking the @props@ as input and+-- producing a 'ReactElementM'.  For small views, such a Haskell function is ideal.+-- Using a 'ReactView' provides more than just a Haskell function when used with a key property with+-- 'viewWithKey'.  The key property allows React to more easily reconcile the virtual DOM with the+-- browser DOM.+--+-- The following is two example views: @mainSection_@ is just a Haskell function and @todoItem@+-- is a React view.  We use the convention that an underscore suffix signifies a combinator+-- which can be used in the rendering function.+--+-- >mainSection_ :: TodoState -> ReactElementM ViewEventHandler ()+-- >mainSection_ st = section_ ["id" $= "main"] $ do+-- >    input_ [ "id" $= "toggle-all"+-- >           , "type" $= "checkbox"+-- >           , "checked" $= if all (todoComplete . snd) $ todoList st then "checked" else ""+-- >           , onChange $ \_ -> dispatchTodo ToggleAllComplete+-- >           ]+-- >+-- >    label_ [ "htmlFor" $= "toggle-all"] "Mark all as complete"+-- >    ul_ [ "id" $= "todo-list" ] $ mapM_ todoItem_ $ todoList st+-- >+-- >todoItem :: ReactView (Int, Todo)+-- >todoItem = defineView "todo item" $ \(todoIdx, todo) ->+-- >    li_ [ "className" @= (unwords $ [ "completed" | todoComplete todo] ++ [ "editing" | todoIsEditing todo ])+-- >        , "key" @= todoIdx+-- >        ] $ do+-- >        +-- >        div_ [ "className" $= "view"] $ do+-- >            input_ [ "className" $= "toggle"+-- >                   , "type" $= "checkbox"+-- >                   , "checked" @= todoComplete todo+-- >                   , onChange $ \_ -> dispatchTodo $ TodoSetComplete todoIdx $ not $ todoComplete todo+-- >                   ]+-- >+-- >            label_ [ onDoubleClick $ \_ _ -> dispatchTodo $ TodoEdit todoIdx] $+-- >                elemText $ todoText todo+-- >+-- >            button_ [ "className" $= "destroy"+-- >                    , onClick $ \_ _ -> dispatchTodo $ TodoDelete todoIdx+-- >                    ] mempty+-- >+-- >        when (todoIsEditing todo) $+-- >            todoTextInput_ TextInputArgs+-- >                { tiaId = Nothing+-- >                , tiaClass = "edit"+-- >                , tiaPlaceholder = ""+-- >                , tiaOnSave = dispatchTodo . UpdateText todoIdx+-- >                , tiaValue = Just $ todoText todo+-- >                }+-- >+-- >todoItem_ :: (Int, Todo) -> ReactElementM eventHandler ()+-- >todoItem_ todo = viewWithKey todoItem (fst todo) todo mempty+defineView :: Typeable props+       => String -- ^ A name for this view, used only for debugging/console logging+       -> (props -> ReactElementM ViewEventHandler ()) -- ^ The rendering function+       -> ReactView props++#ifdef __GHCJS__++defineView name buildNode = unsafePerformIO $ do+    let render () props = return $ buildNode props+    renderCb <- mkRenderCallback (const $ return ()) runViewHandler render+    ReactView <$> js_createView (toJSString name) renderCb++#else++defineView _ _ = ReactView (ReactViewRef ())++#endif++{-# NOINLINE defineView #-}++---------------------------------------------------------------------------------------------------+--- Two versions of defineStatefulView+---------------------------------------------------------------------------------------------------++-- | A stateful-view event handler produces a list of store actions and potentially a new state.  If+-- the new state is nothing, no change is made to the state (which allows an optimization in that we+-- do not need to re-render the view).+--+-- Changing the state causes a re-render which will cause a new event handler to be created.  If the+-- handler closes over the state passed into the rendering function, there is a race if multiple+-- events occur before React causes a re-render.  Therefore, the handler takes the current state as+-- input.  Your handlers therefore should ignore the state passed into the render function and+-- instead use the state passed directly to the handler.+type StatefulViewEventHandler state = state -> ([SomeStoreAction], Maybe state)++-- | A stateful view is a re-usable component of the page which keeps track of internal state.+-- Try to keep as many views as possible stateless.  The React documentation on+-- <https://facebook.github.io/react/docs/interactivity-and-dynamic-uis.html inteactivity and dynamic UIs>+-- has some discussion of what should and should not go into the state.+--+-- The rendering function is a pure function of the state and the properties from the parent.  The+-- view will be re-rendered whenever the state or properties change.  The only way to+-- transform the internal state of the view is via an event handler, which can optionally produce+-- new state.  Any more complicated state should be moved out into a (possibly new) store.+--+-- >data TextInputArgs = TextInputArgs {+-- >      tiaId :: Maybe String+-- >    , tiaClass :: String+-- >    , tiaPlaceholder :: String+-- >    , tiaOnSave :: String -> [SomeStoreAction]+-- >    , tiaValue :: Maybe String+-- >} deriving (Typeable)+-- >+-- >todoTextInput :: ReactView TextInputArgs+-- >todoTextInput = defineStatefulView "todo text input" "" $ \curText args ->+-- >    input_ $+-- >        maybe [] (\i -> ["id" @= i]) (tiaId args)+-- >        +++-- >        [ "className" @= tiaClass args+-- >        , "placeholder" @= tiaPlaceholder args+-- >        , "value" @= curText+-- >        , "autoFocus" @= True+-- >        , onChange $ \evt _ -> ([], Just $ target evt "value")+-- >        , onBlur $ \_ _ curState ->+-- >             if not (null curState)+-- >                 then (tiaOnSave args curState, Just "")+-- >                 else ([], Nothing)+-- >        , onKeyDown $ \_ evt curState ->+-- >             if keyCode evt == 13 && not (null curState) -- 13 is enter+-- >                 then (tiaOnSave args curState, Just "")+-- >                 else ([], Nothing)+-- >        ]+-- >+-- >todoTextInput_ :: TextInputArgs -> ReactElementM eventHandler ()+-- >todoTextInput_ args = view todoTextInput args mempty+defineStatefulView :: (Typeable state, Typeable props)+               => String -- ^ A name for this view, used only for debugging/console logging+               -> state -- ^ The initial state+               -> (state -> props -> ReactElementM (StatefulViewEventHandler state) ()) -- ^ The rendering function+               -> ReactView props++#ifdef __GHCJS__++defineStatefulView name initial buildNode = unsafePerformIO $ do+    initialRef <- export initial+    let render state props = return $ buildNode state props+    renderCb <- mkRenderCallback (js_ReactGetState >=> parseExport) runStateViewHandler render+    ReactView <$> js_createStatefulView (toJSString name) initialRef renderCb++-- | Transform a stateful view event handler to a raw event handler+runStateViewHandler :: Typeable state+                    => ReactThis state props -> StatefulViewEventHandler state -> IO ()+runStateViewHandler this handler = do+    st <- js_ReactGetState this >>= parseExport++    let (actions, mNewState) = handler st++    case mNewState of+        Nothing -> return ()+        Just newState -> do+            newStateRef <- export newState+            js_ReactUpdateAndReleaseState this newStateRef++    -- nothing above here should block, so the handler callback should still be running syncronous,+    -- so the deepseq of actions should still pick up the proper event object.+    actions `deepseq` mapM_ executeAction actions++#else++defineStatefulView _ _ _ = ReactView (ReactViewRef ())++#endif++{-# NOINLINE defineStatefulView #-}++---------------------------------------------------------------------------------------------------+--- Class+---------------------------------------------------------------------------------------------------++---------------------------------------------------------------------------------------------------+--- Various GHCJS only utilities+---------------------------------------------------------------------------------------------------++#ifdef __GHCJS__++newtype ReactThis state props = ReactThis (JSRef ())++foreign import javascript unsafe+    "$1['state'].hs"+    js_ReactGetState :: ReactThis state props -> IO (Export state)++foreign import javascript unsafe+    "$1['props'].hs"+    js_ReactGetProps :: ReactThis state props -> IO (Export props)++foreign import javascript unsafe+    "$1['props']['children']"+    js_ReactGetChildren :: ReactThis state props -> IO (JSArray ())++foreign import javascript unsafe+    "$1._updateAndReleaseState($2)"+    js_ReactUpdateAndReleaseState :: ReactThis state props -> Export state -> IO ()++foreign import javascript unsafe+    "React['findDOMNode']($1)"+    js_ReactFindDOMNode :: ReactThis state props -> IO (JSRef a)++foreign import javascript unsafe+    "React['findDOMNode']($1['refs'][$2])"+    js_ReactGetRef :: ReactThis state props -> JSString -> IO (JSRef a)++newtype RenderCbArg = RenderCbArg (JSRef ())++foreign import javascript unsafe+    "$1.newCallbacks = $2; $1.elem = $3;"+    js_RenderCbSetResults :: RenderCbArg -> JSRef [Callback (JSRef () -> IO ())] -> ReactElementRef -> IO ()++foreign import javascript unsafe+    "hsreact$mk_ctrl_view($1, $2, $3)"+    js_createControllerView :: JSString+                            -> ReactStoreRef storeData+                            -> Callback (JSRef () -> JSRef () -> IO ())+                            -> IO (ReactViewRef props)++-- | Create a view with no state.+foreign import javascript unsafe+    "hsreact$mk_view($1, $2)"+    js_createView :: JSString+                  -> Callback (JSRef () -> JSRef () -> IO ())+                  -> IO (ReactViewRef props)++-- | Create a view which tracks its own state.  Similar releasing needs to happen for callbacks and+-- properties as for controller views.+foreign import javascript unsafe+    "hsreact$mk_stateful_view($1, $2, $3)"+    js_createStatefulView :: JSString+                          -> Export state+                          -> Callback (JSRef () -> JSRef () -> IO ())+                          -> IO (ReactViewRef props)++foreign import javascript unsafe+    "hsreact$mk_lifecycle_view($1, $2, $3, $4, $5, $6, $7, $8, $9)"+    js_makeLifecycleView :: JSString -> Export state -> Callback (JSRef () -> JSRef () -> IO ())+                         -> JSRef a -> JSRef b -> JSRef c -> JSRef d -> JSRef e -> JSRef f -> IO (ReactViewRef props)++mkRenderCallback :: Typeable props+                 => (ReactThis state props -> IO state) -- ^ parse state+                 -> (ReactThis state props -> eventHandler -> IO ()) -- ^ execute event args+                 -> (state -> props -> IO (ReactElementM eventHandler ())) -- ^ renderer+                 -> IO (Callback (JSRef () -> JSRef () -> IO ()))+mkRenderCallback parseState runHandler render = syncCallback2 AlwaysRetain False $ \thisRef argRef -> do+    let this = ReactThis thisRef+        arg = RenderCbArg argRef+    state <- parseState this+    props <- js_ReactGetProps this >>= parseExport+    node <- render state props++    let getPropsChildren = do childRef <- js_ReactGetChildren this+                              childArr <- fromArray childRef+                              return $ map ReactElementRef childArr++    (element, evtCallbacks) <- mkReactElement (runHandler this) getPropsChildren node++    evtCallbacksRef <- toJSRef evtCallbacks+    js_RenderCbSetResults arg evtCallbacksRef element++parseExport :: Typeable a => Export a -> IO a+parseExport a = do+    mdata <- derefExport a+    maybe (error "Unable to load export from javascript") return mdata++#endif+++----------------------------------------------------------------------------------------------------+--- Element creation for views+----------------------------------------------------------------------------------------------------+++-- | Create an element from a view.  I suggest you make a combinator for each of your views, similar+-- to the examples above such as @todoItem_@.+view :: Typeable props+     => ReactView props -- ^ the view+     -> props -- ^ the properties to pass into the instance of this view+     -> ReactElementM eventHandler a -- ^ The children of the element+     -> ReactElementM eventHandler a+view rc props (ReactElementM child) =+    let (a, childEl) = runWriter child+     in elementToM a $ ViewElement (reactView rc) (Nothing :: Maybe Int) props childEl++-- | Create an element from a view, and also pass in a key property for the instance.  Key+-- properties speed up the <https://facebook.github.io/react/docs/reconciliation.html reconciliation>+-- of the virtual DOM with the DOM.  The key does not need to be globally unqiue, it only needs to+-- be unique within the siblings of an element.+viewWithKey :: (Typeable props, ReactViewKey key)+            => ReactView props -- ^ the view+            -> key -- ^ A value unique within the siblings of this element+            -> props -- ^ The properties to pass to the view instance+            -> ReactElementM eventHandler a -- ^ The children of the view+            -> ReactElementM eventHandler a+viewWithKey rc key props (ReactElementM child) =+    let (a, childEl) = runWriter child+     in elementToM a $ ViewElement (reactView rc) (Just key) props childEl++-- | Create a 'ReactElement' for a class defined in javascript.  For example, if you would like to+-- use <https://github.com/JedWatson/react-select react-select>, you could do so as follows:+--+-- >foreign import javascript unsafe+-- >    "window['Select']"+-- >    js_ReactSelectClass :: JSRef ()+-- >+-- >reactSelect_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler ()+-- >reactSelect_ props = foreignClass js_ReactSelectClass props mempty+-- >+-- >onSelectChange :: FromJSON a+-- >               => (a -> handler) -- ^ receives the new value and performs an action.+-- >               -> PropertyOrHandler handler+-- >onSelectChange f = callback "onChange" (f . parse)+-- >    where+-- >        parse v =+-- >            case fromJSON v of+-- >                Error err -> error $ "Unable to parse new value for select onChange: " ++ err+-- >                Success e -> e+--+-- This could then be used as part of a rendering function like so:+--+-- >reactSelect_+-- >    [ "name" $= "form-field-name"+-- >    , "value" $= "one"+-- >    , "options" @= [ object [ "value" .= "one", "label" .= "One" ]+-- >                   , object [ "value" .= "two", "label" .= "Two" ]+-- >                   ]+-- >    , onSelectChange dispatchSomething+-- >    ]+foreignClass :: JSRef cl -- ^ The javascript reference to the class+             -> [PropertyOrHandler eventHandler] -- ^ properties and handlers to pass when creating an instance of this class.+             -> ReactElementM eventHandler a -- ^ The child element or elements+             -> ReactElementM eventHandler a++#if __GHCJS__++foreignClass name attrs (ReactElementM child) =+    let (a, childEl) = runWriter child+     in elementToM a $ ForeignElement (Right $ ReactViewRef $ castRef name) attrs childEl++#else+foreignClass _ _ x = x+#endif
+ test/client/TestClient.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE OverloadedStrings, TypeFamilies #-}+module Main where++import Control.Monad+import Data.Typeable (Typeable)+import Data.Maybe+import Debug.Trace+import React.Flux+import React.Flux.Lifecycle++import GHCJS.Types (JSRef, JSString)+import GHCJS.Foreign (toJSString)+import GHCJS.Marshal (fromJSRef)++-- TODO: +-- * Addons+-- * callback property++foreign import javascript unsafe+    "(function(x) { \+    \    if (!window.test_client_output) window.test_client_output = []; \+    \    window.test_client_output.push(x); \+    \})($1)"+    js_output :: JSString -> IO ()++data OutputStoreData = OutputStoreData+    deriving (Show, Typeable)++instance StoreData OutputStoreData where+    type StoreAction OutputStoreData = [String]+    -- log both to the console and to js_output+    transform ss OutputStoreData = do+        mapM_ (js_output . toJSString) ss+        trace (unlines ss) $ return OutputStoreData++outputStore :: ReactStore OutputStoreData+outputStore = mkStore OutputStoreData++output :: [String] -> [SomeStoreAction]+output s = [SomeStoreAction outputStore s]++outputIO :: [String] -> IO ()+outputIO ss = void $ transform ss OutputStoreData++--------------------------------------------------------------------------------+--- Events+--------------------------------------------------------------------------------++logM :: (String -> Bool) -> String+logM f = "alt modifier: " ++ show (f "Alt")++logT :: EventTarget -> String+logT t = eventTargetProp t "id"++eventsView :: ReactView ()+eventsView = defineView "events" $ \() ->+    div_ $ do+        p_ $ input_ [ "type" $= "text"+                    , "id" $= "keyinput"+                    , "placeholder" $= "onKeyDown"+                    , onKeyDown $ \e k -> output+                        [ "keydown"+                        , show e+                        , show k+                        , logM (keyGetModifierState k)+                        , logT (evtTarget e)+                        , logT (evtCurrentTarget e)+                        ]+                    , onFocus $ \e _ -> output+                        [ "focus"+                        , show e+                        --, logT $ focusRelatedTarget f+                        ]+                    ]++        p_ $ label_ [ "id" $= "clickinput"+                    , onClick $ \e m -> output+                        [ "click"+                        , show e+                        , show m +                        , logM (mouseGetModifierState m)+                        --, logT (mouseRelatedTarget m)+                        ]+                    ]+           "onClick"++        p_ $ label_ [ "id" $= "touchinput"+                    , onTouchStart $ \e t -> output+                        [ "touchstart"+                        , show e+                        , show t+                        , logM (touchGetModifierState t)+                        , logT (touchTarget $ head $ touchTargets t)+                        , "endtouch"+                        ]+                    ]+           "onTouchStart"++        p_ $ a_ [ "id" $= "some-link"+                , "href" $= "http://www.haskell.org"+                , onClick $ \e _ -> output ["Click some-link"] ++ [preventDefault e]+                ]+                "Testing preventDefault"++        p_ $+            div_ [ "id" $= "outer-div"+                 , onClick $ \_ _ -> output ["Click on outer div"]+                 , capturePhase $ onDoubleClick $ \e _ -> output ["Double click outer div"] ++ [stopPropagation e]+                 ] $ do+                +                span_ [ "id" $= "inner-span"+                      , onClick $ \e _ -> output ["Click inner span"] ++ [stopPropagation e]+                      , onDoubleClick $ \_ _ -> output ["Double click inner span"]+                      ]+                      "Testing stopPropagation"++eventsView_ :: ReactElementM eventHandler ()+eventsView_ = view eventsView () mempty++--------------------------------------------------------------------------------+--- Lifecycle+--------------------------------------------------------------------------------++logPandS :: LPropsAndState String Int -> IO ()+logPandS ps = do+    p <- lGetProps ps+    st <- lGetState ps+    outputIO ["Current props and state: " ++ p ++ ", " ++ show st]++foreign import javascript unsafe+    "$1.id"+    js_domGetId :: JSRef a -> IO (JSRef String)++logDOM :: LDOM -> IO ()+logDOM dom = do+    this <- lThis dom >>= js_domGetId >>= fromJSRef+    x <- lRef dom "refSt" >>= js_domGetId >>= fromJSRef+    y <- lRef dom "refProps" >>= js_domGetId >>= fromJSRef+    outputIO [ "this id = " ++ fromMaybe "Nothing" this+             , "refStr id = " ++ fromMaybe "Nothing" x+             , "refProps id = " ++ fromMaybe "Nothing" y+             ]+++testLifecycle :: ReactView String+testLifecycle = defineLifecycleView "testlifecycle" (12 :: Int) lifecycleConfig+    { lRender = \s p -> p_ ["id" $= "lifecycle-p"] $ do+        span_ "Current state: "+        span_ ["ref" $= "refSt", "id" $= "hello"] (elemShow s)+        span_ ["ref" $= "refProps", "id" $= "world"] $ elemText $ "Current props: " ++ p+        button_ [ "id" $= "increment-state"+                , onClick $ \_ _ st -> ([], Just $ st + 1)+                ] "Incr"+        div_ childrenPassedToView++    , lComponentWillMount = Just $ \pAndS setStateFn -> do+        outputIO ["will mount"]+        logPandS pAndS+        setStateFn 100++    , lComponentDidMount = Just $ \pAndS dom _setStateFn -> do+        outputIO ["did mount"]+        logPandS pAndS+        logDOM dom++    , lComponentWillReceiveProps = Just $ \pAndS _dom _setStateFn newProps -> do+        outputIO ["will recv props"]+        logPandS pAndS+        outputIO ["New props: " ++ newProps]++    , lComponentWillUpdate = Just $ \pAndS _dom newProps newState -> do+        outputIO ["will update"]+        logPandS pAndS+        outputIO ["New props: " ++ newProps, "New state: " ++ show newState]++    , lComponentDidUpdate = Just $ \pAndS _dom _setStateFn oldProps oldState -> do+        outputIO ["did update"]+        logPandS pAndS+        outputIO ["Old props: " ++ oldProps, "Old state: " ++ show oldState]++    , lComponentWillUnmount = Just $ \pAndS _dom -> do+        outputIO ["will unmount"]+        logPandS pAndS+    }++testLifecycle_ :: String -> ReactElementM eventHandler ()+testLifecycle_ s = view testLifecycle s $ span_ ["id" $= "child-passed-to-view"] "I am a child!!!"++--------------------------------------------------------------------------------+--- Main+--------------------------------------------------------------------------------++-- | Test a lifecycle view with all lifecycle methods nothing+app :: ReactView ()+app = defineLifecycleView "app" "Hello" lifecycleConfig+    { lRender = \s () -> do+        eventsView_+        when (s /= "") $+            testLifecycle_ s+        button_ [ "id" $= "add-app-str"+                , onClick $ \_ _ s' -> ([], Just $ s' ++ "o")+                ]+                "Add o"+        button_ [ "id" $= "clear-app-str"+                , onClick $ \_ _ _ -> ([], Just "")+                ] "Clear"+    }++main :: IO ()+main = do+    initializeTouchEvents+    reactRender "app" app ()
+ test/client/test-client.html view
@@ -0,0 +1,10 @@+<html>+    <head>+        <title>Test Client</title>+    </head>+    <body>+        <div id="app"></div>+        <script src="https://fb.me/react-with-addons-0.13.3.js"></script>+        <script src="../../dist/build/test-client/test-client.jsexe/all.js"></script>+    </body>+</html>
+ test/spec/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/spec/TestClientSpec.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+module TestClientSpec (spec) where++import Control.Monad.IO.Class (liftIO)+import Control.Monad+import Data.List+import Test.Hspec.WebDriver+import System.Directory (getCurrentDirectory)+import qualified Data.Text as T++loadLog :: WD [String]+loadLog = executeJS [] "var old = window.test_client_output; window.test_client_output = []; return old;"++shouldBeEvent :: String -> (String, Bool, Int) -> WD ()+shouldBeEvent evt (expectedType, evtBandC, evtPhase) = do+    let prefix = concat+                  [ "Event {evtType = \"" ++ expectedType ++ "\", "+                  , "evtBubbles = " ++ show evtBandC ++ ", "+                  , "evtCancelable = " ++ show evtBandC ++ ", "+                  , "evtCurrentTarget = EventTarget, evtDefaultPrevented = False, "+                  , "evtPhase = " ++ show evtPhase ++ ", "+                  , "evtIsTrusted = False, evtTarget = EventTarget, evtTimestamp = "+                  ]+    unless (prefix `isPrefixOf` evt) $+        error $ "Expecting " ++ prefix ++ " but got " ++ evt+    let suffix = dropWhile (/= ' ') $ drop (length prefix) evt+    suffix `shouldBe` " evtHandlerArg = HandlerArg}"++lifecyclePropsAndStateAre :: String -> Int -> WD ()+lifecyclePropsAndStateAre props st = do+    stE <- findElem (ById "hello")+    getText stE `shouldReturn` (T.pack $ show st)+    p <- findElem (ById "world")+    getText p `shouldReturn` (T.pack $ "Current props: " ++ props)++spec :: Spec+spec = session " for the test client" $ using Chrome $ do+    it "opens the page" $ runWD $ do+        dir <- liftIO $ getCurrentDirectory+        openPage $ "file://" ++ dir ++ "/../client/test-client.html"+        loadLog `shouldReturn`+            [ "will mount"+            , "Current props and state: Hello, 12"+            , "did mount"+            , "Current props and state: Hello, 100"+            , "this id = lifecycle-p"+            , "refStr id = hello"+            , "refProps id = world"+            ]+        lifecyclePropsAndStateAre "Hello" 100+        child <- findElem (ById "child-passed-to-view")+        isDisplayed child `shouldReturn` True++    it "processes a focus event" $ runWD $ do+        findElem (ById "keyinput") >>= click+        [focus, evt] <- loadLog+        focus `shouldBe` "focus"+        evt `shouldBeEvent` ("focus", False, 1)++    it "processes a keydown event" $ runWD $ do+        findElem (ById "keyinput") >>= sendKeys "x"+        [keydown, evt, keyEvt, modState, target, curTarget] <- loadLog+        keydown `shouldBe` "keydown"+        evt `shouldBeEvent` ("keydown", True, 3)+        keyEvt `shouldBe` "(False,0,False,\"Unidentified\",88,\"\",0,False,False,False,88)"+        modState `shouldBe` "alt modifier: False"+        target `shouldBe` "keyinput"+        curTarget `shouldBe` "keyinput"++    it "processes a keydown with alt" $ runWD $ do+        findElem (ById "keyinput") >>= sendKeys "\xE00Ar" -- send Alt-r+        -- generates two events, one for alt, one for r+        [_, _, keyEvt, modState, _, _, _, _, keyEvt2, modState2, _, _] <- loadLog+        keyEvt `shouldBe` "(True,0,False,\"Alt\",18,\"\",0,False,False,False,18)"+        modState `shouldBe` "alt modifier: True"+        keyEvt2 `shouldBe` "(True,0,False,\"Unidentified\",82,\"\",0,False,False,False,82)"+        modState2 `shouldBe` "alt modifier: True"++    it "processes a click event" $ runWD $ do+        findElem (ById "clickinput") >>= click+        [clickName, evt, mouseEvt, modState] <- loadLog+        clickName `shouldBe` "click"+        evt `shouldBeEvent` ("click", True, 3)+        mouseEvt `shouldBe` "(False,0,0,37,54,False,False,37,54,EventTarget,37,54,False)"+        modState `shouldBe` "alt modifier: False"++    {- touch events can't be tested at the moment, chrome doesn't support them+    it "processes a touchinput event" $ runWD $ do+        t <- findElem $ ById "touchinput"+        touchClick t+    -}++    it "stops the default browser action" $ runWD $ do+        findElem (ById "some-link") >>= click+        [x] <- loadLog+        x `shouldBe` "Click some-link"+        url <- getCurrentURL+        unless ("file:" `isPrefixOf` url) $ error "Default browser action was not prevented"++    it "stops propagating an event in the bubbling phase" $ runWD $ do+        findElem (ById "inner-span") >>= moveToCenter+        clickWith LeftButton+        [inner] <- loadLog+        inner `shouldBe` "Click inner span"++    it "stops propagating an event during the capture phase" $ runWD $ do+        findElem (ById "inner-span") >>= moveToCenter+        doubleClick+        [inner, outer] <- loadLog+        inner `shouldBe` "Click inner span"+        outer `shouldBe` "Double click outer div"++    describe "lifecycle events" $ do++        it "properly updates the state" $ runWD $ do+            findElem (ById "increment-state") >>= click+            loadLog `shouldReturn`+                [ "will update"+                , "Current props and state: Hello, 100"+                , "New props: Hello"+                , "New state: 101"++                , "did update"+                , "Current props and state: Hello, 101"+                , "Old props: Hello"+                , "Old state: 100"+                ]+            lifecyclePropsAndStateAre "Hello" 101++        it "properly updates the properties" $ runWD $ do+            findElem (ById "add-app-str") >>= click+            loadLog `shouldReturn`+                [ "will recv props"+                , "Current props and state: Hello, 101"+                , "New props: Helloo"+                +                , "will update"+                , "Current props and state: Hello, 101"+                , "New props: Helloo"+                , "New state: 101"++                , "did update"+                , "Current props and state: Helloo, 101"+                , "Old props: Hello"+                , "Old state: 101"+                ]+            lifecyclePropsAndStateAre "Helloo" 101++        it "unmounts" $ runWD $ do+            findElem (ById "clear-app-str") >>= click+            loadLog `shouldReturn`+                [ "will unmount"+                , "Current props and state: Helloo, 101"+                ]++    {-+    it "inspects the session" $ runWD $ do+        loadLog >>= \x -> liftIO $ putStrLn $ show x+        inspectSession+    -}
+ test/spec/TodoSpec.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}+module TodoSpec (spec) where++import Control.Monad.IO.Class (liftIO)+import Control.Monad+import Test.Hspec.WebDriver+import System.Directory (getCurrentDirectory)+import qualified Data.Text as T++expectTodos :: [(T.Text, Bool)] -> WD ()+expectTodos todos = do+    entries <- findElems $ ByCSS "ul#todo-list > li"+    length entries `shouldBe` length todos++    -- check todos+    forM_ (zip entries todos) $ \(li, (todo, complete)) -> do+        chk <- findElemFrom li $ ByCSS "input[type=checkbox]"+        attr chk "checked" `shouldReturn` if complete then Just "true" else Nothing+        spn <- findElemFrom li $ ByTag "span"+        getText spn `shouldReturn` todo++    -- check items left+    let cnt = length $ filter (not . snd) todos+    cntSpan <- findElem $ ByCSS "span#todo-count"++    if cnt == 1+        then getText cntSpan `shouldReturn` "1 item left"+        else getText cntSpan `shouldReturn` (T.pack $ show cnt ++ " items left")++    -- clear completed+    let completedCnt = length $ filter snd todos+    when (completedCnt > 0) $ do+        completeBtn <- findElem $ ByCSS "button#clear-completed span"+        getText completeBtn `shouldReturn` (T.pack $ "Clear completed (" ++ show completedCnt ++ ")")++getRow :: Int -> WD Element+getRow i = do+    entries <- findElems $ ByCSS "ul#todo-list > li"+    return $ entries !! i++spec :: Spec+spec = session " for todo example application" $ using Chrome $ do+    it "opens the page" $ runWD $ do+        dir <- liftIO $ getCurrentDirectory+        openPage $ "file://" ++ dir ++ "/../../example/todo.html"+        expectTodos [("Learn react", True), ("Learn react-flux", False)]++    it "adds a new todo via blur" $ runWD $ do+        txt <- findElem $ ByCSS "input#new-todo"+        sendKeys "Test react-flux" txt+        findElem (ByCSS "header#header h1") >>= click+        expectTodos [("Test react-flux", False), ("Learn react", True), ("Learn react-flux", False)]++    it "marks a todo as completed" $ runWD $ do+        lastRow <- getRow 2+        findElemFrom lastRow (ByCSS "input[type=checkbox]") >>= click+        expectTodos [("Test react-flux", False), ("Learn react", True), ("Learn react-flux", True)]++    it "edits a todo" $ runWD $ do+        midRow <- getRow 1+        findElemFrom midRow (ByTag "span") >>= moveToCenter+        doubleClick+        editBox <- findElemFrom midRow (ByCSS "input.edit")+        sendKeys "Learn react.js" editBox+        findElem (ByCSS "header#header h1") >>= click+        expectTodos [("Test react-flux", False), ("Learn react.js", True), ("Learn react-flux", True)]++    it "clears all completed todos" $ runWD $ do+        findElem (ByCSS "button#clear-completed") >>= click+        expectTodos [("Test react-flux", False)]++    it "adds a todo via enter key" $ runWD $ do+        txt <- findElem $ ByCSS "input#new-todo"+        sendKeys "Party\xE007" txt+        expectTodos [("Party", False), ("Test react-flux", False)]++    it "marks all todos as complete" $ runWD $ do+        findElem (ByCSS "input#toggle-all") >>= click+        expectTodos [("Party", True), ("Test react-flux", True)]++    it "deletes a todo" $ runWD $ do+        lastRow <- getRow 1+        moveToCenter lastRow+        btn <- findElemFrom lastRow (ByCSS "button.destroy")+        click btn+        expectTodos [("Party", True)]
+ test/spec/react-flux-spec.cabal view
@@ -0,0 +1,17 @@+name: react-flux-spec+version: 0.0.0+build-type: Simple+cabal-version: >= 1.9++executable react-flux-spec+   ghc-options: -Wall+   hs-source-dirs: .+   main-is: Spec.hs+   other-modules: TodoSpec, TestClientSpec+   build-depends: base+                , hspec+                , webdriver+                , hspec-webdriver+                , directory+                , transformers+                , text
+ test/spec/stack.yaml view
@@ -0,0 +1,3 @@+resolver: lts-3.0+packages:+- '.'