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