diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +# 0.9.1 + +* Switch to use the improved-base branch of ghcjs (thanks Vladimir Sekissov!) + # 0.9.0 * Initial release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/example/Makefile b/example/Makefile --- a/example/Makefile +++ b/example/Makefile @@ -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 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: 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 diff --git a/src/React/Flux.hs b/src/React/Flux.hs --- a/src/React/Flux.hs +++ b/src/React/Flux.hs @@ -92,7 +92,6 @@ #ifdef __GHCJS__ import GHCJS.Types (JSString) -import GHCJS.Foreign (toJSString) #endif ---------------------------------------------------------------------------------------------------- diff --git a/src/React/Flux/Internal.hs b/src/React/Flux/Internal.hs --- a/src/React/Flux/Internal.hs +++ b/src/React/Flux/Internal.hs @@ -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 (), []) diff --git a/src/React/Flux/Lifecycle.hs b/src/React/Flux/Lifecycle.hs --- a/src/React/Flux/Lifecycle.hs +++ b/src/React/Flux/Lifecycle.hs @@ -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 diff --git a/src/React/Flux/PropertiesAndEvents.hs b/src/React/Flux/PropertiesAndEvents.hs --- a/src/React/Flux/PropertiesAndEvents.hs +++ b/src/React/Flux/PropertiesAndEvents.hs @@ -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 diff --git a/src/React/Flux/Views.hs b/src/React/Flux/Views.hs --- a/src/React/Flux/Views.hs +++ b/src/React/Flux/Views.hs @@ -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 diff --git a/test/client/TestClient.hs b/test/client/TestClient.hs --- a/test/client/TestClient.hs +++ b/test/client/TestClient.hs @@ -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: diff --git a/test/spec/TestClientSpec.hs b/test/spec/TestClientSpec.hs --- a/test/spec/TestClientSpec.hs +++ b/test/spec/TestClientSpec.hs @@ -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" diff --git a/test/spec/TodoSpec.hs b/test/spec/TodoSpec.hs --- a/test/spec/TodoSpec.hs +++ b/test/spec/TodoSpec.hs @@ -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