react-flux 1.0.7 → 1.1.0

raw patch · 37 files changed

+1318/−701 lines, 37 filesdep ~basedep ~textdep ~timenew-component:exe:test-clientPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, text, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +65/−0
• Makefile +1/−1
• README.md +21/−28
• example/purecss-side-menu/PageViews.hs +1/−1
• example/purecss-side-menu/index.html +2/−2
• example/routing/EventTest.hs +9/−5
• example/routing/Main.hs +5/−3
• example/routing/TabbedApps.hs +1/−1
• example/routing/Types.hs +3/−2
• example/todo/TodoComponents.hs +16/−14
• example/todo/TodoStore.hs +5/−4
• example/todo/TodoViews.hs +4/−4
• example/todo/run-in-node.js +1/−0
• example/todo/todo-dev.html +2/−2
• example/todo/todo.html +2/−2
• jsbits/callback.js +12/−0
• jsbits/native.js +3/−0
• jsbits/views.js +44/−2
• react-flux.cabal +10/−21
• src/React/Flux.hs +123/−25
• src/React/Flux/Addons/Bootstrap.hs +6/−0
• src/React/Flux/Addons/Intl.hs +118/−89
• src/React/Flux/Combinators.hs +18/−23
• src/React/Flux/DOM.hs +1/−1
• src/React/Flux/Internal.hs +108/−58
• src/React/Flux/Lifecycle.hs +2/−2
• src/React/Flux/PropertiesAndEvents.hs +89/−31
• src/React/Flux/Store.hs +3/−3
• src/React/Flux/Views.hs +164/−30
• test/client/TestClient.hs +265/−77
• test/client/TestClient13.hs +0/−9
• test/client/TestClient14.hs +0/−126
• test/client/test-client.html +13/−0
• test/client/test-client13.html +0/−12
• test/client/test-client14.html +0/−14
• test/spec/TestClientSpec.hs +200/−108
• test/spec/stack.yaml +1/−1

@@ -1,3 +1,68 @@+# 1.1.0++* Breaking Change - I removed the use of `String` and replaced it with either `Text` or `JSString`+  (from the `Data.JSString` module in `ghcjs-base`).  If a value was just going to be passed straight into+  react, I made it a JSString and if the value was intended to be manipulated in Haskell I used Text.+  The main changes are:+      +      * `elemText` used to (confusingly) take a `String`.  Now there are three functions: `elemString`,+        `elemText`, and `elemJSString` that take a `String`, `Text`, and `JSString` value respectively.++      * The type of `$=` now uses JSString.  `$=` is intended only to avoid ambiguity when using+        overloaded strings and string constants and `JSString` has an `IsString` instance.++      * There is a new property creator `&=` which instead of converting to Aeson and then to a javascript+        value like `@=` does, `&=` uses the `ToJSVal` class from `GHCJS.Foreign.Marshal` to convert values+        directly to javascript.++      * Several functions had their type changed to instead of taking a String as a param take a Text or+        JSString as a parameter++   Despite being quite a large change, it didn't take much effort for me to convert my application to this+   new API.  You can see the conversion of the todo example application here:+   https://bitbucket.org/wuzzeb/react-flux/commits/a630da5f9032745ab92da6e3d9f9038915b9b319+   The main things that required changing are:++      * Converting between `String` and `JSString` is done via `pack` and `unpack` in `Data.JSString`.+        Converting between `Text` and `JSString` is done via `textToJSString` and `textFromJSString`+        in the `Data.JSString.Text` module.  In fact, this conversion needed to happen in only a+        few places for me because for the most part the `IsString` instance and `OverloadedStrings`+        extension properly converted the string literals to the proper type.  A few places I needed to+        use `<>` from `Data.Monoid` to concatenate `JSString`s.++      * A few places I was accidentally using `$=` for non-literal strings.  Switching these to `&=`+        was enough, since `&=` is polymorphic over the type of the property value.++      * Most places using `elemText` had an error, but here it was straightforward to switch to+        either `elemString` or keep `elemText` and use `Text` values inside my store.++* React-flux has used the shouldComponentUpdate lifetime method to prevent re-rendering in some cases,+  but it was finicky and sometimes wouldn't work (not a correctness bug, just a missed performance+  improvement).  I now better understand when it works and does not work, and edited the documentation+  to explain this and what you can do in your own code (primarily add bang patterns to force thunks).+  The new documentation is at the end of the main module page.++* The shouldComponentUpdate lifetime method now knows about view props which are tuples of size two or+  three, and will be able to skip re-rendering as long as each component of the tuple is unchanged+  (and is not a thunk).++* `React.Flux.Addons.Intl` now uses a new type `IntlProperty` defined in the module instead of using+  the pair type from aeson.  This allows passing arbitrary JSVals to i18n functions instead of just+  aeson values.  This causes API breakage in `formattedNumberProp`, `formattedDateProp`, `pluralProp`,+  `messageProp`, and `messageProp'`.++* Ability to export react views to JavaScript.  `callbackViewWithProps` inside `React.Flux.PropertiesAndEvents`+  allows you to create a javascript function which returns a renderable and then pass that JavaScript+  function to a foreign JavaScript class.  This is useful for example for fixed-data-table and ReactNative's+  ListView among others.  Secondly, `exportViewToJavaScript` from `React.Flux` allows just exporting+  a view to a JavaScript function, which is useful to embed a Haskell application into a larger JavaScript+  React application.++* Add a `style` combinator to easily write inline styles on elements.++* Add `viewWithIKey` and `viewWithSKey` for views with integer and string keys.  The old `viewWithKey`+  was akward to use when OverloadedStrings was enabled.+ # 1.0.7  * Fix the build when building with GHC instead of GHCJS (an import was incorrectly protected by CPP)

@@ -5,7 +5,7 @@  js-build/install-root: $(INSTALL_ROOT) 	mkdir -p js-build-	ln -s $(INSTALL_ROOT) js-build/install-root+	ln -sf $(INSTALL_ROOT) js-build/install-root  js-build/todo.min.js: js-build/todo.js 	closure --compilation_level=ADVANCED_OPTIMIZATIONS js-build/todo.js > js-build/todo.min.js

@@ -12,29 +12,27 @@  I use stack to build my frontend which uses react-flux.  I set up stack and ghcjs using [these-instructions](http://docs.haskellstack.org/en/stable/ghcjs.html).  Note that-react-flux requires GHCJS master (a.k.a. improved base).  At the moment I want-to use GHC 7.10.3 and no ghcjs snapshot uses lts-4.1 and GHC 7.10.3, so I am-building ghcjs manually.  So what I do is [install ghcjs from-git](https://github.com/ghcjs/ghcjs) using the following.  (Once the ghcjs-snapshots have caught up I will transition to using them and have stack install-ghcjs instead of installing ghcjs manually.)--~~~-$ git clone https://github.com/ghcjs/ghcjs.git-$ cabal install ./ghcjs-$ ghcjs-boot --dev-~~~--After this, in my application which depends on react-flux, I use the following `stack.yaml`:+instructions](http://docs.haskellstack.org/en/stable/ghcjs/).  Note that+react-flux requires GHCJS master (a.k.a. improved base).  I keep updated with+the latest version of GHCJS and lts.  As I write this, I use the following `stack.yaml`,+but as new LTS versions or new GHCJS versions come out I keep updating to them (and+probably forget to update this README :)  ~~~-resolver: lts-4.1-compiler: ghcjs-0.2.0_ghc-7.10.3+resolver: lts-6.1 packages:     - . extra-deps:-    - react-flux-1.0.3+    - react-flux-(version)++compiler: ghcjs-0.2.0.20160414_ghc-7.10.3+compiler-check: match-exact+setup-info:+  ghcjs:+    source:+      ghcjs-0.2.0.20160414_ghc-7.10.3:+        url: https://s3.amazonaws.com/ghcjs/ghcjs-0.2.0.20160414_ghc-7.10.3.tar.gz+        sha1: 6d6f307503be9e94e0c96ef1308c7cf224d06be3 ~~~  @@ -62,23 +60,18 @@ haskell application using [hspec-webdriver](https://hackage.haskell.org/package/hspec-webdriver).  This must be built using GHC (not GHCJS), so there is a separate `stack.yaml` file-in the `test/spec` directory.  In summary, run the following commands:+in the `test/spec` directory.  Also, `react-intl` must be installed in the test client+directory.  In summary, run the following commands:  ~~~ {.bash}-stack build-make+cd test/client+npm install react-intl cd test/spec stack build ~~~  Next, install [selenium-server-standalone](http://www.seleniumhq.org/download/) (also from-[npm](https://www.npmjs.com/package/selenium-server-standalone-jar)). Also, at the moment, the-release candiate of the react-intl library must be installed from npm.--~~~-cd test/client-npm install react-intl@v2.0.0-rc-1-~~~+[npm](https://www.npmjs.com/package/selenium-server-standalone-jar)).  Finally, start selenium-server-standalone and execute the test suite.  Make sure you also have closure installed, since the test suite will compress the todo app before testing it.  It must be

@@ -17,7 +17,7 @@             clbutton_ "pure-button" (changePageTo Page2) "Change to page 2"             "Also, try reducing the browser width to see the responsive menu."         p_ $ do-            "You must load this file from a server.  If you did not, no page changes will work.  Use for example "+            "You must load this file from a server.  If you did not, page changes might not work depending on your browser security settings (some features don't always work for file URLs).  Use for example "             code_ "python3 -m http.server 8000"             " or "             code_ "python2 -m SimpleHTTPServer 8000"

@@ -9,8 +9,8 @@     </head>     <body>         <div id="side-menu-app"/>-        <script src="https://fb.me/react-0.14.6.min.js"></script>-        <script src="https://fb.me/react-dom-0.14.6.min.js"></script>+        <script src="https://fb.me/react-15.1.0.min.js"></script>+        <script src="https://fb.me/react-dom-15.1.0.min.js"></script>         <script src="purecss-side-menu.js"></script>     </body> </html>

@@ -20,6 +20,10 @@ import           Data.Typeable                (Typeable) import           GHC.Generics                 (Generic) +#ifdef __GHCJS__+import Data.JSString (JSString)+#endif+ data ETState = ETState     { etActions :: [ETAction]     , etText    :: !T.Text@@ -69,13 +73,13 @@ view :: ReactView ETState view = defineView "event-tests" $ \(ETState actions text bool) ->   section_ $ do-    let textVal = "value" $= text+    let textVal = "value" &= text      div_ ["className" $= "et-actions"] $ do       a_ [onClick $ \_ _ -> dispatchEventTest ClearActionsA] $         elemText "Clear event history"       pre_ $-        elemText $ unlines $ map show actions+        elemString $ unlines $ map show actions      h2_ $ elemText "Testing keyboard events"     p_ $ elemText "Type <enter> to test onKeyUp/onKeyDown"@@ -187,13 +191,13 @@  #ifdef __GHCJS__ -targetInt :: Event -> String -> Int+targetInt :: Event -> JSString -> Int targetInt = target -targetText :: Event -> String -> T.Text+targetText :: Event -> JSString -> T.Text targetText = target -targetBool :: Event -> String -> Bool+targetBool :: Event -> JSString -> Bool targetBool = target  #else

@@ -1,5 +1,6 @@ -- | +{-# LANGUAGE OverloadedStrings #-} module Main where  import           React.Flux@@ -9,6 +10,7 @@ import           Router import qualified TabbedApps as TabbedApps import           Types+import qualified Data.Text as T  main :: IO () main = do@@ -33,15 +35,15 @@                  TabbedApps.Tab (appName a) (\pr -> view v pr mempty) (appRouter a))       apps appViews -clockApp :: String -> App TabbedApps.ParentRouter+clockApp :: T.Text -> App TabbedApps.ParentRouter clockApp name = App name Clock.store (\st _ -> Clock.view_ st) Clock.ClockInit Nothing -etApp :: String -> App TabbedApps.ParentRouter+etApp :: T.Text -> App TabbedApps.ParentRouter etApp name = App name rst (\st _ -> EventTest.view_ st) EventTest.ETInit Nothing   where     rst = EventTest.store -tabApp :: String -> [TabbedApps.Tab] -> App TabbedApps.ParentRouter+tabApp :: T.Text -> [TabbedApps.Tab] -> App TabbedApps.ParentRouter tabApp name tabs =   let rst = TabbedApps.newStore tabs   in

@@ -112,7 +112,7 @@   span_ ["style" @= A.object ["color" A..= ("#eee"::String)] | cur == aidx] $   if cur == aidx   then elemText aname-  else a_ ["href" $= actionRoute prouter (SwitchApp aidx Nothing)] $ elemText aname+  else a_ ["href" &= actionRoute prouter (SwitchApp aidx Nothing)] $ elemText aname  tabItem_ :: ((ParentRouter, Int), (Int, AppName)) -> ReactElementM eventHandler () tabItem_ tab =

@@ -14,8 +14,9 @@  import qualified Data.Text     as T import           Data.Typeable (Typeable)+import qualified Data.JSString.Text as JSS -type AppName = String+type AppName = T.Text type AppView = ReactElementM ViewEventHandler type AppRouter = [T.Text] -> IO () @@ -30,6 +31,6 @@  initApp :: Typeable props => App props -> IO (ReactView props) initApp App{..} = do-  let view' = defineControllerView appName appState (\st props -> appView st props)+  let view' = defineControllerView (JSS.textToJSString appName) appState (\st props -> appView st props)   alterStore appState appInitAction   return view'

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, BangPatterns #-}  -- | 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@@ -7,15 +7,17 @@  import Data.Typeable (Typeable) import React.Flux+import Data.JSString (JSString)+import qualified Data.Text as T  -- | 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+      tiaId :: Maybe JSString+    , tiaClass :: JSString+    , tiaPlaceholder :: JSString+    , tiaOnSave :: T.Text -> [SomeStoreAction]+    , tiaValue :: Maybe T.Text } deriving (Typeable)  -- | The text input stateful view.  The state is the text that has been typed into the textbox@@ -24,27 +26,27 @@ todoTextInput :: ReactView TextInputArgs todoTextInput = defineStatefulView "todo text input" "" $ \curText args ->     input_ $-        maybe [] (\i -> ["id" @= i]) (tiaId args)+        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+        [ "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)+            if not (T.null curState)                 then (tiaOnSave args curState, Just "")                 else ([], Nothing)         , onKeyDown $ \_ evt curState ->-             if keyCode evt == 13 && not (null curState) -- 13 is enter+             if keyCode evt == 13 && not (T.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+todoTextInput_ !args = view todoTextInput args mempty

@@ -1,13 +1,14 @@-{-# LANGUAGE TypeFamilies, DeriveGeneric, DeriveAnyClass #-}+{-# LANGUAGE TypeFamilies, DeriveGeneric, DeriveAnyClass, OverloadedStrings #-} module TodoStore where  import React.Flux import Control.DeepSeq import GHC.Generics (Generic) import Data.Typeable (Typeable)+import qualified Data.Text as T  data Todo = Todo {-    todoText :: String+    todoText :: T.Text   , todoComplete :: Bool   , todoIsEditing :: Bool } deriving (Show, Typeable)@@ -16,10 +17,10 @@     todoList :: [(Int, Todo)] } deriving (Show, Typeable) -data TodoAction = TodoCreate String+data TodoAction = TodoCreate T.Text                 | TodoDelete Int                 | TodoEdit Int-                | UpdateText Int String+                | UpdateText Int T.Text                 | ToggleAllComplete                 | TodoSetComplete Int Bool                 | ClearCompletedTodos

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, BangPatterns #-} -- | The views for the TODO app module TodoViews where @@ -82,7 +82,7 @@  -- | A combinator for a todo item to use inside rendering functions todoItem_ :: (Int, Todo) -> ReactElementM eventHandler ()-todoItem_ todo = viewWithKey todoItem (fst todo) todo mempty+todoItem_ !todo = viewWithIKey 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.@@ -100,8 +100,8 @@                 button_ [ "id" $= "clear-completed"                         , onClick $ \_ _ -> dispatchTodo ClearCompletedTodos                         ] $-                    elemText $ "Clear completed (" ++ show completed ++ ")"+                    elemString $ "Clear completed (" ++ show completed ++ ")"  -- | A render combinator for the footer todoFooter_ :: TodoState -> ReactElementM eventHandler ()-todoFooter_ s = view todoFooter s mempty+todoFooter_ !s = view todoFooter s mempty

@@ -1,2 +1,3 @@ React = require("react");+ReactDOMServer = require("react-dom/server"); require("../../js-build/install-root/bin/todo-node.jsexe/all.js");

@@ -7,8 +7,8 @@     </head>     <body>         <section id="todoapp"/>-        <script src="https://fb.me/react-0.14.6.js"></script>-        <script src=" https://fb.me/react-dom-0.14.6.js"></script>+        <script src="https://fb.me/react-0.15.1.js"></script>+        <script src=" https://fb.me/react-dom-0.15.1.js"></script>         <script src="../../js-build/install-root/bin/todo.jsexe/all.js"></script>     </body> </html>

@@ -7,8 +7,8 @@     </head>     <body>         <section id="todoapp"/>-        <script src="https://fb.me/react-15.0.0-rc.1.js"></script>-        <script src="https://fb.me/react-dom-15.0.0-rc.1.js"></script>+        <script src="https://fb.me/react-15.0.1.js"></script>+        <script src="https://fb.me/react-dom-15.0.1.js"></script>         <script src="../../js-build/todo.min.js"></script>     </body> </html>

@@ -7,3 +7,15 @@         f(args);     }; }++function hsreact$wrap_callback_returning_element(f) {+    return function() {+        var args = new Array(arguments.length);+        for (var i = 0; i < arguments.length; i++) {+            args[i] = arguments[i];+        }+        var ret = {};+        f(ret, args);+        return ret.elem;+    };+}

@@ -0,0 +1,3 @@+//Tests for ReactNative+var hsreact$divLikeElement = (typeof window === "object" && window['navigator']['product'] === "ReactNative") ? window["View"] : "div";+var hsreact$textWrapper = (typeof window === "object" && window['navigator']['product'] === "ReactNative") ? window["Text"] : "span";

@@ -32,13 +32,55 @@         },         _currentCallbacks: []     };++    //Checks if the javascript representations of two haskell values are the same.+    //This can't check equality but just checks if the javascript object has not been+    //changed.  We have special support for tuples of size 2 and 3, where we do check if the individual components of+    //the tuple are equal.+    var areValuesSame = function(obj1, obj2) {+        if (obj1 == obj2) { //use two equal signs to test if the objects are the same+            return true;++        } else {++            //check tuples of size two and 3.+            //+            //Tuples of size 2 are stored as+            //  { d1: first value+            //  , d2: second value+            //  , f: constructor function+            //  }+            //+            //Tuples of size 3 are stored as+            //  { d1: first value+            //  , d2: { d1: second value+            //        , d2: third value+            //        }+            //  , f: constructor function+            //  }+            var obj1_f = (obj1['f'] || {})['name'];+            var obj2_f = (obj2['f'] || {})['name'];++            if (obj1_f === "h$ghczmprimZCGHCziTupleziZLz2cUZR_con_e" && obj1_f === obj2_f) {+                //pair+                return obj1['d1'] == obj2['d1'] && obj1['d2'] == obj2['d2']; //use two equal signs to test if the objects are the same++            } else if (obj1_f === "h$ghczmprimZCGHCziTupleziZLz2cUz2cUZR_con_e" && obj1_f === obj2_f) {+                var obj1_d2 = obj1['d2'] || {};+                var obj2_d2 = obj2['d2'] || {};+                return obj1['d1'] == obj2['d1'] && obj1_d2['d1'] == obj2_d2['d1'] && obj1_d2['d2'] == obj2_d2['d2'];+            } else {+                return false;+            }+        }+    };     if (checkState) {         cl['shouldComponentUpdate'] = function(newProps, newState) {-            return this['props'].hs.root != newProps.hs.root || this['state'].hs.root != newState.hs.root;+            return !areValuesSame(this['props'].hs.root, newProps.hs.root) || !areValuesSame(this['state'].hs.root, newState.hs.root);         };     } else {         cl['shouldComponentUpdate'] = function(newProps, newState) {-            return this['props'].hs.root != newProps.hs.root;+            return !areValuesSame(this['props'].hs.root, newProps.hs.root);         };     } 

