diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,14 @@ +# 1.0.4 + +* Add helper functions `ajax` and `jsonAjax` to `React.Flux.Combinators` to assist with sending + a request to the backend and turning the response into actions. See the haddocks for more + information. + +* Everything in react-flux is working with no changes against React 15 release candidate 1, although + react-bootstrap is currently not compatible (https://github.com/react-bootstrap/react-bootstrap/issues/1686). + +* Everything in `React.Flux.Addons.Intl` is working with no changes with react-intl 2.0 release candidate 1. + # 1.0.3 * I switched to using stack to build, and updated the documentation to explain how to use stack. It is diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -72,12 +72,12 @@ ~~~ 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 beta -version of the react-intl library must be installed from npm. +[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-beta-2 +npm install react-intl@v2.0.0-rc-1 ~~~ Finally, start selenium-server-standalone and execute the test suite. Make sure you also have diff --git a/example/README.md b/example/README.md --- a/example/README.md +++ b/example/README.md @@ -14,30 +14,20 @@ ### Build -To build, you must pass the `-fexample` flag to cabal. - -~~~ -cabal configure -fexample -cabal build -~~~ +To build, run `stack build` followed by `make` in the top-level directory. The makefile sets up a symbolic +link to the stack output directory and also compresses the resulting javascript using closure. ### TODO in the browser -A result of this build is a file `dist/build/todo/todo.jsexe/all.js`. There is a file -`example/todo/todo-dev.html` which loads this `all.js` file directly from the `dist` directory, so you +A result of the build is in the directory `js-build/install-root/bin/todo.jsexe`. There is a file +`example/todo/todo-dev.html` which loads this `all.js` file from this directory, so you can open `todo-dev.html` after building. -But to deploy a react-flux application, you should minimize it since the size of `all.js` is 1.8 -mebibytes. To do so, there is a `Makefile` which calls closure. So if you have closure installed -on your path, you can execute - -~~~ -cd example/todo -make -~~~ - -This produces a file `js-build/todo.min.js` which is only 500 kibibytes which when compressed with -gzip is 124 kibibytes. You can then open `example/todo/todo.html` which loads this minimized javascript. +But to deploy a react-flux application, you should minimize it since the size +of `all.js` is 1.8 mebibytes. To do so, the `Makefile` calls closure to +produce a file `js-build/todo.min.js`. Then the `todo.html` references this +minimized javascript file, which is only 500 kibibytes which when compressed +with gzip is 124 kibibytes. ### TODO in node @@ -46,7 +36,7 @@ ~~~ cd example/todo -npm install react@0.13.3 +npm install react@0.14.6 node run-in-node.js ~~~ @@ -74,14 +64,15 @@ * `App.hs` contains the layout for the entire application, with the navigation bar and header. * `Main.hs` renders the application into the DOM. -It is also built with `-fexample`. It uses the browser [history -API](https://developer.mozilla.org/en-US/docs/Web/API/History_API) which does not work if you open `index.html` directly from the filesystem. Instead, the index.html file must be served. +It uses the browser [history +API](https://developer.mozilla.org/en-US/docs/Web/API/History_API) which might +not work if you open `index.html` directly from the filesystem (depends on +browser settings). Instead, the index.html file can be served and the history +API always works. ~~~ -cabal configure -fexample -cabal build cd example/purecss-side-menu -ln -s ../../dist/build/purecss-side-menu/purecss-side-menu.jsexe/all.js purecss-side-menu.js +ln -s ../../js-build/install-root/bin/purecss-side-menu.jsexe/all.js purecss-side-menu.js python3 -m http.server 8000 ~~~ @@ -90,11 +81,3 @@ # Routing Example The third 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 -~~~ diff --git a/example/todo/run-in-node.js b/example/todo/run-in-node.js --- a/example/todo/run-in-node.js +++ b/example/todo/run-in-node.js @@ -1,2 +1,2 @@ React = require("react"); -require("../../dist/build/todo-node/todo-node.jsexe/all.js"); +require("../../js-build/install-root/bin/todo-node.jsexe/all.js"); diff --git a/example/todo/todo.html b/example/todo/todo.html --- a/example/todo/todo.html +++ b/example/todo/todo.html @@ -7,8 +7,8 @@
- - + + diff --git a/jsbits/ajax.js b/jsbits/ajax.js new file mode 100644 --- /dev/null +++ b/jsbits/ajax.js @@ -0,0 +1,22 @@ +/* jshint sub:true */ + +var hsreact$ajaxCallback; + +function hsreact$setAjaxCallback(c) { + hsreact$ajaxCallback = c; +} + +function hsreact$ajax(req, handler) { + var xhr = new XMLHttpRequest(); + xhr['open'](req['reqMethod'], req['reqURI']); + var lst = req['reqHeaders']; + for (var i = 0; i < lst.length; i++) { + xhr['setRequestHeader'](lst[i][0], lst[i][1]); + } + xhr['onreadystatechange'] = function() { + if (xhr['readyState'] === XMLHttpRequest['DONE']) { + hsreact$ajaxCallback(xhr, {hs: handler}); + } + }; + xhr['send'](req['reqBody']); +} diff --git a/react-flux.cabal b/react-flux.cabal --- a/react-flux.cabal +++ b/react-flux.cabal @@ -1,5 +1,5 @@ name: react-flux -version: 1.0.3 +version: 1.0.4 synopsis: A binding to React based on the Flux application architecture for GHCJS category: Web homepage: https://bitbucket.org/wuzzeb/react-flux @@ -52,6 +52,7 @@ jsbits/store.js jsbits/export.js jsbits/callback.js + jsbits/ajax.js exposed-modules: React.Flux React.Flux.DOM diff --git a/src/React/Flux.hs b/src/React/Flux.hs --- a/src/React/Flux.hs +++ b/src/React/Flux.hs @@ -36,7 +36,7 @@ -- -- >React = require("react"); -- >ReactDOM = require("react-dom"); --- >require("../../dist/build/todo-node/todo-node.jsexe/all.js"); +-- >require("../../js-build/install-root/bin/todo-node.jsexe/all.js"); -- -- __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 diff --git a/src/React/Flux/Addons/Intl.hs b/src/React/Flux/Addons/Intl.hs --- a/src/React/Flux/Addons/Intl.hs +++ b/src/React/Flux/Addons/Intl.hs @@ -3,11 +3,11 @@ -- 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 in beta (I am currently --- using v2.0.0-beta-2). For temporary documentation, +-- 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 . Because this is a binding to a --- beta, 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. +-- 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. -- -- 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 diff --git a/src/React/Flux/Combinators.hs b/src/React/Flux/Combinators.hs --- a/src/React/Flux/Combinators.hs +++ b/src/React/Flux/Combinators.hs @@ -1,29 +1,51 @@ -- | This module contains some useful combinators I have come across as I built a large -- react-flux application. None of these are required to use React.Flux, they just reduce somewhat -- the typing needed to create rendering functions. +{-# LANGUAGE DeriveAnyClass #-} module React.Flux.Combinators ( clbutton_ , cldiv_ , faIcon_ , foreign_ , labeledInput_ + -- * Ajax + , initAjax + , jsonAjax + , AjaxRequest(..) + , AjaxResponse(..) + , ajax ) where +import Data.Aeson import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) import React.Flux.DOM import React.Flux.Internal import React.Flux.PropertiesAndEvents +import React.Flux.Store import React.Flux.Views #ifdef __GHCJS__ +import Control.Arrow ((***)) +import Control.DeepSeq (deepseq) +import GHCJS.Foreign.Callback +import GHCJS.Marshal (ToJSVal(..), toJSVal_aeson, FromJSVal(..)) import GHCJS.Types (JSString, JSVal) +import qualified Data.Text as T +import qualified Data.JSString.Text as JSS +import React.Flux.Export + foreign import javascript unsafe "$r = window[$1]" js_lookupWindow :: JSString -> JSVal #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 @@ -80,7 +102,7 @@ -- | A 'button_' with the given class names and `onClick` handler. -- --- >clbutton_ ["pure-button button-success"] (dispatch LaunchMissiles) $ do +-- >clbutton_ ["pure-button button-success"] (dispatch LaunchTheMissiles) $ do -- > faIcon_ "rocket" -- > "Launch the missiles!" clbutton_ :: String -- ^ class names separated by spaces @@ -115,3 +137,192 @@ -- >faIcon_ "refresh fa-spin" -- produces faIcon_ :: String -> ReactElementM handler () faIcon_ cl = i_ ["className" @= ("fa fa-" ++ cl)] mempty + +-------------------------------------------------------------------------------- +--- Ajax +-------------------------------------------------------------------------------- + +-- | The input to an AJAX request built using @XMLHttpRequest@. +data AjaxRequest = AjaxRequest + { reqMethod :: JSString + , reqURI :: JSString + , reqHeaders :: [(JSString, JSString)] + , reqBody :: JSVal + } deriving (Typeable, Generic) + +-- | The response after @XMLHttpRequest@ indicates that the @readyState@ is done. +data AjaxResponse = AjaxResponse + { respStatus :: Int + , respResponseText :: JSString + , respResponseXHR :: JSVal -- ^ The raw @XMLHttpRequest@ object. Use this if you want more status about the response, + -- such as response headers. + } deriving (Typeable, Generic) + +#ifdef __GHCJS__ +-- | GHCJS panics if we export the function directly, so wrap it in a data struct +data HandlerWrapper = HandlerWrapper (AjaxResponse -> IO [SomeStoreAction]) + deriving Typeable + +-- | This is broken out as a separate function because if the code is inlined (either manually or by +-- ghc), there is a runtime error. +useHandler :: AjaxResponse -> HandlerWrapper -> IO () +useHandler r (HandlerWrapper h) = do + actions <- h r + actions `deepseq` mapM_ executeAction actions +{-# NOINLINE useHandler #-} -- if this is inlined, there is a bug in ghcjs +#endif + +-- | If you are going to use 'ajax' or 'jsonAjax', you must call 'initAjax' once from your main +-- function. The call should appear before the call to 'reactRender'. +initAjax :: IO () +#ifdef __GHCJS__ +initAjax = do + return () + a <- asyncCallback2 $ \rawXhr h -> do + resp <- AjaxResponse <$> js_xhrStatus rawXhr <*> js_xhrResponseText rawXhr <*> pure rawXhr + e <- js_getHandlerWrapper h + js_release e + parseExport e >>= useHandler resp + + js_setAjaxCallback a +#else +initAjax = return () +#endif + +-- | Use @XMLHttpRequest@ to send a request to the backend. Once the response arrives +-- and the @readyState@ is done, the response will be passed to the given handler and the resulting +-- actions will be executed. Note that 'ajax' returns immedietly and does not wait for the request +-- to finish. +ajax :: AjaxRequest -> (AjaxResponse -> IO [SomeStoreAction]) -> IO () +#ifdef __GHCJS__ +ajax req handler = do + reqJson <- toJSVal req + handlerE <- export $ HandlerWrapper handler + js_ajax reqJson handlerE +#else +ajax _ _ = return () +#endif + +-- | Use @XMLHttpRequest@ to send a request with a JSON body, parse the response body as JSON, and +-- then dispatch some actions with the response. This should be used from within the transform +-- function of your store. For example, +-- +-- >data Target = AlienShip | AlienPlanet +-- > deriving (Show, Typeable, Generic, ToJSON, FromJSON) +-- > +-- >data Trajectory = Trajectory +-- > { x :: Double, y :: Double, z :: Double, vx :: Double, vy :: Double, vz :: Double } +-- > deriving (Show, Typeable, Generic, ToJSON, FromJSON) +-- > +-- >data UpdatePending = NoUpdatePending | UpdatePending Text | PreviousUpdateHadError Text +-- > +-- >data MyStore = MyStore { currentTrajectory :: Maybe Trajectory, launchUpdate :: UpdatePending } +-- > +-- >data MyStoreAction = LaunchTheMissiles Target +-- > | MissilesLaunched Trajectory +-- > | UnableToLaunchMissiles Text +-- > deriving (Typeable, Generic, NFData) +-- > +-- >instance StoreData MyStore where +-- > type StoreAction MyStore = MyStoreAction +-- > +-- > transform (LaunchTheMissiles t) s = do +-- > jsonAjax "PUT" "/launch-the-missiles" [] t $ \case -> +-- > Left (_, msg) -> return [SomeStoreAction myStore $ UnableToLaunchMissiles msg] +-- > Right traj -> return [SomeStoreAction myStore $ MissilesLaunched traj] +-- > return s { launchUpdate = UpdatePending ("Requesting missle launch against " ++ T.pack (show t)) } +-- > +-- > transform (MissilesLaunched traj) s = +-- > return s { currentTrajectory = Just traj, launchUpdate = NoUpdatePending } +-- > +-- > transform (UnableToLaunchMissiles err) s = +-- > return s { launchUpdate = PreviousUpdateHadError err } +-- > +-- >myStore :: ReactStore MyStore +-- >myStore = mkStore $ MyStore Nothing NoUpdatePending +-- +-- And then in your view, you can render this using something like: +-- +-- >myView :: ReactView () +-- >myView = defineControllerView "launch the missles" myStore $ \s () -> do +-- > case launchUpdate s of +-- > NoUpdatePending -> return () +-- > UpdatePending msg -> span_ $ faIcon_ "rocket" <> elemText (T.unpack msg) +-- > PreviousUpdateHadErroer err -> span_ $ faIcon_ "exclamation" <> elemText (T.unpack err) +-- > clbutton_ ["pure-button button-success"] ([SomeStoreAction myStore $ LaunchTheMissiles AlienShip]) $ do +-- > faIcon_ "rocket" +-- > "Launch the missles against the alien ship!" +-- > p_ $ elemText $ "Current trajectory " ++ show (currentTrajectory s) +-- +jsonAjax :: (ToJSON body, FromJSON response) + => Text -- ^ the method + -> Text -- ^ the URI + -> [(Text, Text)] -- ^ the headers + -> body -- ^ the body + -> (Either (Int, Text) response -> IO [SomeStoreAction]) + -- ^ Once @XMLHttpRequest@ changes the @readyState@ to done this handler will be + -- executed and the resulting actions dispatched to the stores. + -- + -- * If the response status is @200@, the body will be parsed as JSON and a + -- 'Right' value will be passed to this handler. If there is an + -- error parsing the JSON response, a 'Left' value with @500@ and the error message + -- from aeson is given to the handler. + -- + -- * If the response status is anything besides @200@, a 'Left' value with a pair + -- of the response status and response text is passed to the handler. + -> IO () +#ifdef __GHCJS__ +jsonAjax method uri headers body handler = do + bodyRef <- toJSVal_aeson body + let req = AjaxRequest + { reqMethod = JSS.textToJSString method + , reqURI = JSS.textToJSString uri + , reqHeaders = map (JSS.textToJSString *** JSS.textToJSString) headers + , reqBody = bodyRef + } + ajax req $ \resp -> + if respStatus resp == 200 + then do + j <- js_JSONParse $ respResponseText resp + mv <- fromJSVal j + case mv of + Nothing -> handler $ Left (500, "Unable to convert response body") + Just v -> case fromJSON v of + Success v' -> handler $ Right v' + Error e -> handler $ Left (500, T.pack e) + else handler $ Left (respStatus resp, JSS.textFromJSString $ respResponseText resp) +#else +jsonAjax _ _ _ _ _ = return () +#endif + +#ifdef __GHCJS__ +foreign import javascript unsafe + "hsreact$ajax($1, $2)" + js_ajax :: JSVal -> Export HandlerWrapper -> IO () + +foreign import javascript unsafe + "hsreact$setAjaxCallback($1)" + js_setAjaxCallback :: Callback (JSVal -> JSVal -> IO ()) -> IO () + +foreign import javascript unsafe + "JSON['parse']($1)" + js_JSONParse :: JSString -> IO JSVal + +foreign import javascript unsafe + "$1.hs" + js_getHandlerWrapper :: JSVal -> IO (Export HandlerWrapper) + +foreign import javascript unsafe + "$1['status']" + js_xhrStatus :: JSVal -> IO Int + +foreign import javascript unsafe + "$1['responseText']" + js_xhrResponseText :: JSVal -> IO JSString + +foreign import javascript unsafe + "h$release($1)" + js_release :: Export HandlerWrapper -> IO () + +instance ToJSVal AjaxRequest +#endif diff --git a/src/React/Flux/Store.hs b/src/React/Flux/Store.hs --- a/src/React/Flux/Store.hs +++ b/src/React/Flux/Store.hs @@ -95,7 +95,8 @@ -- re-rendered until the transform is complete. Therefore, if you need to perform some longer -- action, you should fork a thread from inside 'transform'. The thread can then call 'alterStore' -- with another action with the result of its computation. This is very common to communicate with - -- the backend using AJAX. + -- the backend using AJAX. Indeed, the 'React.Flux.Combinators.jsonAjax' utility function + -- implements exactly this strategy since it is so common. -- -- Note that if the transform throws an exception, the transform will be aborted and the old -- store data will be kept unchanged. The exception will then be thrown from 'alterStore'. diff --git a/test/client/test-client14.html b/test/client/test-client14.html --- a/test/client/test-client14.html +++ b/test/client/test-client14.html @@ -7,7 +7,7 @@ - + diff --git a/test/spec/TestClientSpec.hs b/test/spec/TestClientSpec.hs --- a/test/spec/TestClientSpec.hs +++ b/test/spec/TestClientSpec.hs @@ -56,9 +56,10 @@ -- | Only up to 999,999 since this is just used for the number of days since 1969 showWithComma :: Integer -> String -showWithComma i = show x ++ "," ++ show y +showWithComma i = show x ++ "," ++ replicate (3-length y') '0' ++ y' where (x, y) = divMod i 1000 + y' = show y spec :: Spec spec = do @@ -300,8 +301,8 @@ 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-1) ++ " years ago") - "f-relative-days" `intlSpanShouldBe` (showWithComma daysAgo ++ " days ago") + "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" diff --git a/test/spec/stack.yaml b/test/spec/stack.yaml --- a/test/spec/stack.yaml +++ b/test/spec/stack.yaml @@ -1,3 +1,3 @@ -resolver: lts-4.1 +resolver: lts-5.6 packages: - '.'