Commit 28e65139 authored by James Laver's avatar James Laver

v0.4.0

parent 8df9707e
...@@ -100,6 +100,30 @@ Breaking: ...@@ -100,6 +100,30 @@ Breaking:
* `useEffect`, `useLayoutEffect` and their numbered variants no longer * `useEffect`, `useLayoutEffect` and their numbered variants no longer
take a redundant dummy unit value to delay computation. take a redundant dummy unit value to delay computation.
New:
* 'Magic' DOM Props. Each takes a record of props which will be transformed
* `aria` - prop names will be prefixed with `aria-`
* `data` - prop names will be prefixed with `data-`
* `on` - prop names will be prefixed with `on`, values will be `mkEffectFn1`'d
Example:
```purescript
import Reactix as R
import Reactix.DOM.HTML (div, text)
import DOM.Simple.Console (log)
ex :: R.Element
ex =
div
{ aria: {label: "example"}
, data: {thing: Just 1}
, on: {click: \_ -> log "Hello World"}
}
[ text "Hello World" ]
```
### 0.3.1 ### 0.3.1
Bug Fixes: Bug Fixes:
......
module Reactix.DOM.HTML where module Reactix.DOM.HTML where
import Prelude ((<<<), ($), (<>), map, identity)
import Data.Maybe (maybe)
import Data.Foldable (foldl)
import Data.String (toUpper)
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple.Objects ((.?), (.=), (!-), (..), keys)
import Reactix.React (Element, createDOMElement) import Reactix.React (Element, createDOMElement)
import Reactix.Utils (ucFirst)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
createLeafElement :: forall props. String -> Record props -> Element createDOM :: forall props. String -> Record props -> Array Element -> Element
createLeafElement e p = createDOMElement e p [] createDOM e p = createDOMElement e (magicProps p)
magicProps :: forall props. props -> props
magicProps = xformAriaProps <<< xformDataProps <<< xformEventProps
where
xformAriaProps = magicPrefixProp "aria" "aria-"
xformDataProps = magicPrefixProp "data" "data-"
magicPrefixProp :: forall props. String -> String -> props -> props
magicPrefixProp prop pre props = maybe props help (props .? prop)
where help val = prefixCopyAll pre props val !- prop
xformEventProps :: forall props. props -> props
xformEventProps props = maybe props help (props .? "on")
where
help = mapCopyAll eventPropName mkEffectFn1 props
eventPropName other = "on" <> ucFirst other
prefixCopyAll :: forall p q. String -> p -> q -> p
prefixCopyAll pre = mapCopyAll (pre <> _) identity
mapCopyAll :: forall a b p q. (String -> String) -> (a -> b) -> p -> q -> p
mapCopyAll xf yf dest src = foldl f dest (keys src)
where f dest k = (dest .= xf k) (yf $ src .. k)
createLeafDOM :: forall props. String -> Record props -> Element
createLeafDOM e p = createDOM e p []
-- A factory function for a DOM element with no children -- A factory function for a DOM element with no children
type LeafFactory = forall props. Record props -> Element type LeafFactory = forall props. Record props -> Element
...@@ -32,298 +65,298 @@ text :: String -> Element ...@@ -32,298 +65,298 @@ text :: String -> Element
text = unsafeCoerce text = unsafeCoerce
a :: ElemFactory a :: ElemFactory
a = createDOMElement "a" a = createDOM "a"
abbr :: ElemFactory abbr :: ElemFactory
abbr = createDOMElement "abbr" abbr = createDOM "abbr"
address :: ElemFactory address :: ElemFactory
address = createDOMElement "address" address = createDOM "address"
article :: ElemFactory article :: ElemFactory
article = createDOMElement "article" article = createDOM "article"
aside :: ElemFactory aside :: ElemFactory
aside = createDOMElement "aside" aside = createDOM "aside"
audio :: ElemFactory audio :: ElemFactory
audio = createDOMElement "audio" audio = createDOM "audio"
b :: ElemFactory b :: ElemFactory
b = createDOMElement "b" b = createDOM "b"
bdi :: ElemFactory bdi :: ElemFactory
bdi = createDOMElement "bdi" bdi = createDOM "bdi"
bdo :: ElemFactory bdo :: ElemFactory
bdo = createDOMElement "bdo" bdo = createDOM "bdo"
blockquote :: ElemFactory blockquote :: ElemFactory
blockquote = createDOMElement "blockquote" blockquote = createDOM "blockquote"
br :: LeafFactory br :: LeafFactory
br = createLeafElement "br" br = createLeafDOM "br"
button :: ElemFactory button :: ElemFactory
button = createDOMElement "button" button = createDOM "button"
canvas :: ElemFactory canvas :: ElemFactory
canvas = createDOMElement "canvas" canvas = createDOM "canvas"
caption :: ElemFactory caption :: ElemFactory
caption = createDOMElement "caption" caption = createDOM "caption"
cite :: ElemFactory cite :: ElemFactory
cite = createDOMElement "cite" cite = createDOM "cite"
code :: ElemFactory code :: ElemFactory
code = createDOMElement "code" code = createDOM "code"
col :: LeafFactory col :: LeafFactory
col = createLeafElement "col" col = createLeafDOM "col"
colgroup :: ElemFactory colgroup :: ElemFactory
colgroup = createDOMElement "colgroup" colgroup = createDOM "colgroup"
data' :: ElemFactory data' :: ElemFactory
data' = createDOMElement "data" data' = createDOM "data"
datalist :: ElemFactory datalist :: ElemFactory
datalist = createDOMElement "datalist" datalist = createDOM "datalist"
dd :: ElemFactory dd :: ElemFactory
dd = createDOMElement "dd" dd = createDOM "dd"
del :: ElemFactory del :: ElemFactory
del = createDOMElement "del" del = createDOM "del"
details :: ElemFactory details :: ElemFactory
details = createDOMElement "details" details = createDOM "details"
dfn :: ElemFactory dfn :: ElemFactory
dfn = createDOMElement "dfn" dfn = createDOM "dfn"
dialog :: ElemFactory dialog :: ElemFactory
dialog = createDOMElement "dialog" dialog = createDOM "dialog"
div :: ElemFactory div :: ElemFactory
div = createDOMElement "div" div = createDOM "div"
dl :: ElemFactory dl :: ElemFactory
dl = createDOMElement "dl" dl = createDOM "dl"
dt :: ElemFactory dt :: ElemFactory
dt = createDOMElement "dt" dt = createDOM "dt"
em :: ElemFactory em :: ElemFactory
em = createDOMElement "em" em = createDOM "em"
embed :: LeafFactory embed :: LeafFactory
embed = createLeafElement "embed" embed = createLeafDOM "embed"
fieldset :: ElemFactory fieldset :: ElemFactory
fieldset = createDOMElement "fieldset" fieldset = createDOM "fieldset"
figcaption :: ElemFactory figcaption :: ElemFactory
figcaption = createDOMElement "figcaption" figcaption = createDOM "figcaption"
figure :: ElemFactory figure :: ElemFactory
figure = createDOMElement "figure" figure = createDOM "figure"
footer :: ElemFactory footer :: ElemFactory
footer = createDOMElement "footer" footer = createDOM "footer"
form :: ElemFactory form :: ElemFactory
form = createDOMElement "form" form = createDOM "form"
h1 :: ElemFactory h1 :: ElemFactory
h1 = createDOMElement "h1" h1 = createDOM "h1"
h2 :: ElemFactory h2 :: ElemFactory
h2 = createDOMElement "h2" h2 = createDOM "h2"
h3 :: ElemFactory h3 :: ElemFactory
h3 = createDOMElement "h3" h3 = createDOM "h3"
h4 :: ElemFactory h4 :: ElemFactory
h4 = createDOMElement "h4" h4 = createDOM "h4"
h5 :: ElemFactory h5 :: ElemFactory
h5 = createDOMElement "h5" h5 = createDOM "h5"
h6 :: ElemFactory h6 :: ElemFactory
h6 = createDOMElement "h6" h6 = createDOM "h6"
header :: ElemFactory header :: ElemFactory
header = createDOMElement "header" header = createDOM "header"
hr :: LeafFactory hr :: LeafFactory
hr = createLeafElement "hr" hr = createLeafDOM "hr"
i :: ElemFactory i :: ElemFactory
i = createDOMElement "i" i = createDOM "i"
iframe :: ElemFactory iframe :: ElemFactory
iframe = createDOMElement "iframe" iframe = createDOM "iframe"
img :: LeafFactory img :: LeafFactory
img = createLeafElement "img" img = createLeafDOM "img"
input :: LeafFactory input :: LeafFactory
input = createLeafElement "input" input = createLeafDOM "input"
ins :: ElemFactory ins :: ElemFactory
ins = createDOMElement "ins" ins = createDOM "ins"
kbd :: ElemFactory kbd :: ElemFactory
kbd = createDOMElement "kbd" kbd = createDOM "kbd"
label :: ElemFactory label :: ElemFactory
label = createDOMElement "label" label = createDOM "label"
legend :: ElemFactory legend :: ElemFactory
legend = createDOMElement "legend" legend = createDOM "legend"
li :: ElemFactory li :: ElemFactory
li = createDOMElement "li" li = createDOM "li"
link :: LeafFactory link :: LeafFactory
link = createLeafElement "link" link = createLeafDOM "link"
main :: ElemFactory main :: ElemFactory
main = createDOMElement "main" main = createDOM "main"
mark :: ElemFactory mark :: ElemFactory
mark = createDOMElement "mark" mark = createDOM "mark"
meter :: ElemFactory meter :: ElemFactory
meter = createDOMElement "meter" meter = createDOM "meter"
nav :: ElemFactory nav :: ElemFactory
nav = createDOMElement "nav" nav = createDOM "nav"
object :: ElemFactory object :: ElemFactory
object = createDOMElement "object" object = createDOM "object"
ol :: ElemFactory ol :: ElemFactory
ol = createDOMElement "ol" ol = createDOM "ol"
optgroup :: ElemFactory optgroup :: ElemFactory
optgroup = createDOMElement "optgroup" optgroup = createDOM "optgroup"
option :: ElemFactory option :: ElemFactory
option = createDOMElement "option" option = createDOM "option"
output :: ElemFactory output :: ElemFactory
output = createDOMElement "output" output = createDOM "output"
p :: ElemFactory p :: ElemFactory
p = createDOMElement "p" p = createDOM "p"
param :: LeafFactory param :: LeafFactory
param = createLeafElement "param" param = createLeafDOM "param"
picture :: ElemFactory picture :: ElemFactory
picture = createDOMElement "picture" picture = createDOM "picture"
pre :: ElemFactory pre :: ElemFactory
pre = createDOMElement "pre" pre = createDOM "pre"
progress :: ElemFactory progress :: ElemFactory
progress = createDOMElement "progress" progress = createDOM "progress"
q :: ElemFactory q :: ElemFactory
q = createDOMElement "q" q = createDOM "q"
rp :: ElemFactory rp :: ElemFactory
rp = createDOMElement "rp" rp = createDOM "rp"
rt :: ElemFactory rt :: ElemFactory
rt = createDOMElement "rt" rt = createDOM "rt"
ruby :: ElemFactory ruby :: ElemFactory
ruby = createDOMElement "ruby" ruby = createDOM "ruby"
s :: ElemFactory s :: ElemFactory
s = createDOMElement "s" s = createDOM "s"
samp :: ElemFactory samp :: ElemFactory
samp = createDOMElement "samp" samp = createDOM "samp"
section :: ElemFactory section :: ElemFactory
section = createDOMElement "section" section = createDOM "section"
source :: LeafFactory source :: LeafFactory
source = createLeafElement "source" source = createLeafDOM "source"
span :: ElemFactory span :: ElemFactory
span = createDOMElement "span" span = createDOM "span"
strong :: ElemFactory strong :: ElemFactory
strong = createDOMElement "strong" strong = createDOM "strong"
style :: ElemFactory style :: ElemFactory
style = createDOMElement "style" style = createDOM "style"
sub :: ElemFactory sub :: ElemFactory
sub = createDOMElement "sub" sub = createDOM "sub"
sup :: ElemFactory sup :: ElemFactory
sup = createDOMElement "sup" sup = createDOM "sup"
summary :: ElemFactory summary :: ElemFactory
summary = createDOMElement "summary" summary = createDOM "summary"
svg :: ElemFactory svg :: ElemFactory
svg = createDOMElement "svg" svg = createDOM "svg"
table :: ElemFactory table :: ElemFactory
table = createDOMElement "table" table = createDOM "table"
tbody :: ElemFactory tbody :: ElemFactory
tbody = createDOMElement "tbody" tbody = createDOM "tbody"
td :: ElemFactory td :: ElemFactory
td = createDOMElement "td" td = createDOM "td"
template :: ElemFactory template :: ElemFactory
template = createDOMElement "template" template = createDOM "template"
textarea :: ElemFactory textarea :: ElemFactory
textarea = createDOMElement "textarea" textarea = createDOM "textarea"
tfoot :: ElemFactory tfoot :: ElemFactory
tfoot = createDOMElement "tfoot" tfoot = createDOM "tfoot"
th :: ElemFactory th :: ElemFactory
th = createDOMElement "th" th = createDOM "th"
thead :: ElemFactory thead :: ElemFactory
thead = createDOMElement "thead" thead = createDOM "thead"
time :: ElemFactory time :: ElemFactory
time = createDOMElement "time" time = createDOM "time"
title :: ElemFactory title :: ElemFactory
title = createDOMElement "title" title = createDOM "title"
tr :: ElemFactory tr :: ElemFactory
tr = createDOMElement "tr" tr = createDOM "tr"
track :: LeafFactory track :: LeafFactory
track = createLeafElement "track" track = createLeafDOM "track"
u :: ElemFactory u :: ElemFactory
u = createDOMElement "u" u = createDOM "u"
ul :: ElemFactory ul :: ElemFactory
ul = createDOMElement "ul" ul = createDOM "ul"
var :: ElemFactory var :: ElemFactory
var = createDOMElement "var" var = createDOM "var"
video :: ElemFactory video :: ElemFactory
video = createDOMElement "video" video = createDOM "video"
wbr :: LeafFactory wbr :: LeafFactory
wbr = createLeafElement "wbr" wbr = createLeafDOM "wbr"
module Reactix.Utils where module Reactix.Utils where
import Prelude ((<<<), (<>))
import Data.Unit (Unit, unit) import Data.Unit (Unit, unit)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Function.Uncurried (Fn2, runFn2) import Data.Function.Uncurried (Fn2, runFn2)
import Data.String (splitAt, toUpper)
import Effect (Effect) import Effect (Effect)
import Effect.Uncurried (EffectFn1, runEffectFn1) import Effect.Uncurried (EffectFn1, runEffectFn1)
import FFI.Simple (delay) import FFI.Simple (delay)
...@@ -18,3 +20,7 @@ currySecond (Tuple a b) = Tuple a (runEffectFn1 b) ...@@ -18,3 +20,7 @@ currySecond (Tuple a b) = Tuple a (runEffectFn1 b)
hook :: forall v. (Unit -> Effect v) -> Hooks v hook :: forall v. (Unit -> Effect v) -> Hooks v
hook f = unsafeHooksEffect (delay unit f) hook f = unsafeHooksEffect (delay unit f)
ucFirst :: String -> String
ucFirst = help <<< splitAt 1
where help {before, after} = toUpper before <> after
...@@ -5,11 +5,13 @@ import Data.Array as A ...@@ -5,11 +5,13 @@ import Data.Array as A
import Data.Array ( (!!) ) import Data.Array ( (!!) )
import Data.EuclideanRing (mod) import Data.EuclideanRing (mod)
import Data.Maybe ( Maybe(..) ) import Data.Maybe ( Maybe(..) )
import Data.Nullable (null)
import Data.Traversable ( traverse, traverse_, sequence_ ) import Data.Traversable ( traverse, traverse_, sequence_ )
import Data.Tuple ( Tuple(..) ) import Data.Tuple ( Tuple(..) )
import Data.Tuple.Nested ( (/\) ) import Data.Tuple.Nested ( (/\) )
import Data.Unfoldable (fromMaybe)
import Effect ( Effect ) import Effect ( Effect )
import Effect.Aff ( Aff ) import Effect.Aff ( Aff, launchAff )
import Effect.Class ( liftEffect ) import Effect.Class ( liftEffect )
import Effect.Ref as Ref import Effect.Ref as Ref
import Effect.Uncurried ( EffectFn1, mkEffectFn1, runEffectFn1 ) import Effect.Uncurried ( EffectFn1, mkEffectFn1, runEffectFn1 )
...@@ -20,7 +22,9 @@ import Test.Spec.Assertions ( shouldEqual ) ...@@ -20,7 +22,9 @@ import Test.Spec.Assertions ( shouldEqual )
import DOM.Simple as DOM import DOM.Simple as DOM
import DOM.Simple.Document as Document import DOM.Simple.Document as Document
import DOM.Simple.Element as Element import DOM.Simple.Element as Element
import DOM.Simple.Node as Node
import DOM.Simple.Event as Event import DOM.Simple.Event as Event
import DOM.Simple.Types (Element)
import FFI.Simple (delay) import FFI.Simple (delay)
import Reactix as R import Reactix as R
import Reactix.Test as RT import Reactix.Test as RT
...@@ -31,10 +35,22 @@ staticTest :: Spec Unit ...@@ -31,10 +35,22 @@ staticTest :: Spec Unit
staticTest = staticTest =
describe "Basic DOM rendering" $ do describe "Basic DOM rendering" $ do
it "Simple elements" $ do it "Simple elements" $ do
root <- liftEffect $ RT.render elem root <- liftEffect $ RT.render simple
let children = Element.children root.container let children = Element.children root.container
(Element.name <$> children) `shouldEqual` ["I"] (Element.name <$> children) `shouldEqual` ["I"]
(Element.innerHTML <$> children) `shouldEqual` ["hello world"] (Element.innerHTML <$> children) `shouldEqual` ["hello world"]
it "Magic props" $ do
root <- liftEffect $ RT.render magic
let children = Element.children root.container
A.length children `shouldEqual` 1
let children2 = children >>= Element.children
let attrNames = A.sort (children >>= Element.attrNames)
let attrVals =
do name <- attrNames
child <- children
fromMaybe $ Element.attr child name
["aria-label", "data-sample"] `shouldEqual` attrNames
["example", "example"] `shouldEqual` attrVals
it "Fragments" $ do it "Fragments" $ do
root <- liftEffect $ RT.render $ frag root <- liftEffect $ RT.render $ frag
Element.childCount root.container `shouldEqual` 2 Element.childCount root.container `shouldEqual` 2
...@@ -42,8 +58,13 @@ staticTest = ...@@ -42,8 +58,13 @@ staticTest =
A.length children `shouldEqual` 2 A.length children `shouldEqual` 2
(Element.name <$> children) `shouldEqual` ["I", "I"] (Element.name <$> children) `shouldEqual` ["I", "I"]
(Element.innerHTML <$> children) `shouldEqual` ["hello","world"] (Element.innerHTML <$> children) `shouldEqual` ["hello","world"]
where elem = i {} [ text "hello world" ] where
frag = i {} [ text "hello" ] <> i {} [ text "world" ] simple = i {} [ text "hello world" ]
magic = div {aria: {label: "example"}, "data": {sample: "example"}} []
frag = i {} [ text "hello" ] <> i {} [ text "world" ]
getAttr :: String -> Element -> Maybe String
getAttr = flip Element.attr
type CounterProps = ( count :: Int ) type CounterProps = ( count :: Int )
...@@ -53,9 +74,8 @@ counterCpt = R.hooksComponent "Counter" cpt ...@@ -53,9 +74,8 @@ counterCpt = R.hooksComponent "Counter" cpt
cpt {count} _ = do cpt {count} _ = do
y /\ setY <- R.useState' count y /\ setY <- R.useState' count
pure $ div { className: "counter" } pure $ div { className: "counter" }
[ button { type: "button", onClick: onclick setY (_ + 1) } [ text "++" ] [ button { type: "button", on: { click: \_ -> setY (_ + 1) } } [ text "++" ]
, div {} [ text (show y) ] ] , div {} [ text (show y) ] ]
onclick set to = mkEffectFn1 $ \e -> set to
counterTest :: Spec Unit counterTest :: Spec Unit
counterTest = counterTest =
...@@ -95,10 +115,9 @@ bicounterCpt = R.hooksComponent "Bicounter" cpt ...@@ -95,10 +115,9 @@ bicounterCpt = R.hooksComponent "Bicounter" cpt
cpt {count} _ = do cpt {count} _ = do
y /\ reduceY <- R.useReducer' reduce count y /\ reduceY <- R.useReducer' reduce count
pure $ div { className: "counter" } pure $ div { className: "counter" }
[ button { type: "button", onClick: onclick reduceY Inc } [ text "++" ] [ button { type: "button", on: { click: \_ -> reduceY Inc } } [ text "++" ]
, button { type: "button", onClick: onclick reduceY Dec } [ text "--" ] , button { type: "button", on: { click: \_ -> reduceY Dec } } [ text "--" ]
, div {} [ text (show y) ] ] , div {} [ text (show y) ] ]
onclick reducer with = mkEffectFn1 $ \_ -> reducer with
reduce count Inc = count + 1 reduce count Inc = count + 1
reduce count Dec = count - 1 reduce count Dec = count - 1
...@@ -228,11 +247,17 @@ themeChooserCpt = R.hooksComponent "ThemeChooser" cpt ...@@ -228,11 +247,17 @@ themeChooserCpt = R.hooksComponent "ThemeChooser" cpt
let context = R.readRef ref let context = R.readRef ref
pure $ pure $
div {} div {}
[ button { type: "button", onClick: onclick setTheme (const Nothing) } [ text "None" ] [ button
, button { type: "button", onClick: onclick setTheme (const $ Just Dark) } [ text "Dark" ] { type: "button", on: {click: \_ -> setTheme (const Nothing) } }
, button { type: "button", onClick: onclick setTheme (const $ Just Light) } [ text "Light" ] [ text "None" ]
, button
{ type: "button", on: {click: \_ -> setTheme (const $ Just Dark) } }
[ text "Dark" ]
, button
{ type: "button", on: {click: \_ -> setTheme (const $ Just Light) } }
[ text "Light" ]
, R.provideContext context theme [ R.createElement themedCpt { theme: context } [] ] ] , R.provideContext context theme [ R.createElement themedCpt { theme: context } [] ] ]
onclick setTheme theme = mkEffectFn1 $ \_ -> setTheme theme
themeChooserTest :: Spec Unit themeChooserTest :: Spec Unit
themeChooserTest = themeChooserTest =
describe "ThemeChooser" do describe "ThemeChooser" do
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment