react-flux 0.9.0 → 0.9.1
raw patch · 12 files changed
+143/−84 lines, 12 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
+ React.Flux.Internal: toJSString :: String -> String
Files
- ChangeLog.md +4/−0
- README.md +15/−1
- example/Makefile +2/−0
- react-flux.cabal +2/−2
- src/React/Flux.hs +0/−1
- src/React/Flux/Internal.hs +43/−30
- src/React/Flux/Lifecycle.hs +19/−6
- src/React/Flux/PropertiesAndEvents.hs +34/−21
- src/React/Flux/Views.hs +7/−7
- test/client/TestClient.hs +1/−1
- test/spec/TestClientSpec.hs +10/−9
- test/spec/TodoSpec.hs +6/−6
ChangeLog.md view
@@ -1,3 +1,7 @@+# 0.9.1++* Switch to use the improved-base branch of ghcjs (thanks Vladimir Sekissov!)+ # 0.9.0 * Initial release
README.md view
@@ -10,7 +10,9 @@ # Build -I am currently using the latest git version of GHCJS with GHC 7.10.2. To compile and build, I use:+This package requires GHC 7.10 (I am using 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: ~~~ echo "compiler: ghcjs" > cabal.config@@ -64,3 +66,15 @@ ~~~ .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/react-flux-spec/react-flux-spec ~~~++# Other Projects++It differes significantly from the other two react bindings,+[react-haskell](https://github.com/joelburget/react-haskell) and+[ghcjs-react](https://github.com/fpco/ghcjs-react). In particular, the major difference is how+events are handled. In the Flux design, the state is moved out out of the view and then handlers+produce actions which transform the state. Thus there is a one-way flow of data from the store into+the view. In contrast, react-haskell and ghcjs-react both have event signals propagaing up the+react component tree, transforming state at each node. In particular, react-haskell with its InSig+and OutSig have the signals propagate up the tree and optionally transform state at each node and+change the type of the signal.
example/Makefile view
@@ -8,6 +8,8 @@ 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
react-flux.cabal view
@@ -1,5 +1,5 @@ name: react-flux-version: 0.9.0+version: 0.9.1 synopsis: A binding to React based on the Flux application architecture for GHCJS category: Web homepage: https://bitbucket.org/wuzzeb/react-flux@@ -66,7 +66,7 @@ ScopedTypeVariables TypeFamilies - build-depends: base >=4.8 && < 5+ build-depends: base >=4.7 && < 5 , deepseq , mtl >= 2.1 , aeson >= 0.8
src/React/Flux.hs view
@@ -92,7 +92,6 @@ #ifdef __GHCJS__ import GHCJS.Types (JSString)-import GHCJS.Foreign (toJSString) #endif ----------------------------------------------------------------------------------------------------
src/React/Flux/Internal.hs view
@@ -16,26 +16,32 @@ , childrenPassedToView , elementToM , mkReactElement+ , toJSString ) where -import Data.String (IsString(..))-import Data.Aeson-import Data.Aeson.Types (Pair)-import Data.Typeable (Typeable)-import Control.Monad.Writer-import Control.Monad.Identity (Identity(..))+import Data.String (IsString(..))+import Data.Aeson+import Data.Aeson.Types (Pair)+import Data.Typeable (Typeable)+import Control.Monad.Writer+import Control.Monad.Identity (Identity(..)) #ifdef __GHCJS__-import GHCJS.Types (JSRef, castRef, JSString, JSArray, JSObject, JSFun)-import qualified GHCJS.Foreign as Foreign-import GHCJS.Marshal (toJSRef_aeson, ToJSRef(..), fromJSRef)-import React.Flux.Export+import qualified Data.Text as T+import Unsafe.Coerce+import qualified Data.JSString as JSS+import qualified JavaScript.Array as JSA+import GHCJS.Foreign.Callback+import qualified JavaScript.Object as JSO+import GHCJS.Types (JSRef, castRef, JSString)+import GHCJS.Marshal (toJSRef_aeson, ToJSRef(..), fromJSRef)+import React.Flux.Export #else+type Callback a = () type JSRef a = ()-type JSFun a = JSRef a #endif -type Callback a = JSFun a+-- type JSObject a = JSO.Object a -- | This type is for the return value of @React.createClass@ newtype ReactViewRef props = ReactViewRef { reactViewRef :: JSRef () }@@ -75,7 +81,7 @@ #if __GHCJS__ instance ReactViewKey String where- toKeyRef = return . castRef . Foreign.toJSString+ toKeyRef = return . unsafeCoerce . toJSString instance ReactViewKey Int where toKeyRef i = castRef <$> toJSRef i@@ -210,8 +216,8 @@ [] -> lift $ js_ReactCreateElementNoChildren "div" [x] -> return x xs -> lift $ do- emptyObj <- Foreign.newObj- arr <- Foreign.toArray $ map reactElementRef xs+ emptyObj <- JSO.create+ let arr = JSA.fromList $ map reactElementRef xs js_ReactCreateElementName "div" emptyObj arr foreign import javascript unsafe@@ -220,39 +226,41 @@ foreign import javascript unsafe "React['createElement']($1, $2, $3)"- js_ReactCreateElementName :: JSString -> JSObject b -> JSArray c -> IO ReactElementRef+ js_ReactCreateElementName :: JSString -> JSO.Object -> JSA.JSArray -> IO ReactElementRef foreign import javascript unsafe "React['createElement']($1, $2, $3)"- js_ReactCreateForeignElement :: ReactViewRef a -> JSObject b -> JSArray c -> IO ReactElementRef+ js_ReactCreateForeignElement :: ReactViewRef a -> JSO.Object -> JSA.JSArray -> IO ReactElementRef foreign import javascript unsafe "React['createElement']($1, {hs:$2}, $3)"- js_ReactCreateClass :: ReactViewRef a -> Export props -> JSArray b -> IO ReactElementRef+ js_ReactCreateClass :: ReactViewRef a -> Export props -> JSA.JSArray -> IO ReactElementRef foreign import javascript unsafe "React['createElement']($1, {key: $2, hs:$3}, $4)"- js_ReactCreateKeyedElement :: ReactViewRef a -> JSRef key -> Export props -> JSArray b -> IO ReactElementRef+ js_ReactCreateKeyedElement :: ReactViewRef a -> JSRef key -> Export props -> JSA.JSArray -> IO ReactElementRef js_ReactCreateContent :: String -> ReactElementRef-js_ReactCreateContent = ReactElementRef . castRef . Foreign.toJSString+js_ReactCreateContent = ReactElementRef . unsafeCoerce . toJSString -addPropOrHandlerToObj :: JSObject a -> PropertyOrHandler (IO ()) -> WriterT [Callback (JSRef () -> IO ())] IO ()+addPropOrHandlerToObj :: JSO.Object -> PropertyOrHandler (IO ()) -> WriterT [Callback (JSRef () -> IO ())] IO () addPropOrHandlerToObj obj (Property (n, v)) = lift $ do vRef <- toJSRef_aeson v- Foreign.setProp (Foreign.toJSString n) vRef obj+ JSO.setProp (toJSString $ T.unpack n) vRef obj addPropOrHandlerToObj obj (EventHandler str handler) = do -- this will be released by the render function of the class (jsbits/class.js)- cb <- lift $ Foreign.syncCallback1 Foreign.AlwaysRetain True $ \evtRef ->+ cb <- lift $ syncCallback1 ContinueAsync $ \evtRef -> handler $ HandlerArg evtRef tell [cb]- lift $ Foreign.setProp (Foreign.toJSString str) cb obj+ cbRef <- lift $ toJSRef cb+ lift $ JSO.setProp (toJSString str) cbRef obj addPropOrHandlerToObj obj (CallbackProperty str handler) = do- cb <- lift $ Foreign.syncCallback1 Foreign.AlwaysRetain True $ \argref -> do+ cb <- lift $ syncCallback1 ContinueAsync $ \argref -> do v <- fromJSRef $ castRef argref handler $ maybe (error "Unable to decode callback value") id v tell [cb]- lift $ Foreign.setProp (Foreign.toJSString str) cb obj+ cbRef <- lift $ toJSRef cb+ lift $ JSO.setProp (toJSString str) cbRef obj createElement :: IO [ReactElementRef] -> ReactElement (IO ()) -> WriterT [Callback (JSRef () -> IO ())] IO [ReactElementRef] createElement _ EmptyElement = return []@@ -260,18 +268,18 @@ createElement _ (Content s) = return [js_ReactCreateContent s] createElement c ChildrenPassedToView = lift c createElement c (f@(ForeignElement{})) = do- obj <- lift $ Foreign.newObj+ obj <- lift $ JSO.create mapM_ (addPropOrHandlerToObj obj) $ fProps f childNodes <- createElement c $ fChild f- childArr <- lift $ Foreign.toArray $ map reactElementRef childNodes+ let childArr = JSA.fromList $ map reactElementRef childNodes e <- lift $ case fName f of- Left s -> js_ReactCreateElementName (Foreign.toJSString s) obj childArr+ Left s -> js_ReactCreateElementName (toJSString s) obj childArr Right ref -> js_ReactCreateForeignElement ref obj childArr return [e] createElement c (ViewElement { ceClass = rc, ceProps = props, ceKey = mkey, ceChild = child }) = do childNodes <- createElement c child propsE <- lift $ export props -- this will be released inside the lifetime events for the class (jsbits/class.js)- arr <- lift $ Foreign.toArray $ map reactElementRef childNodes+ let arr = JSA.fromList $ map reactElementRef childNodes e <- lift $ case mkey of Just key -> do keyRef <- toKeyRef key@@ -279,7 +287,12 @@ Nothing -> js_ReactCreateClass rc propsE arr return [e] +toJSString :: String -> JSString+toJSString = JSS.pack+ #else+toJSString :: String -> String+toJSString = id mkReactElement _ _ _ = return (ReactElementRef (), [])
src/React/Flux/Lifecycle.hs view
@@ -48,8 +48,11 @@ import React.Flux.Export +import GHCJS.Foreign (jsNull)+import GHCJS.Foreign.Callback+import GHCJS.Marshal (ToJSRef(..)) import GHCJS.Types (JSRef, castRef)-import GHCJS.Foreign (syncCallback1, syncCallback2, toJSString, ForeignRetention(..), jsNull)+ #endif type HTMLElement = JSRef ()@@ -151,32 +154,42 @@ willUnmountCb <- mkLCallback1 (lComponentWillUnmount cfg) $ \f this -> f (dom this) + -- willMountCbRef <- toJSRef willMountCb+ -- didMountCbRef <- toJSRef didMountCb+ -- willRecvPropsCbRef <- toJSRef willRecvPropsCb+ -- willUpdateCbRef <- toJSRef willUpdateCb+ -- didUpdateCbRef <- toJSRef didUpdateCb+ -- willUnmountCbRef <- toJSRef willUnmountCb ReactView <$> js_makeLifecycleView (toJSString name) initialRef- renderCb willMountCb didMountCb willRecvPropsCb willUpdateCb didUpdateCb willUnmountCb+ renderCb willMountCb didMountCb willRecvPropsCb willUpdateCb didUpdateCb willUnmountCb mkLCallback1 :: (Typeable props, Typeable state) => Maybe (LPropsAndState props state -> f) -> (f -> ReactThis state props -> IO ())- -> IO (Callback (JSRef () -> IO ()))+ -> IO (JSRef (Callback (JSRef () -> IO ()))) mkLCallback1 Nothing _ = return jsNull-mkLCallback1 (Just f) c = syncCallback1 AlwaysRetain False $ \thisRef -> do+mkLCallback1 (Just f) c = do+ cb <- syncCallback1 ThrowWouldBlock $ \thisRef -> do let this = ReactThis thisRef ps = LPropsAndState { lGetProps = js_ReactGetProps this >>= parseExport , lGetState = js_ReactGetState this >>= parseExport } c (f ps) this+ toJSRef cb mkLCallback2 :: (Typeable props, Typeable state) => Maybe (LPropsAndState props state -> f) -> (f -> ReactThis state props -> JSRef a -> IO ())- -> IO (Callback (JSRef () -> JSRef a -> IO ()))+ -> IO (JSRef (Callback (JSRef () -> JSRef a -> IO ()))) mkLCallback2 Nothing _ = return jsNull-mkLCallback2 (Just f) c = syncCallback2 AlwaysRetain False $ \thisRef argRef -> do+mkLCallback2 (Just f) c = do+ cb <- syncCallback2 ThrowWouldBlock $ \thisRef argRef -> do let this = ReactThis thisRef ps = LPropsAndState { lGetProps = js_ReactGetProps this >>= parseExport , lGetState = js_ReactGetState this >>= parseExport } c (f ps) this argRef+ toJSRef cb #else
src/React/Flux/PropertiesAndEvents.hs view
@@ -74,22 +74,25 @@ , onError ) where -import Control.Monad (forM)-import Control.Concurrent.MVar (newMVar)-import Control.DeepSeq-import System.IO.Unsafe (unsafePerformIO)+import Control.Monad (forM)+import Control.Concurrent.MVar (newMVar)+import Control.DeepSeq+import System.IO.Unsafe (unsafePerformIO) import qualified Data.Text as T import qualified Data.Aeson as A -import React.Flux.Internal-import React.Flux.Store+import React.Flux.Internal+import React.Flux.Store #ifdef __GHCJS__-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe) -import GHCJS.Types (JSRef, nullRef, JSString, JSBool)-import GHCJS.Foreign (toJSString, lengthArray, indexArray, fromJSBool)-import GHCJS.Marshal (FromJSRef(..))+import qualified Data.JSString as JSS+import GHCJS.Foreign (fromJSBool)+import GHCJS.Marshal (FromJSRef(..))+import GHCJS.Types (JSRef, nullRef, JSString)+import JavaScript.Array as JSA+ #else type JSRef a = () type JSString = String@@ -487,10 +490,10 @@ parseTouchList :: JSRef a -> JSString -> [Touch] parseTouchList obj key = unsafePerformIO $ do- let arr = js_getProp obj key- len <- lengthArray arr+ let arr = js_getArrayProp obj key+ len = arrayLength arr forM [0..len-1] $ \idx -> do- jsref <- indexArray idx arr+ let jsref = arrayIndex idx arr return $ parseTouch jsref parseTouchEvent :: HandlerArg -> TouchEvent parseTouchEvent (HandlerArg o) = TouchEvent@@ -568,6 +571,10 @@ "$1[$2]" js_getProp :: JSRef a -> JSString -> JSRef b +foreign import javascript unsafe+ "$1[$2]"+ js_getArrayProp :: JSRef a -> JSString -> JSA.JSArray+ -- | Access a property from an object. Since event objects are immutable, we can use -- unsafePerformIO without worry. (.:) :: FromJSRef b => JSRef a -> JSString -> b@@ -576,29 +583,35 @@ foreign import javascript unsafe "$1['getModifierState']($2)"- js_GetModifierState :: JSRef () -> JSString -> JSBool+ js_GetModifierState :: JSRef () -> JSString -> JSRef Bool getModifierState :: JSRef () -> String -> Bool getModifierState ref = fromJSBool . js_GetModifierState ref . toJSString +arrayLength :: JSArray -> Int+arrayLength = JSA.length++arrayIndex :: Int -> JSArray -> JSRef a+arrayIndex = JSA.index+ #else js_getProp :: a -> String -> JSRef b js_getProp _ _ = () +js_getArrayProp :: a -> String -> JSRef b+js_getArrayProp _ _ = ()+ (.:) :: JSRef () -> String -> b _ .: _ = undefined -toJSString :: String -> JSString-toJSString = id- getModifierState :: JSRef () -> String -> Bool getModifierState _ _ = False -lengthArray :: JSArray -> IO Int-lengthArray _ = return 0+arrayLength :: JSArray -> Int+arrayLength _ = 0 -indexArray :: Int -> JSArray -> IO (JSRef ())-indexArray _ _ = return ()+arrayIndex :: Int -> JSArray -> JSRef ()+arrayIndex _ _ = () #endif
src/React/Flux/Views.hs view
@@ -11,11 +11,11 @@ import Control.DeepSeq import System.IO.Unsafe (unsafePerformIO) import React.Flux.Export--import GHCJS.Types (JSRef, castRef, JSFun, JSString, JSArray)-import GHCJS.Foreign (syncCallback2, toJSString, ForeignRetention(..), fromArray)+import JavaScript.Array+import GHCJS.Foreign.Callback+import GHCJS.Types (JSRef, castRef, JSString) import GHCJS.Marshal (ToJSRef(..))-type Callback a = JSFun a+ #else type JSRef a = () #endif@@ -285,7 +285,7 @@ foreign import javascript unsafe "$1['props']['children']"- js_ReactGetChildren :: ReactThis state props -> IO (JSArray ())+ js_ReactGetChildren :: ReactThis state props -> IO (JSArray) foreign import javascript unsafe "$1._updateAndReleaseState($2)"@@ -338,7 +338,7 @@ -> (ReactThis state props -> eventHandler -> IO ()) -- ^ execute event args -> (state -> props -> IO (ReactElementM eventHandler ())) -- ^ renderer -> IO (Callback (JSRef () -> JSRef () -> IO ()))-mkRenderCallback parseState runHandler render = syncCallback2 AlwaysRetain False $ \thisRef argRef -> do+mkRenderCallback parseState runHandler render = syncCallback2 ContinueAsync $ \thisRef argRef -> do let this = ReactThis thisRef arg = RenderCbArg argRef state <- parseState this@@ -346,7 +346,7 @@ node <- render state props let getPropsChildren = do childRef <- js_ReactGetChildren this- childArr <- fromArray childRef+ let childArr = toList childRef return $ map ReactElementRef childArr (element, evtCallbacks) <- mkReactElement (runHandler this) getPropsChildren node
test/client/TestClient.hs view
@@ -7,9 +7,9 @@ import Debug.Trace import React.Flux import React.Flux.Lifecycle+import React.Flux.Internal (toJSString) import GHCJS.Types (JSRef, JSString)-import GHCJS.Foreign (toJSString) import GHCJS.Marshal (fromJSRef) -- TODO:
test/spec/TestClientSpec.hs view
@@ -1,12 +1,13 @@-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} module TestClientSpec (spec) where -import Control.Monad.IO.Class (liftIO)-import Control.Monad-import Data.List-import Test.Hspec.WebDriver-import System.Directory (getCurrentDirectory)-import qualified Data.Text as T+import Control.Monad+import Control.Monad.IO.Class (liftIO)+import Data.List+import qualified Data.Text as T+import System.Directory (getCurrentDirectory)+import Test.Hspec.WebDriver loadLog :: WD [String] loadLog = executeJS [] "var old = window.test_client_output; window.test_client_output = []; return old;"@@ -81,7 +82,7 @@ [clickName, evt, mouseEvt, modState] <- loadLog clickName `shouldBe` "click" evt `shouldBeEvent` ("click", True, 3)- mouseEvt `shouldBe` "(False,0,0,37,54,False,False,37,54,EventTarget,37,54,False)"+ mouseEvt `shouldBe` "(False,0,0,33,55,False,False,33,55,EventTarget,33,55,False)" modState `shouldBe` "alt modifier: False" {- touch events can't be tested at the moment, chrome doesn't support them@@ -133,7 +134,7 @@ [ "will recv props" , "Current props and state: Hello, 101" , "New props: Helloo"- + , "will update" , "Current props and state: Hello, 101" , "New props: Helloo"
test/spec/TodoSpec.hs view
@@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module TodoSpec (spec) where -import Control.Monad.IO.Class (liftIO)-import Control.Monad-import Test.Hspec.WebDriver-import System.Directory (getCurrentDirectory)-import qualified Data.Text as T+import Control.Monad+import Control.Monad.IO.Class (liftIO)+import qualified Data.Text as T+import System.Directory (getCurrentDirectory)+import Test.Hspec.WebDriver expectTodos :: [(T.Text, Bool)] -> WD () expectTodos todos = do@@ -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.html"+ openPage $ "file://" ++ dir ++ "/../../example/todo-dev.html" expectTodos [("Learn react", True), ("Learn react-flux", False)] it "adds a new todo via blur" $ runWD $ do