packages feed

react-flux 0.9.1 → 0.9.2

raw patch · 36 files changed

+1248/−306 lines, 36 filesdep +bytestringdep +timedep +transformersdep ~aesondep ~basedep ~textnew-component:exe:route-examplePVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, time, transformers, web-routes

Dependency ranges changed: aeson, base, text

API changes (from Hackage documentation)

+ React.Flux.Addons.Bootstrap: bootstrap_ :: String -> [PropertyOrHandler eventHandler] -> ReactElementM eventHandler a -> ReactElementM eventHandler a
+ React.Flux.Addons.React: CSSTransitionProps :: String -> Bool -> Bool -> Bool -> CSSTransitionProps
+ React.Flux.Addons.React: PerfPrintDOM :: PerfPrint
+ React.Flux.Addons.React: PerfPrintExclusive :: PerfPrint
+ React.Flux.Addons.React: PerfPrintInclusive :: PerfPrint
+ React.Flux.Addons.React: PerfPrintWasted :: PerfPrint
+ React.Flux.Addons.React: PerfStart :: PerfAction
+ React.Flux.Addons.React: PerfStopAndPrint :: [PerfPrint] -> PerfAction
+ React.Flux.Addons.React: [transitionAppear] :: CSSTransitionProps -> Bool
+ React.Flux.Addons.React: [transitionEnter] :: CSSTransitionProps -> Bool
+ React.Flux.Addons.React: [transitionLeave] :: CSSTransitionProps -> Bool
+ React.Flux.Addons.React: [transitionName] :: CSSTransitionProps -> String
+ React.Flux.Addons.React: cssTransitionGroup :: CSSTransitionProps -> ReactElementM eventHandler a -> ReactElementM eventHandler a
+ React.Flux.Addons.React: data CSSTransitionProps
+ React.Flux.Addons.React: data PerfAction
+ React.Flux.Addons.React: data PerfPrint
+ React.Flux.Addons.React: defaultTransitionProps :: CSSTransitionProps
+ React.Flux.Addons.React: instance Control.DeepSeq.NFData React.Flux.Addons.React.PerfAction
+ React.Flux.Addons.React: instance Control.DeepSeq.NFData React.Flux.Addons.React.PerfPrint
+ React.Flux.Addons.React: instance GHC.Classes.Eq React.Flux.Addons.React.PerfAction
+ React.Flux.Addons.React: instance GHC.Classes.Eq React.Flux.Addons.React.PerfPrint
+ React.Flux.Addons.React: instance GHC.Generics.Constructor React.Flux.Addons.React.C1_0PerfAction
+ React.Flux.Addons.React: instance GHC.Generics.Constructor React.Flux.Addons.React.C1_0PerfPrint
+ React.Flux.Addons.React: instance GHC.Generics.Constructor React.Flux.Addons.React.C1_1PerfAction
+ React.Flux.Addons.React: instance GHC.Generics.Constructor React.Flux.Addons.React.C1_1PerfPrint
+ React.Flux.Addons.React: instance GHC.Generics.Constructor React.Flux.Addons.React.C1_2PerfPrint
+ React.Flux.Addons.React: instance GHC.Generics.Constructor React.Flux.Addons.React.C1_3PerfPrint
+ React.Flux.Addons.React: instance GHC.Generics.Datatype React.Flux.Addons.React.D1PerfAction
+ React.Flux.Addons.React: instance GHC.Generics.Datatype React.Flux.Addons.React.D1PerfPrint
+ React.Flux.Addons.React: instance GHC.Generics.Generic React.Flux.Addons.React.PerfAction
+ React.Flux.Addons.React: instance GHC.Generics.Generic React.Flux.Addons.React.PerfPrint
+ React.Flux.Addons.React: instance GHC.Show.Show React.Flux.Addons.React.PerfAction
+ React.Flux.Addons.React: instance GHC.Show.Show React.Flux.Addons.React.PerfPrint
+ React.Flux.Addons.React: instance React.Flux.Store.StoreData React.Flux.Addons.React.PerfStoreData
+ React.Flux.Addons.React: perfA :: PerfAction -> SomeStoreAction
+ React.Flux.Addons.React: perfToggleButton_ :: [PerfPrint] -> ReactElementM handler ()

Files

