diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# 0.9.0
+
+* Initial release
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -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
+~~~
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/example/Main.hs b/example/Main.hs
new file mode 100644
--- /dev/null
+++ b/example/Main.hs
@@ -0,0 +1,7 @@
+module Main where
+
+import React.Flux
+import TodoViews
+
+main :: IO ()
+main = reactRender "todoapp" todoApp ()
diff --git a/example/Makefile b/example/Makefile
new file mode 100644
--- /dev/null
+++ b/example/Makefile
@@ -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
diff --git a/example/README.md b/example/README.md
new file mode 100644
--- /dev/null
+++ b/example/README.md
@@ -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.
diff --git a/example/TodoComponents.hs b/example/TodoComponents.hs
new file mode 100644
--- /dev/null
+++ b/example/TodoComponents.hs
@@ -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
diff --git a/example/TodoDispatcher.hs b/example/TodoDispatcher.hs
new file mode 100644
--- /dev/null
+++ b/example/TodoDispatcher.hs
@@ -0,0 +1,7 @@
+module TodoDispatcher (dispatchTodo) where
+
+import React.Flux
+import TodoStore
+
+dispatchTodo :: TodoAction -> [SomeStoreAction]
+dispatchTodo a = [SomeStoreAction todoStore a]
diff --git a/example/TodoStore.hs b/example/TodoStore.hs
new file mode 100644
--- /dev/null
+++ b/example/TodoStore.hs
@@ -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)
+ ]
diff --git a/example/TodoViews.hs b/example/TodoViews.hs
new file mode 100644
--- /dev/null
+++ b/example/TodoViews.hs
@@ -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
diff --git a/example/css/bg.png b/example/css/bg.png
new file mode 100644
Binary files /dev/null and b/example/css/bg.png differ
diff --git a/example/css/todo.css b/example/css/todo.css
new file mode 100644
--- /dev/null
+++ b/example/css/todo.css
@@ -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;
+}
diff --git a/example/todo-dev.html b/example/todo-dev.html
new file mode 100644
--- /dev/null
+++ b/example/todo-dev.html
@@ -0,0 +1,13 @@
+
+
+
+
+ Todo example
+
+
+
+
+
+
+
+
diff --git a/example/todo.html b/example/todo.html
new file mode 100644
--- /dev/null
+++ b/example/todo.html
@@ -0,0 +1,13 @@
+
+
+
+
+ Todo example
+
+
+
+
+
+
+
+
diff --git a/jsbits/export.js b/jsbits/export.js
new file mode 100644
--- /dev/null
+++ b/jsbits/export.js
@@ -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;
+};
diff --git a/jsbits/store.js b/jsbits/store.js
new file mode 100644
--- /dev/null
+++ b/jsbits/store.js
@@ -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); });
+}
diff --git a/jsbits/views.js b/jsbits/views.js
new file mode 100644
--- /dev/null
+++ b/jsbits/views.js
@@ -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);
+}
diff --git a/react-flux.cabal b/react-flux.cabal
new file mode 100644
--- /dev/null
+++ b/react-flux.cabal
@@ -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
+maintainer: John Lenz
+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
diff --git a/src/React/Flux.hs b/src/React/Flux.hs
new file mode 100644
--- /dev/null
+++ b/src/React/Flux.hs
@@ -0,0 +1,186 @@
+-- | A binding to based on the
+-- 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 , 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
+-- , 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 .
+--
+-- __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 .
+-- 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
+-- 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 from two techniques: the
+-- and
+-- 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
+-- 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]
diff --git a/src/React/Flux/DOM.hs b/src/React/Flux/DOM.hs
new file mode 100644
--- /dev/null
+++ b/src/React/Flux/DOM.hs
@@ -0,0 +1,342 @@
+-- | This module contains combinators for creating DOM React elements.
+--
+-- The design of creating 'ReactElement's is loosly based on
+-- .
+-- 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
+-- between the browser DOM
+-- objects/properties and the properties and attributes you pass to React, as well as React only
+-- supports .
+-- 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
+-- 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
+--
+-- >
+-- >
Hello
+-- >
World
+-- >
+-- >
Nested
+-- >
List
+-- >
+-- >
+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"
diff --git a/src/React/Flux/Export.hs b/src/React/Flux/Export.hs
new file mode 100644
--- /dev/null
+++ b/src/React/Flux/Export.hs
@@ -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
diff --git a/src/React/Flux/Internal.hs b/src/React/Flux/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/React/Flux/Internal.hs
@@ -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
+--
+-- >
+-- >
Hello
+-- >
World
+-- >
+-- >
Nested
+-- >
List
+-- >
+-- >
+--
+-- 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
+--
+-- 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
diff --git a/src/React/Flux/Lifecycle.hs b/src/React/Flux/Lifecycle.hs
new file mode 100644
--- /dev/null
+++ b/src/React/Flux/Lifecycle.hs
@@ -0,0 +1,187 @@
+-- | React has
+-- 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
+-- , "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 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 #-}
diff --git a/src/React/Flux/PropertiesAndEvents.hs b/src/React/Flux/PropertiesAndEvents.hs
new file mode 100644
--- /dev/null
+++ b/src/React/Flux/PropertiesAndEvents.hs
@@ -0,0 +1,604 @@
+-- | This module contains the definitions for creating properties to pass to elements, as well as
+-- the definitions for the
+-- .
+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.
+--
+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
+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
diff --git a/src/React/Flux/Store.hs b/src/React/Flux/Store.hs
new file mode 100644
--- /dev/null
+++ b/src/React/Flux/Store.hs
@@ -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
diff --git a/src/React/Flux/Views.hs b/src/React/Flux/Views.hs
new file mode 100644
--- /dev/null
+++ b/src/React/Flux/Views.hs
@@ -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
+--
+-- 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
+-- 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 , 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
diff --git a/test/client/TestClient.hs b/test/client/TestClient.hs
new file mode 100644
--- /dev/null
+++ b/test/client/TestClient.hs
@@ -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 ()
diff --git a/test/client/test-client.html b/test/client/test-client.html
new file mode 100644
--- /dev/null
+++ b/test/client/test-client.html
@@ -0,0 +1,10 @@
+
+
+ Test Client
+
+
+
+
+
+
+
diff --git a/test/spec/Spec.hs b/test/spec/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/spec/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/test/spec/TestClientSpec.hs b/test/spec/TestClientSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/spec/TestClientSpec.hs
@@ -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
+ -}
diff --git a/test/spec/TodoSpec.hs b/test/spec/TodoSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/spec/TodoSpec.hs
@@ -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)]
diff --git a/test/spec/react-flux-spec.cabal b/test/spec/react-flux-spec.cabal
new file mode 100644
--- /dev/null
+++ b/test/spec/react-flux-spec.cabal
@@ -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
diff --git a/test/spec/stack.yaml b/test/spec/stack.yaml
new file mode 100644
--- /dev/null
+++ b/test/spec/stack.yaml
@@ -0,0 +1,3 @@
+resolver: lts-3.0
+packages:
+- '.'