@@ -1,5 +1,5 @@ name:                react-flux-version:             1.0.7+version:             1.1.0 synopsis:            A binding to React based on the Flux application architecture for GHCJS category:            Web homepage:            https://bitbucket.org/wuzzeb/react-flux@@ -53,6 +53,7 @@               jsbits/export.js               jsbits/callback.js               jsbits/ajax.js+              jsbits/native.js    exposed-modules: React.Flux                    React.Flux.DOM@@ -106,6 +107,9 @@    build-depends: base                 , react-flux                 , deepseq+                , text+   if impl(ghcjs)+      build-depends: ghcjs-base  executable todo-node    if !flag(example)@@ -119,6 +123,8 @@                 , react-flux                 , deepseq                 , text+   if impl(ghcjs)+      build-depends: ghcjs-base  executable purecss-side-menu    if !flag(example)@@ -135,24 +141,7 @@    if impl(ghcjs)       build-depends: ghcjs-base -executable test-client-13-   if !flag(test-client)-        Buildable: False-   ghc-options: -Wall-   cpp-options: -DGHCJS_BROWSER--   default-language: Haskell2010-   hs-source-dirs: test/client-   other-modules: TestClient-   main-is: TestClient13.hs-   build-depends: base-                , react-flux-                , time-                , deepseq-   if impl(ghcjs)-      build-depends: ghcjs-base--executable test-client-14+executable test-client    if !flag(test-client)         Buildable: False    ghc-options: -Wall@@ -160,11 +149,11 @@     default-language: Haskell2010    hs-source-dirs: test/client-   other-modules: TestClient-   main-is: TestClient14.hs+   main-is: TestClient.hs    build-depends: base                 , react-flux                 , time+                , text                 , deepseq                 , aeson    if impl(ghcjs)

@@ -30,14 +30,20 @@ -- >})(window, window['React'], window['ReactDOM']); -- -- __Node Deployment__: 'reactRenderToString' is used to render the application to a string when--- running in node (not the browser).  To execute with node, you need to get @global.React@ (and--- @global.ReactDOM@ for 0.14) before executing all.js.  The TODO example application does this by+-- running in node (not the browser).  To execute with node, you need to get @global.React@ and+-- @global.ReactDOMServer@  before executing all.js.  The TODO example application does this by -- creating a file @run-in-node.js@ with the contents -- -- >React = require("react");--- >ReactDOM = require("react-dom");+-- >ReactDOMServer = require("react-dom/server"); -- >require("../../js-build/install-root/bin/todo-node.jsexe/all.js"); --+-- __React Native__: This module also works with <https://facebook.github.io/react-native/ React-Native>+-- to create a standalone native applications.  When combined with <http://electron.atom.io/ electron>,+-- you can even create standalone desktop applications.  The workflow is to use 'reactRender' the+-- same as web deployment but use the resulting JavaScript file in react-native and/or electron.+-- <https://github.com/jyrimatti/hseverywhere Jyrimatti has an example using react-native>.+-- -- __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,@@ -52,6 +58,7 @@ -- 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. +{-# OPTIONS_GHC -fno-warn-duplicate-exports #-} -- ArgumentsToProps is exported twice, once by React.Flux.PropertiesAndEvents and once here module React.Flux (   -- * Dispatcher   -- $dispatcher@@ -76,11 +83,13 @@   -- * Elements   , ReactElement   , ReactElementM(..)+  , elemString   , elemText+  , elemJSString   , elemShow   , view-  , viewWithKey-  , ReactViewKey+  , viewWithSKey+  , viewWithIKey   , childrenPassedToView   , foreignClass   , module React.Flux.DOM@@ -90,9 +99,16 @@   -- * Main   , reactRender   , reactRenderToString+  , exportViewToJavaScript+  , ArgumentsToProps+  , ReturnProps(..)    -- * Performance   -- $performance++  -- * Depracated+  , viewWithKey+  , ReactViewKey ) where  import Data.Typeable (Typeable)@@ -106,7 +122,7 @@ import React.Flux.Store  #ifdef __GHCJS__-import GHCJS.Types (JSString, JSVal, nullRef)+import GHCJS.Types (JSVal, nullRef) import GHCJS.Marshal (fromJSVal) #endif @@ -138,8 +154,8 @@  #endif --- | Render your React application to a string using either @React.renderToString@ if the first--- argument is false or @React.renderToStaticMarkup@ if the first argument is true.+-- | Render your React application to a string using either @ReactDOMServer.renderToString@ if the first+-- argument is false or @ReactDOMServer.renderToStaticMarkup@ if the first argument is true. -- Use this only on the server when running with node. reactRenderToString :: Typeable props                     => Bool -- ^ Render to static markup?  If true, this won't create extra DOM attributes@@ -159,11 +175,11 @@     maybe (error "Unable to convert string return to Text") return mtxt  foreign import javascript unsafe-    "(typeof ReactDOM === 'object' ? ReactDOM : React)['renderToString']($1)"+    "(typeof ReactDOMServer === 'object' ? ReactDOMServer : (typeof ReactDOM === 'object' ? ReactDOM : React))['renderToString']($1)"     js_ReactRenderToString :: ReactElementRef -> IO JSVal  foreign import javascript unsafe-    "(typeof ReactDOM === 'object' ? ReactDOM : React)['renderToStaticMarkup']($1)"+    "(typeof ReactDOMServer === 'object' ? ReactDOMServer : (typeof ReactDOM === 'object' ? ReactDOM : React))['renderToStaticMarkup']($1)"     js_ReactRenderStaticMarkup :: ReactElementRef -> IO JSVal  #else@@ -178,6 +194,8 @@ -- <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. --+-- __Reconciliation__+-- -- 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@@ -185,24 +203,104 @@ -- 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+-- re-rendering that view instance.  Note that we are not checking equality, just if the javascript+-- object representing a Haskell object has changed, with some special support for pairs and tuples+-- of size three. ----- >[ (idx, todo) | (idx, todo) <- todos, idx /= deleteIdx ]+-- There is subtle issue: this check only works if the props are not a thunk but are an actual data+-- constructor.  Consider the following ----- you should prefer+-- >data MyStoreData = MyStoreData {+-- >   myA :: !A+-- > , myB :: !B+-- > , myC :: !C+-- > , myD :: !D+-- >} deriving (Show, Typeable)+-- >+-- >myAview :: ReactView A+-- >myAview = defineView ....+-- >+-- >myStoreView :: ReactView ()+-- >myStoreView = defineControllerView "my store" myStore $ \myData () ->+-- >    div_ $ view myAview (myA myData) mempty+-- >    div_ .... ----- >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.+-- In @myStoreView@, note that @myA myData@ is passed as the props to @myAview@.  So consider the+-- situtation when say an action changes @C@ but leaves @A@ unchanged.  We would like for the+-- rendering of @myAview@ to be skipped, but unfortunately it will be re-rendered.  The reason is+-- that the props passed to @myAview@ is an unevaluated thunk @myA myData@.  Sure, the @A@+-- constructor has not changed and if the thunk is forced it will return this unchanged @A@ data+-- constructor, but the @shouldComponentUpdate@ test does not do any computation or evaluation, it+-- just checks if the passed in javascript object is the same as it was the last time the view was+-- rendered.  We can fix this by forcing the thunk before passing it to 'view', which I do via bang+-- patterns.  Instead of ever calling 'view' directly from a rendering function, for each+-- 'ReactView' I create a combinator as follows:+--+-- >myAview_ :: A -> ReactElementM handler ()+-- >myAview_ !a = view myAview a mempty+-- >+-- >myStoreView :: ReactView ()+-- >myStoreView = defineControllerView "my store" myStore $ \myData () ->+-- >    div_ $ myAview_ (myA myData)+-- >    div_ ....+--+-- Note the bang pattern on the @a@ parameter to @myAview_@.  What now happens is that the bang pattern+-- forces the thunk @myA myData@ to turn into the @A@ data constructor.  If an action does not edit the @A@ portion+-- of the store data, this will still be represented by the same javascript object as before and+-- React will not re-render the @myAview@.+--+-- Now consider another situtation where you would like a view that takes A and B.+--+-- >myAandBview :: ReactView (A, B)+-- >myAandBview = defineView ....+-- >+-- >myAandBview_ :: A -> B -> ReactElementM handler ()+-- >myAandBview_ !a !b = view myAandBview (a, b) mempty+-- >+-- >myStoreView :: ReactView ()+-- >myStoreView = defineControllerView "my store" myStore $ \myData () ->+-- >    div_ $ myAview_ (myA myData)+-- >    div_ $ myAandBview_ (myA myData) (myB myData)+-- >    div_ ....+--+-- Again, if you have an action that just changes @C@ you would like @myAandBview@ to not be+-- re-rendered.  With the simple javascript object check, it would be re-rendered because the props+-- are a tuple and the Haskell value (and thus javascript object) for the tuple is being recreated each+-- time @myStoreView@ is rendered.  To overcome this obstacle, @react-flux@ contains special code to check pairs+-- and tuples of size three.  If the props are a pair or a tuple of size three, the components of+-- the tuple will be compared to see if they are the same javascript object.  Thus similar to the+-- above we need to make sure each component of the tuple is not a thunk but a data constructor,+-- which happens via the bang patterns in @myAandBview_@.  The end result is that if an action just+-- changes @C@ or @D@ and leaves @A@ and @B@ unchanged, the above code will cause React to not+-- re-render @myAandBview@ because the two components of the pair are forced and are still the same+-- unchanged data value/javascript object.  You can see this in action inside the test suite if you+-- would like an example.+--+-- So far we have been focusing on making sure the new props are not a thunk by forcing it before+-- passing it into 'view'.  But we also need to make sure the initial props are not a thunk.  This+-- is not quite as bad since the check will only fail the next time a re-render occurs and after+-- that everything will be OK so we will still mostly skip re-rendering, but is still a small+-- annoyance.  There are several ways to fix this, but the easiest is to add bang patterns to the+-- definition of @MyStoreData@.  If you scroll up you can see that each member of @MyStoreData@ has+-- a bang pattern.  Thus when an action does change @A@, whatever a new value is set into @myA@, it+-- will not be a thunk but an actual data constructor.  Then the initial props passed into the view+-- will not be a thunk.+--+-- In summary, you should follow these rules:+--+--  1. Use bang patterns on each member in your store data.  In fact, once GHC 8 is released, I+--  plan on turning on the new @StrictData@ extension and then all these bang patterns can be+--  dropped.+--+--  2. Try and keep your view parameters as part of the store that will be unchanged by some+--  actions.  Use tuples of size two or three to combine multiple parts of the store data or even+--  data from multiple stores. (Tuples of larger size could be supported without much effort if+--  required.)+--+--  3. For each view, make a combinator with a underscore suffix which uses bang patterns to force+--  the props before passing it to the 'view' function.+--+-- __Events__ -- -- 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

@@ -1,6 +1,12 @@ -- | Bindings to <http://react-bootstrap.github.io/ React-Bootstrap>.  To use this -- binding, include the browser-global version of @react-bootstrap.js@ so that @window.ReactBootstrap@ -- is defined.  You can then use 'bootstrap_' inside your rendering functions.+--+-- Note: I initially wrote these bindings when I was first starting React, but after some experience+-- I think that bootstrap and react just do not fit together and I no longer use bootstrap and react+-- together.  While I am leaving this here for backwards compatibility, I suggest you use a different+-- library.  I am currently using <http://www.material-ui.com Material UI> and accessing the+-- components using @foreign_@. module React.Flux.Addons.Bootstrap (     bootstrap_ ) where

