packages feed

react-haskell (empty) → 1.1.0.0

raw patch · 10 files changed

+1017/−0 lines, 10 filesdep +basedep +haste-libdep +monads-tfsetup-changed

Dependencies added: base, haste-lib, monads-tf, transformers

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Joel Burget++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lib/stubs.js view
@@ -0,0 +1,243 @@+// EventProperties+function js_bubbles(obj) {return obj.bubbles;}+function js_cancelable(obj) {return obj.cancelable;}+function js_currentTarget(obj) {return obj.currentTarget;}+function js_defaultPrevented(obj) {return obj.defaultPrevented;}+function js_eventPhase(obj) {return obj.eventPhase;}+function js_isTrusted(obj) {return obj.isTrusted;}+//                  -- ,  nativeEvent :: DOMEvent+//                  -- , preventDefault :: IO ()+//                  -- ,  stopPropagation :: IO ()+function js_evtTarget(obj) {return obj.evtTarget;}+//                  --, timeStamp :: DateTime++//ModifierKeys+function js_type(obj) {return obj.type;}+function js_altKey(obj) {return obj.altKey;}+function js_ctrlKey(obj) {return obj.ctrlKey;}+function js_metaKey(obj) {return obj.metaKey;}+function js_shiftKey(obj) {return obj.shiftKey;}++//MouseEvent+function js_button(obj) {return obj.button;}+function js_buttons(obj) {return obj.buttons;}+function js_clientX(obj) {return obj.clientX;}+function js_clientY(obj) {return obj.clientY;}+function js_pageX(obj) {return obj.pageX;}+function js_pageY(obj) {return obj.pageY;}+//--                             , relatedTarget :: Unpacked+function js_screenX(obj) {return obj.screenX;}+function js_screenY(obj) {return obj.screenY;}++// KeyboardEvent+function js_charCode(obj) {return obj.charCode;}+function js_key(obj) {return obj.key;}+function js_keyCode(obj) {return obj.keyCode;}+function js_locale(obj) {return obj.locale;}+function js_location(obj) {return obj.location;}+function js_repeat(obj) {return obj.repeat;}+function js_which(obj) {return obj.which;}++//ChangeEvent+function js_targetValue(obj) {return obj.target.value;}++//FocusEvent+function js_focusEventProperties(obj) {return obj.focusEventProperties;}+function js_domEventTarget(obj) {return obj.domEventTarget;}+function js_relatedTarget(obj) {return obj.relatedTarget;}++function js_empty_object() {return {};}+function js_set_field(obj, field, value) {obj[field] = value;}+function js_set_field_True(obj, field, value) {obj[field] = true;}+function js_set_field_False(obj, field, value) {obj[field] = false;}++function js_set_onClick(cb, attrs) {attrs.onClick = function(e) {B(A(cb,[[0,e],0]));};}+function js_set_onDoubleClick(cb, attrs) {attrs.onDoubleClick = function(e) {B(A(cb,[[0,e],0]));};}+function js_set_onChange(cb, attrs) {attrs.onChange = function(e) {B(A(cb,[[0,e],0]));};}+function js_set_onKeyUp(cb, attrs) {attrs.onKeyUp = function(e) {B(A(cb,[[0,e],0]));};}+function js_set_onKeyPress(cb, attrs) {attrs.onKeyPress = function(e) {B(A(cb,[[0,e],0]));};}+function js_set_onKeyDown(cb, attrs) {attrs.onKeyDown = function(e) { B(A(cb,[[0,e],0]));};}+function js_set_onBlur(cb, attrs) {attrs.onBlur = function(e) {B(A(cb,[[0,e],0]));};}+function js_set_onMouseEnter(cb, attrs) {attrs.onMouseEnter = function(e) {B(A(cb,[[0,e],0]));};}+function js_set_onMouseLeave(cb, attrs) {attrs.onMouseLeave = function(e) {B(A(cb,[[0,e],0]));};}++function js_React_DOM(tagName, attrs) {return React.DOM[tagName](attrs);}++function js_empty() {return [];}+function js_push(a,v) {a.push(v);}++// Ptr (Maybe React)+function js_React_getDomNode(r) {+  try {+    var ret = [1, [0, r.getDOMNode()]];+  } catch(e) {+    return [0];+  }+  return ret;+}++// Normal elements+function js_React_DOM_a(a,c) {return React.DOM.a(a,c);}+function js_React_DOM_abbr(a,c) {return React.DOM.abbr(a,c);}+function js_React_DOM_address(a,c) {return React.DOM.address(a,c);}+function js_React_DOM_article(a,c) {return React.DOM.article(a,c);}+function js_React_DOM_aside(a,c) {return React.DOM.aside(a,c);}+function js_React_DOM_audio(a,c) {return React.DOM.audio(a,c);}+function js_React_DOM_b(a,c) {return React.DOM.b(a,c);}+function js_React_DOM_bdi(a,c) {return React.DOM.bdi(a,c);}+function js_React_DOM_bdo(a,c) {return React.DOM.bdo(a,c);}+function js_React_DOM_big(a,c) {return React.DOM.big(a,c);}+function js_React_DOM_blockquote(a,c) {return React.DOM.blockquote(a,c);}+function js_React_DOM_body(a,c) {return React.DOM.body(a,c);}+function js_React_DOM_button(a,c) {return React.DOM.button(a,c);}+function js_React_DOM_canvas(a,c) {return React.DOM.canvas(a,c);}+function js_React_DOM_caption(a,c) {return React.DOM.caption(a,c);}+function js_React_DOM_cite(a,c) {return React.DOM.cite(a,c);}+function js_React_DOM_code(a,c) {return React.DOM.code(a,c);}+function js_React_DOM_colgroup(a,c) {return React.DOM.colgroup(a,c);}+function js_React_DOM_data(a,c) {return React.DOM.data(a,c);}+function js_React_DOM_datalist(a,c) {return React.DOM.datalist(a,c);}+function js_React_DOM_dd(a,c) {return React.DOM.dd(a,c);}+function js_React_DOM_del(a,c) {return React.DOM.del(a,c);}+function js_React_DOM_details(a,c) {return React.DOM.details(a,c);}+function js_React_DOM_dfn(a,c) {return React.DOM.dfn(a,c);}+function js_React_DOM_div(a,c) {return React.DOM.div(a,c);}+function js_React_DOM_dl(a,c) {return React.DOM.dl(a,c);}+function js_React_DOM_dt(a,c) {return React.DOM.dt(a,c);}+function js_React_DOM_em(a,c) {return React.DOM.em(a,c);}+function js_React_DOM_fieldset(a,c) {return React.DOM.fieldset(a,c);}+function js_React_DOM_figcaption(a,c) {return React.DOM.figcaption(a,c);}+function js_React_DOM_figure(a,c) {return React.DOM.figure(a,c);}+function js_React_DOM_footer(a,c) {return React.DOM.footer(a,c);}+function js_React_DOM_form(a,c) {return React.DOM.form(a,c);}+function js_React_DOM_h1(a,c) {return React.DOM.h1(a,c);}+function js_React_DOM_h2(a,c) {return React.DOM.h2(a,c);}+function js_React_DOM_h3(a,c) {return React.DOM.h3(a,c);}+function js_React_DOM_h4(a,c) {return React.DOM.h4(a,c);}+function js_React_DOM_h5(a,c) {return React.DOM.h5(a,c);}+function js_React_DOM_h6(a,c) {return React.DOM.h6(a,c);}+function js_React_DOM_head(a,c) {return React.DOM.head(a,c);}+function js_React_DOM_header(a,c) {return React.DOM.header(a,c);}+function js_React_DOM_html(a,c) {return React.DOM.html(a,c);}+function js_React_DOM_i(a,c) {return React.DOM.i(a,c);}+function js_React_DOM_iframe(a,c) {return React.DOM.iframe(a,c);}+function js_React_DOM_ins(a,c) {return React.DOM.ins(a,c);}+function js_React_DOM_kbd(a,c) {return React.DOM.kbd(a,c);}+function js_React_DOM_label(a,c) {return React.DOM.label(a,c);}+function js_React_DOM_legend(a,c) {return React.DOM.legend(a,c);}+function js_React_DOM_li(a,c) {return React.DOM.li(a,c);}+function js_React_DOM_main(a,c) {return React.DOM.main(a,c);}+function js_React_DOM_map(a,c) {return React.DOM.map(a,c);}+function js_React_DOM_mark(a,c) {return React.DOM.mark(a,c);}+function js_React_DOM_menu(a,c) {return React.DOM.menu(a,c);}+function js_React_DOM_menuitem(a,c) {return React.DOM.menuitem(a,c);}+function js_React_DOM_meter(a,c) {return React.DOM.meter(a,c);}+function js_React_DOM_nav(a,c) {return React.DOM.nav(a,c);}+function js_React_DOM_noscript(a,c) {return React.DOM.noscript(a,c);}+function js_React_DOM_object(a,c) {return React.DOM.object(a,c);}+function js_React_DOM_ol(a,c) {return React.DOM.ol(a,c);}+function js_React_DOM_optgroup(a,c) {return React.DOM.optgroup(a,c);}+function js_React_DOM_option(a,c) {return React.DOM.option(a,c);}+function js_React_DOM_output(a,c) {return React.DOM.output(a,c);}+function js_React_DOM_p(a,c) {return React.DOM.p(a,c);}+function js_React_DOM_pre(a,c) {return React.DOM.pre(a,c);}+function js_React_DOM_progress(a,c) {return React.DOM.progress(a,c);}+function js_React_DOM_q(a,c) {return React.DOM.q(a,c);}+function js_React_DOM_rp(a,c) {return React.DOM.rp(a,c);}+function js_React_DOM_rt(a,c) {return React.DOM.rt(a,c);}+function js_React_DOM_ruby(a,c) {return React.DOM.ruby(a,c);}+function js_React_DOM_s(a,c) {return React.DOM.s(a,c);}+function js_React_DOM_samp(a,c) {return React.DOM.samp(a,c);}+function js_React_DOM_section(a,c) {return React.DOM.section(a,c);}+function js_React_DOM_select(a,c) {return React.DOM.select(a,c);}+function js_React_DOM_small(a,c) {return React.DOM.small(a,c);}+function js_React_DOM_span(a,c) {return React.DOM.span(a,c);}+function js_React_DOM_strong(a,c) {return React.DOM.strong(a,c);}+function js_React_DOM_sub(a,c) {return React.DOM.sub(a,c);}+function js_React_DOM_summary(a,c) {return React.DOM.summary(a,c);}+function js_React_DOM_sup(a,c) {return React.DOM.sup(a,c);}+function js_React_DOM_table(a,c) {return React.DOM.table(a,c);}+function js_React_DOM_tbody(a,c) {return React.DOM.tbody(a,c);}+function js_React_DOM_td(a,c) {return React.DOM.td(a,c);}+function js_React_DOM_tfoot(a,c) {return React.DOM.tfoot(a,c);}+function js_React_DOM_th(a,c) {return React.DOM.th(a,c);}+function js_React_DOM_thead(a,c) {return React.DOM.thead(a,c);}+function js_React_DOM_time(a,c) {return React.DOM.time(a,c);}+function js_React_DOM_tr(a,c) {return React.DOM.tr(a,c);}+function js_React_DOM_u(a,c) {return React.DOM.u(a,c);}+function js_React_DOM_ul(a,c) {return React.DOM.ul(a,c);}+function js_React_DOM_var(a,c) {return React.DOM.var(a,c);}+function js_React_DOM_video(a,c) {return React.DOM.video(a,c);}++// No-child+function js_React_DOM_area(a) {return React.DOM.area(a);}+function js_React_DOM_base(a) {return React.DOM.base(a);}+function js_React_DOM_br(a) {return React.DOM.br(a);}+function js_React_DOM_col(a) {return React.DOM.col(a);}+function js_React_DOM_embed(a) {return React.DOM.embed(a);}+function js_React_DOM_hr(a) {return React.DOM.hr(a);}+function js_React_DOM_img(a) {return React.DOM.img(a);}+function js_React_DOM_input(a) {return React.DOM.input(a);}+function js_React_DOM_keygen(a) {return React.DOM.keygen(a);}+function js_React_DOM_link(a) {return React.DOM.link(a);}+function js_React_DOM_meta(a) {return React.DOM.meta(a);}+function js_React_DOM_param(a) {return React.DOM.param(a);}+function js_React_DOM_source(a) {return React.DOM.source(a);}+function js_React_DOM_track(a) {return React.DOM.track(a);}+function js_React_DOM_wbr(a) {return React.DOM.wbr(a);}++// text-only+function js_React_DOM_script(a,t) {return React.DOM.script(a,t);}+function js_React_DOM_style(a,t) {return React.DOM.style(a,t);}+function js_React_DOM_textarea(a,t) {return React.DOM.textarea(a,t);}+function js_React_DOM_title(a,t) {return React.DOM.title(a,t);}+function js_id(a) {return a;}++// custom+function js_React_DOM_leaf(name, a) { return React.DOM[name](a); }+function js_React_DOM_parent(name, a, c) { return React.DOM[name](a, c); }++function js_parseChangeEvent(raw) {+    // wrap the string in two constructors - Ptr and JSString+    return [0, raw.target.value];+}++function js_parseKeyboardEvent(raw) {+    return [+        0,+        [+            0,+            raw.altKey,+            raw.ctrlKey,+            raw.metaKey,+            raw.shiftKey,+        ],+        raw.charCode,+        raw.key,+        raw.keyCode,+        raw.locale,+        raw.location,+        raw.repeat,+        raw.which,+    ];+}++function js_parseMouseEvent(raw) {+    return [+        0,+        [+            0,+            raw.altKey,+            raw.ctrlKey,+            raw.metaKey,+            raw.shiftKey,+        ],+        raw.button,+        raw.clientX,+        raw.clientY,+        raw.pageX,+        raw.pageY,+        raw.screenX,+        raw.screenY,+    ];+}
+ react-haskell.cabal view
@@ -0,0 +1,57 @@+name:                react-haskell+version:             1.1.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>.+  .+  React is a JavaScript library for building user interfaces. React (and React-Haskell) is focused on just UI - it's not a framework.+  .+  Currently React-Haskell can render simple stateful components, but not what React calls classes. Put another way, React-Haskell doesn't support lifecycle methods yet.+  .+  Here's a simple example which demonstrates basic elements, attributes, state, and handling events.+  .+  > statefulView :: StatefulReact JSString ()+  > statefulView = div_ <! class_ "container" $ do+  >     str <- getState+  >     input_ <! value_ str+  >            <! onChange (\_ evt -> toJSStr $ map toUpper $ fromJSStr $ targetValue evt)+license:             MIT+license-file:        LICENSE+author:              Joel Burget+maintainer:          joelburget@gmail.com+category:            Web+build-type:          Simple+cabal-version:       >=1.10++homepage: https://github.com/joelburget/react-haskell+bug-reports: https://github.com/joelburget/react-haskell/issues++data-dir: lib+data-files: stubs.js++source-repository head+  type: git+  location: https://github.com/joelburget/react-haskell.git++library+  exposed-modules: React+  other-modules:+    React.Attrs,+    React.Elements,+    React.Events,+    React.Imports,+    React.Types+  other-extensions:+    FlexibleInstances,+    FlexibleContexts,+    ForeignFunctionInterface,+    GeneralizedNewtypeDeriving,+    MultiParamTypeClasses,+    OverloadedStrings+  build-depends:+    base == 4.7.*,+    transformers,+    haste-lib >= 0.4 && <0.5,+    monads-tf+  hs-source-dirs:      src+  default-language:    Haskell2010
+ src/React.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances, LambdaCase,+  MultiParamTypeClasses, FlexibleContexts #-}++module React+    ( module X+    , getDomNode+    , render+    ) 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++import Haste hiding (fromString)+import Haste.Foreign+import Haste.JSON+import Haste.Prim++import Prelude hiding (div)++import React.Attrs as X+import React.Elements as X+import React.Events as X+import React.Imports+import React.Types as X++-- TODO+-- * 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+        -> [(RawEvent -> IO (), EvtType)]+        -> [ForeignNode]+        -> IO ForeignNode+element constructor name attrs handlers content = do+    attr <- js_empty_object+    mapM_ (setField attr) attrs+    mapM_ (makeHandler attr) handlers++    children <- js_ReactArray_empty+    mapM_ (js_ReactArray_push children) content+    constructor name attr children++makeHandler :: RawAttrs -> (RawEvent -> IO (), EvtType) -> IO ()+makeHandler obj (handle, ChangeEvt) = js_set_onChange (toPtr handle) obj+makeHandler obj (handle, KeyDownEvt) = js_set_onKeyDown (toPtr handle) obj+makeHandler obj (handle, KeyPressEvt) = js_set_onKeyPress (toPtr handle) obj+makeHandler obj (handle, KeyUpEvt) = js_set_onKeyUp (toPtr handle) obj+makeHandler obj (handle, ClickEvt) = js_set_onClick (toPtr handle) obj+makeHandler obj (handle, DoubleClickEvt) = js_set_onDoubleClick (toPtr handle) obj+makeHandler obj (handle, MouseEnterEvt) = js_set_onMouseEnter (toPtr handle) obj+makeHandler obj (handle, MouseLeaveEvt) = js_set_onMouseLeave (toPtr handle) obj++voidElement :: (JSString -> RawAttrs -> IO ForeignNode)+            -> JSString+            -> Attrs+            -> [(RawEvent -> IO (), EvtType)]+            -> IO ForeignNode+voidElement constructor name attrs handlers =+    element (\n a c -> constructor n a) name attrs handlers []++setField :: RawAttrs -> (JSString, JSON) -> IO ()+setField attr (fld, Str v) = js_set_field_String attr fld v+setField attr (fld, Dict vs) = do+    subObj <- js_empty_object+    mapM_ (setField subObj) vs+    js_set_field_Obj attr fld subObj+setField attr (fld, Num v) = js_set_field_Double attr fld v+setField attr (fld, Bool True) = js_set_field_True attr fld+setField attr (fld, Bool False) = js_set_field_False attr fld++-- TODO this seems wrong+setField attr (fld, Null) = return ()++getDomNode :: ForeignNode -> IO (Maybe Elem)+getDomNode r = fmap fromPtr (js_React_getDomNode r)++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);})")
+ src/React/Attrs.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+module React.Attrs where++import Haste.JSON+import Haste.Prim++-- class ReactAttr a where++type Attr = (JSString, JSON)++mkAttr :: JSString -> (a -> JSON) -> a -> Attr+mkAttr name f a = (name, f a)++-- exception+className :: JSString -> Attr+className = mkAttr "className" Str++class_ :: JSString -> Attr+class_ = mkAttr "className" Str++href_ :: JSString -> Attr+href_ = mkAttr "href" Str++id_ :: JSString -> Attr+id_ = mkAttr "id" Str++src_ :: JSString -> Attr+src_ = mkAttr "src" Str++style_ :: JSON -> Attr+style_ = mkAttr "style" id++value_ :: JSString -> Attr+value_ = mkAttr "value" Str++placeholder_ :: JSString -> Attr+placeholder_ = mkAttr "placeholder" Str++for_ :: JSString -> Attr+for_ = mkAttr "htmlFor" Str++type_ :: JSString -> Attr+type_ = mkAttr "type" Str++checked_ :: Bool -> Attr+checked_ = mkAttr "checked" Bool++-- TODO think about supporting autoFocus / other camel-cased react names+autofocus_ :: Bool -> Attr+autofocus_ = mkAttr "autoFocus" Bool
+ src/React/Elements.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE OverloadedStrings #-}+module React.Elements where++import Haste.Prim++import React.Types++import Prelude hiding (div, span)++makeParent :: Monad m+           => JSString+           -> StatefulReactT s m a+           -> StatefulReactT s m ()+makeParent name children = StatefulReactT $ \s -> do+    ~(childNodes, s', _) <- runStatefulReactT children s+    return ([Parent name [] [] childNodes], s', ())++makeLeaf :: Monad m+         => JSString+         -> StatefulReactT s m ()+makeLeaf name = StatefulReactT $ \s -> return ([Leaf name [] []], s, ())++text_ :: JSString -> StatefulReact s ()+text_ str = StatefulReactT $ \s -> return ([Text (fromJSStr str)], s, ())++a_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+a_ = makeParent "a"+abbr_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+abbr_ = makeParent "abbr"+address_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+address_ = makeParent "address"+article_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+article_ = makeParent "article"+aside_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+aside_ = makeParent "aside"+audio_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+audio_ = makeParent "audio"+b_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+b_ = makeParent "b"+bdi_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+bdi_ = makeParent "bdi"+bdo_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+bdo_ = makeParent "bdo"+big_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+big_ = makeParent "big"+blockquote_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+blockquote_ = makeParent "blockquote"+body_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+body_ = makeParent "body"+button_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+button_ = makeParent "button"+canvas_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+canvas_ = makeParent "canvas"+caption_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+caption_ = makeParent "caption"+cite_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+cite_ = makeParent "cite"+code_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+code_ = makeParent "code"+colgroup_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+colgroup_ = makeParent "colgroup"+data_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+data_ = makeParent "data"+datalist_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+datalist_ = makeParent "datalist"+dd_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+dd_ = makeParent "dd"+del_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+del_ = makeParent "del"+details_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+details_ = makeParent "details"+dfn_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+dfn_ = makeParent "dfn"+div_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+div_ = makeParent "div"+dl_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+dl_ = makeParent "dl"+dt_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+dt_ = makeParent "dt"+em_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+em_ = makeParent "em"+fieldset_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+fieldset_ = makeParent "fieldset"+figcaption_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+figcaption_ = makeParent "figcaption"+figure_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+figure_ = makeParent "figure"+footer_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+footer_ = makeParent "footer"+form_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+form_ = makeParent "form"+h1_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+h1_ = makeParent "h1"+h2_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+h2_ = makeParent "h2"+h3_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+h3_ = makeParent "h3"+h4_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+h4_ = makeParent "h4"+h5_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+h5_ = makeParent "h5"+h6_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+h6_ = makeParent "h6"+head_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+head_ = makeParent "head"+header_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+header_ = makeParent "header"+html_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+html_ = makeParent "html"+i_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+i_ = makeParent "i"+iframe_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+iframe_ = makeParent "iframe"+ins_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+ins_ = makeParent "ins"+kbd_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+kbd_ = makeParent "kbd"+label_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+label_ = makeParent "label"+legend_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+legend_ = makeParent "legend"+li_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+li_ = makeParent "li"+main_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+main_ = makeParent "main"+map_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+map_ = makeParent "map"+mark_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+mark_ = makeParent "mark"+menu_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+menu_ = makeParent "menu"+menuitem_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+menuitem_ = makeParent "menuitem"+meter_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+meter_ = makeParent "meter"+nav_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+nav_ = makeParent "nav"+noscript_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+noscript_ = makeParent "noscript"+object_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+object_ = makeParent "object"+ol_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+ol_ = makeParent "ol"+optgroup_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+optgroup_ = makeParent "optgroup"+option_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+option_ = makeParent "option"+output_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+output_ = makeParent "output"+p_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+p_ = makeParent "p"+pre_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+pre_ = makeParent "pre"+progress_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+progress_ = makeParent "progress"+q_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+q_ = makeParent "q"+rp_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+rp_ = makeParent "rp"+rt_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+rt_ = makeParent "rt"+ruby_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+ruby_ = makeParent "ruby"+s_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+s_ = makeParent "s"+samp_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+samp_ = makeParent "samp"+section_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+section_ = makeParent "section"+select_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+select_ = makeParent "select"+small_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+small_ = makeParent "small"+span_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+span_ = makeParent "span"+strong_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+strong_ = makeParent "strong"+sub_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+sub_ = makeParent "sub"+summary_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+summary_ = makeParent "summary"+sup_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+sup_ = makeParent "sup"+table_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+table_ = makeParent "table"+tbody_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+tbody_ = makeParent "tbody"+td_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+td_ = makeParent "td"+tfoot_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+tfoot_ = makeParent "tfoot"+th_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+th_ = makeParent "th"+thead_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+thead_ = makeParent "thead"+time_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+time_ = makeParent "time"+tr_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+tr_ = makeParent "tr"+u_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+u_ = makeParent "u"+ul_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+ul_ = makeParent "ul"+var_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+var_ = makeParent "var"+video_ :: Monad m => StatefulReactT s m a -> StatefulReactT s m ()+video_ = makeParent "video"++area_ :: Monad m => StatefulReactT s m ()+area_ = makeLeaf "area"+base_ :: Monad m => StatefulReactT s m ()+base_ = makeLeaf "base"+br_ :: Monad m => StatefulReactT s m ()+br_ = makeLeaf "br"+col_ :: Monad m => StatefulReactT s m ()+col_ = makeLeaf "col"+embed_ :: Monad m => StatefulReactT s m ()+embed_ = makeLeaf "embed"+hr_ :: Monad m => StatefulReactT s m ()+hr_ = makeLeaf "hr"+img_ :: Monad m => StatefulReactT s m ()+img_ = makeLeaf "img"+input_ :: Monad m => StatefulReactT s m ()+input_ = makeLeaf "input"+keygen_ :: Monad m => StatefulReactT s m ()+keygen_ = makeLeaf "keygen"+link_ :: Monad m => StatefulReactT s m ()+link_ = makeLeaf "link"+meta_ :: Monad m => StatefulReactT s m ()+meta_ = makeLeaf "meta"+param_ :: Monad m => StatefulReactT s m ()+param_ = makeLeaf "param"+source_ :: Monad m => StatefulReactT s m ()+source_ = makeLeaf "source"+track_ :: Monad m => StatefulReactT s m ()+track_ = makeLeaf "track"+wbr_ :: Monad m => StatefulReactT s m ()+wbr_ = makeLeaf "wbr"++-- script :: RawAttrs -> JSString -> IO ForeignNode+-- style :: RawAttrs -> JSString -> IO ForeignNode+-- textarea :: RawAttrs -> JSString -> IO ForeignNode+-- title :: RawAttrs -> JSString -> IO ForeignNode
+ src/React/Events.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+module React.Events where++import Haste+import Haste.Prim++import React.Imports+import React.Types++onChange :: (s -> ChangeEvent -> s) -> StatefulEventHandler s+onChange handler = StatefulEventHandler+    (\s evt -> handler s (fromPtr (js_parseChangeEvent evt)))+    ChangeEvt++onKeyDown :: (s -> KeyboardEvent -> s) -> StatefulEventHandler s+onKeyDown handler = StatefulEventHandler+    (\s evt -> handler s (fromPtr (js_parseKeyboardEvent evt)))+    KeyDownEvt++onKeyPress :: (s -> KeyboardEvent -> s) -> StatefulEventHandler s+onKeyPress handler = StatefulEventHandler+    (\s evt -> handler s (fromPtr (js_parseKeyboardEvent evt)))+    KeyPressEvt++onKeyUp :: (s -> KeyboardEvent -> s) -> StatefulEventHandler s+onKeyUp handler = StatefulEventHandler+    (\s evt -> handler s (fromPtr (js_parseKeyboardEvent evt)))+    KeyUpEvt++onMouseEnter :: (s -> MouseEvent -> s) -> StatefulEventHandler s+onMouseEnter handler = StatefulEventHandler+    (\s evt -> handler s (fromPtr (js_parseMouseEvent evt)))+    MouseEnterEvt++onMouseLeave :: (s -> MouseEvent -> s) -> StatefulEventHandler s+onMouseLeave handler = StatefulEventHandler+    (\s evt -> handler s (fromPtr (js_parseMouseEvent evt)))+    MouseLeaveEvt++onDoubleClick :: (s -> MouseEvent -> s) -> StatefulEventHandler s+onDoubleClick handler = StatefulEventHandler+    (\s evt -> handler s (fromPtr (js_parseMouseEvent evt)))+    DoubleClickEvt++onClick :: (s -> MouseEvent -> s) -> StatefulEventHandler s+onClick handler = StatefulEventHandler+    (\s evt -> handler s (fromPtr (js_parseMouseEvent evt)))+    ClickEvt++onEnter :: (s -> s) -> StatefulEventHandler s+onEnter f = onKeyPress handler where+    handler s KeyboardEvent{key="Enter"} = f s+    handler s _ = s
+ src/React/Imports.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module React.Imports where++import React.Types++import Haste+import Haste.Foreign+import Haste.JSON+import Haste.Prim++foreign import ccall js_React_DOM_leaf :: JSString -> RawAttrs -> IO ForeignNode+foreign import ccall js_React_DOM_parent :: JSString -> RawAttrs -> ReactArray -> IO ForeignNode++foreign import ccall js_empty_object :: IO RawAttrs+foreign import ccall "js_set_field" js_set_field_String :: RawAttrs -> JSString -> JSString -> IO ()+foreign import ccall "js_set_field" js_set_field_Double :: RawAttrs -> JSString -> Double -> IO ()+foreign import ccall "js_set_field" js_set_field_Int :: RawAttrs -> JSString -> Int -> IO ()+foreign import ccall "js_set_field" js_set_field_Obj :: RawAttrs -> JSString -> RawAttrs -> IO ()+foreign import ccall js_set_field_True :: RawAttrs -> JSString -> IO ()+foreign import ccall js_set_field_False :: RawAttrs -> JSString -> IO ()+foreign import ccall js_targetValue :: RawEvent -> JSString++foreign import ccall js_set_onClick       :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+foreign import ccall js_set_onDoubleClick :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+foreign import ccall js_set_onChange      :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+foreign import ccall js_set_onKeyUp       :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+foreign import ccall js_set_onKeyPress    :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+foreign import ccall js_set_onKeyDown     :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+foreign import ccall js_set_onBlur        :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+foreign import ccall js_set_onMouseEnter :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+foreign import ccall js_set_onMouseLeave :: Ptr (RawEvent -> IO ()) -> RawAttrs -> IO ()+foreign import ccall js_React_getDomNode :: ForeignNode -> IO (Ptr (Maybe Elem))++foreign import ccall "js_empty" js_ReactArray_empty :: IO ReactArray+foreign import ccall "js_push" js_ReactArray_push :: ReactArray -> ForeignNode -> IO ()++foreign import ccall "js_id" js_React_DOM_text :: JSString -> IO ForeignNode++foreign import ccall js_parseChangeEvent :: RawEvent -> Ptr ChangeEvent+foreign import ccall js_parseKeyboardEvent :: RawEvent -> Ptr KeyboardEvent+foreign import ccall js_parseMouseEvent :: RawEvent -> Ptr MouseEvent
+ src/React/Types.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses,+    FlexibleInstances, FlexibleContexts, GADTs #-}+module React.Types where++import Control.Applicative+import Control.Monad+import Data.Functor.Identity+import Data.Monoid+import Data.String++import Haste+import Haste.Foreign+import Haste.JSON+import Haste.Prim++newtype ForeignNode = ForeignNode JSAny deriving (Pack, Unpack)+newtype RawAttrs = RawAttrs JSAny  deriving (Pack, Unpack)+newtype ReactArray = ReactArray JSAny deriving (Pack, Unpack)++data EvtType+    = ChangeEvt+    | KeyDownEvt+    | KeyPressEvt+    | KeyUpEvt+    | ClickEvt+    | DoubleClickEvt+    | MouseEnterEvt+    | MouseLeaveEvt++data StatefulEventHandler s = StatefulEventHandler+    { handler :: s -> RawEvent -> s+    , evtType :: EvtType+    }++newtype RawEvent = RawEvent JSAny deriving (Pack, Unpack)++type Attrs = [(JSString, JSON)]++data ReactNode s = Parent JSString Attrs [StatefulEventHandler s] [ReactNode s]+                 | Leaf JSString Attrs [StatefulEventHandler s]+                 -- | 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?+++getState :: StatefulReact s s+getState = StatefulReactT $ \s -> return ([], s, s)++newtype StatefulReactT s m a = StatefulReactT+    { runStatefulReactT :: s -> m ([ReactNode s], s, a) }++type StatefulReact s = StatefulReactT s Identity++-- runStatefulReact :: StatefulReactT s a -> s -> ([ReactNode s], s, a)+-- runStatefulReact react s = runIdentity $ runStatefulReact react s++instance Monoid a => Monoid (StatefulReact s a) where+    mempty = StatefulReactT $ \s -> return ([], s, mempty)+    mappend f1 f2 = StatefulReactT $ \s -> do+        ~(c1, s1, a) <- runStatefulReactT f1 s+        ~(c2, s2, b) <- runStatefulReactT f2 s1+        return (c1 <> c2, s2, a <> b)++instance Monad m => Functor (StatefulReactT s m) where+    fmap = liftM++instance Monad m => Applicative (StatefulReactT s m) where+    pure = return+    (<*>) = ap++instance (Monad m, a ~ ()) => IsString (StatefulReactT s m a) where+    fromString str = StatefulReactT $ \s -> return ([Text str], s, ())++instance Monad m => Monad (StatefulReactT s m) where+    return a = StatefulReactT $ \s -> return ([], s, a)+    m >>= f = StatefulReactT $ \s -> do+        ~(c1, s1, a) <- runStatefulReactT m s+        ~(c2, s2, b) <- runStatefulReactT (f a) s1+        return (c1 <> c2, s2, b)++-- TODO thinking there should be some notion of single / multiple?+-- We should only ever apply an attribute / handler to one element here.+--+-- div <! attr $ ...+--+-- vs+--+-- (div >> div) <! attr+--+-- in fact, I think we should only ever apply attrs to+-- `React -> React`+--+-- except things with no children?+--+-- input <! attr++instance Monad m => Attributable (StatefulReactT s m a) (JSString, JSON) where+    react <! attr = StatefulReactT $ \s -> do+        ~(children, s', a) <- runStatefulReactT react s+        return (children <!> attr, s', a)++instance Monad m =>+         Attributable (StatefulReactT s m a) (StatefulEventHandler s) where+    react <! attr = StatefulReactT $ \s -> do+        ~(children, s', a) <- runStatefulReactT react s+        return (children <!< attr, s', a)++instance Attributable (StatefulReactT s m a) x =>+         Attributable (StatefulReactT s m a -> StatefulReactT s m a) x where+    f <! attr = (<! attr) . f++class Attributable h a where+    (<!) :: h -> a -> h++(<!?) :: Attributable h a => h -> (Bool, a) -> h+h <!? (True, a) = h <! a+h <!? (False, _) = h++(<!>) :: [ReactNode s] -> (JSString, JSON) -> [ReactNode s]+[elem] <!> attr = [go elem] where+    go (Parent name as hs cs) = Parent name (attr:as) hs cs+    go (Leaf name as hs)      = Leaf name (attr:as) hs+    go (Text str)             = Text str+_ <!> _ = error "attr applied to multiple elems!"++(<!<) :: [ReactNode s] -> StatefulEventHandler s -> [ReactNode s]+[elem] <!< hndl = [go elem] where+    go (Parent name as hs cs) = Parent name as (hndl:hs) cs+    go (Leaf name as hs)      = Leaf name as (hndl:hs)+    go (Text str)             = Text str+_ <!< _ = error "handler applied to multiple elems!"++data EventProperties e =+  EventProperties { bubbles :: !Bool+                  , cancelable :: !Bool+                  , currentTarget :: !e -- NativeElem+                  , defaultPrevented :: !Bool+                  , eventPhase :: !Int+                  , isTrusted :: !Bool+                    -- ,  nativeEvent :: DOMEvent+                    -- , preventDefault :: IO ()+                    -- ,  stopPropagation :: IO ()+                  , evtTarget :: !e -- NativeElem+                    --, timeStamp :: Date+                  , eventType :: !JSString -- type+                  }++data ModifierKeys =+  ModifierKeys { altKey :: !Bool+               , ctrlKey :: !Bool+               , metaKey :: !Bool+               , shiftKey :: !Bool+               } deriving (Eq, Show)++data MouseEvent =+  MouseEvent { -- mouseEventProperties :: !(EventProperties e)+               mouseModifierKeys :: !ModifierKeys+             , buttonNum :: !Int -- "button"+               -- , buttons :: Int+             , clientX :: !Double+             , clientY :: !Double+             , pageX :: !Double+             , pageY :: !Double+               -- , relatedTarget :: Unpacked+             , screenX :: !Double+             , screenY :: !Double+             } deriving Show++data KeyboardEvent =+  KeyboardEvent { -- keyboardEventProperties :: ! (EventProperties e)+                  keyboardModifierKeys :: !ModifierKeys+                , charCode :: !Int+                , key :: !JSString+                , keyCode :: !Int+                , locale :: !JSString+                , location :: !Int+                , repeat :: !Bool+                , which :: !Int+                } deriving Show++newtype ChangeEvent = ChangeEvent { targetValue :: JSString }++data FocusEvent e =+  FocusEvent { -- focusEventProperties :: ! (EventProperties e)+               domEventTarget :: !e -- NativeElem+             , relatedTarget :: !e -- NativeElem+             }