diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,13 @@ +# 1.2.3 + +* Add `rawJsRendering` function which allows you to inject arbitrary javascript code + into the rendering function of a view. This is quite low-level and should be a last + resort, but it can be used if you have especially tricky 3rd-party React classes. Having + said that, I suggest you try other approaches first. + +* Add `transHandler` and `liftViewToStateHandler` utility functions which can be used to transform + the handler that a `ReactElementM` lives in. + # 1.2.2 * Update the test suite to use hspec-webdriver-1.2. There was no change to any code 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.2.2 +version: 1.2.3 synopsis: A binding to React based on the Flux application architecture for GHCJS category: Web homepage: https://bitbucket.org/wuzzeb/react-flux diff --git a/src/React/Flux.hs b/src/React/Flux.hs --- a/src/React/Flux.hs +++ b/src/React/Flux.hs @@ -92,6 +92,9 @@ , viewWithIKey , childrenPassedToView , foreignClass + , rawJsRendering + , transHandler + , liftViewToStateHandler , module React.Flux.DOM , module React.Flux.PropertiesAndEvents , module React.Flux.Combinators @@ -143,7 +146,7 @@ #ifdef __GHCJS__ reactRender htmlId rc props = do - (e, _) <- mkReactElement id (return nullRef) (return []) $ view rc props mempty + (e, _) <- mkReactElement id (ReactThis nullRef) $ view rc props mempty js_ReactRender e (toJSString htmlId) foreign import javascript unsafe @@ -175,7 +178,7 @@ #ifdef __GHCJS__ reactRenderToString includeStatic rc props = do - (e, _) <- mkReactElement id (return nullRef) (return []) $ view rc props mempty + (e, _) <- mkReactElement id (ReactThis nullRef) $ view rc props mempty sRef <- (if includeStatic then js_ReactRenderStaticMarkup else js_ReactRenderToString) e --return sRef --return $ JSS.unpack sRef diff --git a/src/React/Flux/Ajax.hs b/src/React/Flux/Ajax.hs --- a/src/React/Flux/Ajax.hs +++ b/src/React/Flux/Ajax.hs @@ -1,3 +1,7 @@ +-- | Make calls to the backend from within your stores. This module is low-level +-- in that it mostly directly exposes the XMLHttpRequest access. If you are using +-- servant, +-- for a higher-level interface. module React.Flux.Ajax ( initAjax , RequestTimeout(..) 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 @@ -6,12 +6,14 @@ module React.Flux.Internal( ReactViewRef(..) , ReactElementRef(..) + , ReactThis(..) , HandlerArg(..) , PropertyOrHandler(..) , property , (&=) , ReactElement(..) , ReactElementM(..) + , transHandler , elemString , elemText , elemJSString @@ -73,6 +75,10 @@ newtype HandlerArg = HandlerArg JSVal instance IsJSVal HandlerArg +-- | The this value during the rendering function +newtype ReactThis state props = ReactThis {reactThisRef :: JSVal } +instance IsJSVal (ReactThis state props) + instance Show HandlerArg where show _ = "HandlerArg" @@ -85,7 +91,7 @@ { propertyName :: JSString , propertyVal :: ref } - | forall ref. ToJSVal ref => PropertyFromContext + | forall ref. ToJSVal ref => PropertyFromContext { propFromThisName :: JSString , propFromThisVal :: JSVal -> ref -- ^ will be passed this.context } @@ -147,6 +153,11 @@ , ceProps :: props , ceChild :: ReactElement eventHandler } + | RawJsElement + { rawTransform :: JSVal -> [ReactElementRef] -> IO ReactElementRef + -- ^ first arg is this from render method, second argument is the rendering of 'rawChild' + , rawChild :: ReactElement eventHandler + } | ChildrenPassedToView | Content JSString | Append (ReactElement eventHandler) (ReactElement eventHandler) @@ -159,6 +170,7 @@ instance Functor ReactElement where fmap f (ForeignElement n p c) = ForeignElement n (map (fmap f) p) (fmap f c) fmap f (ViewElement n k p c) = ViewElement n k p (fmap f c) + fmap f (RawJsElement t c) = RawJsElement t (fmap f c) fmap _ ChildrenPassedToView = ChildrenPassedToView fmap f (Append a b) = Append (fmap f a) (fmap f b) fmap _ (Content s) = Content s @@ -204,6 +216,12 @@ instance (a ~ ()) => IsString (ReactElementM eventHandler a) where fromString s = elementToM () $ Content $ toJSString s +-- | Transform the event handler for a 'ReactElementM'. +transHandler :: (handler1 -> handler2) -> ReactElementM handler1 a -> ReactElementM handler2 a +transHandler f (ReactElementM writer) = ReactElementM $ mapWriter f' writer + where + f' (a, x) = (a, fmap f x) + -- | Create a text element from a string. The text content is escaped to be HTML safe. -- If you need to insert HTML, instead use the -- @@ -253,16 +271,15 @@ -- | Execute a ReactElementM to create a javascript React element and a list of callbacks attached -- to nodes within the element. These callbacks will need to be released with 'releaseCallback' -- once the class is re-rendered. -mkReactElement :: forall eventHandler. +mkReactElement :: forall eventHandler state props. (eventHandler -> IO ()) - -> IO JSVal -- ^ this.context - -> IO [ReactElementRef] -- ^ this.props.children + -> ReactThis state props -- ^ this -> ReactElementM eventHandler () -> IO (ReactElementRef, [CallbackToRelease]) #ifdef __GHCJS__ -mkReactElement runHandler getContext getPropsChildren = runWriterT . mToElem +mkReactElement runHandler this = runWriterT . mToElem where -- Run the ReactElementM monad to create a ReactElementRef. mToElem :: ReactElementM eventHandler () -> MkReactElementM ReactElementRef @@ -286,7 +303,7 @@ vRef <- toJSVal val JSO.setProp n vRef obj addPropOrHandlerToObj obj (PropertyFromContext n f) = lift $ do - ctx <- getContext + ctx <- js_ReactGetContext this vRef <- toJSVal $ f ctx JSO.setProp n vRef obj addPropOrHandlerToObj obj (NestedProperty n vals) = do @@ -321,7 +338,9 @@ createElement EmptyElement = return [] createElement (Append x y) = (++) <$> createElement x <*> createElement y createElement (Content s) = return [js_ReactCreateContent s] - createElement ChildrenPassedToView = lift getPropsChildren + createElement ChildrenPassedToView = lift $ do + childRef <- js_ReactGetChildren this + return $ map ReactElementRef $ JSA.toList childRef createElement (f@(ForeignElement{})) = do obj <- lift $ JSO.create mapM_ (addPropOrHandlerToObj obj) $ fProps f @@ -348,6 +367,11 @@ Nothing -> js_ReactCreateClass rc propsE children return [e] + createElement (RawJsElement trans child) = do + childNodes <- createElement child + e <- liftIO $ trans (reactThisRef this) childNodes + return [e] + type MkReactElementM a = WriterT [CallbackToRelease] IO a foreign import javascript unsafe @@ -390,6 +414,15 @@ "$r = hsreact$textWrapper" js_textWrapper :: JSVal +foreign import javascript unsafe + "$1['context']" + js_ReactGetContext :: ReactThis state props -> IO JSVal + +foreign import javascript unsafe + "hsreact$children_to_array($1['props']['children'])" + js_ReactGetChildren :: ReactThis state props -> IO JSArray + + js_ReactCreateContent :: JSString -> ReactElementRef js_ReactCreateContent = ReactElementRef . unsafeCoerce @@ -408,7 +441,7 @@ return (jsval cb, wrappedCb) #else -mkReactElement _ _ _ _ = return (ReactElementRef (), []) +mkReactElement _ _ _ = return (ReactElementRef (), []) toJSString :: String -> String toJSString = id 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 @@ -196,6 +196,12 @@ -- instead use the state passed directly to the handler. type StatefulViewEventHandler state = state -> ([SomeStoreAction], Maybe state) +-- | Change the event handler from 'ViewEventHandler' to 'StatefulViewEventHandler' to allow you to embed +-- combinators with 'ViewEventHandler's into a stateful view. Each such lifted handler makes no change to +-- the state. +liftViewToStateHandler :: ReactElementM ViewEventHandler a -> ReactElementM (StatefulViewEventHandler st) a +liftViewToStateHandler = transHandler (\h _ -> (h, Nothing)) + -- | A stateful view is a re-usable component of the page which keeps track of internal state. -- Try to keep as many views as possible stateless. The React documentation on -- @@ -286,9 +292,6 @@ #ifdef __GHCJS__ -newtype ReactThis state props = ReactThis JSVal -instance IsJSVal (ReactThis state props) - foreign import javascript unsafe "$1['state'].hs" js_ReactGetState :: ReactThis state props -> IO (Export state) @@ -298,14 +301,6 @@ js_ReactGetProps :: ReactThis state props -> IO (Export props) foreign import javascript unsafe - "$1['context']" - js_ReactGetContext :: ReactThis state props -> IO JSVal - -foreign import javascript unsafe - "hsreact$children_to_array($1['props']['children'])" - js_ReactGetChildren :: ReactThis state props -> IO JSArray - -foreign import javascript unsafe "$1._updateAndReleaseState($2)" js_ReactUpdateAndReleaseState :: ReactThis state props -> Export state -> IO () @@ -366,12 +361,7 @@ state <- parseState this props <- js_ReactGetProps this >>= parseExport node <- render state props - - let getPropsChildren = do childRef <- js_ReactGetChildren this - return $ map ReactElementRef $ toList childRef - getContext = js_ReactGetContext this - - (element, evtCallbacks) <- mkReactElement (runHandler this) getContext getPropsChildren node + (element, evtCallbacks) <- mkReactElement (runHandler this) this node evtCallbacksRef <- toJSVal evtCallbacks js_RenderCbSetResults arg evtCallbacksRef element @@ -469,6 +459,31 @@ #else foreignClass _ _ x = x +#endif + +-- | Inject arbitrary javascript code into the rendering function. This is very low level and should only +-- be used as a last resort when interacting with complex third-party react classes. For the most part, +-- third-party react classes can be interacted with using 'foreignClass' and the various ways of creating +-- properties. +rawJsRendering :: (JSVal -> JSArray -> IO JSVal) + -- ^ The raw code to inject into the rendering function. The first argument is the 'this' value + -- from the rendering function so points to the react class. The second argument is the result of + -- rendering the children so is an array of react elements. The return value must be a React element. + -> ReactElementM handler () -- ^ the children + -> ReactElementM handler () + +#ifdef __GHCJS__ + +rawJsRendering trans (ReactElementM child) = + let (a, childEl) = runWriter child + trans' thisVal childLst = + ReactElementRef <$> trans thisVal (JSA.fromList $ map reactElementRef childLst) + in elementToM a $ RawJsElement trans' childEl + +#else + +rawJsRendering _ x = x + #endif -- | A class which is used to implement . diff --git a/test/client/TestClient.hs b/test/client/TestClient.hs --- a/test/client/TestClient.hs +++ b/test/client/TestClient.hs @@ -18,6 +18,7 @@ import GHCJS.Types (JSVal, JSString) import GHCJS.Marshal (fromJSVal) +import JavaScript.Array (JSArray) import qualified Data.JSString.Text as JSS foreign import javascript unsafe @@ -46,6 +47,10 @@ outputIO :: [T.Text] -> IO () outputIO ss = void $ transform ss OutputStoreData +foreign import javascript unsafe + "React['createElement']('p', {'id': 'test-raw-js-para'}, $2)" + js_testRawJs :: JSVal -> JSArray -> IO JSVal + -------------------------------------------------------------------------------- --- Events -------------------------------------------------------------------------------- @@ -87,7 +92,7 @@ , onClick $ \e m -> output [ "click" , tshow e - , tshow m + , tshow m , logM (mouseGetModifierState m) --, logT (mouseRelatedTarget m) ] @@ -117,7 +122,7 @@ , onClick $ \_ _ -> output ["Click on outer div"] , capturePhase $ onDoubleClick $ \e _ -> output ["Double click outer div"] ++ [stopPropagation e] ] $ do - + span_ [ "id" $= "inner-span" , onClick $ \e _ -> output ["Click inner span"] ++ [stopPropagation e] , onDoubleClick $ \_ _ -> output ["Double click inner span"] @@ -406,7 +411,7 @@ let step = UTCTime moon (2*60*60 + 56*60) -- 1969-7-20 02:56 UTC fullT = (fullDayF, TimeFormat { hourF = Just "numeric", minuteF = Just "2-digit", secondF = Just "numeric", timeZoneNameF = Just "long" }) - + li_ ["id" $= "f-shorttime"] $ utcTime_ shortDateTime step li_ ["id" $= "f-fulltime"] $ utcTime_ fullT step li_ ["id" $= "f-time"] $ formattedDate_ (Right step) @@ -499,6 +504,10 @@ view callbackViewWrapper () mempty view intlSpec () mempty + + rawJsRendering js_testRawJs $ + span_ ["id" $= "test-raw-js-body"] + "Raw Javascript Render Body" } main :: IO () diff --git a/test/spec/TestClientSpec.hs b/test/spec/TestClientSpec.hs --- a/test/spec/TestClientSpec.hs +++ b/test/spec/TestClientSpec.hs @@ -164,6 +164,10 @@ (findElem (ById "raw-show-view") >>= getText) `shouldReturn` "42" + it "has rendered the raw javascript rendering" $ runWD $ + (findElem (ByCSS "p#test-raw-js-para > span") >>= getText) + `shouldReturn` "Raw Javascript Render Body" + describe "lifecycle events" $ do it "properly updates the state" $ runWD $ do diff --git a/test/spec/stack.yaml b/test/spec/stack.yaml --- a/test/spec/stack.yaml +++ b/test/spec/stack.yaml @@ -2,4 +2,4 @@ packages: - '.' extra-deps: -- hspec-webdriver-1.2 +- hspec-webdriver-1.2.0