@@ -1,13 +1,7 @@--- | Bindings to the <http://formatjs.io/react/ ReactIntl> library, which allows easy formatting of--- numbers, dates, times, relative times, pluralization, and translated messages. This library can--- be used for formatting and pluralization even if you intend to present your application in a single--- language and locale.------ These bindings are for the 2.0 version of ReactIntl which is currently as a release candidate--- (I am currently using v2.0.0-rc-1).  For temporary documentation,--- see <https://github.com/yahoo/react-intl/issues/162 issue62>.  Because this is a binding to a--- release candidate, the API below might change!  I consider it unlikely, but if a change is required--- I will violate the PVP and not increment the major number, just the minor number.+-- | Bindings to the <https://github.com/yahoo/react-intl ReactIntl> library version 2, which allows easy+-- formatting of numbers, dates, times, relative times, pluralization, and translated messages. This+-- library can be used for formatting and pluralization even if you intend to present your application+-- in a single language and locale. -- -- To use these bindings, you need to provide the @ReactIntl@ variable.  In the browser you can just -- load the @react-intl.min.js@ script onto the page so that @window.ReactIntl@ exists.  If you are@@ -91,6 +85,10 @@     intlProvider_    -- * Formatting+  , IntlProperty+  , iprop+  , dayProp+  , timeProp      -- ** Numbers   , int_@@ -125,6 +123,8 @@   , messageProp'   , htmlMsg   , htmlMsg'+  , formattedMessage_+  , formattedHtmlMessage_    -- * Translation   , Message(..)@@ -136,7 +136,6 @@  import Control.Monad (when, forM_) import Data.Aeson (Object, Value(Object), object, (.=))-import Data.Aeson.Types (Pair) import Data.Char (ord, isPrint) import Data.List (sortBy) import Data.Maybe (catMaybes, fromMaybe)@@ -146,7 +145,7 @@ import Language.Haskell.TH (runIO, Q, Loc, location, ExpQ) import Language.Haskell.TH.Syntax (liftString, qGetQ, qPutQ, reportWarning, Dec) import React.Flux-import React.Flux.Internal (PropertyOrHandler(PropertyFromContext))+import React.Flux.Internal (PropertyOrHandler(PropertyFromContext), toJSString) import System.IO (withFile, IOMode(..)) import qualified Data.Aeson as Aeson import qualified Data.ByteString as B@@ -157,9 +156,9 @@  #ifdef __GHCJS__ -import GHCJS.Types (JSVal, JSString)+import GHCJS.Types (JSString, JSVal) import GHCJS.Marshal (ToJSVal(..))-import qualified Data.JSString as JSS+import qualified JavaScript.Object as JSO  foreign import javascript unsafe     "$r = ReactIntl['IntlProvider']"@@ -194,8 +193,8 @@     js_mkDate :: Int -> Int -> Int -> JSVal  -- | Convert a day to a javascript Date-dayToRef :: Day -> JSVal-dayToRef day = js_mkDate (fromIntegral y) m d+dayToJSVal :: Day -> JSVal+dayToJSVal day = js_mkDate (fromIntegral y) m d     where         (y, m, d) = toGregorian day @@ -204,31 +203,17 @@     js_mkDateTime :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> JSVal  -- | Convert a UTCTime to a javascript date object.-timeToRef :: UTCTime -> JSVal-timeToRef (UTCTime uday time) = js_mkDateTime (fromIntegral year) month day hour minute sec micro+timeToJSVal :: UTCTime -> JSVal+timeToJSVal (UTCTime uday time) = js_mkDateTime (fromIntegral year) month day hour minute sec milli     where         (year, month, day) = toGregorian uday         TimeOfDay hour minute pSec = timeToTimeOfDay time         (sec, fracSec) = properFraction pSec-        micro = round $ fracSec * 1000000-+        milli = round $ fracSec * 1000 -- milli is 10^3  foreign import javascript unsafe     "$1['intl'][$2]($3, $4)"-    js_callContextAPI :: JSVal -> JSString -> JSVal -> JSVal -> IO JSVal---data ContextApiCall a = ContextApiCall String a [Pair] JSVal--instance ToJSVal a => ToJSVal (ContextApiCall a) where-    toJSVal (ContextApiCall name a b ctx) = do-        aRef <- toJSVal a-        bRef <- toJSVal $ object b-        js_callContextAPI ctx (JSS.pack name) aRef bRef--formatCtx :: ToJSVal a => String -> String -> a -> [Pair] -> PropertyOrHandler handler-formatCtx name func val options = PropertyFromContext name $ ContextApiCall func val options-+    js_callContextAPI :: JSVal -> JSString -> JSVal -> JSO.Object -> IO JSVal #else  type JSVal = ()@@ -254,21 +239,53 @@ js_formatHtmlMsg :: JSVal js_formatHtmlMsg = () -dayToRef :: Day -> JSVal-dayToRef _ = ()+dayToJSVal :: Day -> JSVal+dayToJSVal _ = () -timeToRef :: UTCTime -> JSVal-timeToRef _ = ()+timeToJSVal :: UTCTime -> JSVal+timeToJSVal _ = ()  class ToJSVal a+instance ToJSVal JSVal+type JSString = String+#endif -formatCtx :: String -> String -> a -> [Pair] -> PropertyOrHandler handler-formatCtx name _ _ _ = PropertyFromContext name $ \() -> () +data IntlProperty = forall ref. ToJSVal ref => IntlProperty JSString ref++iprop :: ToJSVal v => JSString -> v -> IntlProperty+iprop = IntlProperty++dayProp :: JSString -> Day -> IntlProperty+dayProp n d = IntlProperty n (dayToJSVal d)++timeProp :: JSString -> UTCTime -> IntlProperty+timeProp n t = IntlProperty n (timeToJSVal t)++#ifdef __GHCJS__+data ContextApiCall a = ContextApiCall JSString a [IntlProperty] JSVal++instance ToJSVal a => ToJSVal (ContextApiCall a) where+    toJSVal (ContextApiCall name a props ctx) = do+        aRef <- toJSVal a+        propsObj <- JSO.create+        forM_ props $ \(IntlProperty n p) -> do+            pRef <- toJSVal p+            JSO.setProp n pRef propsObj+        js_callContextAPI ctx name aRef propsObj++formatCtx :: ToJSVal a => JSString -> JSString -> a -> [IntlProperty] -> PropertyOrHandler handler+formatCtx name func val options = PropertyFromContext name $ ContextApiCall func val options++#else+formatCtx :: JSString -> JSString -> a -> [IntlProperty] -> PropertyOrHandler handler+formatCtx name _ _ _ = PropertyFromContext name $ \() -> () #endif ++ -- | Use the IntlProvider to set the @locale@, @formats@, and @messages@ property.-intlProvider_ :: String -- ^ the locale to use+intlProvider_ :: JSString -- ^ the locale to use               -> Maybe JSVal                   -- ^ A reference to translated messages, which must be an object with keys                   -- 'MessageId' and value the translated message.  Set this as Nothing if you are not using@@ -283,7 +300,7 @@               -> ReactElementM eventHandler a intlProvider_ locale mmsgs mformats = foreignClass js_intlProvider props     where-        props = catMaybes [ Just ("locale" @= locale)+        props = catMaybes [ Just ("locale" &= locale)                           , (property "messages") <$> mmsgs                           , (property "formats" . Object) <$> mformats                           ]@@ -312,10 +329,10 @@ -- the number has not changed. 'formattedNumberProp' is needed if the formatted number has to be -- a property on another element, such as the placeholder for an input element. formattedNumberProp :: ToJSVal num-                    => String -- ^ the property to set+                    => JSString -- ^ the property to set                     -> num -- ^ the number to format-                    -> [Pair] -- ^ any options accepted by-                              -- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/NumberFormat Intl.NumberFormat>+                    -> [IntlProperty] -- ^ any options accepted by+                                      -- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/NumberFormat Intl.NumberFormat>                     -> PropertyOrHandler handler formattedNumberProp name x options = formatCtx name "formatNumber" x options @@ -330,21 +347,21 @@ -- These properties coorespond directly the options accepted by -- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/DateTimeFormat Intl.DateTimeFormat>. data DayFormat = DayFormat {-    weekdayF :: Maybe String -- ^ possible values are narrow, short, and long-  , eraF :: Maybe String -- ^ possible values are narrow, short, and long-  , yearF :: Maybe String -- ^ possible values are numeric and 2-digit-  , monthF :: Maybe String -- ^ possible values are numeric, 2-digit, narrow, short, and long-  , dayF :: Maybe String -- ^ possible values are numeric and 2-digit+    weekdayF :: Maybe JSString -- ^ possible values are narrow, short, and long+  , eraF :: Maybe JSString -- ^ possible values are narrow, short, and long+  , yearF :: Maybe JSString -- ^ possible values are numeric and 2-digit+  , monthF :: Maybe JSString -- ^ possible values are numeric, 2-digit, narrow, short, and long+  , dayF :: Maybe JSString -- ^ possible values are numeric and 2-digit } deriving Show  -- | Convert a format to the properties accepted by FormattedDate dayFtoProps :: DayFormat -> [PropertyOrHandler handler] dayFtoProps (DayFormat w e y m d) = catMaybes-    [ ("weekday"@=) <$> w-    , ("era"@=) <$> e-    , ("year"@=) <$> y-    , ("month"@=) <$> m-    , ("day"@=) <$> d+    [ ("weekday"&=) <$> w+    , ("era"&=) <$> e+    , ("year"&=) <$> y+    , ("month"&=) <$> m+    , ("day"&=) <$> d     ]  -- | A short day format, where month is \"short\" and year and day are \"numeric\".@@ -363,19 +380,19 @@ -- These properties coorespond directly the options accepted by -- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/DateTimeFormat Intl.DateTimeFormat>. data TimeFormat = TimeFormat {-    hourF :: Maybe String -- ^ possible values are numeric and 2-digit-  , minuteF :: Maybe String -- ^ possible values are numeric and 2-digit-  , secondF :: Maybe String -- ^ possible values are numeric and 2-digit-  , timeZoneNameF :: Maybe String -- ^ possible values are short and long+    hourF :: Maybe JSString -- ^ possible values are numeric and 2-digit+  , minuteF :: Maybe JSString -- ^ possible values are numeric and 2-digit+  , secondF :: Maybe JSString -- ^ possible values are numeric and 2-digit+  , timeZoneNameF :: Maybe JSString -- ^ possible values are short and long } deriving Show  -- | Convert a time format to properties for the FormattedDate element timeFtoProps :: TimeFormat -> [PropertyOrHandler handler] timeFtoProps (TimeFormat h m s t) = catMaybes-    [ ("hour"@=) <$> h-    , ("minute"@=) <$> m-    , ("second"@=) <$> s-    , ("timeZoneName"@=) <$> t+    [ ("hour"&=) <$> h+    , ("minute"&=) <$> m+    , ("second"&=) <$> s+    , ("timeZoneName"&=) <$> t     ]  -- | A default date and time format, using 'shortDate' and then numeric for hour, minute, and@@ -393,7 +410,7 @@ day_ :: DayFormat -> Day -> ReactElementM eventHandler () day_ fmt day = time_ [property "dateTime" dateRef] $ foreignClass js_formatDate props mempty     where-        dateRef = dayToRef day+        dateRef = dayToJSVal day         props = property "value" dateRef : dayFtoProps fmt  -- | Display a 'UTCTime' using the given format.  Despite giving the time in UTC, it will be@@ -402,7 +419,7 @@ utcTime_ :: (DayFormat, TimeFormat) -> UTCTime -> ReactElementM eventHandler () utcTime_ (dayFmt, timeF) t = time_ [property "dateTime" timeRef] $ foreignClass js_formatDate props mempty     where-        timeRef = timeToRef t+        timeRef = timeToJSVal t         props = property "value" timeRef : (dayFtoProps dayFmt ++ timeFtoProps timeF)  -- | A raw <http://formatjs.io/react/#formatted-date FormattedDate> class which allows custom@@ -413,46 +430,46 @@ formattedDate_ :: Either Day UTCTime -> [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () formattedDate_ t props = foreignClass js_formatDate (valProp:props) mempty     where-        valProp = property "value" $ either dayToRef timeToRef t+        valProp = property "value" $ either dayToJSVal timeToJSVal t  -- | Format a day or time as a string, and then use it as the value for a property.  'day_', -- 'utcTime_', or 'formattedDate_' should be prefered because as components they can avoid re-rendering when -- the date has not changed. 'formattedDateProp' is needed if the formatted date has to be -- a property on another element, such as the placeholder for an input element.-formattedDateProp :: String -- ^ the property to set+formattedDateProp :: JSString -- ^ the property to set                   -> Either Day UTCTime -- ^ the day or time to format-                  -> [Pair] -- ^ Any options supported by-                            -- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/DateTimeFormat Intl.DateTimeFormat>.+                  -> [IntlProperty] -- ^ Any options supported by+                                    -- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/DateTimeFormat Intl.DateTimeFormat>.                   -> PropertyOrHandler eventHandler formattedDateProp name (Left day) options =-    formatCtx name "formatDate" (dayToRef day) options+    formatCtx name "formatDate" (dayToJSVal day) options formattedDateProp name (Right time) options =-    formatCtx name "formatTime" (timeToRef time) options+    formatCtx name "formatTime" (timeToJSVal time) options  -- | Display the 'UTCTime' as a relative time.  In addition, wrap the display in a HTML5 -- <https://developer.mozilla.org/en-US/docs/Web/HTML/Element/time time> element. relativeTo_ :: UTCTime -> ReactElementM eventHandler () relativeTo_ t = time_ [property "dateTime" timeRef] $ foreignClass js_formatRelative [property "value" timeRef] mempty     where-        timeRef = timeToRef t+        timeRef = timeToJSVal t  -- | Format the given UTCTime using the <http://formatjs.io/react/#formatted-relative FormattedRelative> -- class to display a relative time to now.  The given 'UTCTime' is passed in the value property. -- The supported style/formatting properties are \"units\" which can be one of second, minute, hour, -- day, month, or year and \"style\" which if given must be numeric. formattedRelative_ :: UTCTime -> [PropertyOrHandler eventHandler] -> ReactElementM eventHandler ()-formattedRelative_ t props = foreignClass js_formatRelative (property "value" (timeToRef t) : props) mempty+formattedRelative_ t props = foreignClass js_formatRelative (property "value" (timeToJSVal t) : props) mempty  -- | Format a time as a relative time string, and then use it as the value for a property. -- 'relativeTo_' or 'formattedRelative_' should be prefered because as components they can avoid re-rendering when -- the date has not changed. 'formattedRelativeProp' is needed if the formatted date has to be -- a property on another element, such as the placeholder for an input element.-formattedRelativeProp :: String -- ^ te property to set+formattedRelativeProp :: JSString -- ^ te property to set                       -> UTCTime -- ^ the time to format-                      -> [Pair] -- ^ an object with properties \"units\" and \"style\".  \"units\" accepts values second, minute, hour-                                -- day, month, or year and \"style\" accepts only the value \"numeric\".+                      -> [IntlProperty] -- ^ an object with properties \"units\" and \"style\".  \"units\" accepts values second, minute, hour+                                        -- day, month, or year and \"style\" accepts only the value \"numeric\".                       -> PropertyOrHandler eventHandler-formattedRelativeProp name time options = formatCtx name "formatRelative" (timeToRef time) options+formattedRelativeProp name time options = formatCtx name "formatRelative" (timeToJSVal time) options  -------------------------------------------------------------------------------- -- Plural@@ -468,7 +485,7 @@ -- | Format a number properly based on pluralization, and then use it as the value for a property. -- 'plural_' should be preferred, but 'pluralProp' can be used in places where a component is not -- possible such as the placeholder of an input element.-pluralProp :: ToJSVal val => String -> val -> [Pair] -> PropertyOrHandler eventHandler+pluralProp :: ToJSVal val => JSString -> val -> [IntlProperty] -> PropertyOrHandler eventHandler pluralProp name val options = formatCtx name "formatPlural" val options  --------------------------------------------------------------------------------@@ -519,9 +536,9 @@         -> T.Text -- ^ The default message written in <http://formatjs.io/guides/message-syntax/ ICU message syntax>.                   -- This message is used if no translation is found, and is also the message given to the translators.         -> ExpQ --Q (TExp ([PropertyOrHandler eventHandler] -> ReactElementM eventHandler ()))-message ident m = formattedMessage [|js_formatMsg|] ident $ Message "" m+message ident m = formatMessage [|js_formatMsg|] ident $ Message "" m --- | Similar to 'message', but produce an expression of type @['Pair'] -> PropertyOrHandler handler@,+-- | Similar to 'message', but produce an expression of type @['IntlProperty'] -> PropertyOrHandler handler@, -- which should be passed the values for the message.  This allows you to format messages in places -- where using a component like 'message' is not possible, such as the placeholder of input -- elements. 'message' should be prefered since it can avoid re-rendering the formatting if the@@ -533,7 +550,7 @@ -- >       , $(messageProp "placeholder" "ageplaceholder" "Hello {name}, enter your age") -- >             [ "name" .= nameFrom storeData ] -- >       ]-messageProp :: String -- ^ the property name to set+messageProp :: T.Text -- ^ the property name to set             -> MessageId -- ^ the message identifier             -> T.Text -- ^ the default message written in ICU message syntax.             -> ExpQ@@ -545,10 +562,10 @@          -> T.Text -- ^ A description indented to provide context for translators          -> T.Text -- ^ The default message written in ICU message syntax          -> ExpQ --Q (TExp ([PropertyOrHandler eventHandler] -> ReactElementM eventHandler ()))-message' ident descr m = formattedMessage [|js_formatMsg|] ident $ Message descr m+message' ident descr m = formatMessage [|js_formatMsg|] ident $ Message descr m  -- | A varient of 'messageProp' which allows you to specify some context for translators.-messageProp' :: String -- ^ property to set+messageProp' :: T.Text -- ^ property to set              -> MessageId              -> T.Text -- ^ A description intended to provide context for translators              -> T.Text -- ^ The default message written in ICU message syntax@@ -563,14 +580,14 @@ htmlMsg :: MessageId         -> T.Text -- ^ default message written in ICU message syntax         -> ExpQ-htmlMsg ident m = formattedMessage [|js_formatHtmlMsg|] ident $ Message "" m+htmlMsg ident m = formatMessage [|js_formatHtmlMsg|] ident $ Message "" m  -- | A variant of 'htmlMsg' that allows you to specify some context for translators. htmlMsg' :: MessageId          -> T.Text -- ^ A description intended to provide context for translators          -> T.Text -- ^ The default message written in ICU message syntax          -> ExpQ-htmlMsg' ident descr m = formattedMessage [|js_formatHtmlMsg|] ident $ Message descr m+htmlMsg' ident descr m = formatMessage [|js_formatHtmlMsg|] ident $ Message descr m  recordMessage :: MessageId -> Message -> Q () recordMessage ident m = do@@ -587,18 +604,30 @@     qPutQ $ H.insert ident (m, curLoc) mmap  -- | Utility function for messages-formattedMessage :: ExpQ -> MessageId -> Message -> ExpQ --Q (TExp ([PropertyOrHandler eventHandler] -> ReactElementM eventHandler ()))-formattedMessage cls ident m = do+formatMessage :: ExpQ -> MessageId -> Message -> ExpQ --Q (TExp ([PropertyOrHandler eventHandler] -> ReactElementM eventHandler ()))+formatMessage cls ident m = do     recordMessage ident m     let liftText x = [| T.pack $(liftString $ T.unpack x)|]         liftedMsg = [| Message $(liftText $ msgDescription m) $(liftText $ msgDefaultMsg m) |]     [|\vals -> foreignClass $cls (messageToProps $(liftText ident) $liftedMsg vals) mempty |] -formatMessageProp :: String -> String -> MessageId -> Message -> ExpQ -- Q (TExp ([Pair] -> PropertyOrHandler eventHandler))+formatMessageProp :: T.Text -> T.Text -> MessageId -> Message -> ExpQ -- Q (TExp ([IntlProperty] -> PropertyOrHandler eventHandler)) formatMessageProp func name ident m = do     recordMessage ident m     let liftedMsg = [| object ["id" .= T.pack $(liftString $ T.unpack ident), "defaultMessage" .= T.pack $(liftString $ T.unpack $ msgDefaultMsg m) ] |]-    [|\options -> formatCtx $(liftString name) $(liftString func) $liftedMsg options |]+    [|\options -> formatCtx (toJSString $(liftString $ T.unpack name)) (toJSString $(liftString $ T.unpack func)) $liftedMsg options |]++-- | A raw @FormattedMessage@ element.  The given properties are passed directly with no handling.+-- Any message is not recorded in Template Haskell and will not appear in any resulting message file+-- created by 'writeIntlMessages'.+formattedMessage_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler ()+formattedMessage_ props = foreignClass js_formatMsg props mempty++-- | A raw @FormattedHTMLMessage@ element.  The given properties are passed directly with no handling.+-- Any message is not recorded in Template Haskell and will not appear in any resulting message file+-- created by 'writeIntlMessages'.+formattedHtmlMessage_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler ()+formattedHtmlMessage_ props = foreignClass js_formatHtmlMsg props mempty  -- | Perform an arbitrary IO action on the accumulated messages at compile time, which usually -- should be to write the messages to a file.  Despite producing a value of type @Q [Dec]@,

@@ -8,6 +8,7 @@   , faIcon_   , foreign_   , labeledInput_+  , style   -- * Ajax   , initAjax   , jsonAjax@@ -32,7 +33,7 @@ import Control.DeepSeq (deepseq) import GHCJS.Foreign.Callback import GHCJS.Marshal (ToJSVal(..), toJSVal_aeson, FromJSVal(..))-import GHCJS.Types (JSString, JSVal)+import GHCJS.Types (JSVal) import qualified Data.Text as T import qualified Data.JSString.Text as JSS @@ -44,8 +45,6 @@ #else js_lookupWindow :: a -> () js_lookupWindow _ = ()--type JSString = String #endif  -- | A wrapper around 'foreignClass' that looks up the class on the `window`.  I use it for several@@ -74,11 +73,11 @@ -- >                       ] -- >        , callback "onChange" $ \(i :: String) -> dispatch $ ItemChangedTo i -- >        ]-foreign_ :: String -- ^ this should be the name of a property on `window` which contains a react class.+foreign_ :: JSString -- ^ this should be the name of a property on `window` which contains a react class.          -> [PropertyOrHandler handler] -- ^ properties          -> ReactElementM handler a -- ^ children          -> ReactElementM handler a-foreign_ x = foreignClass (js_lookupWindow $ toJSString x)+foreign_ x = foreignClass (js_lookupWindow x)  -- | A 'div_' with the given class name (multiple classes can be separated by spaces).  This is -- useful for defining rows and columns in your CSS framework of choice.  I use@@ -88,28 +87,19 @@ -- >    cldiv_ "pure-u-1-3" $ p_ "First Third" -- >    cldiv_ "pure-u-1-3" $ p_ "Middle Third" -- >    cldiv_ "pure-u-1-3" $ p_ "Last Third"------ You should consider writing something like the following for the various components in your frontend--- of choice.  In PureCSS, I use:------ >prow_ :: ReactElementM handler a -> ReactElementM handler a--- >prow_ = cldiv_ "pure-g"--- >--- >pcol_ :: String -> ReactElementM handler a -> ReactElementM handler a--- >pcol_ cl = cldiv_ (unwords $ map ("pure-u-"++) $ words cl)-cldiv_ :: String -> ReactElementM handler a -> ReactElementM handler a-cldiv_ cl = div_ ["className" @= cl]+cldiv_ :: JSString -> ReactElementM handler a -> ReactElementM handler a+cldiv_ cl = div_ ["className" &= cl]  -- | A 'button_' with the given class names and `onClick` handler. ----- >clbutton_ ["pure-button button-success"] (dispatch LaunchTheMissiles) $ do+-- >clbutton_ "pure-button button-success" (dispatch LaunchTheMissiles) $ do -- >    faIcon_ "rocket" -- >    "Launch the missiles!"-clbutton_ :: String  -- ^ class names separated by spaces+clbutton_ :: JSString  -- ^ class names separated by spaces           -> handler -- ^ the onClick handler for the button           -> ReactElementM handler a -- ^ the children           -> ReactElementM handler a-clbutton_ cl h = button_ ["className" @= cl, onClick (\_ _ -> h)]+clbutton_ cl h = button_ ["className" &= cl, onClick (\_ _ -> h)]  -- | A 'label_' and an 'input_' together.  Useful for laying out forms.  For example, a -- stacked <http://purecss.io/forms/ Pure CSS Form> could be@@ -123,20 +113,25 @@ -- >            ["type" $= "password"] -- -- The second 'labeledInput_' shows an example using "React.Flux.Addons.Intl".-labeledInput_ :: String -- ^ the ID for the input element+labeledInput_ :: JSString -- ^ the ID for the input element               -> ReactElementM handler () -- ^ the label content.  This is wrapped in a 'label_' with a `htmlFor` property                                           -- equal to the given ID.               -> [PropertyOrHandler handler] -- ^ the properties to pass to 'input_'.  A property with key `id` is added to this list of properties.               -> ReactElementM handler ()-labeledInput_ ident lbl props = label_ ["htmlFor" @= ident] lbl <> input_ (("id" @= ident):props)+labeledInput_ ident lbl props = label_ ["htmlFor" &= ident] lbl <> input_ (("id" &= ident):props)  -- | A <http://fortawesome.github.io/Font-Awesome/ Font Awesome> icon.  The given string is prefixed -- by `fa fa-` and then used as the class for an `i` element.  This allows you to icons such as -- -- >faIcon_ "fighter-jet" -- produces <i class="fa fa-fighter-jet"> -- >faIcon_ "refresh fa-spin" -- produces <i class="fa fa-refresh fa-spin">-faIcon_ :: String -> ReactElementM handler ()-faIcon_ cl = i_ ["className" @= ("fa fa-" ++ cl)] mempty+faIcon_ :: JSString -> ReactElementM handler ()+faIcon_ cl = i_ ["className" &= ("fa fa-" <> cl)] mempty++-- | A simple combinator to easily write <https://facebook.github.io/react/tips/inline-styles.html inline styles>+-- on elements.+style :: [(JSString,JSString)] -> PropertyOrHandler handler+style = nestedProperty "style" . map (\(n,a) -> (n &= a))  -------------------------------------------------------------------------------- --- Ajax