ChangeLog.md view
@@ -1,3 +1,8 @@+# 0.9.2++* Bindings to react-bootstrap and the react addons+* Add new routing example application (thanks Vladimir Sekissov!)+ # 0.9.1  * Switch to use the improved-base branch of ghcjs (thanks Vladimir Sekissov!)
README.md view
@@ -10,7 +10,7 @@  # Build -This package requires GHC 7.10 (I am using GHC 7.10.2) and the improved-base branch of ghcjs.+This package requires GHC 7.10.2 and the improved-base branch of ghcjs. I followed the instructions in the [ghcjs wiki](https://github.com/ghcjs/ghcjs/wiki/GHCJS-with-GHC-7.10) to install the improved-base branch.  Once ghcjs is installed, I use the following to build react-flux: @@ -20,32 +20,33 @@ cabal build ~~~ -# TODO Example Application+# Example Applications -The source contains an [example TODO-application](https://bitbucket.org/wuzzeb/react-flux/src/tip/example/).+The source contains some [example applications](https://bitbucket.org/wuzzeb/react-flux/src/tip/example).+To try out the TODO example, execute  ~~~ cabal configure -fexample cabal build-cd example+cd example/todo make firefox todo.html ~~~ -If you don't have closure installed, you can open `example/todo-dev.html`.+If you don't have closure installed, you can open `todo-dev.html` instead of `todo.html`.  For more details on+the example applications, see the [README](https://bitbucket.org/wuzzeb/react-flux/src/tip/example/README.md).  # Test Suite -To run the test suite, first you must build both the example application and the test-client.  (The-test-client is a react-flux application which contains everything not contained in the todo+To run the test suite, first you must build both the example applications and the test-client.  (The+test-client is a react-flux application which contains code for everything not contained in the todo example.)  ~~~ echo "compiler: ghcjs" > cabal.config cabal configure -fexample -ftest-client cabal build-cd example+cd example/todo make ~~~ @@ -64,7 +65,7 @@ `test/spec` directory, otherwise it does not find the correct javascript files.  ~~~-.stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/react-flux-spec/react-flux-spec+stack exec react-flux-spec ~~~  # Other Projects
− example/Main.hs
@@ -1,7 +0,0 @@-module Main where--import React.Flux-import TodoViews--main :: IO ()-main = reactRender "todoapp" todoApp ()
− example/Makefile
@@ -1,15 +0,0 @@-js-build/todo.min.js: js-build/todo.js-	closure --compilation_level=ADVANCED_OPTIMIZATIONS js-build/todo.js > js-build/todo.min.js--js-build/todo.js: ../dist/build/todo/todo.jsexe/all.js-	mkdir -p js-build-	echo "(function(global,React) {" > js-build/todo.js-	cat ../dist/build/todo/todo.jsexe/all.js >> js-build/todo.js-	echo "})(this, window['React']);" >> js-build/todo.js-	sed -i 's/goog.provide.*//' js-build/todo.js-	sed -i 's/goog.require.*//' js-build/todo.js-	# https://github.com/ghcjs/shims/issues/21-	sed -i 's/final\([^a-z]\)/final0\1/g' js-build/todo.js--clean:-	rm -rf js-build
example/README.md view
@@ -1,13 +1,18 @@-This directory contains an example TODO application.  The design is copied pretty much exactly from the-[flux todo example](https://github.com/facebook/flux/tree/master/examples/flux-todomvc).  It uses-the same actions, same views, and produces the same DOM, so the design overview from the flux-repository covers this example application as well.+This directory contains two example applications. +# Todo Example++This is the simpler of the two examples, and you should start here.  The design+is copied pretty much exactly from the [flux todo+example](https://github.com/facebook/flux/tree/master/examples/flux-todomvc).+It uses the same actions, same views, and produces the same DOM, so the design+overview from the flux repository covers this example application as well.+ When reading the code for the example application, you should start with `TodoStore.hs`.  Next, look at `TodoDispatcher.hs` and `TodoViews.hs`.  Finally, you can look at `TodoComponents.hs` and `Main.hs`. -# Build+### Build  To build, you must pass the `-fexample` flag to cabal. @@ -17,7 +22,7 @@ ~~~  The result of this build is a file `dist/build/todo/todo.jsexe/all.js`.  There is a file-`example/todo-dev.html` which loads this `all.js` file directly from the `dist` directory, so you+`example/todo/todo-dev.html` which loads this `all.js` file directly from the `dist` directory, so you can open `todo-dev.html` after building.  But to deploy a react-flux application, you should minimize it since the size of `all.js` is 1.8@@ -25,16 +30,28 @@ on your path, you can execute  ~~~-cd example+cd example/todo make ~~~  This produces a file `js-build/todo.min.js` which is only 500 kibibytes which when compressed with gzip is 124 kibibytes. -# Testing+### Testing  Finally, you might be interested to look at [test/spec/TodoSpec.hs](https://bitbucket.org/wuzzeb/react-flux/src/tip/test/spec/TodoSpec.hs) as it contains an [hspec-webdriver](https://hackage.haskell.org/package/hspec-webdriver) spec for the TODO example application.++# Routing Example++The second example application shows routing with the [web-routes](https://hackage.haskell.org/package/web-routes) package.+It is also built by passing `-fexample` to cabal.++~~~+cabal configure -fexample+cabal build+cd example/routing+firefox route-example.html+~~~
− example/TodoComponents.hs
@@ -1,50 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | The division between a view and a component is arbitrary, but for me components are pieces that--- are re-used many times for different purposes.  In the TODO app, there is one component for the--- text box.-module TodoComponents where--import Data.Typeable (Typeable)-import React.Flux---- | The properties for the text input component.  Note how we can pass anything, including--- functions, as the properties; the only requirement is an instance of Typeable.-data TextInputArgs = TextInputArgs {-      tiaId :: Maybe String-    , tiaClass :: String-    , tiaPlaceholder :: String-    , tiaOnSave :: String -> [SomeStoreAction]-    , tiaValue :: Maybe String-} deriving (Typeable)---- | The text input stateful view.  The state is the text that has been typed into the textbox--- but not yet saved.  The save is triggered either on enter or blur, which resets the state/content--- of the text box to the empty string.-todoTextInput :: ReactView TextInputArgs-todoTextInput = defineStatefulView "todo text input" "" $ \curText args ->-    input_ $-        maybe [] (\i -> ["id" @= i]) (tiaId args)-        ++-        [ "className" @= tiaClass args-        , "placeholder" @= tiaPlaceholder args-        , "value" @= curText -- using value here creates a controlled component: https://facebook.github.io/react/docs/forms.html-        , "autoFocus" @= True--        -- Update the current state with the current text in the textbox, sending no actions-        , onChange $ \evt _ -> ([], Just $ target evt "value")--        -- Produce the save action and reset the current state to the empty string-        , onBlur $ \_ _ curState ->-            if not (null curState)-                then (tiaOnSave args curState, Just "")-                else ([], Nothing)-        , onKeyDown $ \_ evt curState ->-             if keyCode evt == 13 && not (null curState) -- 13 is enter-                 then (tiaOnSave args curState, Just "")-                 else ([], Nothing)-        ]---- | A combinator suitible for use inside rendering functions.-todoTextInput_ :: TextInputArgs -> ReactElementM eventHandler ()-todoTextInput_ args = view todoTextInput args mempty
− example/TodoDispatcher.hs
@@ -1,7 +0,0 @@-module TodoDispatcher (dispatchTodo) where--import React.Flux-import TodoStore--dispatchTodo :: TodoAction -> [SomeStoreAction]-dispatchTodo a = [SomeStoreAction todoStore a]
− example/TodoStore.hs
@@ -1,61 +0,0 @@-{-# LANGUAGE TypeFamilies, DeriveGeneric, DeriveAnyClass #-}-module TodoStore where--import React.Flux-import Control.DeepSeq-import GHC.Generics (Generic)-import Data.Typeable (Typeable)--data Todo = Todo {-    todoText :: String-  , todoComplete :: Bool-  , todoIsEditing :: Bool-} deriving (Show, Typeable)--newtype TodoState = TodoState {-    todoList :: [(Int, Todo)]-} deriving (Show, Typeable)--data TodoAction = TodoCreate String-                | TodoDelete Int-                | TodoEdit Int-                | UpdateText Int String-                | ToggleAllComplete-                | TodoSetComplete Int Bool-                | ClearCompletedTodos-  deriving (Show, Typeable, Generic, NFData)--instance StoreData TodoState where-    type StoreAction TodoState = TodoAction-    transform action (TodoState todos) = do-        putStrLn $ "Action: " ++ show action-        putStrLn $ "Initial todos: " ++ show todos--        -- Care is taken here to leave the Haskell object for the pair (Int, Todo) unchanged if the todo-        -- itself is unchanged.  This allows React to avoid re-rendering the todo when it does not change.-        -- For more, see the "Performance" section of the React.Flux haddocks.-        newTodos <- return $ case action of-            (TodoCreate txt) -> (maximum (map fst todos) + 1, Todo txt False False) : todos-            (TodoDelete i) -> filter ((/=i) . fst) todos-            (TodoEdit i) -> let f (idx, todo) | idx == i = (idx, todo { todoIsEditing = True })-                                f p = p-                             in map f todos-            (UpdateText newIdx newTxt) ->-                let f (idx, todo) | idx == newIdx = (idx, todo { todoText = newTxt, todoIsEditing = False })-                    f p = p-                 in map f todos-            ToggleAllComplete -> [ (idx, Todo txt True False) | (idx, Todo txt _ _) <- todos ]-            TodoSetComplete newIdx newComplete ->-                let f (idx, todo) | idx == newIdx = (idx, todo { todoComplete = newComplete })-                    f p = p-                 in map f todos-            ClearCompletedTodos -> filter (not . todoComplete . snd) todos--        putStrLn $ "New todos: " ++ show newTodos-        return $ TodoState newTodos--todoStore :: ReactStore TodoState-todoStore = mkStore $ TodoState-    [ (0, Todo "Learn react" True False)-    , (1, Todo "Learn react-flux" False False)-    ]
− example/TodoViews.hs
@@ -1,110 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- | The views for the TODO app-module TodoViews where--import Control.Monad (when)-import React.Flux--import TodoDispatcher-import TodoStore-import TodoComponents---- | The controller view and also the top level of the TODO app.  This controller view registers--- with the store and will be re-rendered whenever the store changes.-todoApp :: ReactView ()-todoApp = defineControllerView "todo app" todoStore $ \todoState () ->-    div_ $ do-        todoHeader_-        mainSection_ todoState-        todoFooter_ todoState---- | The TODO header as a React view with no properties.-todoHeader :: ReactView ()-todoHeader = defineView "header" $ \() ->-    header_ ["id" $= "header"] $ do-        h1_ "todos"-        todoTextInput_  TextInputArgs-          { tiaId = Just "new-todo"-          , tiaClass = "new-todo"-          , tiaPlaceholder = "What needs to be done?"-          , tiaOnSave = dispatchTodo . TodoCreate-          , tiaValue = Nothing-          }---- | A combinator for the header suitable for use inside the 'todoApp' rendering function.-todoHeader_ :: ReactElementM eventHandler ()-todoHeader_ = view todoHeader () mempty---- | A view that does not use a ReactView and is instead just a Haskell function.--- Note how we use an underscore to signal that this is directly a combinator that can be used--- inside the rendering function.-mainSection_ :: TodoState -> ReactElementM ViewEventHandler ()-mainSection_ st = section_ ["id" $= "main"] $ do-    input_ [ "id" $= "toggle-all"-           , "type" $= "checkbox"-           , "checked" $= if all (todoComplete . snd) $ todoList st then "checked" else ""-           , onChange $ \_ -> dispatchTodo ToggleAllComplete-           ]--    label_ [ "htmlFor" $= "toggle-all"] "Mark all as complete"-    ul_ [ "id" $= "todo-list" ] $ mapM_ todoItem_ $ todoList st---- | A view for each todo item.  We specifically use a ReactView here to take advantage of the--- ability for React to only re-render the todo items that have changed.  Care is taken in the--- transform function of the store to not change the Haskell object for the pair (Int, Todo), and--- in this case React will not re-render the todo item.  For more details, see the "Performance"--- section of the React.Flux documentation.-todoItem :: ReactView (Int, Todo)-todoItem = defineView "todo item" $ \(todoIdx, todo) ->-    li_ [ "className" @= (unwords $ [ "completed" | todoComplete todo] ++ [ "editing" | todoIsEditing todo ])-        , "key" @= todoIdx-        ] $ do-        -        div_ [ "className" $= "view"] $ do-            input_ [ "className" $= "toggle"-                   , "type" $= "checkbox"-                   , "checked" @= todoComplete todo-                   , onChange $ \_ -> dispatchTodo $ TodoSetComplete todoIdx $ not $ todoComplete todo-                   ]--            label_ [ onDoubleClick $ \_ _ -> dispatchTodo $ TodoEdit todoIdx] $-                elemText $ todoText todo--            button_ [ "className" $= "destroy"-                    , onClick $ \_ _ -> dispatchTodo $ TodoDelete todoIdx-                    ] mempty--        when (todoIsEditing todo) $-            todoTextInput_ TextInputArgs-                { tiaId = Nothing-                , tiaClass = "edit"-                , tiaPlaceholder = ""-                , tiaOnSave = dispatchTodo . UpdateText todoIdx-                , tiaValue = Just $ todoText todo-                }---- | A combinator for a todo item to use inside rendering functions-todoItem_ :: (Int, Todo) -> ReactElementM eventHandler ()-todoItem_ todo = viewWithKey todoItem (fst todo) todo mempty---- | A view for the footer, taking the entire state as the properties.  This could alternatively--- been modeled as a controller-view, attaching directly to the store.-todoFooter :: ReactView TodoState-todoFooter = defineView "footer" $ \(TodoState todos) ->-    let completed = length (filter (todoComplete . snd) todos)-        itemsLeft = length todos - completed-     in footer_ [ "id" $= "footer"] $ do--            span_ [ "id" $= "todo-count" ] $ do-                strong_ $ elemShow itemsLeft-                elemText $ if itemsLeft == 1 then " item left" else " items left"--            when (completed > 0) $ do-                button_ [ "id" $= "clear-completed"-                        , onClick $ \_ _ -> dispatchTodo ClearCompletedTodos-                        ] $-                    elemText $ "Clear completed (" ++ show completed ++ ")"---- | A render combinator for the footer-todoFooter_ :: TodoState -> ReactElementM eventHandler ()-todoFooter_ s = view todoFooter s mempty
+ example/css/route-example.css view
@@ -0,0 +1,97 @@+/* The following CSS was copied from the flux todo example:+ * https://github.com/facebook/flux/tree/master/examples+ */++html,+body {+	margin: 0;+	padding: 0;+}++button {+	margin: 0;+	padding: 0;+	border: 0;+	background: none;+	font-size: 100%;+	vertical-align: baseline;+	font-family: inherit;+	color: inherit;+	-webkit-appearance: none;+	-ms-appearance: none;+	-o-appearance: none;+	appearance: none;+}++body {+	font: 14px 'Helvetica Neue', Helvetica, Arial, sans-serif;+	line-height: 1.4em;+	background: #eaeaea url('bg.png');+	color: #4d4d4d;+	// width: 550px;+	margin: 0 auto;+	-webkit-font-smoothing: antialiased;+	-moz-font-smoothing: antialiased;+	-ms-font-smoothing: antialiased;+	-o-font-smoothing: antialiased;+	font-smoothing: antialiased;+}++.tabbed-app-picker {+    background-color: #333;+    color: #999;+}++.tabbed-app-picker a:link {+    text-decoration: none;+    color: #999;+}++.tabbed-app-picker a:visited {+    text-decoration: none;+    color: #999;+}++.tabbed-app-picker span {+    padding-left: 3em;+}++.et-actions {+    width: 50%;+    height: 400px;+    background: white;+    position: fixed;+    right: 10px;+    overflow: scroll;+}+.et-box1 {+    background: red;+    padding: 1em;+    width: 150px;+    text-align: center;+    color: white;+}+.et-box2 {+    background: lightgreen;+    padding: 1em;+    color: black;+}+.et-box3 {+    background: blue;+    padding: 1em;+    color: white;+}+.et-box4 {+    background: black;+    width: 150px;+    padding: 1em;+    text-align: center;+    color: white;+}++.et-box5 {+    background: white;+    height: 100px;+    width: 150px;+    overflow: scroll;+}
+ example/routing/Clock.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE DeriveAnyClass     #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE TypeFamilies       #-}++-- |++module Clock where++import           React.Flux         hiding (view)+import qualified React.Flux         as RF++import           Control.Concurrent (forkIO, threadDelay)+import           Control.DeepSeq+import           Control.Monad      (void)+import           Data.Time          (UTCTime, getCurrentTime)+import           Data.Typeable      (Typeable)+import           GHC.Generics       (Generic)+++data ClockState = ClockState {csTime :: !(Maybe UTCTime)+                             }+                deriving (Show, Typeable)++data ClockAction = ClockInit+                 | ClockTick UTCTime+                 deriving (Show, Typeable, Generic, NFData)++instance StoreData ClockState where+  type StoreAction ClockState = ClockAction+  transform action st =+    -- putStrLn $ "Action: " ++ show action+    case action of+      ClockInit -> do+        void $ forkIO $ workerLoop store+        return st+      ClockTick tm ->+        return $ st{csTime = Just tm}+    where+      workerLoop rst = do+        storeWorker rst+        workerLoop rst+      storeWorker rst = do+        threadDelay 1000000+        tm <- getCurrentTime+        alterStore rst (ClockTick tm)++store :: ReactStore ClockState+store = mkStore $ ClockState Nothing++view :: ReactView ClockState+view = defineView "clock" $ \st ->+  div_ $  maybe mempty elemShow $ csTime st++view_ :: ClockState -> ReactElementM eventHandler ()+view_ st =+  RF.view view st mempty++
+ example/routing/EventTest.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE DeriveAnyClass     #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE TypeFamilies       #-}+++-- |++module EventTest where++import           React.Flux                   hiding (view)+import qualified React.Flux                   as RF++import           Control.DeepSeq+import qualified Data.Text                    as T+import           Data.Typeable                (Typeable)+import           GHC.Generics                 (Generic)++data ETState = ETState+    { etActions :: [ETAction]+    , etText    :: !T.Text+    , etBool    :: !Bool+    } deriving (Show, Typeable)++data ETAction+    = ETInit+    | ClearActionsA+    | KeyDownEnterA+    | KeyUpEnterA+    | KeyPressCapitalA+    | FocusA+    | BlurA+    | TextChangeA T.Text+    | BoolChangeA Bool+    | MouseEnterA Int+    | MouseLeaveA Int+    | MouseOverA Int+    | MouseOutA Int+    | MouseDownA+    | MouseUpA+    | ClickA+    | DoubleClickA+    | MouseMoveA Int Int+    | ScrollA Int+    deriving (Show, Typeable, Generic, NFData)++instance StoreData ETState where+  type StoreAction ETState = ETAction+  transform action st = do+    let st1 = st{etActions = action:etActions st}+        st2 = case action of+          ETInit           -> st1+          ClearActionsA    -> st1{etActions = []}+          TextChangeA txt  -> st1{etText = txt}+          BoolChangeA bool -> st1{etBool = bool}+          _                -> st1+    return st2++store :: ReactStore ETState+store = mkStore $ ETState [] "" True++dispatchEventTest :: ETAction -> [SomeStoreAction]+dispatchEventTest a = [SomeStoreAction store a]++view :: ReactView ETState+view = defineView "event-tests" $ \(ETState actions text bool) ->+  section_ $ do+    let textVal = "value" $= text++    div_ ["className" $= "et-actions"] $ do+      a_ [onClick $ \_ _ -> dispatchEventTest ClearActionsA] $+        elemText "Clear event history"+      pre_ $+        elemText $ unlines $ map show actions++    h2_ $ elemText "Testing keyboard events"+    p_ $ elemText "Type <enter> to test onKeyUp/onKeyDown"+    input_ ["type" $= "text"+            , onKeyDown $ \_ ke ->+            case keyCode ke of+            13 -> dispatchEventTest KeyDownEnterA+            _ -> []+            , onKeyUp $ \_ ke ->+            case keyCode ke of+            13 -> dispatchEventTest KeyUpEnterA+            _ -> []]+    p_ $ elemText "Type a capital letter to test onKeyPress"+    input_ ["type" $= "text"+           , onKeyPress $ \_ ke ->+           let chars = map fromEnum ['A'..'Z']+           in+             if keyEvtCharCode ke `elem` chars+             then dispatchEventTest KeyPressCapitalA+             else []+           ]+    h2_ $ elemText "Testing focus events"+    p_ $ elemText "Use the box below to test onBlur/onFocus"+    input_ ["type" $= "text"+           , onFocus $ \_ _ -> dispatchEventTest FocusA+           , onBlur $ \_ _ -> dispatchEventTest BlurA+           ]++    h2_ $ elemText "Testing form events"+    p_ $ elemText "These elements share a text value. Use them to test onChange."+    p_ $ input_ [textVal,+                 onChange $ \evt ->+                 dispatchEventTest (TextChangeA $ targetText evt "value")+                ]+    p_ $ textarea_ [textVal+                   , onChange $ \evt ->+                   dispatchEventTest (TextChangeA $ targetText evt "value")+                   ] mempty+    p_ $ select_ [textVal, onChange $ \evt ->+                    dispatchEventTest (TextChangeA $ targetText evt "value")] $ do+      option_ ["value" $= "sheep"] $ elemText "Sheep"+      option_ ["value" $= "pig"  ] $ elemText "Pig"+      option_ ["value" $= "cow"  ] $ elemText "Cow"+    p_ $ elemText "These elements share a boolean value. Use them to test onChange."+    p_ $+      input_ ["type" $= "checkbox"+             , "checked" @= bool+             , onChange $ \evt ->+             dispatchEventTest (BoolChangeA $ targetBool evt "checked")+             ]+    p_ $ do+      input_ ["type" $= "radio"+             , "checked" @= bool+             , onChange $ \evt ->+             dispatchEventTest (BoolChangeA $ targetBool evt "checked")+             ]+      input_ ["type" $= "radio"+             , "checked" @= not bool+             , onChange $ \evt ->+             dispatchEventTest (BoolChangeA $ not $ targetBool evt "checked")+             ]++    h2_ $ elemText "Testing mouse events"+    p_ $ elemText "Use the box below to test onMouseDown, onMouseUp, onClick, and onDoubleClick."+    div_  ["className" $= "et-box4"+          , onMouseDown   $ \_ _ -> dispatchEventTest MouseDownA+          , onMouseUp     $ \_ _ -> dispatchEventTest MouseUpA+          , onClick       $ \_ _ -> dispatchEventTest ClickA+          , onDoubleClick $ \_ _ -> dispatchEventTest DoubleClickA+          ] $+      span_ $ elemText "Click me!"+    p_ $ elemText "Use the boxes below to test onMouseEnter, onMouseLeave, onMouseOver, and onMouseOut."+    div_ ["className" $= "et-box1"+         , onMouseOver  $ \_ _ -> dispatchEventTest $ MouseOverA 1+         , onMouseOut   $ \_ _ -> dispatchEventTest $ MouseOutA 1+         , onMouseEnter $ \_ _ -> dispatchEventTest $ MouseEnterA 1+         , onMouseLeave $ \_ _ -> dispatchEventTest $ MouseLeaveA 1] $ do+      span_ $ elemText "1"+      div_ ["className" $= "et-box2"+           , onMouseOver  $ \_ _ -> dispatchEventTest $ MouseOverA 2+           , onMouseOut   $ \_ _ -> dispatchEventTest $ MouseOutA 2+           , onMouseEnter $ \_ _ -> dispatchEventTest $ MouseEnterA 2+           , onMouseLeave $ \_ _ -> dispatchEventTest $ MouseLeaveA 2] $ do+        span_ $ elemText "2"+        div_ ["className" $= "et-box3"+             , onMouseOver  $ \_ _ -> dispatchEventTest $ MouseOverA 2+             , onMouseOut   $ \_ _ -> dispatchEventTest $ MouseOutA 2+             , onMouseEnter $ \_ _ -> dispatchEventTest $ MouseEnterA 3+             , onMouseLeave $ \_ _ -> dispatchEventTest $ MouseLeaveA 3] $+          elemText "3"+    p_ $ elemText "Use the box below to test onMouseMove"+    div_ ["className" $= "et-box4"+         , onMouseMove $ \_ me ->+         dispatchEventTest $ MouseMoveA  (mousePageX me) (mousePageY me)+         ] $+      span_ $ elemText "Move mouse here"++    h2_ $ elemText "Testing scroll events"+    p_ $ elemText "Use the div below to test onScroll."+    div_ ["className" $= "et-box5"+          , onScroll  $ \evt ->+          dispatchEventTest $ ScrollA (targetInt evt "scrollTop")+          ] $+      elemText "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Cras at ligula orci. Nam efficitur ante justo, eget ultrices mauris maximus ut. Maecenas laoreet a lorem non fermentum. Vestibulum maximus porta quam, a pellentesque elit tristique eget. Sed sit amet lacus ut nunc malesuada aliquam. Sed leo erat, aliquam sagittis massa non, tempor condimentum ipsum. Nullam efficitur vel metus ac pharetra. Aenean in feugiat urna. Aenean in ante fermentum, sagittis ligula vel, malesuada arcu. Aliquam accumsan varius tempor. Etiam consectetur augue lorem, sit amet ullamcorper lacus finibus ac. Etiam semper euismod suscipit. Sed dapibus consectetur lacus, ac feugiat purus. Etiam lobortis ac leo et vehicula. Nullam pellentesque, lectus sed imperdiet viverra, odio felis rutrum sem, nec tristique ex enim eget velit. Phasellus semper venenatis metus, in sagittis mauris convallis et. Donec luctus ex a blandit sollicitudin. Vestibulum sollicitudin ipsum ut arcu ultrices molestie. Nulla id lorem tincidunt, ullamcorper libero ac, fringilla felis. Aenean rutrum et nisi eget commodo. Phasellus scelerisque ante eleifend elementum facilisis. Proin enim nisi, dapibus id nunc ac, dictum tincidunt neque. Cras ac viverra dolor, eu tincidunt nisl. Pellentesque finibus, massa pellentesque laoreet auctor, nisl odio pharetra velit, vel sollicitudin mi eros ac lectus."++view_ :: ETState -> ReactElementM eventHandler ()+view_ st =+  RF.view view st mempty++#ifdef __GHCJS__++targetInt :: Event -> String -> Int+targetInt = target++targetText :: Event -> String -> T.Text+targetText = target++targetBool :: Event -> String -> Bool+targetBool = target++#else++targetInt :: Event -> String -> Int+targetInt _ _ = 1++targetText :: Event -> String -> T.Text+targetText _ _ = ""++targetBool :: Event -> String -> Bool+targetBool _ _ = True++#endif
+ example/routing/Main.hs view
@@ -0,0 +1,48 @@+-- |++module Main where++import           React.Flux++import qualified Clock      as Clock+import qualified EventTest  as EventTest+import           Router+import qualified TabbedApps as TabbedApps+import           Types++main :: IO ()+main = do+  let nestedApps = [clockApp "Clock1", clockApp "Clock2"]+  nestedViews <- mapM initApp nestedApps++  let apps = [appsToTabs "Nested Tab" nestedApps nestedViews+             , clockApp "Clock"+             , etApp "Event Tests"+             ]+  appViews <- mapM initApp apps+  let tabs = appsToTabs "main tabs" apps appViews+  tabView <- initApp tabs+  case tabs of+    App{appRouter = Just ar} -> initRouter ar+    _ -> return ()+  reactRender "route-example" tabView Nothing+  where+    appsToTabs tabsName apps appViews =+      tabApp tabsName $+      zipWith (\a v ->+                 TabbedApps.Tab (appName a) (\pr -> view v pr mempty) (appRouter a))+      apps appViews++clockApp :: String -> App TabbedApps.ParentRouter+clockApp name = App name Clock.store (\st _ -> Clock.view_ st) Clock.ClockInit Nothing++etApp :: String -> 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 name tabs =+  let rst = TabbedApps.newStore tabs+  in+    App name rst (\st rt -> TabbedApps.view_ rst rt st) TabbedApps.TabbedInit (Just $ storeRouter rst)
+ example/routing/Router.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}++#ifdef __GHCJS__+{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}+#endif+-- |++module Router (setLocationHash+              , getLocationHash+              , onLocationHashChange+              , actionRoute+              , childRoutePath+              , initRouter+              , storeRouter+              ) where++import           React.Flux++import qualified Data.Text as T+import qualified Data.ByteString.Char8 as BC+import           Control.Monad.IO.Class (liftIO)+import qualified Web.Routes as WR+++#ifdef __GHCJS__++import           Control.Monad (liftM)+import qualified Data.JSString as JSS+import           GHCJS.Foreign.Callback+import           GHCJS.Types (JSString, JSRef)+import           Unsafe.Coerce++#endif++#ifdef __GHCJS__++foreign import javascript unsafe+  "window.onhashchange = function() {$1(location.hash.toString());}"+  js_attachtLocationHashCb :: (Callback (JSRef JSString -> IO ())) -> IO ()++foreign import javascript unsafe+  "window.location.hash = $1"+  js_setLocationHash :: JSString -> IO ()++foreign import javascript unsafe+  "window.location.hash.toString()"+  js_getLocationHash :: IO JSString++setLocationHash :: String -> IO ()+setLocationHash = js_setLocationHash . JSS.pack++getLocationHash :: IO (Maybe String)+getLocationHash = do+  rt <- liftM JSS.unpack js_getLocationHash+  return $ case rt of+    "" -> Nothing+    _ -> Just rt++onLocationHashChange :: (String -> IO ()) -> IO ()+onLocationHashChange fn = do+  cb <- syncCallback1 ThrowWouldBlock (fn . JSS.unpack . unsafeCoerce)+  js_attachtLocationHashCb cb++# else++setLocationHash :: String -> IO ()+setLocationHash _ = return ()++getLocationHash :: IO (Maybe String)+getLocationHash = return Nothing++onLocationHashChange :: (String -> IO ()) -> IO ()+onLocationHashChange _ = return ()++#endif++childRoutePath :: WR.PathInfo action => action -> [T.Text]+childRoutePath = WR.toPathSegments++actionRoute :: WR.PathInfo action => Maybe ([T.Text] -> T.Text) -> action -> T.Text+actionRoute mparentRouter action =+  frag+  where+    path = maybe (WR.toPathInfo action) ($ childRoutePath action) mparentRouter+    frag = if "#" `T.isPrefixOf` path+           then path+           else T.cons '#' path++initRouter :: ([T.Text] -> IO ()) -> IO ()+initRouter router =+  onLocationHashChange $ router . stripHash . WR.decodePathInfo . BC.pack+  where+    stripHash ("#":path) = path+    stripHash path = path++storeRouter :: (StoreData store, WR.PathInfo (StoreAction store)) =>+               ReactStore store -> ([T.Text] -> IO ())+storeRouter store =+  let site = WR.mkSitePI $ WR.runRouteT $ routerAlterStore+  in+    \rt -> either (const $ return ()) id $ WR.runSite "" site rt+  where+    routerAlterStore action =+      liftIO $ alterStore store action
+ example/routing/TabbedApps.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE DeriveAnyClass     #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE TupleSections      #-}+{-# LANGUAGE TypeFamilies       #-}++-- |++module TabbedApps (TabbedAction(..)+                  , TabbedState(..)+                  , Tab(..)+                  , ParentRouter+                  , dispatch+                  , newStore+                  , view+                  , view_) where++import           React.Flux          hiding (view)+import qualified React.Flux          as RF++import           Router+import           Types++import           Control.Applicative ((<|>))+import           Control.DeepSeq+import qualified Data.Aeson          as A+import           Data.Maybe          (fromMaybe)+import qualified Data.Text           as T+import qualified Data.Text.Read      as TR+import           Data.Typeable       (Typeable)+import           GHC.Generics        (Generic)+import qualified Web.Routes          as WR++type ParentRouter = Maybe ([T.Text] -> T.Text)++data Tab = Tab {tabName    :: AppName+               , tabView   :: ParentRouter -> AppView ()+               , tabRouter :: Maybe AppRouter+               }+data TabbedState =+  TabbedState { tsFocus :: !Int+              , tsTabs  :: ![Tab]+              }+  deriving Typeable++data TabbedAction = SwitchApp !Int (Maybe [T.Text])+                  | TabbedInit+                  deriving (Show, Typeable, Generic, NFData)++instance WR.PathInfo TabbedAction where+  toPathSegments (SwitchApp aidx apath) =+    "switchapp":WR.toPathSegments aidx ++ fromMaybe [] apath+  toPathSegments TabbedInit = ["tabbedinit"]+  fromPathSegments = SwitchApp <$ WR.segment "switchapp"+                     <*> WR.pToken ("app-num"::String) intParser+                     <*> WR.patternParse subRouteParser+                     <|> TabbedInit <$ WR.segment "tabbedinit"+    where+      intParser v =+        case TR.decimal v of+        Right (aidx, "") -> Just aidx+        _ -> Nothing+      subRouteParser apath =+        Right $ if null apath then Nothing else Just apath++instance Show TabbedState where+  showsPrec prec TabbedState{..} =+    showsPrec prec ("TabbedState" :: String, tsFocus, map tabName tsTabs)++instance StoreData TabbedState where+  type StoreAction TabbedState = TabbedAction+  transform action st@TabbedState{..} = do+    putStrLn $ "Action: " ++ show action+    case action of+      TabbedInit ->+        return st+      SwitchApp idx tabRoute+        | idx >= 0 && idx <= length tsTabs -> do+            let Tab{..} = tsTabs !! idx+            case (tabRouter, tabRoute) of+              (Just tr, Just rt) ->+                tr rt+              _ ->+                return ()+            return $ st{tsFocus = idx}+        | otherwise ->+          error $ "Application index is out of range " ++ show idx++newStore :: [Tab] -> ReactStore TabbedState+newStore tabs = mkStore $ TabbedState 0 tabs++view :: ReactStore TabbedState -> ParentRouter -> ReactView TabbedState+view _ prouter = defineView "tabbed" $ \TabbedState{..} ->+  div_ $ do+    div_ ["className" $= "tabbed-app-picker"] $+      mapM_ (tabItem_ . ((prouter,tsFocus),)) $ zip [0..] $ map tabName tsTabs+    div_ ["className" $= "tabbed-internal-app"] $+      if tsFocus < length tsTabs+       then tabView (tsTabs !! tsFocus) (Just $ router tsFocus)+      else mempty+  where+    router cur action =+      actionRoute prouter $ SwitchApp cur (Just $ childRoutePath action)++tabItem :: ReactView ((ParentRouter, Int), (Int, AppName))+tabItem =+  defineView "tab-item" $ \((prouter, cur), (aidx, aname)) ->+  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++tabItem_ :: ((ParentRouter, Int), (Int, AppName)) -> ReactElementM eventHandler ()+tabItem_ tab =+  viewWithKey tabItem (fst $ snd tab) tab mempty++view_ :: ReactStore TabbedState -> ParentRouter -> TabbedState -> ReactElementM eventHandler ()+view_ rst pr st =+  RF.view (view rst pr) st mempty++dispatch :: ReactStore TabbedState -> TabbedAction -> [SomeStoreAction]+dispatch rst a = [SomeStoreAction rst a]
+ example/routing/Types.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DeriveDataTypeable        #-}+{-# LANGUAGE DeriveGeneric             #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE RankNTypes                #-}+{-# LANGUAGE RecordWildCards           #-}++-- |++module Types where++import           React.Flux+++import qualified Data.Text     as T+import           Data.Typeable (Typeable)++type AppName = String+type AppView = ReactElementM ViewEventHandler+type AppRouter = [T.Text] -> IO ()++data App props = forall state. StoreData state =>+           App {appName        :: AppName+               , appState      :: ReactStore state+               , appView       :: Typeable props => state -> props -> AppView ()+               , appInitAction :: StoreAction state+               , appRouter     :: Maybe AppRouter+               }+               deriving Typeable++initApp :: Typeable props => App props -> IO (ReactView props)+initApp App{..} = do+  let view' = defineControllerView appName appState (\st props -> appView st props)+  alterStore appState appInitAction+  return view'
+ example/routing/route-example.html view
@@ -0,0 +1,13 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>ReactFlux example</title>+        <link rel="stylesheet" href="../css/route-example.css"/>+    </head>+    <body>+      <section id="route-example"/>+      <script src="https://fb.me/react-0.13.3.js"></script>+      <script src="../../dist/build/route-example/route-example.jsexe/all.js"></script>+    </body>+</html>
− example/todo-dev.html
@@ -1,13 +0,0 @@-<!doctype html>-<html lang="en">-    <head>-        <meta charset="utf-8">-        <title>Todo example</title>-        <link rel="stylesheet" href="css/todo.css"/>-    </head>-    <body>-        <section id="todoapp"/>-        <script src="https://fb.me/react-0.13.3.js"></script>-        <script src="../dist/build/todo/todo.jsexe/all.js"></script>-    </body>-</html>
− example/todo.html
@@ -1,13 +0,0 @@-<!doctype html>-<html lang="en">-    <head>-        <meta charset="utf-8">-        <title>Todo example</title>-        <link rel="stylesheet" href="css/todo.css"/>-    </head>-    <body>-        <section id="todoapp"/>-        <script src="https://fb.me/react-0.13.3.js"></script>-        <script src="js-build/todo.min.js"></script>-    </body>-</html>
+ example/todo/Main.hs view
@@ -0,0 +1,7 @@+module Main where++import React.Flux+import TodoViews++main :: IO ()+main = reactRender "todoapp" todoApp ()
+ example/todo/Makefile view
@@ -0,0 +1,15 @@+js-build/todo.min.js: js-build/todo.js+	closure --compilation_level=ADVANCED_OPTIMIZATIONS js-build/todo.js > js-build/todo.min.js++js-build/todo.js: ../../dist/build/todo/todo.jsexe/all.js+	mkdir -p js-build+	echo "(function(global,React) {" > js-build/todo.js+	cat ../../dist/build/todo/todo.jsexe/all.js >> js-build/todo.js+	echo "})(this, window['React']);" >> js-build/todo.js+	sed -i 's/goog.provide.*//' js-build/todo.js+	sed -i 's/goog.require.*//' js-build/todo.js+	# https://github.com/ghcjs/shims/issues/21+	sed -i 's/final\([^a-z]\)/final0\1/g' js-build/todo.js++clean:+	rm -rf js-build
+ example/todo/TodoComponents.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++-- | The division between a view and a component is arbitrary, but for me components are pieces that+-- are re-used many times for different purposes.  In the TODO app, there is one component for the+-- text box.+module TodoComponents where++import Data.Typeable (Typeable)+import React.Flux++-- | The properties for the text input component.  Note how we can pass anything, including+-- functions, as the properties; the only requirement is an instance of Typeable.+data TextInputArgs = TextInputArgs {+      tiaId :: Maybe String+    , tiaClass :: String+    , tiaPlaceholder :: String+    , tiaOnSave :: String -> [SomeStoreAction]+    , tiaValue :: Maybe String+} deriving (Typeable)++-- | The text input stateful view.  The state is the text that has been typed into the textbox+-- but not yet saved.  The save is triggered either on enter or blur, which resets the state/content+-- of the text box to the empty string.+todoTextInput :: ReactView TextInputArgs+todoTextInput = defineStatefulView "todo text input" "" $ \curText args ->+    input_ $+        maybe [] (\i -> ["id" @= i]) (tiaId args)+        +++        [ "className" @= tiaClass args+        , "placeholder" @= tiaPlaceholder args+        , "value" @= curText -- using value here creates a controlled component: https://facebook.github.io/react/docs/forms.html+        , "autoFocus" @= True++        -- Update the current state with the current text in the textbox, sending no actions+        , onChange $ \evt _ -> ([], Just $ target evt "value")++        -- Produce the save action and reset the current state to the empty string+        , onBlur $ \_ _ curState ->+            if not (null curState)+                then (tiaOnSave args curState, Just "")+                else ([], Nothing)+        , onKeyDown $ \_ evt curState ->+             if keyCode evt == 13 && not (null curState) -- 13 is enter+                 then (tiaOnSave args curState, Just "")+                 else ([], Nothing)+        ]++-- | A combinator suitible for use inside rendering functions.+todoTextInput_ :: TextInputArgs -> ReactElementM eventHandler ()+todoTextInput_ args = view todoTextInput args mempty
+ example/todo/TodoDispatcher.hs view
@@ -0,0 +1,7 @@+module TodoDispatcher (dispatchTodo) where++import React.Flux+import TodoStore++dispatchTodo :: TodoAction -> [SomeStoreAction]+dispatchTodo a = [SomeStoreAction todoStore a]
+ example/todo/TodoStore.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE TypeFamilies, DeriveGeneric, DeriveAnyClass #-}+module TodoStore where++import React.Flux+import Control.DeepSeq+import GHC.Generics (Generic)+import Data.Typeable (Typeable)++data Todo = Todo {+    todoText :: String+  , todoComplete :: Bool+  , todoIsEditing :: Bool+} deriving (Show, Typeable)++newtype TodoState = TodoState {+    todoList :: [(Int, Todo)]+} deriving (Show, Typeable)++data TodoAction = TodoCreate String+                | TodoDelete Int+                | TodoEdit Int+                | UpdateText Int String+                | ToggleAllComplete+                | TodoSetComplete Int Bool+                | ClearCompletedTodos+  deriving (Show, Typeable, Generic, NFData)++instance StoreData TodoState where+    type StoreAction TodoState = TodoAction+    transform action (TodoState todos) = do+        putStrLn $ "Action: " ++ show action+        putStrLn $ "Initial todos: " ++ show todos++        -- Care is taken here to leave the Haskell object for the pair (Int, Todo) unchanged if the todo+        -- itself is unchanged.  This allows React to avoid re-rendering the todo when it does not change.+        -- For more, see the "Performance" section of the React.Flux haddocks.+        newTodos <- return $ case action of+            (TodoCreate txt) -> (maximum (map fst todos) + 1, Todo txt False False) : todos+            (TodoDelete i) -> filter ((/=i) . fst) todos+            (TodoEdit i) -> let f (idx, todo) | idx == i = (idx, todo { todoIsEditing = True })+                                f p = p+                             in map f todos+            (UpdateText newIdx newTxt) ->+                let f (idx, todo) | idx == newIdx = (idx, todo { todoText = newTxt, todoIsEditing = False })+                    f p = p+                 in map f todos+            ToggleAllComplete -> [ (idx, Todo txt True False) | (idx, Todo txt _ _) <- todos ]+            TodoSetComplete newIdx newComplete ->+                let f (idx, todo) | idx == newIdx = (idx, todo { todoComplete = newComplete })+                    f p = p+                 in map f todos+            ClearCompletedTodos -> filter (not . todoComplete . snd) todos++        putStrLn $ "New todos: " ++ show newTodos+        return $ TodoState newTodos++todoStore :: ReactStore TodoState+todoStore = mkStore $ TodoState+    [ (0, Todo "Learn react" True False)+    , (1, Todo "Learn react-flux" False False)+    ]
+ example/todo/TodoViews.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedStrings #-}+-- | The views for the TODO app+module TodoViews where++import Control.Monad (when)+import React.Flux++import TodoDispatcher+import TodoStore+import TodoComponents++-- | The controller view and also the top level of the TODO app.  This controller view registers+-- with the store and will be re-rendered whenever the store changes.+todoApp :: ReactView ()+todoApp = defineControllerView "todo app" todoStore $ \todoState () ->+    div_ $ do+        todoHeader_+        mainSection_ todoState+        todoFooter_ todoState++-- | The TODO header as a React view with no properties.+todoHeader :: ReactView ()+todoHeader = defineView "header" $ \() ->+    header_ ["id" $= "header"] $ do+        h1_ "todos"+        todoTextInput_  TextInputArgs+          { tiaId = Just "new-todo"+          , tiaClass = "new-todo"+          , tiaPlaceholder = "What needs to be done?"+          , tiaOnSave = dispatchTodo . TodoCreate+          , tiaValue = Nothing+          }++-- | A combinator for the header suitable for use inside the 'todoApp' rendering function.+todoHeader_ :: ReactElementM eventHandler ()+todoHeader_ = view todoHeader () mempty++-- | A view that does not use a ReactView and is instead just a Haskell function.+-- Note how we use an underscore to signal that this is directly a combinator that can be used+-- inside the rendering function.+mainSection_ :: TodoState -> ReactElementM ViewEventHandler ()+mainSection_ st = section_ ["id" $= "main"] $ do+    input_ [ "id" $= "toggle-all"+           , "type" $= "checkbox"+           , "checked" $= if all (todoComplete . snd) $ todoList st then "checked" else ""+           , onChange $ \_ -> dispatchTodo ToggleAllComplete+           ]++    label_ [ "htmlFor" $= "toggle-all"] "Mark all as complete"+    ul_ [ "id" $= "todo-list" ] $ mapM_ todoItem_ $ todoList st++-- | A view for each todo item.  We specifically use a ReactView here to take advantage of the+-- ability for React to only re-render the todo items that have changed.  Care is taken in the+-- transform function of the store to not change the Haskell object for the pair (Int, Todo), and+-- in this case React will not re-render the todo item.  For more details, see the "Performance"+-- section of the React.Flux documentation.+todoItem :: ReactView (Int, Todo)+todoItem = defineView "todo item" $ \(todoIdx, todo) ->+    li_ [ "className" @= (unwords $ [ "completed" | todoComplete todo] ++ [ "editing" | todoIsEditing todo ])+        , "key" @= todoIdx+        ] $ do+        +        div_ [ "className" $= "view"] $ do+            input_ [ "className" $= "toggle"+                   , "type" $= "checkbox"+                   , "checked" @= todoComplete todo+                   , onChange $ \_ -> dispatchTodo $ TodoSetComplete todoIdx $ not $ todoComplete todo+                   ]++            label_ [ onDoubleClick $ \_ _ -> dispatchTodo $ TodoEdit todoIdx] $+                elemText $ todoText todo++            button_ [ "className" $= "destroy"+                    , onClick $ \_ _ -> dispatchTodo $ TodoDelete todoIdx+                    ] mempty++        when (todoIsEditing todo) $+            todoTextInput_ TextInputArgs+                { tiaId = Nothing+                , tiaClass = "edit"+                , tiaPlaceholder = ""+                , tiaOnSave = dispatchTodo . UpdateText todoIdx+                , tiaValue = Just $ todoText todo+                }++-- | A combinator for a todo item to use inside rendering functions+todoItem_ :: (Int, Todo) -> ReactElementM eventHandler ()+todoItem_ todo = viewWithKey todoItem (fst todo) todo mempty++-- | A view for the footer, taking the entire state as the properties.  This could alternatively+-- been modeled as a controller-view, attaching directly to the store.+todoFooter :: ReactView TodoState+todoFooter = defineView "footer" $ \(TodoState todos) ->+    let completed = length (filter (todoComplete . snd) todos)+        itemsLeft = length todos - completed+     in footer_ [ "id" $= "footer"] $ do++            span_ [ "id" $= "todo-count" ] $ do+                strong_ $ elemShow itemsLeft+                elemText $ if itemsLeft == 1 then " item left" else " items left"++            when (completed > 0) $ do+                button_ [ "id" $= "clear-completed"+                        , onClick $ \_ _ -> dispatchTodo ClearCompletedTodos+                        ] $+                    elemText $ "Clear completed (" ++ show completed ++ ")"++-- | A render combinator for the footer+todoFooter_ :: TodoState -> ReactElementM eventHandler ()+todoFooter_ s = view todoFooter s mempty
+ example/todo/todo-dev.html view
@@ -0,0 +1,13 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>Todo example</title>+        <link rel="stylesheet" href="../css/todo.css"/>+    </head>+    <body>+        <section id="todoapp"/>+        <script src="https://fb.me/react-0.13.3.js"></script>+        <script src="../../dist/build/todo/todo.jsexe/all.js"></script>+    </body>+</html>
+ example/todo/todo.html view
@@ -0,0 +1,13 @@+<!doctype html>+<html lang="en">+    <head>+        <meta charset="utf-8">+        <title>Todo example</title>+        <link rel="stylesheet" href="../css/todo.css"/>+    </head>+    <body>+        <section id="todoapp"/>+        <script src="https://fb.me/react-0.13.3.js"></script>+        <script src="js-build/todo.min.js"></script>+    </body>+</html>
react-flux.cabal view
@@ -1,5 +1,5 @@ name:                react-flux-version:             0.9.1+version:             0.9.2 synopsis:            A binding to React based on the Flux application architecture for GHCJS category:            Web homepage:            https://bitbucket.org/wuzzeb/react-flux@@ -14,11 +14,13 @@     ChangeLog.md,     README.md,     example/README.md,-    example/css/todo.css,+    example/css/*.css,     example/css/bg.png,-    example/Makefile,-    example/*.hs,-    example/*.html,+    example/todo/Makefile,+    example/todo/*.hs,+    example/todo/*.html+    example/routing/*.hs,+    example/routing/*.html,     test/client/test-client.html,     test/spec/react-flux-spec.cabal,     test/spec/Spec.hs,@@ -49,6 +51,8 @@                    React.Flux.PropertiesAndEvents                    React.Flux.Lifecycle                    React.Flux.Internal+                   React.Flux.Addons.React+                   React.Flux.Addons.Bootstrap    other-modules: React.Flux.Views                  React.Flux.Store@@ -62,11 +66,12 @@                       FunctionalDependencies                       GeneralizedNewtypeDeriving                       MultiParamTypeClasses+                      DeriveGeneric                       OverloadedStrings                       ScopedTypeVariables                       TypeFamilies -  build-depends: base >=4.7 && < 5+  build-depends: base >=4.8 && < 5                , deepseq                , mtl >= 2.1                , aeson >= 0.8@@ -82,7 +87,7 @@    cpp-options: -DGHCJS_BROWSER     default-language: Haskell2010-   hs-source-dirs: example+   hs-source-dirs: example/todo    main-is: Main.hs    build-depends: base                 , react-flux@@ -99,5 +104,27 @@    main-is: TestClient.hs    build-depends: base                 , react-flux+   if impl(ghcjs)+      build-depends: ghcjs-base++executable route-example+   if !flag(example)+        Buildable: False+   ghc-options: -Wall+   cpp-options: -DGHCJS_BROWSER++   default-extensions: CPP+   default-language: Haskell2010+   hs-source-dirs: example/routing+   main-is: Main.hs+   build-depends: base+                , react-flux+                , time+                , aeson+                , text+                , web-routes+                , transformers+                , bytestring+                , deepseq    if impl(ghcjs)       build-depends: ghcjs-base
src/React/Flux.hs view
@@ -17,7 +17,7 @@ -- __Organization__: Briefly, you should create one module to contain the dispatcher, one module for -- each store, and modules for the view definitions.  These are then imported into a Main module, -- which calls 'reactRender' and initializes any AJAX load calls to the backend. The source package--- contains an example <https://bitbucket.org/wuzzeb/react-flux/src/tip/example/ TODO application>.+-- contains some <https://bitbucket.org/wuzzeb/react-flux/src/tip/example/ example applications>. -- -- __Deployment__: Care has been taken to make sure closure with ADVANCED_OPTIMIZATIONS correctly -- minimizes a react-flux application.  No externs are needed, instead all you need to do is provide
+ src/React/Flux/Addons/Bootstrap.hs view
@@ -0,0 +1,42 @@+-- | 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.+module React.Flux.Addons.Bootstrap (+    bootstrap_+) where++import React.Flux++#ifdef __GHCJS__+import GHCJS.Types (JSRef, JSString)+import React.Flux.Internal (toJSString)+#endif++-- | A bootstrap <http://react-bootstrap.github.io/components.html component>.  For example,+--+-- >bootstrap_ "Alert" [ "bsStyle" $= "danger"+--                     , callback "onDismiss" (const $ dispatch CloseAlert)+--                     ] $+-- >    p_ "Hello, World!"+bootstrap_ :: String+           -- ^ The component name.   Uses @window['ReactBootstrap'][name]@ to find the class, so+           -- the name can be anything exported to the @window.ReactBoostrap@ object.+           -> [PropertyOrHandler eventHandler]+           -- ^ Properties and callbacks to pass to the ReactBootstrap class.  You can use 'callback'+           -- to create function properties.+           -> ReactElementM eventHandler a -- ^ The child or children of the component.+           -> ReactElementM eventHandler a++#ifdef __GHCJS__++bootstrap_ n = foreignClass (js_ReactBootstrap $ toJSString n)++foreign import javascript unsafe+    "window['ReactBootstrap'][$1]"+    js_ReactBootstrap :: JSString -> JSRef ()++#else++bootstrap_ _ _ x = x++#endif
+ src/React/Flux/Addons/React.hs view
@@ -0,0 +1,142 @@+-- | Bindings for the <https://facebook.github.io/react/docs/addons.html React addons> that make+-- sense to use from Haskell.  At the moment, that is only the+-- <https://facebook.github.io/react/docs/animation.html animation> and+-- <https://facebook.github.io/react/docs/perf.html performance tools>.+module React.Flux.Addons.React (+  -- * Animation+    cssTransitionGroup+  , CSSTransitionProps(..)+  , defaultTransitionProps++  -- * Perf+  , PerfAction(..)+  , PerfPrint(..)+  , perfToggleButton_+  , perfA+) where++import Control.DeepSeq (NFData)+import Control.Monad (forM_)+import Data.Typeable (Typeable)+import GHC.Generics (Generic)+import React.Flux++#ifdef __GHCJS__+import GHCJS.Types (JSRef, JSString)+#endif++-- | The properties for the CSS Transition Group.+data CSSTransitionProps = CSSTransitionProps+    { transitionName :: String+    , transitionAppear :: Bool+    , transitionEnter :: Bool+    , transitionLeave :: Bool+    } deriving (Typeable)++-- | Default properties for CSS Transition Group, using \"react-transition\" as the transition name.+defaultTransitionProps :: CSSTransitionProps+defaultTransitionProps = CSSTransitionProps+    { transitionName = "react-transition"+    , transitionAppear = False+    , transitionEnter = True+    , transitionLeave = True+    }++-- | The <https://facebook.github.io/react/docs/animation.html ReactCSSTransitionGroup> element.  At+-- the moment, only the high-level API is supported.+cssTransitionGroup :: CSSTransitionProps -> ReactElementM eventHandler a -> ReactElementM eventHandler a++#ifdef __GHCJS__+cssTransitionGroup p children = foreignClass js_CSSTransitionGroup props children+    where+        props = [ "transitionName" @= transitionName p+                , "transitionAppear" @= transitionAppear p+                , "transitionEnter" @= transitionEnter p+                , "transitionLeave" @= transitionLeave p+                ]++foreign import javascript unsafe+    "React['addons']['CSSTransitionGroup']"+    js_CSSTransitionGroup :: JSRef ()++#else+cssTransitionGroup _ x = x+#endif++--------------------------------------------------------------------------------+-- Perf+--------------------------------------------------------------------------------++data PerfStoreData = PerfStoreData { perfIsActive :: Bool }++-- | What to print after stopping performance measurement.  See+-- <https://facebook.github.io/react/docs/perf.html> for documentation.+data PerfPrint = PerfPrintInclusive+               | PerfPrintExclusive+               | PerfPrintWasted+               | PerfPrintDOM+    deriving (Show, Eq, Generic)++instance NFData PerfPrint++-- | An action to start or stop performance measurement.  For details, see+-- <https://facebook.github.io/react/docs/perf.html>.+data PerfAction = PerfStart+                | PerfStopAndPrint [PerfPrint]+    deriving (Show, Eq, Generic)++instance NFData PerfAction++instance StoreData PerfStoreData where+    type StoreAction PerfStoreData = PerfAction++    transform PerfStart _ = do+        js_perf "start"+        return $ PerfStoreData True++    transform (PerfStopAndPrint toPrint) _ = do+        js_perf "stop"+        forM_ toPrint $ \action -> do+            js_perf $ case action of+                PerfPrintInclusive -> "printInclusive"+                PerfPrintExclusive -> "printExclusive"+                PerfPrintWasted -> "printWasted"+                PerfPrintDOM -> "printDOM"+        return $ PerfStoreData False++perfStore :: ReactStore PerfStoreData+perfStore = mkStore $ PerfStoreData False++-- | Convert a performance action into a store action.   Use this if you are not using+-- 'perfToggleButton_'.+perfA :: PerfAction -> SomeStoreAction+perfA = SomeStoreAction perfStore++-- | The performance toggle button view+perfToggleButton :: ReactView [PerfPrint]+perfToggleButton = defineControllerView "perf toggle button" perfStore $ \sData toPrint ->+    button_ [ onClick $ \_ _ ->+                if perfIsActive sData+                    then [perfA $ PerfStopAndPrint toPrint]+                    else [perfA PerfStart]+            ] $+        if perfIsActive sData then "Stop perf measurement" else "Start perf measurement"++-- | A button which when clicked toggles the performance measurement on and off.  When the+-- measurement is stopped, the given measurements are printed.  If you want more control over the+-- performance tools, you can use 'perfA' directly from your own event handlers.+perfToggleButton_ :: [PerfPrint] -> ReactElementM handler ()+perfToggleButton_ toPrint = view perfToggleButton toPrint mempty++#ifdef __GHCJS__++foreign import javascript unsafe+    "React['addons']['Perf'][$1]()"+    js_perf :: JSString -> IO ()++#else++js_perf :: String -> IO ()+js_perf _ = return ()++#endif
src/React/Flux/Internal.hs view
@@ -211,7 +211,10 @@  mkReactElement runHandler getPropsChildren eM = runWriterT $ do     let e = execWriter $ runReactElementM eM-    refs <- createElement getPropsChildren $ fmap runHandler e+        e' = case e of+                Content txt -> ForeignElement (Left "span") [] (Content txt)+                _ -> e+    refs <- createElement getPropsChildren $ fmap runHandler e'     case refs of         [] -> lift $ js_ReactCreateElementNoChildren "div"         [x] -> return x
test/client/TestClient.hs view
@@ -52,6 +52,9 @@ logT :: EventTarget -> String logT t = eventTargetProp t "id" +rawShowView :: ReactView Int+rawShowView = defineView "raw show view" elemShow+ eventsView :: ReactView () eventsView = defineView "events" $ \() ->     div_ $ do@@ -113,6 +116,8 @@                       , onDoubleClick $ \_ _ -> output ["Double click inner span"]                       ]                       "Testing stopPropagation"++        p_ [ "id" $= "raw-show-view"] $ view rawShowView 42 mempty  eventsView_ :: ReactElementM eventHandler () eventsView_ = view eventsView () mempty
test/spec/TestClientSpec.hs view
@@ -82,7 +82,7 @@         [clickName, evt, mouseEvt, modState] <- loadLog         clickName `shouldBe` "click"         evt `shouldBeEvent` ("click", True, 3)-        mouseEvt `shouldBe` "(False,0,0,33,55,False,False,33,55,EventTarget,33,55,False)"+        mouseEvt `shouldBe` "(False,0,0,37,54,False,False,37,54,EventTarget,37,54,False)"         modState `shouldBe` "alt modifier: False"      {- touch events can't be tested at the moment, chrome doesn't support them@@ -110,6 +110,10 @@         [inner, outer] <- loadLog         inner `shouldBe` "Click inner span"         outer `shouldBe` "Double click outer div"++    it "has rendered the raw show view" $ runWD $+        (findElem (ById "raw-show-view") >>= getText)+            `shouldReturn` "42"      describe "lifecycle events" $ do 
test/spec/TodoSpec.hs view
@@ -42,7 +42,7 @@ spec = session " for todo example application" $ using Chrome $ do     it "opens the page" $ runWD $ do         dir <- liftIO $ getCurrentDirectory-        openPage $ "file://" ++ dir ++ "/../../example/todo-dev.html"+        openPage $ "file://" ++ dir ++ "/../../example/todo/todo.html"         expectTodos [("Learn react", True), ("Learn react-flux", False)]      it "adds a new todo via blur" $ runWD $ do
test/spec/stack.yaml view
@@ -1,3 +1,3 @@-resolver: lts-3.0+resolver: lts-3.2 packages: - '.'