packages feed

react-haskell 1.1.0.0 → 1.2.0.0

raw patch · 4 files changed

+240/−44 lines, 4 filesdep +haste-compilerdep ~base

Dependencies added: haste-compiler

Dependency ranges changed: base

Files

react-haskell.cabal view
@@ -1,5 +1,5 @@ name:                react-haskell-version:             1.1.0.0+version:             1.2.0.0 synopsis:            Haskell React bindings description:   This package provides high level bindings to Facebook's <facebook.github.io/react/ React> library, meant for use with <haste-lang.org Haste>.@@ -29,6 +29,10 @@ data-dir: lib data-files: stubs.js +flag haste-inst+  description: Built with haste-inst/hastec+  default: False+ source-repository head   type: git   location: https://github.com/joelburget/react-haskell.git@@ -49,9 +53,14 @@     MultiParamTypeClasses,     OverloadedStrings   build-depends:-    base == 4.7.*,+    base >= 4.5 && < 4.7,     transformers,-    haste-lib >= 0.4 && <0.5,     monads-tf+  if flag(haste-inst)+    build-depends:+      haste-lib >= 0.4 && <0.5+  else+    build-depends:+      haste-compiler   hs-source-dirs:      src   default-language:    Haskell2010
src/React.hs view
@@ -1,16 +1,17 @@ {-# LANGUAGE OverloadedStrings, FlexibleInstances, LambdaCase,-  MultiParamTypeClasses, FlexibleContexts #-}+  MultiParamTypeClasses, FlexibleContexts, Rank2Types #-}  module React     ( module X     , getDomNode     , render+    , nest+    , pureNest     ) where  import Control.Applicative import Control.Monad import Control.Monad.IO.Class--- import Control.Monad.Writer import Data.Functor.Identity import Data.Monoid import Data.String@@ -32,37 +33,7 @@ -- * restricted monads -- * store elem in monad -- * escaping / dangerouslySetInnerHTML--- * http://chrisdone.com/posts/lucid -interpret :: Monad m-          => StatefulReactT s m ()-          -> s-          -> (s -> IO ())-          -> m (IO ForeignNode)-interpret react s cb = do-    ~(child:_, s', ()) <- runStatefulReactT react s-    return $ interpret' s' cb child--interpret' :: s-           -> (s -> IO ())-           -> ReactNode s-           -> IO ForeignNode-interpret' s cb = \case-    Parent name as hs children -> do-        children' <- forM children (interpret' s cb)-        let hs' = map (unStateful s cb) hs-        element js_React_DOM_parent name as hs' children'-    Leaf name as hs -> do-        let hs' = map (unStateful s cb) hs-        voidElement js_React_DOM_leaf name as hs'-    Text str -> js_React_DOM_text (toJSStr str)--unStateful :: s-           -> (s -> IO ())-           -> StatefulEventHandler s-           -> (RawEvent -> IO (), EvtType)-unStateful s act (StatefulEventHandler handle ty) = (act . handle s, ty)- element :: (JSString -> RawAttrs -> ReactArray -> IO ForeignNode)         -> JSString         -> Attrs@@ -109,14 +80,57 @@ -- TODO this seems wrong setField attr (fld, Null) = return () +-- TODO figure out what to do with this getDomNode :: ForeignNode -> IO (Maybe Elem) getDomNode r = fmap fromPtr (js_React_getDomNode r) +unStateful :: s+           -> (s -> IO ())+           -> StatefulEventHandler s+           -> (RawEvent -> IO (), EvtType)+unStateful s act (StatefulEventHandler handle ty) = (act . handle s, ty)++interpret :: Monad m+          => StatefulReactT s m ()+          -> s+          -> (s -> IO ())+          -> m (IO ForeignNode)+interpret react s cb = do+    ~(child:_, s', ()) <- runStatefulReactT react s+    return $ interpret' s' cb child++interpret' :: s+           -> (s -> IO ())+           -> ReactNode s+           -> IO ForeignNode+interpret' s cb = \case+    Parent name as hs children -> do+        children' <- forM children (interpret' s cb)+        let hs' = map (unStateful s cb) hs+        element js_React_DOM_parent name as hs' children'+    Leaf name as hs -> do+        let hs' = map (unStateful s cb) hs+        voidElement js_React_DOM_leaf name as hs'+    Text str -> js_React_DOM_text (toJSStr str)++nest :: Monad m => MockLens a b -> StatefulReactT b m x -> StatefulReactT a m x+nest lens nested = StatefulReactT $ \a -> do+    (nodes, b, x) <- runStatefulReactT nested (mockGet lens a)+    return (map (nodeConvert lens) nodes, mockSet lens b a, x)++pureNest :: Monad m => StatefulReactT () m x -> StatefulReactT a m x+pureNest = nest pureLens where+    pureLens :: MockLens a ()+    pureLens f a = const a <$> f ()++render' :: Elem -> ForeignNode -> IO ()+render' = ffi "(function(e,r){React.render(r,e);})"+ render :: s -> Elem -> StatefulReact s () -> IO () render s elem r = do     let cb s' = render s' elem r     foreignNode <- runIdentity $ interpret r s cb     render' elem foreignNode -render' :: Elem -> ForeignNode -> IO ()-render' = ffi (toJSStr "(function(e,r){React.render(r,e);})")+renderPureReact :: Elem -> PureReact -> IO ()+renderPureReact = render ()
src/React/Imports.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ForeignFunctionInterface, CPP #-} module React.Imports where  import React.Types@@ -8,34 +8,184 @@ import Haste.JSON import Haste.Prim +#ifdef __HASTE__ foreign import ccall js_React_DOM_leaf :: JSString -> RawAttrs -> IO ForeignNode+#else+js_React_DOM_leaf :: JSString -> RawAttrs -> IO ForeignNode+js_React_DOM_leaf = error "cannot evaluate js_React_DOM_leaf in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_React_DOM_parent :: JSString -> RawAttrs -> ReactArray -> IO ForeignNode+#else+js_React_DOM_parent :: JSString -> RawAttrs -> ReactArray -> IO ForeignNode+js_React_DOM_parent = error "cannot evaluate js_React_DOM_parent in ghc"+#endif +#ifdef __HASTE__ foreign import ccall js_empty_object :: IO RawAttrs+#else+js_empty_object :: IO RawAttrs+js_empty_object = error "cannot evaluate js_empty_object in ghc"+#endif++#ifdef __HASTE__ foreign import ccall "js_set_field" js_set_field_String :: RawAttrs -> JSString -> JSString -> IO ()+#else+js_set_field_String :: RawAttrs -> JSString -> JSString -> IO ()+js_set_field_String = error "cannot evaluate js_set_field_String in ghc"+#endif++#ifdef __HASTE__ foreign import ccall "js_set_field" js_set_field_Double :: RawAttrs -> JSString -> Double -> IO ()+#else+js_set_field_Double :: RawAttrs -> JSString -> Double -> IO ()+js_set_field_Double = error "cannot evaluate js_set_field_Double in ghc"+#endif++#ifdef __HASTE__ foreign import ccall "js_set_field" js_set_field_Int :: RawAttrs -> JSString -> Int -> IO ()+#else+js_set_field_Int :: RawAttrs -> JSString -> Int -> IO ()+js_set_field_Int = error "cannot evaluate js_set_field_Int in ghc"+#endif++#ifdef __HASTE__ foreign import ccall "js_set_field" js_set_field_Obj :: RawAttrs -> JSString -> RawAttrs -> IO ()+#else+js_set_field_Obj :: RawAttrs -> JSString -> RawAttrs -> IO ()+js_set_field_Obj = error "cannot evaluate js_set_field_Obj in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_set_field_True :: RawAttrs -> JSString -> IO ()+#else+js_set_field_True :: RawAttrs -> JSString -> IO ()+js_set_field_True = error "cannot evaluate js_set_field_True in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_set_field_False :: RawAttrs -> JSString -> IO ()+#else+js_set_field_False :: RawAttrs -> JSString -> IO ()+js_set_field_False = error "cannot evaluate js_set_field_False in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_targetValue :: RawEvent -> JSString+#else+js_targetValue :: RawEvent -> JSString+js_targetValue = error "cannot evaluate js_targetValue in ghc"+#endif +#ifdef __HASTE__ foreign import ccall js_set_onClick       :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+#else+js_set_onClick       :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+js_set_onClick       = error "cannot evaluate js_set_onClick in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_set_onDoubleClick :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+#else+js_set_onDoubleClick :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+js_set_onDoubleClick = error "cannot evaluate js_set_onDoubleClick in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_set_onChange      :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+#else+js_set_onChange      :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+js_set_onChange      = error "cannot evaluate js_set_onChangein ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_set_onKeyUp       :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+#else+js_set_onKeyUp       :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+js_set_onKeyUp       = error "cannot evaluate js_set_onKeyUp in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_set_onKeyPress    :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+#else+js_set_onKeyPress    :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+js_set_onKeyPress    = error "cannot evaluate js_set_onKeyPress in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_set_onKeyDown     :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+#else+js_set_onKeyDown     :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+js_set_onKeyDown     = error "cannot evaluate js_set_onKeyDown in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_set_onBlur        :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+#else+js_set_onBlur        :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+js_set_onBlur        = error "cannot evaluate js_set_onBlur in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_set_onMouseEnter :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+#else+js_set_onMouseEnter :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+js_set_onMouseEnter = error "cannot evaluate js_set_onMouseEnter in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_set_onMouseLeave :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+#else+js_set_onMouseLeave :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+js_set_onMouseLeave = error "cannot evaluate js_set_onMouseLeave in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_React_getDomNode :: ForeignNode -> IO (Ptr (Maybe Elem))+#else+js_React_getDomNode :: ForeignNode -> IO (Ptr (Maybe Elem))+js_React_getDomNode = error "cannot evaluate js_React_getDomNode in ghc"+#endif +#ifdef __HASTE__ foreign import ccall "js_empty" js_ReactArray_empty :: IO ReactArray+#else+js_ReactArray_empty :: IO ReactArray+js_ReactArray_empty = error "cannot evaluate js_ReactArray_empty in ghc"+#endif++#ifdef __HASTE__ foreign import ccall "js_push" js_ReactArray_push :: ReactArray -> ForeignNode -> IO ()+#else+js_ReactArray_push :: ReactArray -> ForeignNode -> IO ()+js_ReactArray_push = error "cannot evaluate js_ReactArray_push in ghc"+#endif +#ifdef __HASTE__ foreign import ccall "js_id" js_React_DOM_text :: JSString -> IO ForeignNode+#else+js_React_DOM_text :: JSString -> IO ForeignNode+js_React_DOM_text = error "cannot evaluate js_React_DOM_text in ghc"+#endif +#ifdef __HASTE__ foreign import ccall js_parseChangeEvent :: RawEvent -> Ptr ChangeEvent+#else+js_parseChangeEvent :: RawEvent -> Ptr ChangeEvent+js_parseChangeEvent = error "cannot evaluate js_parseChangeEvent in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_parseKeyboardEvent :: RawEvent -> Ptr KeyboardEvent+#else+js_parseKeyboardEvent :: RawEvent -> Ptr KeyboardEvent+js_parseKeyboardEvent = error "cannot evaluate js_parseKeyboardEvent in ghc"+#endif++#ifdef __HASTE__ foreign import ccall js_parseMouseEvent :: RawEvent -> Ptr MouseEvent+#else+js_parseMouseEvent :: RawEvent -> Ptr MouseEvent+js_parseMouseEvent = error "cannot evaluate js_parseMouseEvent in ghc"+#endif
src/React/Types.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses,-    FlexibleInstances, FlexibleContexts, GADTs #-}+    FlexibleInstances, FlexibleContexts, GADTs, Rank2Types #-} module React.Types where  import Control.Applicative@@ -41,19 +41,42 @@                  -- | Pre Attrs Handlers [ReactNode] -- it'd be super cool to restrict this to a string somehow (restrict the underlying monad so it can only set attrs and string?)                  | Text String -- TODO(joel) JSString? +type MockLens s a = Functor f => (a -> f a) -> s -> f s -getState :: StatefulReact s s-getState = StatefulReactT $ \s -> return ([], s, s)+mockGet :: MockLens s a -> s -> a+mockGet l = getConst . l Const +mockMod :: MockLens s a -> (a -> a) -> s -> s+mockMod l f = runIdentity . l (Identity . f)++mockSet :: MockLens s a -> a -> s -> s+mockSet l a = mockMod l (const a)++handlerConvert :: MockLens a b+               -> StatefulEventHandler b+               -> StatefulEventHandler a+handlerConvert l (StatefulEventHandler f ty) = StatefulEventHandler+    (\a raw -> mockSet l (f (mockGet l a) raw) a)+    ty++nodeConvert :: MockLens a b -> ReactNode b -> ReactNode a+nodeConvert l (Parent name attrs handlers children) =+    Parent name attrs (map (handlerConvert l) handlers)+        (map (nodeConvert l) children)+nodeConvert l (Leaf name attrs handlers) =+    Leaf name attrs (map (handlerConvert l) handlers)+nodeConvert l (Text str) = Text str+ newtype StatefulReactT s m a = StatefulReactT     { runStatefulReactT :: s -> m ([ReactNode s], s, a) }  type StatefulReact s = StatefulReactT s Identity+type PureReact = StatefulReact () () --- runStatefulReact :: StatefulReactT s a -> s -> ([ReactNode s], s, a)--- runStatefulReact react s = runIdentity $ runStatefulReact react s+getState :: Monad m => StatefulReactT s m s+getState = StatefulReactT $ \s -> return ([], s, s) -instance Monoid a => Monoid (StatefulReact s a) where+instance (Monad m, Monoid a) => Monoid (StatefulReactT s m a) where     mempty = StatefulReactT $ \s -> return ([], s, mempty)     mappend f1 f2 = StatefulReactT $ \s -> do         ~(c1, s1, a) <- runStatefulReactT f1 s