@@ -51,7 +51,7 @@ -- | 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+    term :: JSString -> arg -> result  instance (child ~ ReactElementM eventHandler a) => Term eventHandler [PropertyOrHandler eventHandler] (child -> ReactElementM eventHandler a) where     term name props = el name props

@@ -2,22 +2,27 @@ -- -- 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(..)   , property+  , (&=)   , ReactElement(..)   , ReactElementM(..)+  , elemString   , elemText+  , elemJSString   , elemShow   , el   , childrenPassedToView   , elementToM   , mkReactElement+  , exportViewToJs   , toJSString+  , JSString ) where  import           Data.String (IsString(..))@@ -25,10 +30,12 @@ import           Data.Typeable (Typeable) import           Control.Monad.Writer import           Control.Monad.Identity (Identity(..))+import qualified Data.Text as T  #ifdef __GHCJS__ import           Unsafe.Coerce import qualified Data.JSString as JSS+import qualified Data.JSString.Text as JSS import           JavaScript.Array (JSArray) import qualified JavaScript.Array as JSA import           GHCJS.Foreign.Callback@@ -39,7 +46,6 @@ import           React.Flux.Export #else import Data.Text (Text)-type Callback a = () type JSVal = () class ToJSVal a instance ToJSVal Value@@ -47,6 +53,10 @@ instance ToJSVal () class IsJSVal a type JSArray = JSVal+type JSString = String+instance IsJSVal JSVal+instance IsJSVal JSString+instance ToJSVal JSString #endif  -- type JSObject a = JSO.Object a@@ -72,29 +82,34 @@ -- passed as the second argument to @React.createElement@. data PropertyOrHandler handler =    forall ref. ToJSVal ref => Property-      { propertyName :: String+      { propertyName :: JSString       , propertyVal :: ref       }  | forall ref. ToJSVal ref => PropertyFromContext -      { propFromThisName :: String+      { propFromThisName :: JSString       , propFromThisVal :: JSVal -> ref -- ^ will be passed this.context       }  | NestedProperty-      { nestedPropertyName :: String+      { nestedPropertyName :: JSString       , nestedPropertyVals :: [PropertyOrHandler handler]       }  | ElementProperty-      { elementPropertyName :: String+      { elementPropertyName :: JSString       , elementValue :: ReactElementM handler ()       }  | CallbackPropertyWithArgumentArray-      { caPropertyName :: String+      { caPropertyName :: JSString       , caFunc :: JSArray -> IO handler       }  | CallbackPropertyWithSingleArgument-      { csPropertyName :: String+      { csPropertyName :: JSString       , csFunc :: HandlerArg -> handler       }+ | forall props. Typeable props => CallbackPropertyReturningView+      { cretPropertyName :: JSString+      , cretArgToProp :: JSArray -> IO props+      , cretView :: ReactViewRef props+      }  instance Functor PropertyOrHandler where     fmap _ (Property name val) = Property name val@@ -104,28 +119,16 @@         ElementProperty name $ ReactElementM $ mapWriter (\((),e) -> ((), fmap f e)) mkElem     fmap f (CallbackPropertyWithArgumentArray name h) = CallbackPropertyWithArgumentArray name (fmap f . h)     fmap f (CallbackPropertyWithSingleArgument name h) = CallbackPropertyWithSingleArgument name (f . h)+    fmap _ (CallbackPropertyReturningView name f v) = CallbackPropertyReturningView name f v  -- | Create a property from anything that can be converted to a JSVal-property :: ToJSVal val => String -> val -> PropertyOrHandler handler+property :: ToJSVal val => JSString -> val -> PropertyOrHandler handler property = Property --- | Keys in React can either be strings or integers-class ReactViewKey key where-    toKeyRef :: key -> IO JSVal--#if __GHCJS__-instance ReactViewKey String where-    toKeyRef = return . unsafeCoerce . toJSString--instance ReactViewKey Int where-    toKeyRef i = toJSVal i-#else-instance ReactViewKey String where-    toKeyRef = const $ return ()--instance ReactViewKey Int where-    toKeyRef = const $ return ()-#endif+-- | Create a property for anything that can be converted to a javascript value using the @ToJSVal@+-- class from the @ghcjs-base@ package..  This is just an infix version of 'property'.+(&=) :: ToJSVal a => JSString -> a -> PropertyOrHandler handler+n &= a = Property n a  -- | 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@@ -134,19 +137,18 @@ -- elements are rendered into the browser DOM as siblings. data ReactElement eventHandler     = ForeignElement-        { fName :: Either String (ReactViewRef Object)+        { fName :: Either JSString (ReactViewRef Object)         , fProps :: [PropertyOrHandler eventHandler]         , fChild :: ReactElement eventHandler         }-    | forall props key. (Typeable props, ReactViewKey key) => ViewElement+    | forall props. Typeable props => ViewElement         { ceClass :: ReactViewRef props-        , ceKey :: Maybe key-        -- TODO: ref?  ref support would need to tie into the Class too.+        , ceKey :: Maybe JSVal         , ceProps :: props         , ceChild :: ReactElement eventHandler         }     | ChildrenPassedToView-    | Content String+    | Content JSString     | Append (ReactElement eventHandler) (ReactElement eventHandler)     | EmptyElement @@ -200,22 +202,35 @@          in elementToM () $ Append e1' e2'  instance (a ~ ()) => IsString (ReactElementM eventHandler a) where-    fromString s = elementToM () $ Content s+    fromString s = elementToM () $ Content $ toJSString 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+-- | Create a text element from a string. 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+-- property.  This is an alias for 'fromString'.+elemString :: String -> ReactElementM eventHandler ()+elemString s = elementToM () $ Content $ toJSString s +-- | Create a text element from a text value. The text content is escaped to be HTML safe.+elemText :: T.Text -> ReactElementM eventHandler ()+#ifdef __GHCJS__+elemText s = elementToM () $ Content $ JSS.textToJSString s+#else+elemText s = elementToM () $ Content $ T.unpack s+#endif++-- | Create a text element from a @JSString@.  This is more efficient for hard-coded strings than+-- converting from text to a JavaScript string.  The string is escaped to be HTML safe.+elemJSString :: JSString -> ReactElementM eventHandler ()+elemJSString 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+elemShow s = elementToM () $ Content $ toJSString $ show s  -- | Create a React element.-el :: String -- ^ The element name (the first argument to @React.createElement@).+el :: JSString -- ^ 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@@ -233,6 +248,8 @@ -- mkReactElement has two versions ---------------------------------------------------------------------------------------------------- +type CallbackToRelease = JSVal+ -- | 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.@@ -241,7 +258,7 @@                -> IO JSVal -- ^ this.context                -> IO [ReactElementRef] -- ^ this.props.children                -> ReactElementM eventHandler ()-               -> IO (ReactElementRef, [Callback (JSVal -> IO ())])+               -> IO (ReactElementRef, [CallbackToRelease])  #ifdef __GHCJS__ @@ -252,47 +269,52 @@         mToElem eM = do             let e = execWriter $ runReactElementM eM                 e' = case e of-                        Content txt -> ForeignElement (Left "span") [] (Content txt)+                        Content txt -> ForeignElement (Right $ ReactViewRef js_textWrapper) [] (Content txt)                         _ -> e             refs <- createElement e'             case refs of-                [] -> lift $ js_ReactCreateElementNoChildren "div"+                [] -> lift $ js_ReactCreateElementNoChildren js_divLikeElement                 [x] -> return x                 xs -> lift $ do                     emptyObj <- JSO.create                     let arr = jsval $ JSA.fromList $ map reactElementRef xs-                    js_ReactCreateElementName "div" emptyObj arr+                    js_ReactCreateForeignElement (ReactViewRef js_divLikeElement) emptyObj arr          -- add the property or handler to the javascript object         addPropOrHandlerToObj :: JSO.Object -> PropertyOrHandler eventHandler -> MkReactElementM ()         addPropOrHandlerToObj obj (Property n val) = lift $ do             vRef <- toJSVal val-            JSO.setProp (toJSString n) vRef obj+            JSO.setProp n vRef obj         addPropOrHandlerToObj obj (PropertyFromContext n f) = lift $ do             ctx <- getContext             vRef <- toJSVal $ f ctx-            JSO.setProp (toJSString n) vRef obj+            JSO.setProp n vRef obj         addPropOrHandlerToObj obj (NestedProperty n vals) = do             nested <- lift $ JSO.create             mapM_ (addPropOrHandlerToObj nested) vals-            lift $ JSO.setProp (toJSString n) (jsval nested) obj+            lift $ JSO.setProp n (jsval nested) obj         addPropOrHandlerToObj obj (ElementProperty name rM) = do             ReactElementRef ref <- mToElem rM-            lift $ JSO.setProp (toJSString name) ref obj+            lift $ JSO.setProp name ref obj         addPropOrHandlerToObj obj (CallbackPropertyWithArgumentArray name func) = do             -- this will be released by the render function of the class (jsbits/class.js)             cb <- lift $ syncCallback1 ContinueAsync $ \argref -> do                 handler <- func $ unsafeCoerce argref                 runHandler handler-            tell [cb]+            tell [jsval cb]             wrappedCb <- lift $ js_CreateArgumentsCallback cb-            lift $ JSO.setProp (toJSString name) wrappedCb obj+            lift $ JSO.setProp name wrappedCb obj         addPropOrHandlerToObj obj (CallbackPropertyWithSingleArgument name func) = do             -- this will be released by the render function of the class (jsbits/class.js)             cb <- lift $ syncCallback1 ContinueAsync $ \ref ->                 runHandler $ func $ HandlerArg ref+            tell [jsval cb]+            lift $ JSO.setProp name (jsval cb) obj++        addPropOrHandlerToObj obj (CallbackPropertyReturningView name toProps v) = do+            (cb, wrappedCb) <- lift $ exportViewToJs v toProps             tell [cb]-            lift $ JSO.setProp (toJSString name) (jsval cb) obj+            lift $ JSO.setProp name wrappedCb obj          -- call React.createElement         createElement :: ReactElement eventHandler -> MkReactElementM [ReactElementRef]@@ -309,7 +331,7 @@                              [x] -> x                              xs -> jsval $ JSA.fromList xs             e <- lift $ case fName f of-                Left s -> js_ReactCreateElementName (toJSString s) obj children+                Left s -> js_ReactCreateElementName s obj children                 Right ref -> js_ReactCreateForeignElement ref obj children             return [e]         createElement (ViewElement { ceClass = rc, ceProps = props, ceKey = mkey, ceChild = child }) = do@@ -322,17 +344,15 @@                              xs -> jsval $ JSA.fromList xs              e <- lift $ case mkey of-                Just key -> do-                    keyRef <- toKeyRef key-                    js_ReactCreateKeyedElement rc keyRef propsE children+                Just keyRef -> js_ReactCreateKeyedElement rc keyRef propsE children                 Nothing -> js_ReactCreateClass rc propsE children             return [e] -type MkReactElementM a = WriterT [Callback (JSVal -> IO ())] IO a+type MkReactElementM a = WriterT [CallbackToRelease] IO a  foreign import javascript unsafe     "React['createElement']($1)"-    js_ReactCreateElementNoChildren :: JSString -> IO ReactElementRef+    js_ReactCreateElementNoChildren :: JSVal -> IO ReactElementRef  foreign import javascript unsafe     "React['createElement']($1, $2, $3)"@@ -354,16 +374,46 @@     "hsreact$mk_arguments_callback($1)"     js_CreateArgumentsCallback :: Callback (JSVal -> IO ()) -> IO JSVal -js_ReactCreateContent :: String -> ReactElementRef-js_ReactCreateContent = ReactElementRef . unsafeCoerce . toJSString+foreign import javascript unsafe+    "hsreact$wrap_callback_returning_element($1)"+    js_wrapCallbackReturningElement :: Callback (JSVal -> JSVal -> IO ()) -> IO JSVal +foreign import javascript unsafe+    "$1.elem = $2"+    js_setElemReturnFromCallback :: JSVal -> ReactElementRef -> IO ()++foreign import javascript unsafe+    "$r = hsreact$divLikeElement"+    js_divLikeElement :: JSVal++foreign import javascript unsafe+    "$r = hsreact$textWrapper"+    js_textWrapper :: JSVal++js_ReactCreateContent :: JSString -> ReactElementRef+js_ReactCreateContent = ReactElementRef . unsafeCoerce+ toJSString :: String -> JSString toJSString = JSS.pack ++exportViewToJs :: Typeable props => ReactViewRef props -> (JSArray -> IO props) -> IO (CallbackToRelease, JSVal)+exportViewToJs view toProps = do+    cb <- syncCallback2 ContinueAsync $ \ret argref -> do+        props <- toProps $ unsafeCoerce argref+        propsE <- export props -- this will be released inside the lifetime events for the class+        e <- js_ReactCreateClass view propsE jsNull+        js_setElemReturnFromCallback ret e+    wrappedCb <- js_wrapCallbackReturningElement cb+    return (jsval cb, wrappedCb)+ #else mkReactElement _ _ _ _ = return (ReactElementRef (), [])  toJSString :: String -> String toJSString = id++exportViewToJs :: Typeable props => ReactViewRef props -> (JSArray -> IO props) -> IO (CallbackToRelease, JSVal)+exportViewToJs _ _ = return ((), ())  #endif

@@ -68,7 +68,7 @@ -- 'lRef'. data LDOM = LDOM   { lThis :: IO HTMLElement-  , lRef :: String -> IO HTMLElement+  , lRef :: JSString -> IO HTMLElement   }  -- | Set the state of the class.@@ -124,7 +124,7 @@     renderCb <- mkRenderCallback (js_ReactGetState >=> parseExport) runStateViewHandler render      let dom this = LDOM { lThis = js_ReactFindDOMNode this-                        , lRef = \r -> js_ReactGetRef this $ toJSString r+                        , lRef = \r -> js_ReactGetRef this r                         }          setStateFn this s = export s >>= js_ReactUpdateAndReleaseState this

@@ -11,10 +11,15 @@   , nestedProperty   , CallbackFunction   , callback+  , callbackView+  , ArgumentsToProps+  , ReturnProps(..)+  , callbackViewWithProps    -- ** Combinators   , (@=)   , ($=)+  , (&=)   , classNames    -- * Creating Events@@ -89,25 +94,27 @@ import           Control.Concurrent.MVar (newMVar) import           Control.DeepSeq import           System.IO.Unsafe (unsafePerformIO)+import           Data.Typeable (Typeable)+import           Data.Monoid ((<>)) import qualified Data.Text as T import qualified Data.Aeson as A import qualified Data.HashMap.Strict as M  import           React.Flux.Internal import           React.Flux.Store-import           React.Flux.Views (ViewEventHandler, StatefulViewEventHandler)+import           React.Flux.Views (ReactView(..), ViewEventHandler, StatefulViewEventHandler, ArgumentsToProps(..), ReturnProps(..))  #ifdef __GHCJS__ import           Data.Maybe (fromMaybe)  import           GHCJS.Foreign (fromJSBool) import           GHCJS.Marshal (FromJSVal(..))-import           GHCJS.Types (JSVal, nullRef, JSString, IsJSVal)+import           GHCJS.Types (JSVal, nullRef, IsJSVal) import           JavaScript.Array as JSA+import qualified Data.JSString.Text as JSS  #else type JSVal = ()-type JSString = String type JSArray = () class FromJSVal a class IsJSVal a@@ -118,7 +125,7 @@ -- | Some third-party React classes allow passing React elements as properties.  This function -- will first run the given 'ReactElementM' to obtain an element or elements, and then use that -- element as the value for a property with the given key.-elementProperty :: String -> ReactElementM handler () -> PropertyOrHandler handler+elementProperty :: JSString -> ReactElementM handler () -> PropertyOrHandler handler elementProperty = ElementProperty  -- | Allows you to create nested object properties.  The list of properties passed in will be@@ -132,7 +139,7 @@ -- would create a javascript object -- -- >{"Hello": {a: 100, b: "World"}, "c": "!!!"}-nestedProperty :: String -> [PropertyOrHandler handler] -> PropertyOrHandler handler+nestedProperty :: JSString -> [PropertyOrHandler handler] -> PropertyOrHandler handler nestedProperty = NestedProperty  -- | A class which is used to implement <https://wiki.haskell.org/Varargs variable argument functions>.@@ -176,21 +183,71 @@ -- >baz :: ViewEventHandler -- -- For another example, see the haddock comments in "React.Flux.Addons.Bootstrap".-callback :: CallbackFunction handler func => String -> func -> PropertyOrHandler handler+callback :: CallbackFunction handler func => JSString -> func -> PropertyOrHandler handler callback name func = CallbackPropertyWithArgumentArray name $ \arr -> applyFromArguments arr 0 func +-- | Create a zero-argument callback property.  When this callback function is executed, it+-- will render the given view and return the resulting React element.  If you need to +-- create a callback which expects arguments, use 'callbackViewWithProps' instead.+callbackView :: JSString -> ReactView () -> PropertyOrHandler handler+callbackView name v = CallbackPropertyReturningView name (const $ return ()) (reactView v)++-- | Create a callback that when called will render a view.  This is useful for interacting with third-party React classes that expect+-- a property which is a function which when called returns a React element.   The way this works is+-- as follows:+--+-- 1. You create a Haskell function which translates the javascript arguments of the callback into a Haskell+-- value of type @ReturnProps props@.  This is a variable-argument function using the 'ArgumentsToProps' class.+-- For example,+--+--       @+--       data MyProps = MyProps { theInt :: Int, theString :: String }+--       myArgsToProps :: Int -> String -> ReturnProps MyProps+--       myArgsToProps i s = ReturnProps $ MyProps i s+--       @+--+-- 2. You create a view which receives these properties and renders itself.  This view will not+-- receive any children.+--+--       @+--       myView :: ReactView MyProps+--       mYView = defineView "my view" $ \\myProps -> ...+--       @+--+-- 3. You can then use 'callbackViewWithProps' to create a property which is a JavaScript function.+-- When this JavaScript function is executed, the JavaScript arguments are converted to the props,+-- the view is rendered using the props, and the resulting React element is returned from the+-- JavaScript function.+--+--       @+--       someOtherView :: ReactView ()+--       someOtherView = defineView "some other view" $ \\() ->+--           div_ $+--              foreignClass_ "theForeginThing"+--                  [ callbackViewWithProps "the_propname_to_pass_to_theForeignThing" myView myArgsToProps+--                  , "hello" $= "world"+--                  ] mempty+--      @+--+--      @theForeignThing@ React class will receive a property called+--      @the_propname_to_pass_to_theForeignThing@.  The value of this property is a JavaScript+--      function which when executed will convert the arguments to @props@, render the view, and+--      return the resulting React element.+callbackViewWithProps :: (Typeable props, ArgumentsToProps props func) => JSString -> ReactView props -> func -> PropertyOrHandler handler+callbackViewWithProps name v func = CallbackPropertyReturningView name (\arr -> returnViewFromArguments arr 0 func) (reactView v)+ ---------------------------------------------------------------------------------------------------- --- Combinators ---------------------------------------------------------------------------------------------------- --- | Create a property.-(@=) :: A.ToJSON a => T.Text -> a -> PropertyOrHandler handler-n @= a = Property (T.unpack n) (A.toJSON a)+-- | Create a property from any aeson value (the at sign looks like "A" for aeson)+(@=) :: A.ToJSON a => JSString -> 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 (T.unpack n) a+($=) :: JSString -> JSString -> PropertyOrHandler handler+n $= a = Property n a  -- | Set the <https://facebook.github.io/react/docs/class-name-manipulation.html className> property to consist -- of all the names which are matched with True, allowing you to easily toggle class names based on@@ -213,12 +270,12 @@     show _ = "EventTarget"  -- | Access a property in an event target-eventTargetProp :: FromJSVal val => EventTarget -> String -> val-eventTargetProp (EventTarget ref) key = ref .: toJSString key+eventTargetProp :: FromJSVal val => EventTarget -> JSString -> val+eventTargetProp (EventTarget ref) key = ref .: key  -- | Every event in React is a synthetic event, a cross-browser wrapper around the native event. data Event = Event-    { evtType :: String+    { evtType :: T.Text     , evtBubbles :: Bool     , evtCancelable :: Bool     , evtCurrentTarget :: EventTarget@@ -240,7 +297,7 @@ -- >           ] -- -- In this case, @val@ would coorespond to the javascript expression @evt.target.value@.-target :: FromJSVal val => Event -> String -> val+target :: FromJSVal val => Event -> JSString -> val target e s = eventTargetProp (evtTarget e) s  parseEvent :: HandlerArg -> Event@@ -257,16 +314,17 @@     , evtHandlerArg = arg     } --- | Use this to create an event handler for an event not covered by the rest of this module.  At--- the moment, this is just the media events (onPlay, onPause, etc.) on image and video tags.-on :: String -> (Event -> handler) -> PropertyOrHandler handler+-- | Use this to create an event handler for an event not covered by the rest of this module.+-- (Events are not covered if they don't have extra arguments that require special handling.)+-- For example, onPlay and onPause are events you could use with @on@.+on :: JSString -> (Event -> handler) -> PropertyOrHandler handler on name f = CallbackPropertyWithSingleArgument     { csPropertyName = name     , csFunc = f . parseEvent     }  -- | Construct a handler from a detail parser, used by the various events below.-on2 :: String -- ^ The event name+on2 :: JSString -- ^ The event name     -> (HandlerArg -> detail) -- ^ A function parsing the details for the specific event.     -> (Event -> detail -> handler) -- ^ The function implementing the handler.     -> PropertyOrHandler handler@@ -334,7 +392,7 @@ -- | 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 (CallbackPropertyWithSingleArgument n h) = CallbackPropertyWithSingleArgument (n ++ "Capture") h+capturePhase (CallbackPropertyWithSingleArgument n h) = CallbackPropertyWithSingleArgument (n <> "Capture") h capturePhase _ = error "You must use React.Flux.PropertiesAndEvents.capturePhase on an event handler"  ---------------------------------------------------------------------------------------------------@@ -351,10 +409,10 @@   { keyEvtAltKey :: Bool   , keyEvtCharCode :: Int   , keyEvtCtrlKey :: Bool-  , keyGetModifierState :: String -> Bool-  , keyKey :: String+  , keyGetModifierState :: T.Text -> Bool+  , keyKey :: T.Text   , keyCode :: Int-  , keyLocale :: String+  , keyLocale :: Maybe T.Text   , keyLocation :: Int   , keyMetaKey :: Bool   , keyRepeat :: Bool@@ -434,7 +492,7 @@   , mouseClientX :: Int   , mouseClientY :: Int   , mouseCtrlKey :: Bool-  , mouseGetModifierState :: String -> Bool+  , mouseGetModifierState :: T.Text -> Bool   , mouseMetaKey :: Bool   , mousePageX :: Int   , mousePageY :: Int@@ -549,7 +607,7 @@     touchAltKey :: Bool   , changedTouches :: [Touch]   , touchCtrlKey :: Bool-  , touchGetModifierState :: String -> Bool+  , touchGetModifierState :: T.Text -> Bool   , touchMetaKey :: Bool   , touchShiftKey :: Bool   , touchTargets :: [Touch]@@ -669,8 +727,8 @@     "$1['getModifierState']($2)"     js_GetModifierState :: JSVal -> JSString -> JSVal -getModifierState :: JSVal -> String -> Bool-getModifierState ref = fromJSBool . js_GetModifierState ref . toJSString+getModifierState :: JSVal -> T.Text -> Bool+getModifierState ref = fromJSBool . js_GetModifierState ref . JSS.textToJSString  arrayLength :: JSArray -> Int arrayLength = JSA.length@@ -680,16 +738,16 @@  #else -js_getProp :: a -> String -> JSVal+js_getProp :: a -> JSString -> JSVal js_getProp _ _ = () -js_getArrayProp :: a -> String -> JSVal+js_getArrayProp :: a -> JSString -> JSVal js_getArrayProp _ _ = () -(.:) :: JSVal -> String -> b+(.:) :: JSVal -> JSString -> b _ .: _ = undefined -getModifierState :: JSVal -> String -> Bool+getModifierState :: JSVal -> T.Text -> Bool getModifierState _ _ = False  arrayLength :: JSArray -> Int

@@ -39,7 +39,7 @@ -- plus node can also be used for unit testing. -- -- >data Todo = Todo {--- >    todoText :: String+-- >    todoText :: Text -- >  , todoComplete :: Bool -- >  , todoIsEditing :: Bool -- >} deriving (Show, Typeable)@@ -48,10 +48,10 @@ -- >    todoList :: [(Int, Todo)] -- >} deriving (Show, Typeable) -- >--- >data TodoAction = TodoCreate String+-- >data TodoAction = TodoCreate Text -- >                | TodoDelete Int -- >                | TodoEdit Int--- >                | UpdateText Int String+-- >                | UpdateText Int Text -- >                | ToggleAllComplete -- >                | TodoSetComplete Int Bool -- >                | ClearCompletedTodos

@@ -1,4 +1,5 @@ -- | Internal module containing the view definitions+{-# LANGUAGE UndecidableInstances #-} module React.Flux.Views where  import Control.Monad.Writer@@ -13,11 +14,17 @@ import React.Flux.Export import JavaScript.Array import GHCJS.Foreign.Callback-import GHCJS.Types (JSVal, JSString, IsJSVal, jsval)-import GHCJS.Marshal (ToJSVal(..))+import GHCJS.Types (JSVal, IsJSVal, nullRef)+import GHCJS.Marshal (ToJSVal(..), FromJSVal(..))+import GHCJS.Marshal.Pure (PToJSVal(..))+import qualified JavaScript.Array as JSA  #else type JSVal = ()+type JSArray = ()+class FromJSVal a+pToJSVal :: a -> JSVal+pToJSVal _ = () #endif  @@ -65,7 +72,7 @@ -- >        mainSection_ todoState -- >        todoFooter_ todoState defineControllerView :: (StoreData storeData, Typeable props)-                 => String -- ^ A name for this view, used only for debugging/console logging+                 => JSString -- ^ 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@@ -75,7 +82,7 @@ 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+    ReactView <$> js_createControllerView name store renderCb  -- | Transform a controller view handler to a raw handler. runViewHandler :: ReactThis state props -> ViewEventHandler -> IO ()@@ -99,7 +106,7 @@ -- 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+-- 'viewWithSKey' and 'viewWithIKey'.  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@@@ -147,9 +154,9 @@ -- >                } -- > -- >todoItem_ :: (Int, Todo) -> ReactElementM eventHandler ()--- >todoItem_ todo = viewWithKey todoItem (fst todo) todo mempty+-- >todoItem_ !todo = viewWithIKey todoItem (fst todo) todo mempty defineView :: Typeable props-       => String -- ^ A name for this view, used only for debugging/console logging+       => JSString -- ^ A name for this view, used only for debugging/console logging        -> (props -> ReactElementM ViewEventHandler ()) -- ^ The rendering function        -> ReactView props @@ -158,7 +165,7 @@ defineView name buildNode = unsafePerformIO $ do     let render () props = return $ buildNode props     renderCb <- mkRenderCallback (const $ return ()) runViewHandler render-    ReactView <$> js_createView (toJSString name) renderCb+    ReactView <$> js_createView name renderCb  #else @@ -194,37 +201,37 @@ -- 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+-- >      tiaId :: Maybe JSString+-- >    , tiaClass :: JSString+-- >    , tiaPlaceholder :: JSString+-- >    , tiaOnSave :: Text -> [SomeStoreAction]+-- >    , tiaValue :: Maybe Text -- >} deriving (Typeable) -- > -- >todoTextInput :: ReactView TextInputArgs -- >todoTextInput = defineStatefulView "todo text input" "" $ \curText args -> -- >    input_ $--- >        maybe [] (\i -> ["id" @= i]) (tiaId args)+-- >        maybe [] (\i -> ["id" &= i]) (tiaId args) -- >        ++--- >        [ "className" @= tiaClass args--- >        , "placeholder" @= tiaPlaceholder args--- >        , "value" @= curText--- >        , "autoFocus" @= True+-- >        [ "className" &= tiaClass args+-- >        , "placeholder" &= tiaPlaceholder args+-- >        , "value" &= curText+-- >        , "autoFocus" &= True -- >        , onChange $ \evt _ -> ([], Just $ target evt "value") -- >        , onBlur $ \_ _ curState ->--- >             if not (null curState)+-- >             if not (Text.null curState) -- >                 then (tiaOnSave args curState, Just "") -- >                 else ([], Nothing) -- >        , onKeyDown $ \_ evt curState ->--- >             if keyCode evt == 13 && not (null curState) -- 13 is enter+-- >             if keyCode evt == 13 && not (Text.null curState) -- 13 is enter -- >                 then (tiaOnSave args curState, Just "") -- >                 else ([], Nothing) -- >        ] -- > -- >todoTextInput_ :: TextInputArgs -> ReactElementM eventHandler ()--- >todoTextInput_ args = view todoTextInput args mempty+-- >todoTextInput_ !args = view todoTextInput args mempty defineStatefulView :: (Typeable state, NFData state, Typeable props)-               => String -- ^ A name for this view, used only for debugging/console logging+               => JSString -- ^ 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@@ -235,7 +242,7 @@     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+    ReactView <$> js_createStatefulView name initialRef renderCb  -- | Transform a stateful view event handler to a raw event handler runStateViewHandler :: (Typeable state, NFData state)@@ -360,7 +367,7 @@      (element, evtCallbacks) <- mkReactElement (runHandler this) getContext getPropsChildren node -    evtCallbacksRef <- toJSVal $ map jsval evtCallbacks+    evtCallbacksRef <- toJSVal evtCallbacks     js_RenderCbSetResults arg evtCallbacksRef element  parseExport :: Typeable a => Export a -> IO a@@ -385,12 +392,27 @@      -> ReactElementM eventHandler a view rc props (ReactElementM child) =     let (a, childEl) = runWriter child-     in elementToM a $ ViewElement (reactView rc) (Nothing :: Maybe Int) props childEl+     in elementToM a $ ViewElement (reactView rc) Nothing 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.+-- | Keys in React can either be strings or integers+class ReactViewKey key where+    toKeyRef :: key -> JSVal+#if __GHCJS__+instance ReactViewKey String where+    toKeyRef = pToJSVal++instance ReactViewKey Int where+    toKeyRef = pToJSVal+#else+instance ReactViewKey String where+    toKeyRef = const ()++instance ReactViewKey Int where+    toKeyRef = const ()+#endif++-- | A deprecated way to create a view with a key which has problems when OverloadedStrings is+-- active.  Use 'viewWithSKey' or 'viewWithIKey' instead. viewWithKey :: (Typeable props, ReactViewKey key)             => ReactView props -- ^ the view             -> key -- ^ A value unique within the siblings of this element@@ -399,8 +421,33 @@             -> ReactElementM eventHandler a viewWithKey rc key props (ReactElementM child) =     let (a, childEl) = runWriter child-     in elementToM a $ ViewElement (reactView rc) (Just key) props childEl+     in elementToM a $ ViewElement (reactView rc) (Just $ toKeyRef key) props childEl +-- | Create an element from a view, and also pass in a string 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.+viewWithSKey :: Typeable props+             => ReactView props -- ^ the view+             -> JSString -- ^ The 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+viewWithSKey rc key props (ReactElementM child) =+    let (a, childEl) = runWriter child+     in elementToM a $ ViewElement (reactView rc) (Just $ pToJSVal key) props childEl++-- | Similar to 'viewWithSKey', but with an integer key instead of a string key.+viewWithIKey :: Typeable props+             => ReactView props -- ^ the view+             -> Int -- ^ The 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+viewWithIKey rc key props (ReactElementM child) =+    let (a, childEl) = runWriter child+     in elementToM a $ ViewElement (reactView rc) (Just $ pToJSVal key) props childEl+ -- | Create a 'ReactElement' for a class defined in javascript.  See -- 'React.Flux.Combinators.foreign_' for a convenient wrapper and some examples. foreignClass :: JSVal -- ^ The javascript reference to the class@@ -417,3 +464,90 @@ #else foreignClass _ _ x = x #endif++-- | A class which is used to implement <https://wiki.haskell.org/Varargs variable argument functions>.+-- These variable argument functions are used to convert from a JavaScript+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Functions/arguments arguments array>+-- to a Haskell value of type @props@.+--+-- Any function where each argument implements 'FromJSVal' and the result is 'ReturnProps' is an+-- instance of this class.  Entries from the JavaScript arguments array are matched one-by-one to+-- the arguments before 'ReturnProps' value.  If the Haskell function has more parameters than the+-- javascript @arguments@ object, a javascript null is used for the conversion.  Since the 'Maybe'+-- instance of 'FromJSVal' converts null references to 'Nothing', you can exploit this to handle+-- arguments not given to the JavaScript function.+class ArgumentsToProps props a | a -> props where+    returnViewFromArguments :: JSArray -> Int -> a -> IO props++-- | A type needed to make GHC happy when solving for instances of 'ArgumentsToProps'.+newtype ReturnProps props = ReturnProps props++instance ArgumentsToProps props (ReturnProps props) where+    returnViewFromArguments _ _ (ReturnProps v) = return v++instance (FromJSVal a, ArgumentsToProps props b) => ArgumentsToProps props (a -> b) where+#if __GHCJS__+    returnViewFromArguments args k f = do+        ma <- fromJSVal $ if k >= JSA.length args then nullRef else JSA.index k args+        a <- maybe (error "Unable to decode callback argument") return ma+        returnViewFromArguments args (k+1) $ f a+#else+    returnViewFromArguments _ _ _ = error "Not supported in GHC"+#endif++-- | Export a Haskell view to a JavaScript function.  This allows you to embed a Haskell react-flux+-- application into a larger existing JavaScript React application.  If you want to use JavaScript+-- classes in your Haskell application, you should instead use 'React.Flux.Combinators.foreign_' and 'foreignClass'.+--+-- The way this works is as follows:+--+-- 1. You create a Haskell function which translates the javascript arguments of into a Haskell+-- value of type @ReturnProps props@.  This is a variable-argument function using the 'ArgumentsToProps' class.+-- For example,+--+--       @+--       data MyProps = MyProps { theInt :: Int, theString :: String }+--       myArgsToProps :: Int -> String -> ReturnProps MyProps+--       myArgsToProps i s = ReturnProps $ MyProps i s+--       @+--+-- 2. You create a view which receives these properties and renders itself.  This view will not+-- receive any children.+--+--       @+--       myView :: ReactView MyProps+--       myView = defineView "my view" $ \\myProps -> ...+--       @+--+-- 3. You can then use 'exportViewToJavaScript' to create a JavaScript function.  When this+-- JavaScript function is executed, the JavaScript arguments are converted to the props,+-- the view is rendered using the props, and the resulting React element is returned from the+-- JavaScript function.+--+--       @+--       foreign import javascript unsafe+--           "window[\'myHaskellView\'] = $1;"+--           js_setMyView :: JSVal -> IO ()+--+--       exportMyView :: IO ()+--       exportMyView = exportViewToJavaScript myView myArgsToProps >>= js_setMyView+--       @+--+--       @exportMyView@ should be called from your main function.  After executing @exportMyView@,+--       the @window.myHaskellView@ property will be a javascript function.+--+-- 4. Call the javascript function with two arguments to return a React element which can be used+-- in a JavaScript React class rendering function.+-- +--       @+--       var myJsView = React.createClass({+--           render: function() {+--               return \<div\>{window.myHaskellView(5, "Hello World")}\</div\>;+--           }+--       };+--       @+exportViewToJavaScript :: (Typeable props, ArgumentsToProps props func) => ReactView props -> func -> IO JSVal+exportViewToJavaScript v func = do+    (_callbackToRelease, wrappedCb) <- exportViewToJs (reactView v) (\arr -> returnViewFromArguments arr 0 func)+    return wrappedCb+

@@ -1,5 +1,6 @@-{-# LANGUAGE OverloadedStrings, TypeFamilies, ScopedTypeVariables, DeriveAnyClass, FlexibleInstances, DeriveGeneric #-}-module TestClient (testClient) where+{-# LANGUAGE OverloadedStrings, TypeFamilies, ScopedTypeVariables, DeriveAnyClass,+             FlexibleInstances, DeriveGeneric, BangPatterns, TemplateHaskell #-}+module Main (main) where  import Control.DeepSeq (NFData) import Control.Monad@@ -8,14 +9,16 @@ import Data.Maybe import Debug.Trace import GHC.Generics (Generic)+import Data.Time (UTCTime(..), fromGregorian) import React.Flux import React.Flux.Lifecycle-import React.Flux.Internal (toJSString) import React.Flux.Addons.React-import React.Flux.Addons.Bootstrap+import React.Flux.Addons.Intl+import qualified Data.Text as T  import GHCJS.Types (JSVal, JSString) import GHCJS.Marshal (fromJSVal)+import qualified Data.JSString.Text as JSS  foreign import javascript unsafe     "(function(x) { \@@ -28,31 +31,34 @@     deriving (Show, Typeable)  instance StoreData OutputStoreData where-    type StoreAction OutputStoreData = [String]+    type StoreAction OutputStoreData = [T.Text]     -- log both to the console and to js_output     transform ss OutputStoreData = do-        mapM_ (js_output . toJSString) ss-        trace (unlines ss) $ return OutputStoreData+        mapM_ (js_output . JSS.textToJSString) ss+        trace (unlines $ map T.unpack ss) $ return OutputStoreData  outputStore :: ReactStore OutputStoreData outputStore = mkStore OutputStoreData -output :: [String] -> [SomeStoreAction]+output :: [T.Text] -> [SomeStoreAction] output s = [SomeStoreAction outputStore s] -outputIO :: [String] -> IO ()+outputIO :: [T.Text] -> IO () outputIO ss = void $ transform ss OutputStoreData  -------------------------------------------------------------------------------- --- Events -------------------------------------------------------------------------------- -logM :: (String -> Bool) -> String-logM f = "alt modifier: " ++ show (f "Alt")+logM :: (T.Text -> Bool) -> T.Text+logM f = "alt modifier: " <> (T.pack $ show (f "Alt")) -logT :: EventTarget -> String+logT :: EventTarget -> T.Text logT t = eventTargetProp t "id" +tshow :: Show a => a -> T.Text+tshow = T.pack . show+ rawShowView :: ReactView Int rawShowView = defineView "raw show view" elemShow @@ -64,15 +70,15 @@                     , "placeholder" $= "onKeyDown"                     , onKeyDown $ \e k -> output                         [ "keydown"-                        , show e-                        , show k+                        , tshow e+                        , tshow k                         , logM (keyGetModifierState k)                         , logT (evtTarget e)                         , logT (evtCurrentTarget e)                         ]                     , onFocus $ \e _ -> output                         [ "focus"-                        , show e+                        , tshow e                         --, logT $ focusRelatedTarget f                         ]                     ]@@ -80,8 +86,8 @@         p_ $ label_ [ "id" $= "clickinput"                     , onClick $ \e m -> output                         [ "click"-                        , show e-                        , show m +                        , tshow e+                        , tshow m                          , logM (mouseGetModifierState m)                         --, logT (mouseRelatedTarget m)                         ]@@ -91,8 +97,8 @@         p_ $ label_ [ "id" $= "touchinput"                     , onTouchStart $ \e t -> output                         [ "touchstart"-                        , show e-                        , show t+                        , tshow e+                        , tshow t                         , logM (touchGetModifierState t)                         , logT (touchTarget $ head $ touchTargets t)                         , "endtouch"@@ -127,11 +133,11 @@ --- Lifecycle -------------------------------------------------------------------------------- -logPandS :: LPropsAndState String Int -> IO ()+logPandS :: LPropsAndState T.Text Int -> IO () logPandS ps = do     p <- lGetProps ps     st <- lGetState ps-    outputIO ["Current props and state: " ++ p ++ ", " ++ show st]+    outputIO ["Current props and state: " <> p <> ", " <> (T.pack $ show st)]  foreign import javascript unsafe     "$1.id"@@ -142,18 +148,18 @@     this <- lThis dom >>= js_domGetId >>= fromJSVal     x <- lRef dom "refSt" >>= js_domGetId >>= fromJSVal     y <- lRef dom "refProps" >>= js_domGetId >>= fromJSVal-    outputIO [ "this id = " ++ fromMaybe "Nothing" this-             , "refStr id = " ++ fromMaybe "Nothing" x-             , "refProps id = " ++ fromMaybe "Nothing" y+    outputIO [ "this id = " <> fromMaybe "Nothing" this+             , "refStr id = " <> fromMaybe "Nothing" x+             , "refProps id = " <> fromMaybe "Nothing" y              ]  -testLifecycle :: ReactView String+testLifecycle :: ReactView T.Text 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+        span_ ["ref" $= "refProps", "id" $= "world"] $ elemText $ "Current props: " <> p         button_ [ "id" $= "increment-state"                 , onClick $ \_ _ st -> ([], Just $ st + 1)                 ] "Incr"@@ -171,24 +177,24 @@     , lComponentWillReceiveProps = Just $ \pAndS _dom _setStateFn newProps -> do         outputIO ["will recv props"]         logPandS pAndS-        outputIO ["New props: " ++ newProps]+        outputIO ["New props: " <> newProps]      , lComponentWillUpdate = Just $ \pAndS _dom newProps newState -> do         outputIO ["will update"]         logPandS pAndS-        outputIO ["New props: " ++ newProps, "New state: " ++ show newState]+        outputIO ["New props: " <> newProps, "New state: " <> tshow newState]      , lComponentDidUpdate = Just $ \pAndS _dom _setStateFn oldProps oldState -> do         outputIO ["did update"]         logPandS pAndS-        outputIO ["Old props: " ++ oldProps, "Old state: " ++ show oldState]+        outputIO ["Old props: " <> oldProps, "Old state: " <> tshow oldState]      , lComponentWillUnmount = Just $ \pAndS _dom -> do         outputIO ["will unmount"]         logPandS pAndS     } -testLifecycle_ :: String -> ReactElementM eventHandler ()+testLifecycle_ :: T.Text -> ReactElementM eventHandler () testLifecycle_ s = view testLifecycle s $ span_ ["id" $= "child-passed-to-view"] "I am a child!!!"  --------------------------------------------------------------------------------@@ -213,7 +219,7 @@ --- CSS Transitions -------------------------------------------------------------------------------- -cssTransitions :: ReactView [String]+cssTransitions :: ReactView [T.Text] cssTransitions = defineView "css transitions" $ \items ->     div_ ["id" $= "css-transitions"] $         cssTransitionGroup ["transitionName" $= "example"] $@@ -221,77 +227,250 @@                 div_ ["key" @= key] $ span_ ["className" $= "css-transition-entry"] $ elemText txt  ------------------------------------------------------------------------------------ Bootstrap-----------------------------------------------------------------------------------bootstrapSpec :: ReactView ()-bootstrapSpec = defineView "bootstrap" $ \() -> div_ ["id" $= "bootstrap"] $ do-    bootstrap_ "Alert" [ "bsStyle" $= "danger"-                       , callback "onDismiss" $ output ["Closing alert"]-                       ] $-        p_ "Hello, World!"--    bootstrap_ "Nav" [ "activeKey" @= (1 :: Int)-                     , callback "onSelect" $ \(i :: Int) -> output ["Switched to " ++ show i]-                     ] $ do-        bootstrap_ "NavItem" ["eventKey" @= (1 :: Int)] "Item 1"-        bootstrap_ "NavItem" ["eventKey" @= (2 :: Int)] "Item 2"-        bootstrap_ "NavItem" ["eventKey" @= (3 :: Int)] "Item 3"---------------------------------------------------------------------------------- --- shouldComponentUpdate --------------------------------------------------------------------------------  data ShouldComponentUpdateData = ShouldComponentUpdateData Int String     deriving (Typeable, Show) -data ShouldComponentUpdateAction = IncrementAllSCUData-                                 | IncrementFirstSCUData+-- | The data in the store is four 'ShouldComponentUpdateData's.  The reason is we test+-- views with tuples of size up to 3, and so we want 4 entries in the store to be able to+-- test editing the store but not changing anything that is passed to a view, to test that+-- the shouldComponentUpdate function is working properly.+data ShouldComponentUpdate = ShouldComponentUpdate {+    scu1 :: !ShouldComponentUpdateData -- ^ passed to all three views+  , scu2 :: !ShouldComponentUpdateData -- ^ only passed to the pair view+  , scu3 :: !ShouldComponentUpdateData -- ^ only passed to the triple view+  , scu4 :: !ShouldComponentUpdateData -- ^ not passed to any view+} deriving (Typeable, Show)++data SCUIndex = SCU1 | SCU2 | SCU3 | SCU4+    deriving (Show, Eq, Typeable, Generic, NFData, Bounded, Enum)++data ShouldComponentUpdateAction = IncrementAllSCUData SCUIndex+                                 | IncrementFirstSCUData SCUIndex                                  | NoChangeToSCUData-    deriving (Show, Typeable, Generic, NFData)+    deriving (Show, Typeable, Generic, NFData)  -instance StoreData [ShouldComponentUpdateData] where-    type StoreAction [ShouldComponentUpdateData] = ShouldComponentUpdateAction-    transform NoChangeToSCUData s = return s-    transform IncrementAllSCUData d = return [ShouldComponentUpdateData (i+1) s | ShouldComponentUpdateData i s <- d]-    transform IncrementFirstSCUData (ShouldComponentUpdateData i s:xs) = return $ (ShouldComponentUpdateData (i+1) s) : xs-    transform _ [] = error "Should never happen"+toggleSCU :: ShouldComponentUpdateData -> ShouldComponentUpdateData+toggleSCU (ShouldComponentUpdateData i s) = ShouldComponentUpdateData (i+1) s -shouldComponentUpdateStore :: ReactStore [ShouldComponentUpdateData]-shouldComponentUpdateStore = mkStore [ ShouldComponentUpdateData 1 "Hello"-                                     , ShouldComponentUpdateData 2 "World"-                                     , ShouldComponentUpdateData 3 "!!!"-                                     ]+instance StoreData [ShouldComponentUpdate] where+    type StoreAction [ShouldComponentUpdate] = ShouldComponentUpdateAction+    transform _ [] = error "Will never happen"+    transform action ds@(first:rest) =+        pure $ case action of +            NoChangeToSCUData -> ds+            (IncrementAllSCUData SCU1) -> [ShouldComponentUpdate (toggleSCU s1) s2 s3 s4 | ShouldComponentUpdate s1 s2 s3 s4 <- ds]+            (IncrementAllSCUData SCU2) -> [ShouldComponentUpdate s1 (toggleSCU s2) s3 s4  | ShouldComponentUpdate s1 s2 s3 s4 <- ds]+            (IncrementAllSCUData SCU3) -> [ShouldComponentUpdate s1 s2 (toggleSCU s3) s4 | ShouldComponentUpdate s1 s2 s3 s4 <- ds]+            (IncrementAllSCUData SCU4) -> [ShouldComponentUpdate s1 s2 s3 (toggleSCU s4) | ShouldComponentUpdate s1 s2 s3 s4 <- ds]+            (IncrementFirstSCUData SCU1) -> first { scu1 = toggleSCU $ scu1 first } : rest+            (IncrementFirstSCUData SCU2) -> first { scu2 = toggleSCU $ scu2 first } : rest+            (IncrementFirstSCUData SCU3) -> first { scu3 = toggleSCU $ scu3 first } : rest+            (IncrementFirstSCUData SCU4) -> first { scu4 = toggleSCU $ scu4 first } : rest +shouldComponentUpdateStore :: ReactStore [ShouldComponentUpdate]+shouldComponentUpdateStore = mkStore+        [ ShouldComponentUpdate (mkS 1 "Quick Ben") (mkS 2 "Whiskeyjack") (mkS 3 "Fiddler") (mkS 4 "Kellanved")+        , ShouldComponentUpdate (mkS 5 "Karsa") (mkS 6 "Tehol") (mkS 7 "Tayschrenn") (mkS 8 "Kruppe")+        , ShouldComponentUpdate (mkS 9 "Anomander Rake") (mkS 10 "Iskaral Pust") (mkS 11 "Dujek") (mkS 12 "Tavore")+        ]+    where+        mkS = ShouldComponentUpdateData+ -- | This will log wheenver componentWillUpdate lifecycle event occurs logComponentWillUpdate :: ReactView ShouldComponentUpdateData-logComponentWillUpdate = defineLifecycleView "shouldComponentUpdate spec" () lifecycleConfig+logComponentWillUpdate = defineLifecycleView "shouldComponentUpdate single spec" () lifecycleConfig     { lRender = \() (ShouldComponentUpdateData i s) ->-                    span_ (elemShow i) <> span_ (elemText s)+                    span_ (elemShow i) <> span_ (elemString s)     , lComponentWillUpdate = Just $ \curProps _ (ShouldComponentUpdateData newI newS) () -> do           ShouldComponentUpdateData curI curS <- lGetProps curProps-          outputIO [ "Component will update"-                   , "current props: " ++ show curI ++ " " ++ curS-                   , "new props: " ++ show newI ++ " " ++ newS+          outputIO [ "Component will update single"+                   , "current props: " <> tshow curI <> " " <> T.pack curS+                   , "new props: " <> tshow newI <> " " <> T.pack newS                    ]     } +logComp1_ :: ShouldComponentUpdateData -> Int -> ReactElementM handler ()+logComp1_ !sc i = viewWithKey logComponentWillUpdate i sc mempty++logComponentWillUpdatePair :: ReactView (ShouldComponentUpdateData, ShouldComponentUpdateData)+logComponentWillUpdatePair = defineLifecycleView "shouldComponentUpdate pair spec" () lifecycleConfig+    { lRender = \() (ShouldComponentUpdateData i1 s1, ShouldComponentUpdateData i2 s2) ->+                    span_ (elemShow i1) <> span_ (elemString s1) <> span_ (elemShow i2) <> span_ (elemString s2)+    , lComponentWillUpdate = Just $ \curProps _ (ShouldComponentUpdateData newI1 newS1, ShouldComponentUpdateData newI2 newS2) () -> do+          (ShouldComponentUpdateData curI1 curS1, ShouldComponentUpdateData curI2 curS2) <- lGetProps curProps+          outputIO [ "Component will update for pair input view"+                   , T.pack $ "current props: " ++ show curI1 ++ " " ++ curS1 ++ " " ++ show curI2 ++ " " ++ curS2+                   , T.pack $ "new props: " ++ show newI1 ++ " " ++ newS1 ++ " " ++ show newI2 ++ " " ++ newS2+                   ]+    }++logComp2_ :: ShouldComponentUpdateData -> ShouldComponentUpdateData -> Int -> ReactElementM handler ()+logComp2_ !sc1 !sc2 i = viewWithKey logComponentWillUpdatePair i (sc1, sc2) mempty++logComponentWillUpdateTriple :: ReactView (ShouldComponentUpdateData, ShouldComponentUpdateData, ShouldComponentUpdateData)+logComponentWillUpdateTriple = defineLifecycleView "shouldComponentUpdate triple spec" () lifecycleConfig+    { lRender = \() (ShouldComponentUpdateData i1 s1, ShouldComponentUpdateData i2 s2, ShouldComponentUpdateData i3 s3) ->+                  span_ (elemShow i1) <> span_ (elemString s1) <> span_ (elemShow i2) <> span_ (elemString s2) <> span_ (elemShow i3) <> span_ (elemString s3)+    , lComponentWillUpdate = Just $ \curProps _+        (ShouldComponentUpdateData newI1 newS1, ShouldComponentUpdateData newI2 newS2, ShouldComponentUpdateData newI3 newS3) () -> do+            (ShouldComponentUpdateData curI1 curS1, ShouldComponentUpdateData curI2 curS2, ShouldComponentUpdateData curI3 curS3) <- lGetProps curProps+            outputIO [ "Component will update for triple input view"+                     , T.pack $ "current props: " ++ show curI1 ++ " " ++ curS1 ++ " " ++ show curI2 ++ " " ++ curS2 ++ " " ++ show curI3 ++ " " ++ curS3+                     , T.pack $ "new props: " ++ show newI1 ++ " " ++ newS1 ++ " " ++ show newI2 ++ " " ++ newS2 ++ " " ++ show newI3 ++ " " ++ newS3+                     ]+    }++logComp3_ :: ShouldComponentUpdateData -> ShouldComponentUpdateData -> ShouldComponentUpdateData -> Int -> ReactElementM handler ()+logComp3_ !sc1 !sc2 !sc3 i = viewWithKey logComponentWillUpdateTriple i (sc1, sc2, sc3) mempty+ shouldComponentUpdateSpec :: ReactView () shouldComponentUpdateSpec = defineControllerView "should component update" shouldComponentUpdateStore $ \ds () ->      div_ ["id" $= "should-component-update"] $ do-        ul_ $ forM_ (zip ds [(0 :: Int)..]) $ \(su, i)  ->-            li_ $ viewWithKey logComponentWillUpdate i su mempty+        ul_ ["id" $= "should-component-update-single"] $ forM_ (zip ds [(0 :: Int)..]) $ \(d,i)  ->+            li_ $ logComp1_ (scu1 d) i+        ul_ ["id" $= "should-component-update-pair"]  $ forM_ (zip ds [(0 :: Int)..]) $ \(d,i)  ->+            li_ $ logComp2_ (scu1 d) (scu2 d) i+        ul_ ["id" $= "should-component-update-triple"]  $ forM_ (zip ds [(0 :: Int)..]) $ \(d, i)  ->+            li_ $ logComp3_ (scu1 d) (scu2 d) (scu3 d) i          button_ ["id" $= "no-change-scu", onClick $ \_ _ -> [SomeStoreAction shouldComponentUpdateStore NoChangeToSCUData]]             "No change to data" -        button_ ["id" $= "change-all-scu", onClick $ \_ _ -> [SomeStoreAction shouldComponentUpdateStore IncrementAllSCUData]]-            "Increment all"+        forM_ [minBound..maxBound] $ \idx -> do+            button_ ["id" @= ("change-all-scu-" ++ show idx), onClick $ \_ _ -> [SomeStoreAction shouldComponentUpdateStore $ IncrementAllSCUData idx]] $+                elemString $ "Increment all " ++ show idx+            button_ ["id" @=("increment-first-scu" ++ show idx), onClick $ \_ _ -> [SomeStoreAction shouldComponentUpdateStore $ IncrementFirstSCUData idx]] $+                elemString $ "Increment first entry's integer" ++ show idx -        button_ ["id" $= "increment-first-scu", onClick $ \_ _ -> [SomeStoreAction shouldComponentUpdateStore IncrementFirstSCUData]]-            "Increment first entry's integer"+--------------------------------------------------------------------------------+--- Callback returning view+-------------------------------------------------------------------------------- +data CallbackViewProps = CallbackViewProps Int String+    deriving (Show, Typeable)++callbackArgsToProps :: Int -> String -> ReturnProps CallbackViewProps+callbackArgsToProps i s = ReturnProps $ CallbackViewProps i s++callbackViewTest :: ReactView CallbackViewProps+callbackViewTest = defineView "callback view props test" $ \(CallbackViewProps i s) ->+    p_ [ "id" $= "callback-view-props-test"] $+        elemString $ "Props are " ++ show i ++ " and " ++ s++foreign import javascript unsafe+    "React['createClass']({'displayName':'callback wrapper', 'render': function() { \+    \ return React['createElement']('div', {}, [React.createElement('p', {}, 'From Callback'), this.props.foo(5, 'Hello World')]); \+    \ }})"+    js_createWrapperClass :: JSVal++callbackViewWrapper :: ReactView ()+callbackViewWrapper = defineView "callback view wrapper" $ \() ->+    div_ ["id" $= "callback-view-wrapper"] $+        foreignClass js_createWrapperClass [ callbackViewWithProps "foo" callbackViewTest callbackArgsToProps ] mempty+ --------------------------------------------------------------------------------+--- Intl+--------------------------------------------------------------------------------++foreign import javascript unsafe+    "{'with_trans': 'message from translation {abc}'}"+    js_translations :: JSVal++intlSpec :: ReactView ()+intlSpec = defineView "intl" $ \() ->+    intlProvider_ "en" (Just js_translations) Nothing $+        view intlSpecBody () mempty++intlSpecBody :: ReactView ()+intlSpecBody = defineView "intl body" $ \() -> div_ ["id" $= "intl-spec"] $ +    ul_ $ do+        li_ ["id" $= "f-number"] $+            formattedNumber_ [ "value" @= (0.9 :: Double), "style" $= "percent" ]+        li_ ["id" $= "f-int"] $ int_ 100000+        li_ ["id" $= "f-double"] $ double_ 40000.2+        li_ ["id" $= "f-number-prop"] $+            input_ [formattedNumberProp "placeholder" (123456 :: Int) []]++        let moon = fromGregorian 1969 7 20+            fullDayF = DayFormat { weekdayF = Just "long", eraF = Just "short", yearF = Just "2-digit", monthF = Just "long", dayF = Just "2-digit" }++        li_ ["id" $= "f-shortday"] $ day_ shortDate moon+        li_ ["id" $= "f-fullday"] $ day_ fullDayF moon+        li_ ["id" $= "f-date"] $ formattedDate_ (Left moon)+                [ "weekday" $= "short", "month" $= "short", "day" $= "numeric", "year" $= "2-digit" ]+        li_ ["id" $= "f-date-prop"] $+            input_ [formattedDateProp "placeholder" (Left moon) []]++        let step = UTCTime moon (2*60*60 + 56*60) -- 1969-7-20 02:56 UTC+            fullT = (fullDayF, TimeFormat { hourF = Just "numeric", minuteF = Just "2-digit", secondF = Just "numeric", timeZoneNameF = Just "long" })+        +        li_ ["id" $= "f-shorttime"] $ utcTime_ shortDateTime step+        li_ ["id" $= "f-fulltime"] $ utcTime_ fullT step+        li_ ["id" $= "f-time"] $ formattedDate_ (Right step)+                [ "year" $= "2-digit", "month" $= "short", "day" $= "numeric"+                , "hour" $= "numeric", "minute" $= "2-digit", "second" $= "numeric"+                , "timeZoneName" $= "short"+                , "timeZone" $= "Pacific/Tahiti"+                ]+        li_ ["id" $= "f-time-prop"] $+            input_ [formattedDateProp "placeholder" (Right step)+                    [ "year" `iprop` ("2-digit" :: String)+                    , "month" `iprop` ("short" :: String)+                    , "day" `iprop` ("2-digit" :: String)+                    , "hour" `iprop` ("numeric" :: String)+                    , "timeZone" `iprop` ("Pacific/Tahiti" :: String)+                    ]+                   ]++        li_ ["id" $= "f-relative"] $ relativeTo_ step+        li_ ["id" $= "f-relative-days"] $ formattedRelative_ step [ "units" $= "day" ]++        li_ ["id" $= "f-plural"] $ plural_ [ "value" @= (100 :: Int), "one" $= "plural one", "other" $= "plural other"]+        li_ ["id" $= "f-plural-prop"] $+            input_ [pluralProp "placeholder" (100 :: Int) ["one" `iprop` ("plural one" :: String), "other" `iprop` ("plural other" :: String)]]++        li_ ["id" $= "f-msg"] $+            $(message "photos" "{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}} {takenAgo}.")+                [ "name" $= "Neil Armstrong"+                , "numPhotos" @= (100 :: Int)+                , elementProperty "takenAgo" $ span_ ["id" $= "takenAgoSpan"] "years ago"+                ]++        li_ ["id" $= "f-msg-prop"] $+            input_ [ $(messageProp "placeholder" "photosprop" "{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}")+                [ "name" `iprop` ("Neil Armstrong" :: String)+                , "numPhotos" `iprop` (100 :: Int)+                ]+            ]++        li_ ["id" $= "f-msg-with-trans"] $+            $(message "with_trans" "this is not used {abc}") ["abc" $= "xxx"]++        li_ ["id" $= "f-msg-with-descr"] $+            $(message' "photos2" "How many photos?" "{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}.")+                [ "name" $= "Neil Armstrong"+                , "numPhotos" @= (0 :: Int)+                ]++        li_ ["id" $= "f-msg-prop-with-descr"] $+            input_ [$(messageProp' "placeholder" "photosprop2" "How many photos?" "{name} took {numPhotos, number} photos")+                        [ "name" `iprop` ("Neil Armstrong" :: String)+                        , "numPhotos" `iprop` (0 :: Int)+                        ]+                   ]++        li_ ["id" $= "f-html-msg"] $+            $(htmlMsg "html1" "<b>{num}</b> is the answer to life, the universe, and everything")+                [ "num" @= (42 :: Int) ]++        li_ ["id" $= "f-html-msg-with-descr"] $+            $(htmlMsg' "html2" "Hitchhiker's Guide" "{num} is the <b>answer</b> to life, the universe, and everything")+                [ "num" @= (42 :: Int) ]++-------------------------------------------------------------------------------- --- Main -------------------------------------------------------------------------------- @@ -304,7 +483,7 @@         when (s /= "") $             testLifecycle_ s         button_ [ "id" $= "add-app-str"-                , onClick $ \_ _ s' -> ([], Just $ s' ++ "o")+                , onClick $ \_ _ s' -> ([], Just $ s' <> "o")                 ]                 "Add o"         button_ [ "id" $= "clear-app-str"@@ -315,7 +494,16 @@          view cssTransitions ["A", "B"] mempty -        view bootstrapSpec () mempty-         view shouldComponentUpdateSpec () mempty++        view callbackViewWrapper () mempty++        view intlSpec () mempty     }++main :: IO ()+main = reactRender "app" testClient ()++writeIntlMessages (intlFormatJson "test/client/msgs/jsonmsgs.json")+writeIntlMessages (intlFormatJsonWithoutDescription "test/client/msgs/jsonnodescr.json")+writeIntlMessages (intlFormatAndroidXML "test/client/msgs/android.xml")

@@ -1,9 +0,0 @@-module Main (main) where--import TestClient-import React.Flux--main :: IO ()-main = do-    initializeTouchEvents-    reactRender "app" testClient ()

@@ -1,126 +0,0 @@-{-# LANGUAGE OverloadedStrings, TypeFamilies, ScopedTypeVariables, TemplateHaskell #-}-module Main (main) where--import Data.Time-import React.Flux-import React.Flux.Addons.Intl-import GHCJS.Types (JSVal)-import Data.Aeson ((.=))--import TestClient-------------------------------------------------------------------------------------- Intl-----------------------------------------------------------------------------------foreign import javascript unsafe-    "{'with_trans': 'message from translation {abc}'}"-    js_translations :: JSVal--intlSpec :: ReactView ()-intlSpec = defineView "intl" $ \() ->-    intlProvider_ "en" (Just js_translations) Nothing $-        view intlSpecBody () mempty--intlSpecBody :: ReactView ()-intlSpecBody = defineView "intl body" $ \() -> div_ ["id" $= "intl-spec"] $ -    ul_ $ do-        li_ ["id" $= "f-number"] $-            formattedNumber_ [ "value" @= (0.9 :: Double), "style" $= "percent" ]-        li_ ["id" $= "f-int"] $ int_ 100000-        li_ ["id" $= "f-double"] $ double_ 40000.2-        li_ ["id" $= "f-number-prop"] $-            input_ [formattedNumberProp "placeholder" (123456 :: Int) []]--        let moon = fromGregorian 1969 7 20-            fullDayF = DayFormat { weekdayF = Just "long", eraF = Just "short", yearF = Just "2-digit", monthF = Just "long", dayF = Just "2-digit" }--        li_ ["id" $= "f-shortday"] $ day_ shortDate moon-        li_ ["id" $= "f-fullday"] $ day_ fullDayF moon-        li_ ["id" $= "f-date"] $ formattedDate_ (Left moon)-                [ "weekday" $= "short", "month" $= "short", "day" $= "numeric", "year" $= "2-digit" ]-        li_ ["id" $= "f-date-prop"] $-            input_ [formattedDateProp "placeholder" (Left moon) []]--        let step = UTCTime moon (2*60*60 + 56*60) -- 1969-7-20 02:56 UTC-            fullT = (fullDayF, TimeFormat { hourF = Just "numeric", minuteF = Just "2-digit", secondF = Just "numeric", timeZoneNameF = Just "long" })-        -        li_ ["id" $= "f-shorttime"] $ utcTime_ shortDateTime step-        li_ ["id" $= "f-fulltime"] $ utcTime_ fullT step-        li_ ["id" $= "f-time"] $ formattedDate_ (Right step)-                [ "year" $= "2-digit", "month" $= "short", "day" $= "numeric"-                , "hour" $= "numeric", "minute" $= "2-digit", "second" $= "numeric"-                , "timeZoneName" $= "short"-                , "timeZone" $= "Pacific/Tahiti"-                ]-        li_ ["id" $= "f-time-prop"] $-            input_ [formattedDateProp "placeholder" (Right step)-                    [ "year" .= ("2-digit" :: String)-                    , "month" .= ("short" :: String)-                    , "day" .= ("2-digit" :: String)-                    , "hour" .= ("numeric" :: String)-                    , "timeZone" .= ("Pacific/Tahiti" :: String)-                    ]-                   ]--        li_ ["id" $= "f-relative"] $ relativeTo_ step-        li_ ["id" $= "f-relative-days"] $ formattedRelative_ step [ "units" $= "day" ]--        li_ ["id" $= "f-plural"] $ plural_ [ "value" @= (100 :: Int), "one" $= "plural one", "other" $= "plural other"]-        li_ ["id" $= "f-plural-prop"] $-            input_ [pluralProp "placeholder" (100 :: Int) ["one" .= ("plural one" :: String), "other" .= ("plural other" :: String)]]--        li_ ["id" $= "f-msg"] $-            $(message "photos" "{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}} {takenAgo}.")-                [ "name" $= "Neil Armstrong"-                , "numPhotos" @= (100 :: Int)-                , elementProperty "takenAgo" $ span_ ["id" $= "takenAgoSpan"] "years ago"-                ]--        li_ ["id" $= "f-msg-prop"] $-            input_ [ $(messageProp "placeholder" "photosprop" "{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}")-                [ "name" .= ("Neil Armstrong" :: String)-                , "numPhotos" .= (100 :: Int)-                ]-            ]--        li_ ["id" $= "f-msg-with-trans"] $-            $(message "with_trans" "this is not used {abc}") ["abc" $= "xxx"]--        li_ ["id" $= "f-msg-with-descr"] $-            $(message' "photos2" "How many photos?" "{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}.")-                [ "name" $= "Neil Armstrong"-                , "numPhotos" @= (0 :: Int)-                ]--        li_ ["id" $= "f-msg-prop-with-descr"] $-            input_ [$(messageProp' "placeholder" "photosprop2" "How many photos?" "{name} took {numPhotos, number} photos")-                        [ "name" .= ("Neil Armstrong" :: String)-                        , "numPhotos" .= (0 :: Int)-                        ]-                   ]--        li_ ["id" $= "f-html-msg"] $-            $(htmlMsg "html1" "<b>{num}</b> is the answer to life, the universe, and everything")-                [ "num" @= (42 :: Int) ]--        li_ ["id" $= "f-html-msg-with-descr"] $-            $(htmlMsg' "html2" "Hitchhiker's Guide" "{num} is the <b>answer</b> to life, the universe, and everything")-                [ "num" @= (42 :: Int) ]-------------------------------------------------------------------------------------- Main------------------------------------------------------------------------------------- | Test a lifecycle view with all lifecycle methods nothing-app :: ReactView ()-app = defineView "main app" $ \() -> do-    view testClient () mempty-    view intlSpec () mempty--main :: IO ()-main = reactRender "app" app ()--writeIntlMessages (intlFormatJson "test/client/msgs/jsonmsgs.json")-writeIntlMessages (intlFormatJsonWithoutDescription "test/client/msgs/jsonnodescr.json")-writeIntlMessages (intlFormatAndroidXML "test/client/msgs/android.xml")

@@ -0,0 +1,13 @@+<html>+    <head>+        <title>Test Client</title>+    </head>+    <body>+        <div id="app"></div>+        <script src="https://fb.me/react-with-addons-15.0.1.js"></script>+        <script src="https://fb.me/react-dom-15.0.1.js"></script>+        <script src="node_modules/react-intl/dist/react-intl.js"></script>+        <script src="node_modules/react-intl/locale-data/en.js"></script>+        <script src="../../js-build/install-root/bin/test-client.jsexe/all.js"></script>+    </body>+</html>

@@ -1,12 +0,0 @@-<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="node_modules/react-intl/dist/react-intl.js"></script>-        <script src="https://cdnjs.cloudflare.com/ajax/libs/react-bootstrap/0.26.2/react-bootstrap.min.js"></script>-        <script src="../../js-build/install-root/bin/test-client-13.jsexe/all.js"></script>-    </body>-</html>

@@ -1,14 +0,0 @@-<html>-    <head>-        <title>Test Client</title>-    </head>-    <body>-        <div id="app"></div>-        <script src="https://fb.me/react-with-addons-0.14.6.js"></script>-        <script src=" https://fb.me/react-dom-0.14.6.js"></script>-        <script src="node_modules/react-intl/dist/react-intl.js"></script>-        <script src="node_modules/react-intl/locale-data/en.js"></script>-        <script src="https://cdnjs.cloudflare.com/ajax/libs/react-bootstrap/0.28.2/react-bootstrap.min.js"></script>-        <script src="../../js-build/install-root/bin/test-client-14.jsexe/all.js"></script>-    </body>-</html>

@@ -35,14 +35,32 @@     p <- findElem (ById "world")     getText p `shouldReturn` (T.pack $ "Current props: " ++ props) -scuShouldBe :: [(Int, String)] -> WD ()-scuShouldBe items = do-    d <- findElem $ ById "should-component-update"+scuShouldBe :: String -> [String] -> WD ()+scuShouldBe ident items = do+    d <- findElem $ ById $ T.pack ident     lis <- findElemsFrom d $ ByTag "li"     length lis `shouldBe` length items-    forM_ (zip lis items) $ \(li,(i, s)) ->-        getText li `shouldReturn` (T.pack $ show i ++ s)+    forM_ (zip lis items) $ \(li,i) ->+        getText li `shouldReturn` T.pack i +scuSingleShouldBe :: [String] -> WD ()+scuSingleShouldBe = scuShouldBe "should-component-update-single"++scuPairShouldBe :: [String] -> WD ()+scuPairShouldBe = scuShouldBe "should-component-update-pair"++scuTripleShouldBe :: [String] -> WD ()+scuTripleShouldBe = scuShouldBe "should-component-update-triple"++scuSingleLogMsg :: String -> String -> [String]+scuSingleLogMsg current new = ["Component will update single", "current props: " ++ current, "new props: " ++ new]++scuPairLogMsg :: String -> String -> [String]+scuPairLogMsg current new = ["Component will update for pair input view", "current props: " ++ current, "new props: " ++ new]++scuTripleLogMsg :: String -> String -> [String]+scuTripleLogMsg current new = ["Component will update for triple input view", "current props: " ++ current, "new props: " ++ new]+ intlSpanShouldBe :: String -> String -> WD () intlSpanShouldBe ident txt = do     e <- findElem (ById $ T.pack ident)@@ -62,11 +80,7 @@         y' = show y  spec :: Spec-spec = do-    describe "React 0.13" $ testClientSpec "test-client13.html"-    describe "React 0.14" $ do-        testClientSpec "test-client14.html"-        intlSpec "test-client14.html"+spec = testClientSpec "test-client.html"  testClientSpec :: String -> Spec testClientSpec filename = session " for the test client" $ using Chrome $ do@@ -95,7 +109,7 @@         [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)"+        keyEvt `shouldBe` "(False,0,False,\"Unidentified\",88,Nothing,0,False,False,False,88)"         modState `shouldBe` "alt modifier: False"         target `shouldBe` "keyinput"         curTarget `shouldBe` "keyinput"@@ -104,9 +118,9 @@         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)"+        keyEvt `shouldBe` "(True,0,False,\"Alt\",18,Nothing,0,False,False,False,18)"         modState `shouldBe` "alt modifier: True"-        keyEvt2 `shouldBe` "(True,0,False,\"Unidentified\",82,\"\",0,False,False,False,82)"+        keyEvt2 `shouldBe` "(True,0,False,\"Unidentified\",82,Nothing,0,False,False,False,82)"         modState2 `shouldBe` "alt modifier: True"      it "processes a click event" $ runWD $ do@@ -218,117 +232,195 @@         getText a `shouldReturn` "A"         getText b `shouldReturn` "B" -    describe "bootstrap" $ do--        it "displays and closes alert" $ runWD $ do-            alert <- findElem $ ByCSS "div#bootstrap div.alert"-            (findElemFrom alert (ByTag "p") >>= getText)-                `shouldReturn` "Hello, World!"-            findElemFrom alert (ByTag "button") >>= click-            loadLog `shouldReturn` ["Closing alert"]--        it "switchs nav items" $ runWD $ do-            navUl <- findElem $ ByCSS "div#bootstrap ul"-            i1 <- findElemFrom navUl $ ByCSS "li:first-child a"-            i2 <- findElemFrom navUl $ ByCSS "li:nth-child(2) a"-            i3 <- findElemFrom navUl $ ByCSS "li:nth-child(3) a"-            click i2-            loadLog `shouldReturn` ["Switched to 2"]-            click i3-            loadLog `shouldReturn` ["Switched to 3"]-            click i1-            loadLog `shouldReturn` ["Switched to 1"]+    it "renders a callback returning a view" $ runWD $ do+        e <- findElem $ ById "callback-view-props-test"+        getText e `shouldReturn` "Props are 5 and Hello World"      describe "should component update" $ do -        it "has the initial data" $ runWD $-            scuShouldBe [(1, "Hello"), (2, "World"), (3, "!!!")]--        it "increments just the first entry without re-rendering all entries" $ runWD $ do-            findElem (ById "increment-first-scu") >>= click-            scuShouldBe [(2, "Hello"), (2, "World"), (3, "!!!")]-            loadLog `shouldReturn`-                [ "Component will update"-                , "current props: 1 Hello"-                , "new props: 2 Hello"-                ]+        it "has the initial data" $ runWD $ do+            scuSingleShouldBe ["1Quick Ben", "5Karsa", "9Anomander Rake"]+            scuPairShouldBe ["1Quick Ben2Whiskeyjack", "5Karsa6Tehol", "9Anomander Rake10Iskaral Pust"]+            scuTripleShouldBe ["1Quick Ben2Whiskeyjack3Fiddler", "5Karsa6Tehol7Tayschrenn", "9Anomander Rake10Iskaral Pust11Dujek"]          it "does not update when no change to data" $ runWD $ do             findElem (ById "no-change-scu") >>= click-            scuShouldBe [(2, "Hello"), (2, "World"), (3, "!!!")]+            scuSingleShouldBe ["1Quick Ben", "5Karsa", "9Anomander Rake"]+            scuPairShouldBe ["1Quick Ben2Whiskeyjack", "5Karsa6Tehol", "9Anomander Rake10Iskaral Pust"]+            scuTripleShouldBe ["1Quick Ben2Whiskeyjack3Fiddler", "5Karsa6Tehol7Tayschrenn", "9Anomander Rake10Iskaral Pust11Dujek"]             loadLog `shouldReturn` [] -        it "increments all entries" $ runWD $ do-            findElem (ById "change-all-scu") >>= click-            scuShouldBe [(3, "Hello"), (3, "World"), (4, "!!!")]-            loadLog `shouldReturn`-                [ "Component will update"-                , "current props: 2 Hello"-                , "new props: 3 Hello"-                , "Component will update"-                , "current props: 2 World"-                , "new props: 3 World"-                , "Component will update"-                , "current props: 3 !!!"-                , "new props: 4 !!!"-                ]+        describe "Changing the first scu" $ do +            it "increments just the head of the list without re-rendering all entries" $ runWD $ do+                findElem (ById "increment-first-scuSCU1") >>= click+                scuSingleShouldBe ["2Quick Ben", "5Karsa", "9Anomander Rake"]+                scuPairShouldBe ["2Quick Ben2Whiskeyjack", "5Karsa6Tehol", "9Anomander Rake10Iskaral Pust"]+                scuTripleShouldBe ["2Quick Ben2Whiskeyjack3Fiddler", "5Karsa6Tehol7Tayschrenn", "9Anomander Rake10Iskaral Pust11Dujek"]+                loadLog `shouldReturn` concat+                    [ scuSingleLogMsg "1 Quick Ben"+                                      "2 Quick Ben"+                    , scuPairLogMsg "1 Quick Ben 2 Whiskeyjack"+                                    "2 Quick Ben 2 Whiskeyjack"+                    , scuTripleLogMsg "1 Quick Ben 2 Whiskeyjack 3 Fiddler"+                                      "2 Quick Ben 2 Whiskeyjack 3 Fiddler"+                    ] -    {--    it "inspects the session" $ runWD $ do-        loadLog >>= \x -> liftIO $ putStrLn $ show x-        inspectSession-    -} -intlSpec :: String -> Spec-intlSpec filename = session " for the i18n test client" $ using Chrome $ do-    it "opens the page" $ runWD $ do-        dir <- liftIO $ getCurrentDirectory-        openPage $ "file://" ++ dir ++ "/../client/" ++ filename+            it "increments all entries" $ runWD $ do+                findElem (ById "change-all-scu-SCU1") >>= click+                scuSingleShouldBe ["3Quick Ben", "6Karsa", "10Anomander Rake"]+                scuPairShouldBe ["3Quick Ben2Whiskeyjack", "6Karsa6Tehol", "10Anomander Rake10Iskaral Pust"]+                scuTripleShouldBe ["3Quick Ben2Whiskeyjack3Fiddler", "6Karsa6Tehol7Tayschrenn", "10Anomander Rake10Iskaral Pust11Dujek"]+                loadLog `shouldReturn` concat+                    [ scuSingleLogMsg "2 Quick Ben"+                                      "3 Quick Ben"+                    , scuSingleLogMsg "5 Karsa"+                                      "6 Karsa"+                    , scuSingleLogMsg "9 Anomander Rake"+                                      "10 Anomander Rake"+                    , scuPairLogMsg   "2 Quick Ben 2 Whiskeyjack"+                                      "3 Quick Ben 2 Whiskeyjack"+                    , scuPairLogMsg   "5 Karsa 6 Tehol"+                                      "6 Karsa 6 Tehol"+                    , scuPairLogMsg   "9 Anomander Rake 10 Iskaral Pust"+                                      "10 Anomander Rake 10 Iskaral Pust"+                    , scuTripleLogMsg "2 Quick Ben 2 Whiskeyjack 3 Fiddler"+                                      "3 Quick Ben 2 Whiskeyjack 3 Fiddler"+                    , scuTripleLogMsg "5 Karsa 6 Tehol 7 Tayschrenn"+                                      "6 Karsa 6 Tehol 7 Tayschrenn"+                    , scuTripleLogMsg "9 Anomander Rake 10 Iskaral Pust 11 Dujek"+                                      "10 Anomander Rake 10 Iskaral Pust 11 Dujek"+                    ] -    it "displays the intl formatted data" $ runWD $ do-        "f-number" `intlSpanShouldBe` "90%"-        "f-int" `intlSpanShouldBe` "100,000"-        "f-double" `intlSpanShouldBe` "40,000.2"-        "f-shortday" `intlSpanShouldBe` "Jul 20, 1969"-        "f-fullday" `intlSpanShouldBe` "Sunday, July 20, 69 AD"-        "f-date" `intlSpanShouldBe` "Sun, Jul 20, 69"-        -- f-shorttime and f-fulltime cannot be (easily) tested since they rely on the current timezone-        "f-time" `intlSpanShouldBe` "Jul 19, 69, 4:56:00 PM GMT-10"-        "f-plural" `intlSpanShouldBe` "plural other"+        describe "Changing the second scu" $ do -        today <- liftIO (utctDay <$> getCurrentTime)-        let moon = fromGregorian 1969 7 20-            daysAgo = diffDays today moon-            yearsAgo :: Int = round $ realToFrac daysAgo / (365 :: Double) -- is close enough-        "f-relative" `intlSpanShouldBe` (show (yearsAgo) ++ " years ago")-        "f-relative-days" `intlSpanShouldBe` (showWithComma (daysAgo+1) ++ " days ago")+            it "increments just the head of the list without re-rendering all entries" $ runWD $ do+                findElem (ById "increment-first-scuSCU2") >>= click+                scuSingleShouldBe ["3Quick Ben", "6Karsa", "10Anomander Rake"] -- unchanged+                scuPairShouldBe ["3Quick Ben3Whiskeyjack", "6Karsa6Tehol", "10Anomander Rake10Iskaral Pust"]+                scuTripleShouldBe ["3Quick Ben3Whiskeyjack3Fiddler", "6Karsa6Tehol7Tayschrenn", "10Anomander Rake10Iskaral Pust11Dujek"]+                loadLog `shouldReturn` concat+                    [ scuPairLogMsg "3 Quick Ben 2 Whiskeyjack"+                                    "3 Quick Ben 3 Whiskeyjack"+                    , scuTripleLogMsg "3 Quick Ben 2 Whiskeyjack 3 Fiddler"+                                      "3 Quick Ben 3 Whiskeyjack 3 Fiddler"+                    ] -    it "displays messages" $ runWD $ do-        msg <- findElem $ ById "f-msg"-        getText msg `shouldReturn` "Neil Armstrong took 100 photos years ago."-        takenAgoSpan <- findElemFrom msg $ ById "takenAgoSpan"-        getText takenAgoSpan `shouldReturn` "years ago" -        msg' <- findElem $ ById "f-msg-with-descr"-        getText msg' `shouldReturn` "Neil Armstrong took no photos."+            it "increments all entries" $ runWD $ do+                findElem (ById "change-all-scu-SCU2") >>= click+                scuSingleShouldBe ["3Quick Ben", "6Karsa", "10Anomander Rake"] -- unchanged+                scuPairShouldBe ["3Quick Ben4Whiskeyjack", "6Karsa7Tehol", "10Anomander Rake11Iskaral Pust"]+                scuTripleShouldBe ["3Quick Ben4Whiskeyjack3Fiddler", "6Karsa7Tehol7Tayschrenn", "10Anomander Rake11Iskaral Pust11Dujek"]+                loadLog `shouldReturn` concat+                    [ scuPairLogMsg   "3 Quick Ben 3 Whiskeyjack"+                                      "3 Quick Ben 4 Whiskeyjack"+                    , scuPairLogMsg   "6 Karsa 6 Tehol"+                                      "6 Karsa 7 Tehol"+                    , scuPairLogMsg   "10 Anomander Rake 10 Iskaral Pust"+                                      "10 Anomander Rake 11 Iskaral Pust"+                    , scuTripleLogMsg "3 Quick Ben 3 Whiskeyjack 3 Fiddler"+                                      "3 Quick Ben 4 Whiskeyjack 3 Fiddler"+                    , scuTripleLogMsg "6 Karsa 6 Tehol 7 Tayschrenn"+                                      "6 Karsa 7 Tehol 7 Tayschrenn"+                    , scuTripleLogMsg "10 Anomander Rake 10 Iskaral Pust 11 Dujek"+                                      "10 Anomander Rake 11 Iskaral Pust 11 Dujek"+                    ] -        "f-msg-with-trans" `intlSpanShouldBe` "message from translation xxx"+        describe "Changing the third scu" $ do -        htmlMsg <- findElem $ ById "f-html-msg"-        getText htmlMsg `shouldReturn` "42 is the answer to life, the universe, and everything"-        (findElemFrom htmlMsg (ByTag "b") >>= getText)-            `shouldReturn` "42"+            it "increments just the head of the list without re-rendering all entries" $ runWD $ do+                findElem (ById "increment-first-scuSCU3") >>= click+                scuSingleShouldBe ["3Quick Ben", "6Karsa", "10Anomander Rake"] -- unchanged+                scuPairShouldBe ["3Quick Ben4Whiskeyjack", "6Karsa7Tehol", "10Anomander Rake11Iskaral Pust"] -- unchanged+                scuTripleShouldBe ["3Quick Ben4Whiskeyjack4Fiddler", "6Karsa7Tehol7Tayschrenn", "10Anomander Rake11Iskaral Pust11Dujek"]+                loadLog `shouldReturn` concat+                    [ scuTripleLogMsg "3 Quick Ben 4 Whiskeyjack 3 Fiddler"+                                      "3 Quick Ben 4 Whiskeyjack 4 Fiddler"+                    ] -        htmlMsg' <- findElem $ ById "f-html-msg-with-descr"-        getText htmlMsg' `shouldReturn` "42 is the answer to life, the universe, and everything"-        (findElemFrom htmlMsg' (ByTag "b") >>= getText)-            `shouldReturn` "answer" -    it "displays formatted properties" $ runWD $ do-        "f-number-prop" `intlPlaceholderShouldBe` "123,456"-        "f-date-prop" `intlPlaceholderShouldBe` "7/20/1969"-        "f-time-prop" `intlPlaceholderShouldBe` "Jul 19, 69, 4 PM"-        "f-plural-prop" `intlPlaceholderShouldBe` "other"-        "f-msg-prop" `intlPlaceholderShouldBe` "Neil Armstrong took 100 photos"-        "f-msg-prop-with-descr" `intlPlaceholderShouldBe` "Neil Armstrong took 0 photos"+            it "increments all entries" $ runWD $ do+                findElem (ById "change-all-scu-SCU3") >>= click+                scuSingleShouldBe ["3Quick Ben", "6Karsa", "10Anomander Rake"] -- unchanged+                scuPairShouldBe ["3Quick Ben4Whiskeyjack", "6Karsa7Tehol", "10Anomander Rake11Iskaral Pust"] -- unchanged+                scuTripleShouldBe ["3Quick Ben4Whiskeyjack5Fiddler", "6Karsa7Tehol8Tayschrenn", "10Anomander Rake11Iskaral Pust12Dujek"]+                loadLog `shouldReturn` concat+                    [ scuTripleLogMsg "3 Quick Ben 4 Whiskeyjack 4 Fiddler"+                                      "3 Quick Ben 4 Whiskeyjack 5 Fiddler"+                    , scuTripleLogMsg "6 Karsa 7 Tehol 7 Tayschrenn"+                                      "6 Karsa 7 Tehol 8 Tayschrenn"+                    , scuTripleLogMsg "10 Anomander Rake 11 Iskaral Pust 11 Dujek"+                                      "10 Anomander Rake 11 Iskaral Pust 12 Dujek"+                    ]++        describe "changing the fourth scu" $ do++            it "increments just the head of the list" $ runWD $ do+                findElem (ById "increment-first-scuSCU4") >>= click+                -- unchanged+                scuSingleShouldBe ["3Quick Ben", "6Karsa", "10Anomander Rake"] -- unchanged+                scuPairShouldBe ["3Quick Ben4Whiskeyjack", "6Karsa7Tehol", "10Anomander Rake11Iskaral Pust"] -- unchanged+                scuTripleShouldBe ["3Quick Ben4Whiskeyjack5Fiddler", "6Karsa7Tehol8Tayschrenn", "10Anomander Rake11Iskaral Pust12Dujek"]+                loadLog `shouldReturn` []++            it "increments all entries" $ runWD $ do+                findElem (ById "change-all-scu-SCU4") >>= click+                -- unchanged+                scuSingleShouldBe ["3Quick Ben", "6Karsa", "10Anomander Rake"] -- unchanged+                scuPairShouldBe ["3Quick Ben4Whiskeyjack", "6Karsa7Tehol", "10Anomander Rake11Iskaral Pust"] -- unchanged+                scuTripleShouldBe ["3Quick Ben4Whiskeyjack5Fiddler", "6Karsa7Tehol8Tayschrenn", "10Anomander Rake11Iskaral Pust12Dujek"]+                loadLog `shouldReturn` []++    describe "i18n" $ do+        it "opens the page" $ runWD $ do+            dir <- liftIO $ getCurrentDirectory+            openPage $ "file://" ++ dir ++ "/../client/" ++ filename++        it "displays the intl formatted data" $ runWD $ do+            "f-number" `intlSpanShouldBe` "90%"+            "f-int" `intlSpanShouldBe` "100,000"+            "f-double" `intlSpanShouldBe` "40,000.2"+            "f-shortday" `intlSpanShouldBe` "Jul 20, 1969"+            "f-fullday" `intlSpanShouldBe` "Sunday, July 20, 69 AD"+            "f-date" `intlSpanShouldBe` "Sun, Jul 20, 69"+            -- f-shorttime and f-fulltime cannot be (easily) tested since they rely on the current timezone+            "f-time" `intlSpanShouldBe` "Jul 19, 69, 4:56:00 PM GMT-10"+            "f-plural" `intlSpanShouldBe` "plural other"++            today <- liftIO (utctDay <$> getCurrentTime)+            let moon = fromGregorian 1969 7 20+                daysAgo = diffDays today moon+                yearsAgo :: Int = round $ realToFrac daysAgo / (365 :: Double) -- is close enough+            "f-relative" `intlSpanShouldBe` (show (yearsAgo) ++ " years ago")+            "f-relative-days" `intlSpanShouldBe` (showWithComma (daysAgo+1) ++ " days ago")++        it "displays messages" $ runWD $ do+            msg <- findElem $ ById "f-msg"+            getText msg `shouldReturn` "Neil Armstrong took 100 photos years ago."+            takenAgoSpan <- findElemFrom msg $ ById "takenAgoSpan"+            getText takenAgoSpan `shouldReturn` "years ago"++            msg' <- findElem $ ById "f-msg-with-descr"+            getText msg' `shouldReturn` "Neil Armstrong took no photos."++            "f-msg-with-trans" `intlSpanShouldBe` "message from translation xxx"++            htmlMsg <- findElem $ ById "f-html-msg"+            getText htmlMsg `shouldReturn` "42 is the answer to life, the universe, and everything"+            (findElemFrom htmlMsg (ByTag "b") >>= getText)+                `shouldReturn` "42"++            htmlMsg' <- findElem $ ById "f-html-msg-with-descr"+            getText htmlMsg' `shouldReturn` "42 is the answer to life, the universe, and everything"+            (findElemFrom htmlMsg' (ByTag "b") >>= getText)+                `shouldReturn` "answer"++        it "displays formatted properties" $ runWD $ do+            "f-number-prop" `intlPlaceholderShouldBe` "123,456"+            "f-date-prop" `intlPlaceholderShouldBe` "7/20/1969"+            "f-time-prop" `intlPlaceholderShouldBe` "Jul 19, 69, 4 PM"+            "f-plural-prop" `intlPlaceholderShouldBe` "other"+            "f-msg-prop" `intlPlaceholderShouldBe` "Neil Armstrong took 100 photos"+            "f-msg-prop-with-descr" `intlPlaceholderShouldBe` "Neil Armstrong took 0 photos"

@@ -1,3 +1,3 @@-resolver: lts-5.6+resolver: lts-6.1 packages: - '.'