From 52edf80b5f960b18406b3c6b72960ed3238ceb35 Mon Sep 17 00:00:00 2001 From: Madeline Trotter Date: Thu, 6 Aug 2020 13:38:37 -0700 Subject: [PATCH 1/4] wip button refactor --- docs/Examples2/Button.example.purs | 120 +++--- docs/Examples2/ButtonGroup.example.purs | 60 ++- src/Lumi/Components.purs | 14 + src/Lumi/Components/Color.purs | 25 +- src/Lumi/Components/EditableTable.purs | 25 +- src/Lumi/Components2/Button.purs | 505 +++++++++++++++++++++--- src/Lumi/Components2/ButtonGroup.purs | 57 ++- src/Lumi/Components2/Clip.purs | 9 +- src/Lumi/Components2/Link.purs | 28 +- src/Lumi/Components2/QRCode.purs | 81 ++-- src/Lumi/Styles/Box.purs | 2 +- src/Lumi/Styles/Button.purs | 310 --------------- src/Lumi/Styles/Loader.purs | 25 +- src/Lumi/Styles/QRCode.purs | 15 - 14 files changed, 723 insertions(+), 553 deletions(-) delete mode 100644 src/Lumi/Styles/Button.purs delete mode 100644 src/Lumi/Styles/QRCode.purs diff --git a/docs/Examples2/Button.example.purs b/docs/Examples2/Button.example.purs index bd1e6923..0ecb72ee 100644 --- a/docs/Examples2/Button.example.purs +++ b/docs/Examples2/Button.example.purs @@ -1,16 +1,19 @@ module Lumi.Components2.Examples.Button where import Prelude + import Data.Array (intercalate) +import Effect.Aff (Milliseconds(..), delay) +import Effect.Class (liftEffect) +import Lumi.Components (propsModifier, ($$$)) import Lumi.Components.Column (column_) import Lumi.Components.Example (example) import Lumi.Components.Icon (IconType(..), icon) import Lumi.Components.Size (Size(..)) import Lumi.Components.Spacing (Space(..), hspace, vspace) import Lumi.Components.Text (h2_, h4_) -import Lumi.Components2.Button (_linkStyle, button, _secondary) +import Lumi.Components2.Button (ButtonState(..), button, linkButton, resize, secondary) import Lumi.Styles.Box (_interactive) -import Lumi.Styles.Button (ButtonState(..)) import React.Basic.Classic (JSX) import React.Basic.DOM as R import Web.HTML (window) @@ -22,45 +25,38 @@ docs = $ intercalate [ vspace S16 ] [ [ example $ button - $ _ { content = [ R.text "Button" ] } + $ propsModifier _ { onPress = delay $ Milliseconds 1000.0 } + $$$ [ column_ [ R.text "Click me" ] ] ] , [ h2_ "Disabled" , example $ button - $ _ { content = [ R.text "Button" ] } + $$$ [ R.text "Button" ] ] , [ h2_ "Size" , h4_ "Medium (default)" , example $ button - $ _ - { content = [ R.text "Button" ] - , size = Medium - } + $ resize Medium + $$$ [ R.text "Button" ] ] , [ h4_ "Small" , example $ button - $ _ - { content = [ R.text "Button" ] - , size = Small - } + $ resize Small + $$$ [ R.text "Button" ] ] , [ h4_ "Large" , example $ button - $ _ - { content = [ R.text "Button" ] - , size = Large - } + $ resize Large + $$$ [ R.text "Button" ] ] , [ h4_ "Extra Large" , example $ button - $ _ - { content = [ R.text "Button" ] - , size = ExtraLarge - } + $ resize ExtraLarge + $$$ [ R.text "Button" ] ] , [ h2_ "Color" , h4_ "Primary (default)" @@ -80,104 +76,90 @@ docs = , [ h4_ "Secondary (outline)" , example $ button - $ _secondary + $ secondary $ _ { content = [ R.text "Button" ] } ] , [ h4_ "Secondary Small" , example $ button - $ _secondary - $ _ - { content = [ R.text "Button" ] - , size = Small - } + $ secondary + $ resize Small + $$$ [ R.text "Button" ] ] , [ h4_ "Secondary Large" , example $ button - $ _secondary - $ _ - { content = [ R.text "Button" ] - , size = Large - } + $ secondary + $ resize Large + $$$ [ R.text "Button" ] ] , [ h4_ "Secondary Extra Large" , example $ button - $ _secondary - $ _ - { content = [ R.text "Button" ] - , size = ExtraLarge - } + $ secondary + $ resize ExtraLarge + $$$ [ R.text "Button" ] ] , [ h4_ "Secondary + Disabled" , example $ button - $ _secondary - $ _ - { content = [ R.text "Button" ] - , state = Disabled - } + $ secondary + $ propsModifier _ { state = Disabled } + $$$ [ R.text "Button" ] ] , [ h4_ "Icon button" , example $ button - $ _ { content = [ buttonIcon Plus, hspace S8, R.text "Add new item" ] } + $$$ [ buttonIcon Plus, hspace S8, R.text "Add new item" ] ] , [ h4_ "Icon button" , example $ button - $ _secondary - $ _ { content = [ buttonIcon Plus, hspace S8, R.text "Add new item" ] } + $ secondary + $$$ [ buttonIcon Plus, hspace S8, R.text "Add new item" ] ] , [ h4_ "Icon button" , example $ button - $ _ { content = [ R.text "Add new item", hspace S8, buttonIcon Plus ] } + $$$ [ R.text "Add new item", hspace S8, buttonIcon Plus ] ] , [ h4_ "Link style" , example - $ button - $ _linkStyle - $ _ { content = [ R.text "Button w/ link style" ] - , onPress = alert "asdf" =<< window - } + $ linkButton + $ propsModifier _ { onPress = liftEffect do alert "asdf" =<< window } + $$$ [ R.text "Button w/ link style" ] , example - $ button - $ _linkStyle - $ _ { state = Disabled - , content = [ R.text "Button w/ link style" ] - , onPress = alert "asdf" =<< window - } + $ linkButton + $ propsModifier _ { onPress = liftEffect do alert "asdf" =<< window } + $ propsModifier _ { state = Disabled } + $$$ [ R.text "Button w/ link style" ] ] , [ h4_ "Loading (Medium/default)" , example $ button - $ _ { state = Loading } + $ propsModifier _ { state = Loading } + $$$ [ R.text "Save" ] ] , [ h4_ "Loading (Small) " , example $ button - $ _ - { state = Loading - , size = Small - } + $ resize Small + $ propsModifier _ { state = Loading } + $$$ [ R.text "Save" ] ] , [ h4_ "Loading (Large) " , example $ button - $ _ - { state = Loading - , size = Large - } + $ resize Large + $ propsModifier _ { state = Loading } + $$$ [ R.text "Save" ] ] , [ h4_ "Loading (ExtraLarge) " , example $ button - $ _ - { state = Loading - , size = ExtraLarge - } + $ resize ExtraLarge + $ propsModifier _ { state = Loading } + $$$ [ R.text "Save" ] ] ] where diff --git a/docs/Examples2/ButtonGroup.example.purs b/docs/Examples2/ButtonGroup.example.purs index f3172eb9..0e723289 100644 --- a/docs/Examples2/ButtonGroup.example.purs +++ b/docs/Examples2/ButtonGroup.example.purs @@ -1,14 +1,16 @@ module Lumi.Components2.Examples.ButtonGroup where import Prelude + import Effect.Console (log) import Effect.Uncurried (mkEffectFn1) +import Lumi.Components (($$$)) import Lumi.Components.Column (column_) import Lumi.Components.Example (example) import Lumi.Components.NativeSelect (nativeSelect, defaults) import Lumi.Components.Text (h2_) -import Lumi.Components2.Button (button, _secondary) -import Lumi.Components2.ButtonGroup (buttonGroup) +import Lumi.Components2.Button (button, secondary) +import Lumi.Components2.ButtonGroup (buttonGroup, joined) import React.Basic.Classic (JSX) import React.Basic.DOM as R @@ -22,7 +24,7 @@ docs = { content = [ button _ { content = [ R.text "Button" ] } , button - $ _secondary + $ secondary $ _ { content = [ R.text "Button" ] } ] } @@ -33,10 +35,10 @@ docs = { content = [ button _ { content = [ R.text "Button" ] } , button - $ _secondary + $ secondary $ _ { content = [ R.text "Button" ] } , button - $ _secondary + $ secondary $ _ { content = [ R.text "Button" ] } ] } @@ -53,39 +55,35 @@ docs = , value = "Foo bar" } , button - $ _secondary + $ secondary $ _ { content = [ R.text "Button" ] } ] } , h2_ "Joined" , example $ buttonGroup - $ _ - { joined = true - , content = - [ button - $ _secondary - $ _ { content = [ R.text "Button" ] } - , button - $ _secondary - $ _ { content = [ R.text "Button" ] } - ] - } + $ joined + $$$ + [ button + $ secondary + $ _ { content = [ R.text "Button" ] } + , button + $ secondary + $ _ { content = [ R.text "Button" ] } + ] , h2_ "Joined" , example $ buttonGroup - $ _ - { joined = true - , content = - [ button - $ _secondary - $ _ { content = [ R.text "Button" ] } - , button - $ _secondary - $ _ { content = [ R.text "Button" ] } - , button - $ _secondary - $ _ { content = [ R.text "Button" ] } - ] - } + $ joined + $$$ + [ button + $ secondary + $ _ { content = [ R.text "Button" ] } + , button + $ secondary + $ _ { content = [ R.text "Button" ] } + , button + $ secondary + $ _ { content = [ R.text "Button" ] } + ] ] diff --git a/src/Lumi/Components.purs b/src/Lumi/Components.purs index 641ef56c..9e3d3409 100644 --- a/src/Lumi/Components.purs +++ b/src/Lumi/Components.purs @@ -7,10 +7,13 @@ module Lumi.Components , lumiComponent , lumiComponentFromHook , withContent, ($$$) + , unsafeMaybeToNullableAttr ) where import Prelude +import Data.Maybe (Maybe) +import Data.Nullable (toNullable) import Data.String (toLower) import Effect (Effect) import Lumi.Styles.Theme (LumiTheme) @@ -18,6 +21,7 @@ import Prim.Row (class Lacks) import React.Basic.Emotion as Emotion import React.Basic.Hooks (Hook, JSX, ReactComponent, Render, element, reactComponent, reactComponentFromHook) import Record.Unsafe.Union (unsafeUnion) +import Unsafe.Coerce (unsafeCoerce) -- | A `LumiComponent` takes a function that updates its default props instead -- | of the plain record of props itself. This helps reduce the surface area for @@ -129,3 +133,13 @@ lumiElement (LumiInternalComponent { component, defaults, className }) modifyPro props { className = className <> " " <> props.className } + +-- | WARNING: This is for JS interop -- don't use this to unwrap Maybes! +-- | +-- | Unsafely nulls out a value so the resulting html attributes are less noisy +-- | Ex: `R.input { type: unsafeMaybeToNullableAttr Nothing }` avoids rendering +-- | the `type` attribute while still validating the type of the Maybe's content +-- | matches the type of the DOM field. It's slightly safer than using +-- | `unsafeCreateDOMComponent` to avoid DOM type checking entirely. +unsafeMaybeToNullableAttr :: forall a. Maybe a -> a +unsafeMaybeToNullableAttr = unsafeCoerce <<< toNullable diff --git a/src/Lumi/Components/Color.purs b/src/Lumi/Components/Color.purs index 24aa1459..5d5a42a0 100644 --- a/src/Lumi/Components/Color.purs +++ b/src/Lumi/Components/Color.purs @@ -4,9 +4,12 @@ module Lumi.Components.Color , ColorMap , colors , colorNames + , shade ) where -import Color (rgb, rgba) +import Prelude + +import Color (darken, desaturate, lighten, rgb, rgba) import Color as C import Data.Newtype (class Newtype) @@ -114,3 +117,23 @@ colorNames = , transparent: ColorName "transparent" } +shade :: + { hue :: Color, white :: Color, black :: Color } -> + { black :: Color + , grey1 :: Color + , grey2 :: Color + , hue :: Color + , hueDarker :: Color + , hueDarkest :: Color + , hueDisabled :: Color + , white :: Color + } +shade { hue, white, black } = + let + hueDarker = darken 0.1 hue + hueDarkest = darken 0.15 hue + hueDisabled = lighten 0.4137 $ desaturate 0.1972 hue + grey1 = lighten 0.7 black + grey2 = lighten 0.82 black + in + { hue, hueDarker, hueDarkest, hueDisabled, grey1, grey2, white, black } diff --git a/src/Lumi/Components/EditableTable.purs b/src/Lumi/Components/EditableTable.purs index 875ef9e4..baafbf97 100644 --- a/src/Lumi/Components/EditableTable.purs +++ b/src/Lumi/Components/EditableTable.purs @@ -10,6 +10,7 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Monoid (guard) import Effect (Effect) +import Effect.Class (liftEffect) import Effect.Unsafe (unsafePerformEffect) import JSS (JSS, jss) import Lumi.Components (($$$)) @@ -18,10 +19,10 @@ import Lumi.Components.Column (column_) import Lumi.Components.Icon (IconType(..), icon, icon_) import Lumi.Components.Text (nbsp) import Lumi.Components2.Box (row) -import Lumi.Components2.Button (button, _linkStyle) +import Lumi.Components2.Button (linkButton, recolor, varButtonHueDarker, varButtonHueDarkest) import Lumi.Components2.Text as T import Lumi.Styles as S -import Lumi.Styles.Box (FlexAlign(..), _align, _justify, _row) +import Lumi.Styles.Box (FlexAlign(..), _align, _justify) import Lumi.Styles.Theme (LumiTheme(..)) import React.Basic.Classic (Component, JSX, createComponent, element, empty, makeStateless) import React.Basic.DOM as R @@ -59,24 +60,25 @@ editableTableDefaults = defaultRemoveCell :: forall row. Maybe (row -> Effect Unit) -> row -> JSX defaultRemoveCell onRowRemove item = onRowRemove # Array.foldMap \onRowRemove' -> - button - $ _linkStyle + linkButton -- TODO: this link button should be a new "icon button" style + $ recolor _.black1 $ S.style ( \(LumiTheme { colors }) -> S.css { fontSize: S.px 20 - , lineHeight: S.px 20 , textDecoration: S.important S.none - , color: S.color colors.black1 , "&:hover": S.nested $ S.css - { color: S.color colors.black + { color: varButtonHueDarker + } + , "&:focus, &:active": S.nested $ S.css + { color: varButtonHueDarkest } , "lumi-font-icon::before": S.nested $ S.css { verticalAlign: S.str "baseline" } } ) - $ _ { onPress = onRowRemove' item + $ _ { onPress = liftEffect do onRowRemove' item , content = [ icon_ Bin ] } @@ -160,10 +162,7 @@ editableTable = makeStateless component render $ S.style_ (S.css { flexFlow: S.str "row-reverse wrap" }) $$$ [ summary , guard canAddRows - $ button - $ _linkStyle - $ _row - $ _align Baseline + $ linkButton $ S.style_ ( S.css { fontSize: S.px 14 @@ -173,7 +172,7 @@ editableTable = makeStateless component render } } ) - $ _ { onPress = onRowAdd + $ _ { onPress = liftEffect onRowAdd , content = [ icon { type_: Plus diff --git a/src/Lumi/Components2/Button.purs b/src/Lumi/Components2/Button.purs index 4b188137..046657ce 100644 --- a/src/Lumi/Components2/Button.purs +++ b/src/Lumi/Components2/Button.purs @@ -1,88 +1,495 @@ -module Lumi.Components2.Button where +module Lumi.Components2.Button + ( Button + , ButtonState(..), ButtonType(..) + , button + + , linkButton + , LinkButton + + , ButtonModifier + , primary, secondary, resize + + , recolor + , varButtonHue, varButtonHueDarker, varButtonHueDarkest + , varButtonHueDisabled, varButtonGrey1, varButtonGrey2 + , varButtonBlack, varButtonWhite + ) where import Prelude import Color (Color) +import Data.Array (fold) import Data.Array as Array -import Data.Maybe (Maybe(..), fromMaybe) -import Effect (Effect) +import Data.Maybe (Maybe(..)) +import Effect.Aff (Aff, finally, launchAff_) +import Effect.Class (liftEffect) import Effect.Unsafe (unsafePerformEffect) import Foreign.Object (fromHomogeneous) -import Lumi.Components (LumiComponent, PropsModifier, lumiComponent, propsModifier) +import Lumi.Components (LumiComponent, PropsModifier, lumiComponent, unsafeMaybeToNullableAttr) import Lumi.Components.Button (invisibleSpace) +import Lumi.Components.Color (ColorMap, shade) import Lumi.Components.Size (Size(..)) -import Lumi.Styles (toCSS) -import Lumi.Styles.Button (ButtonKind(..), ButtonState(..)) -import Lumi.Styles.Button as Styles.Button -import Lumi.Styles.Theme (useTheme) +import Lumi.Components2.Box as Box +import Lumi.Styles (StyleModifier, StyleProperty, color, css, inherit, merge, nested, none, px, str, style, style_, toCSS) +import Lumi.Styles.Box (FlexAlign(..), _align, _focusable, _interactive, _justify, _row, box) +import Lumi.Styles.Loader (mkLoader, spin) +import Lumi.Styles.Theme (LumiTheme(..), useTheme) import React.Basic.DOM as R import React.Basic.Emotion as E import React.Basic.Events (handler_) -import React.Basic.Hooks (JSX) +import React.Basic.Hooks (JSX, useState', (/\)) import React.Basic.Hooks as React +data Button = Button' + +data ButtonState + = Enabled + | Disabled + | Loading + +data ButtonType + = Button + | Submit + | Reset + type ButtonProps - = ( accessibilityLabel :: Maybe String - , onPress :: Effect Unit - , size :: Size - , type :: String - , kind :: ButtonKind + = ( component :: Button + , autoFocus :: Boolean + , tabIndex :: Maybe Int + , onPress :: Aff Unit + , type :: ButtonType , state :: ButtonState - , color :: Maybe Color + -- Set `ariaLabel` when the button content is not legible text, + -- for example a button that only contains an X might set this + -- label to "Close". + , ariaLabel :: Maybe String , content :: Array JSX ) button :: LumiComponent ButtonProps -button = +button = primary >>> unsafePerformEffect do lumiComponent "Button" defaults render where defaults :: Record ButtonProps defaults = - { accessibilityLabel: mempty + { component: Button' + , ariaLabel: mempty + , autoFocus: false + , tabIndex: Nothing , onPress: mempty - , size: Medium - , type: mempty - , kind: Primary + , type: Button , state: Enabled - , color: Nothing , content: mempty } render props = React.do theme <- useTheme + clickInProgress /\ setClickInProgress <- useState' false + let + loading = + clickInProgress || case props.state of + Enabled -> false + Disabled -> false + Loading -> true + disabled = + loading || case props.state of + Enabled -> false + Disabled -> true + Loading -> true pure $ E.element R.button' - { _aria: fromHomogeneous { label: fromMaybe "" props.accessibilityLabel } - , children + { _aria: + unsafeMaybeToNullableAttr + $ map (fromHomogeneous <<< { label: _ }) props.ariaLabel + , autoFocus: props.autoFocus + , tabIndex: unsafeMaybeToNullableAttr props.tabIndex + , css: toCSS buttonStyle theme <> props.css theme , className: props.className - , css: - theme # toCSS (Styles.Button.button props.color props.kind props.state props.size) <> props.css - , onClick: handler_ props.onPress - , type: props.type - , disabled: - case props.state of - Enabled -> false - Disabled -> true - Loading -> false + , onClick: handler_ do + setClickInProgress true + launchAff_ do + props.onPress # finally do + liftEffect do setClickInProgress false + , type: + case props.type of + Button -> "button" + Submit -> "submit" + Reset -> "reset" + , disabled + , _data: + unsafeMaybeToNullableAttr + if loading then + Just (fromHomogeneous { loading: "" }) + else + Nothing + , children: + [ Box.box _ + { className = "button-content" + , content = + if Array.length props.content == 0 then + [ R.text invisibleSpace ] -- preserves button size when content is empty + else + props.content + } + ] } where - children = - if Array.length props.content == 0 then - [ R.text invisibleSpace ] -- preserves button size when content is empty - else - props.content - -_secondary :: forall props. PropsModifier ( kind :: ButtonKind | props ) -_secondary = - propsModifier - _ - { kind = Secondary - } + buttonStyle :: StyleModifier + buttonStyle = + box + <<< _row + <<< _align Center + <<< _justify Center + <<< _interactive + <<< _focusable + <<< style \(theme@(LumiTheme { colors, fontSizes })) -> + css + { label: str "button" + , appearance: none + , outline: none + , minWidth: px 70 + , lineHeight: px 1 + , whiteSpace: str "nowrap" + , textOverflow: str "ellipsis" + , overflow: str "hidden" + , borderRadius: px 3 + , borderWidth: px 1 + , borderStyle: str "solid" + , fontSize: px fontSizes.body + , padding: str "10px 20px" + , height: px 40 + , "@media (min-width: 860px)": + nested + $ css + { fontSize: px fontSizes.body + , padding: str "6px 16px" + , height: px 32 + } + , "&:disabled": nested $ css { cursor: str "default" } + , "&[data-loading]": + nested + $ merge + [ spin + , css + { "&:after": + nested + $ merge + [ css { position: str "absolute" } + , mkLoader + { color: colors.white + , highlightColor: colors.transparent + , radius: "16px" + , borderWidth: "2px" + } + ] + , "> .button-content": nested $ css { opacity: str "0" } + } + ] + } + +type ButtonModifier c = forall r. PropsModifier ( component :: c | r ) -_linkStyle :: forall props. PropsModifier ( kind :: ButtonKind | props ) -_linkStyle = - propsModifier - _ - { kind = Link +-- The default button style +primary :: ButtonModifier Button +primary = + recolor _.primary + <<< style_ + ( css + { color: varButtonWhite + , borderColor: varButtonHue + , backgroundColor: varButtonHue + , "&:hover": + nested + $ css + { color: varButtonWhite + , borderColor: varButtonHueDarker + , backgroundColor: varButtonHueDarker + } + , "&:active": + nested + $ css + { color: varButtonWhite + , borderColor: varButtonHueDarkest + , backgroundColor: varButtonHueDarkest + } + , "&:disabled": + nested + $ css + { color: varButtonWhite + , borderColor: varButtonHueDisabled + , backgroundColor: varButtonHueDisabled + } + } + ) + +-- An outline-style button +secondary :: ButtonModifier Button +secondary = + recolor _.primary + <<< style_ + ( css + { color: varButtonBlack + , borderColor: varButtonGrey1 + , backgroundColor: varButtonWhite + , "&:hover": + nested + $ css + { color: varButtonHueDarker + , borderColor: varButtonHueDarker + , backgroundColor: varButtonWhite + } + , "&:active": + nested + $ css + { color: varButtonHueDarkest + , borderColor: varButtonHueDarkest + , backgroundColor: varButtonWhite + } + , "&:disabled": + nested + $ css + { borderColor: varButtonGrey2 + , color: varButtonGrey1 + , backgroundColor: varButtonWhite + } + } + ) + +resize :: Size -> ButtonModifier Button +resize size = + style \(LumiTheme { fontSizes, lineHeightFactor, textMarginFactor }) -> + css + { "@media (min-width: 860px)": + nested + $ fold + [ case size of + Small -> + css + { fontSize: px fontSizes.subtext + , padding: str "6px 16px" + , height: px 28 + } + Medium -> + mempty + Large -> + css + { fontSize: px fontSizes.subsectionHeader + , padding: str "12px 24px" + , height: px 48 + } + ExtraLarge -> + css + { fontSize: px fontSizes.sectionHeader + , padding: str "16px 32px" + , height: px 64 + } + ExtraExtraLarge -> + css + { fontSize: px fontSizes.sectionHeader + , padding: str "16px 32px" + , height: px 64 + } + ] } + + -- loadingStyles theme size = + -- merge + -- [ spin + -- , css + -- { label: str "loading" + -- , "&:after": nested $ mkLoader theme { radius: "16px", borderWidth: "2px" } + -- , "@media (min-width: 860px)": + -- nested case size of + -- Small -> + -- css + -- { "&:after": + -- nested + -- $ mkLoader theme { radius: "12px", borderWidth: "2px" } + -- } + -- Medium -> mempty + -- Large -> + -- css + -- { "&:after": + -- nested + -- $ mkLoader theme { radius: "24px", borderWidth: "3px" } + -- } + -- ExtraLarge -> + -- css + -- { "&:after": + -- nested + -- $ mkLoader theme { radius: "34px", borderWidth: "4px" } + -- } + -- ExtraExtraLarge -> + -- css + -- { "&:after": + -- nested + -- $ mkLoader theme { radius: "34px", borderWidth: "4px" } + -- } + -- } + -- ] + + +data LinkButton = LinkButton + +type LinkButtonProps + = ( component :: LinkButton + , autoFocus :: Boolean + , tabIndex :: Maybe Int + , onPress :: Aff Unit + , type :: ButtonType + , state :: ButtonState + -- Set `ariaLabel` when the button content is not legible text, + -- for example a button that only contains an X might set this + -- label to "Close". + , ariaLabel :: Maybe String + , content :: Array JSX + ) + +linkButton :: LumiComponent LinkButtonProps +linkButton = recolor _.primary >>> + unsafePerformEffect do + lumiComponent "LinkButton" defaults render + where + defaults :: Record LinkButtonProps + defaults = + { component: LinkButton + , autoFocus: false + , tabIndex: Nothing + , onPress: mempty + , type: Button + , state: Enabled + , ariaLabel: Nothing + , content: mempty + } + + render props = React.do + theme <- useTheme + clickInProgress /\ setClickInProgress <- useState' false + pure + $ E.element R.button' + { _aria: + unsafeMaybeToNullableAttr + $ map (fromHomogeneous <<< { label: _ }) props.ariaLabel + , autoFocus: props.autoFocus + , tabIndex: unsafeMaybeToNullableAttr props.tabIndex + , css: toCSS linkButtonStyle theme <> props.css theme + , className: props.className + , onClick: handler_ do + setClickInProgress true + launchAff_ do + props.onPress # finally do + liftEffect do setClickInProgress false + , type: + case props.type of + Button -> "button" + Submit -> "submit" + Reset -> "reset" + , disabled: + clickInProgress || + case props.state of + Enabled -> false + Disabled -> true + Loading -> true + , children: + if Array.length props.content == 0 then + [ R.text invisibleSpace ] -- preserves button size when content is empty + else + props.content + } + where + linkButtonStyle :: StyleModifier + linkButtonStyle = + box + <<< _row + <<< _align Baseline + <<< _interactive + <<< _focusable + <<< style \(LumiTheme { fontSizes }) -> + css + { label: str "link-button" + , appearance: none + , outline: none + , background: none + , border: none + , display: str "inline-flex" + , whiteSpace: str "nowrap" + , textOverflow: str "ellipsis" + , overflow: str "hidden" + , fontSize: inherit -- TODO: Set fixed link button size? -- px fontSizes.body + , color: varButtonHue + , textDecoration: none + , "&:visited": + nested + $ css + { color: varButtonHue + , textDecoration: none + } + , "&:hover": + nested + $ css + { cursor: str "pointer" + , textDecoration: str "underline" + } + , "&:disabled": + nested + $ css + { color: varButtonHueDisabled + , "&:hover, &:active": + nested + $ css + { cursor: str "default" + , textDecoration: none + } + } + } + +recolor :: forall b. (ColorMap Color -> Color) -> ButtonModifier b +recolor f = + style + ( \theme@(LumiTheme { colors: colors@{ black, white } }) -> + let + shades = + shade { hue: f colors, black, white } + in + css + { "--button-hue": color shades.hue + , "--button-hue-darker": color shades.hueDarker + , "--button-hue-darkest": color shades.hueDarkest + , "--button-hue-disabled": color shades.hueDisabled + , "--button-grey1": color shades.grey1 + , "--button-grey2": color shades.grey2 + , "--button-black": color shades.black + , "--button-white": color shades.white + } + ) + +varButtonHue :: StyleProperty +varButtonHue = var "--button-hue" + +varButtonHueDarker :: StyleProperty +varButtonHueDarker = var "--button-hue-darker" + +varButtonHueDarkest :: StyleProperty +varButtonHueDarkest = var "--button-hue-darkest" + +varButtonHueDisabled :: StyleProperty +varButtonHueDisabled = var "--button-hue-disabled" + +varButtonGrey1 :: StyleProperty +varButtonGrey1 = var "--button-grey1" + +varButtonGrey2 :: StyleProperty +varButtonGrey2 = var "--button-grey2" + +varButtonBlack :: StyleProperty +varButtonBlack = var "--button-black" + +varButtonWhite :: StyleProperty +varButtonWhite = var "--button-white" + +------------------------------------------------------ + +-- TODO: move to react-basic-emotion +var :: String -> StyleProperty +var n = str ("var(" <> n <> ")") diff --git a/src/Lumi/Components2/ButtonGroup.purs b/src/Lumi/Components2/ButtonGroup.purs index 1260233a..6fe40904 100644 --- a/src/Lumi/Components2/ButtonGroup.purs +++ b/src/Lumi/Components2/ButtonGroup.purs @@ -3,9 +3,11 @@ module Lumi.Components2.ButtonGroup where import Prelude import Effect.Unsafe (unsafePerformEffect) +import Lumi.Components (PropsModifier) import Lumi.Components as L -import Lumi.Styles (toCSS) -import Lumi.Styles.Button as Styles.Button +import Lumi.Components.ZIndex (ziButtonGroup) +import Lumi.Styles (css, nested, px, str, style_, toCSS) +import Lumi.Styles.Box (_row, box) import Lumi.Styles.Theme (useTheme) import React.Basic.DOM as R import React.Basic.Emotion as E @@ -13,18 +15,63 @@ import React.Basic.Hooks (JSX) import React.Basic.Hooks as React type ButtonGroupProps - = ( joined :: Boolean + = ( component :: ButtonGroup , content :: Array JSX ) buttonGroup :: L.LumiComponent ButtonGroupProps buttonGroup = unsafePerformEffect do - L.lumiComponent "ButtonGroup" { joined: false, content: [] } \props -> React.do + L.lumiComponent "ButtonGroup" { component: ButtonGroup, content: [] } \props -> React.do theme <- useTheme pure $ E.element R.div' { className: props.className , children: props.content - , css: theme # toCSS (Styles.Button.buttonGroup props.joined) <> props.css + , css: theme # toCSS styles <> props.css } + + where + styles = + box + <<< _row + <<< style_ + ( css + { label: str "buttonGroup" + , "& > *:not(:last-child)": + nested + $ css + { marginRight: px 8 + } + } + ) + + +data ButtonGroup = ButtonGroup + +type ButtonGroupModifier = forall r. PropsModifier ( component :: ButtonGroup | r ) + +joined :: ButtonGroupModifier +joined = + style_ + $ css + { label: str "joined" + , "& > *:not(:last-child)": + nested + $ css + { marginRight: px (-1) + , borderTopRightRadius: px 0 + , borderBottomRightRadius: px 0 + } + , "& > *:not(:first-child)": + nested + $ css + { borderTopLeftRadius: px 0 + , borderBottomLeftRadius: px 0 + } + , "& > *:focus, & > *:hover": + nested + $ css + { zIndex: px ziButtonGroup + } + } diff --git a/src/Lumi/Components2/Clip.purs b/src/Lumi/Components2/Clip.purs index 51b937fe..135cd721 100644 --- a/src/Lumi/Components2/Clip.purs +++ b/src/Lumi/Components2/Clip.purs @@ -16,7 +16,7 @@ import Effect.Unsafe (unsafePerformEffect) import Lumi.Components (LumiComponent, lumiComponent) import Lumi.Components.Spacing (Space(..)) import Lumi.Components2.Box (box) -import Lumi.Components2.Button (_linkStyle, button) +import Lumi.Components2.Button (linkButton, varButtonBlack) import Lumi.Styles (style_, toCSS) import Lumi.Styles as S import Lumi.Styles.Box (FlexAlign(..), _align, _justify) @@ -45,8 +45,7 @@ clip = let buttonWidth = "64px" copyButton = - button - $ _linkStyle + linkButton $ style_ ( E.merge [ E.css @@ -55,14 +54,14 @@ clip = } , guard copied do E.css - { color: E.color colors.black1 + { color: varButtonBlack , "&:hover": E.nested $ E.css { textDecoration: E.none } } ] ) $ _ { content = [ R.text if copied then "Copied!" else "Copy" ] - , onPress = copy + , onPress = liftEffect copy } pure $ E.element R.div' diff --git a/src/Lumi/Components2/Link.purs b/src/Lumi/Components2/Link.purs index 23a48f29..e3ee8eaa 100644 --- a/src/Lumi/Components2/Link.purs +++ b/src/Lumi/Components2/Link.purs @@ -1,18 +1,19 @@ module Lumi.Components2.Link where import Prelude + import Data.Maybe (Maybe(..)) import Data.Newtype (un) -import Data.Nullable (toNullable) import Effect (Effect) import Effect.Uncurried (runEffectFn1) import Effect.Unsafe (unsafePerformEffect) -import Lumi.Components (LumiComponent, lumiComponent) +import Foreign.Object (fromHomogeneous) +import Lumi.Components (LumiComponent, lumiComponent, unsafeMaybeToNullableAttr) import Lumi.Styles (toCSS) import Lumi.Styles.Link as Styles.Link import Lumi.Styles.Theme (useTheme) import React.Basic.Classic (JSX) -import React.Basic.DOM (unsafeCreateDOMComponent) +import React.Basic.DOM as R import React.Basic.DOM.Events (altKey, button, ctrlKey, metaKey, preventDefault, shiftKey, stopPropagation) import React.Basic.Emotion as E import React.Basic.Events (handler, merge, syntheticEvent) @@ -22,10 +23,11 @@ import Web.HTML.History (URL(..)) type LinkProps = ( href :: URL , navigate :: Maybe (Effect Unit) - , tabIndex :: Int + , tabIndex :: Maybe Int , target :: Maybe String , rel :: Maybe String , download :: Maybe String + , ariaLabel :: Maybe String , content :: Array JSX , className :: String ) @@ -36,8 +38,9 @@ link = lumiComponent "Link" defaults \props@{ className } -> React.do theme <- useTheme pure - $ lumiAnchorElement - { css: theme # toCSS Styles.Link.link <> props.css + $ E.element R.a' + { _aria: unsafeMaybeToNullableAttr $ map (fromHomogeneous <<< { label: _ }) props.ariaLabel + , css: theme # toCSS Styles.Link.link <> props.css , children: props.content , className , href: un URL props.href @@ -52,21 +55,20 @@ link = runEffectFn1 (handler stopPropagation mempty) syntheticEvent - , target: toNullable props.target - , rel: toNullable props.rel - , tabIndex: props.tabIndex - , download: toNullable props.download + , target: unsafeMaybeToNullableAttr props.target + , rel: unsafeMaybeToNullableAttr props.rel + , tabIndex: unsafeMaybeToNullableAttr props.tabIndex + , download: unsafeMaybeToNullableAttr props.download } where - lumiAnchorElement = E.element (unsafePerformEffect $ unsafeCreateDOMComponent "a") - defaults = { className: "" , href: URL "" , navigate: Nothing - , tabIndex: 0 + , tabIndex: Nothing , target: Nothing , rel: Nothing , download: Nothing + , ariaLabel: Nothing , content: [] } diff --git a/src/Lumi/Components2/QRCode.purs b/src/Lumi/Components2/QRCode.purs index a8b67339..8cd8b257 100644 --- a/src/Lumi/Components2/QRCode.purs +++ b/src/Lumi/Components2/QRCode.purs @@ -1,14 +1,22 @@ -module Lumi.Components2.QRCode where +module Lumi.Components2.QRCode + ( useQRCode + , UseQRCode + , ErrorCorrectLevel(..) + , errorCorrectLevelToString + , qrcode_ + , generateSVGUrl + ) where import Prelude + import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) import Data.Nullable as Nullable import Effect (Effect) import Effect.Unsafe (unsafePerformEffect) import Lumi.Components (LumiComponent, lumiComponent) -import Lumi.Styles (toCSS) -import Lumi.Styles.QRCode as Styles.QRCode +import Lumi.Styles (StyleModifier, style_, toCSS) +import Lumi.Styles.Box (box) import Lumi.Styles.Theme (useTheme) import React.Basic.DOM as R import React.Basic.Emotion as E @@ -17,37 +25,6 @@ import React.Basic.Hooks as React import Web.DOM (Node) import Web.HTML.History (URL(..)) -newtype UseQRCode hooks - = UseQRCode - ( UseEffect - (UnsafeReference (LumiComponent ())) - ( UseState - (Maybe URL) - ( UseMemo - (String /\ ErrorCorrectLevel) - (LumiComponent ()) - (UseRef (Nullable.Nullable Node) hooks) - ) - ) - ) - -derive instance ntUseQRCode :: Newtype (UseQRCode hooks) _ - -data ErrorCorrectLevel - = ECLLow - | ECLMedium - | ECLQuartile - | ECLHigh - -derive instance eqErrorCorrectLevel :: Eq ErrorCorrectLevel - -errorCorrectLevelToString :: ErrorCorrectLevel -> String -errorCorrectLevelToString = case _ of - ECLLow -> "L" - ECLMedium -> "M" - ECLQuartile -> "Q" - ECLHigh -> "H" - useQRCode :: ErrorCorrectLevel -> String -> Hook UseQRCode { qrcode :: LumiComponent (), url :: Maybe URL } useQRCode level value = coerceHook React.do @@ -72,7 +49,7 @@ useQRCode level value = ] , ref , className: props.className - , css: theme # toCSS Styles.QRCode.qrcode <> props.css + , css: theme # toCSS qrcodeStyle <> props.css } url /\ setUrl <- useState Nothing useEffect (UnsafeReference qrcode) do @@ -81,6 +58,40 @@ useQRCode level value = pure svgUrl.dispose pure { qrcode, url } +qrcodeStyle :: StyleModifier +qrcodeStyle = box <<< style_ (E.css { label: E.str "qrcode" }) + +newtype UseQRCode hooks + = UseQRCode + ( UseEffect + ( UnsafeReference (LumiComponent ()) ) + ( UseState + ( Maybe URL ) + ( UseMemo + (String /\ ErrorCorrectLevel) + (LumiComponent ()) + (UseRef (Nullable.Nullable Node) hooks) + ) + ) + ) + +derive instance ntUseQRCode :: Newtype (UseQRCode hooks) _ + +data ErrorCorrectLevel + = ECLLow + | ECLMedium + | ECLQuartile + | ECLHigh + +derive instance eqErrorCorrectLevel :: Eq ErrorCorrectLevel + +errorCorrectLevelToString :: ErrorCorrectLevel -> String +errorCorrectLevelToString = case _ of + ECLLow -> "L" + ECLMedium -> "M" + ECLQuartile -> "Q" + ECLHigh -> "H" + foreign import qrcode_ :: ReactComponent { value :: String diff --git a/src/Lumi/Styles/Box.purs b/src/Lumi/Styles/Box.purs index ec495bcd..4b3ff933 100644 --- a/src/Lumi/Styles/Box.purs +++ b/src/Lumi/Styles/Box.purs @@ -85,7 +85,7 @@ _focusable :: StyleModifier _focusable = style \(LumiTheme theme) -> css - { "&:focus, &:active": + { "&:focus-within, &:active": nested $ css { outline: str "0" diff --git a/src/Lumi/Styles/Button.purs b/src/Lumi/Styles/Button.purs deleted file mode 100644 index 258b76c5..00000000 --- a/src/Lumi/Styles/Button.purs +++ /dev/null @@ -1,310 +0,0 @@ -module Lumi.Styles.Button where - -import Prelude -import Color (Color, darken, desaturate, lighten) -import Data.Foldable (fold) -import Data.Maybe (Maybe, fromMaybe) -import Lumi.Components.Size (Size(..)) -import Lumi.Components.ZIndex (ziButtonGroup) -import Lumi.Styles (StyleModifier, merge, none, style, style_) -import Lumi.Styles.Box (FlexAlign(..), _align, _focusable, _interactive, _justify, _row, box) -import Lumi.Styles.Link as Link -import Lumi.Styles.Loader (mkLoader, spin) -import Lumi.Styles.Theme (LumiTheme(..)) -import React.Basic.Emotion (color, css, px, nested, str) - -data ButtonKind - = Primary - | Secondary - | Link - -data ButtonState - = Enabled - | Disabled - | Loading - -button :: - Maybe Color -> - ButtonKind -> - ButtonState -> - Size -> - StyleModifier -button colo kind state size = case kind of - Primary -> - buttonStyle - <<< style \theme@(LumiTheme { colors }) -> - let - { hue, hueDarker, hueDarkest, hueDisabled, white } = - makeColorShades - { hue: fromMaybe colors.primary colo - , black: colors.black - , white: colors.white - } - - disabledStyles = - css - { cursor: str "default" - , color: color white - , borderColor: color hueDisabled - , backgroundColor: color hueDisabled - } - in - case state of - Enabled -> - css - { borderColor: color hue - , color: color white - , backgroundColor: color hue - , "&:hover": - nested - $ css - { borderColor: color hueDarker - , backgroundColor: color hueDarker - } - , "&:active": - nested - $ css - { borderColor: color hueDarkest - , backgroundColor: color hueDarkest - } - , "&:disabled": nested disabledStyles - } - Disabled -> disabledStyles - Loading -> - merge - [ disabledStyles - , loadingStyles theme - ] - Secondary -> - buttonStyle - <<< style \theme@(LumiTheme { colors }) -> - let - { hueDarker, hueDarkest, grey1, grey2, white, black } = - makeColorShades - { hue: fromMaybe colors.primary colo - , black: colors.black - , white: colors.white - } - - disabledStyles = - css - { cursor: str "default" - , color: color grey1 - , borderColor: color grey2 - , backgroundColor: color white - } - in - case state of - Enabled -> - css - { borderColor: color grey1 - , color: color black - , backgroundColor: color white - , "&:hover": - nested - $ css - { borderColor: color hueDarker - , color: color hueDarker - , backgroundColor: color white - } - , "&:active": - nested - $ css - { borderColor: color hueDarkest - , color: color hueDarkest - , backgroundColor: color white - } - , "&:disabled": nested disabledStyles - } - Disabled -> disabledStyles - Loading -> - merge - [ disabledStyles - , loadingStyles theme - ] - Link -> - Link.link - <<< style \(LumiTheme { colors }) -> - let - { hueDisabled } = - makeColorShades - { hue: fromMaybe colors.primary colo - , black: colors.black - , white: colors.white - } - - disabledStyles = - css - { cursor: str "default" - , color: color hueDisabled - , "&:hover, &:active": - nested - $ css - { cursor: str "default" - , textDecoration: none - } - } - in - merge - [ css - { label: str "button" - , appearance: none - , outline: none - , padding: px 0 - , background: none - , border: none - } - , case state of - Disabled -> disabledStyles - Loading -> disabledStyles - Enabled -> mempty - ] - where - buttonStyle = - box - <<< _row - <<< _align Center - <<< _justify Center - <<< case state of - Disabled -> identity - Loading -> identity - Enabled -> _interactive <<< _focusable - <<< style_ - ( css - { label: str "button" - , appearance: none - , outline: none - , minWidth: px 70 - , padding: str "10px 20px" - , fontSize: px 14 - , lineHeight: px 1 - , whiteSpace: str "nowrap" - , textOverflow: str "ellipsis" - , overflow: str "hidden" - , height: px 40 - , borderRadius: px 3 - , borderWidth: px 1 - , borderStyle: str "solid" - , "@media (min-width: 860px)": - nested - $ fold - [ css - { padding: str "6px 16px" - , height: px 32 - } - , case size of - Small -> - css - { fontSize: px 12 - , height: px 28 - } - Medium -> mempty - Large -> - css - { fontSize: px 15 - , padding: str "12px 24px" - , height: px 48 - } - ExtraLarge -> - css - { fontSize: px 20 - , padding: str "16px 32px" - , height: px 64 - } - ExtraExtraLarge -> - css - { fontSize: px 20 - , padding: str "16px 32px" - , height: px 64 - } - ] - } - ) - - loadingStyles theme = - merge - [ spin - , css - { label: str "loading" - , "&:after": nested $ mkLoader theme { radius: "16px", borderWidth: "2px" } - , "@media (min-width: 860px)": - nested case size of - Small -> - css - { "&:after": - nested - $ mkLoader theme { radius: "12px", borderWidth: "2px" } - } - Medium -> mempty - Large -> - css - { "&:after": - nested - $ mkLoader theme { radius: "24px", borderWidth: "3px" } - } - ExtraLarge -> - css - { "&:after": - nested - $ mkLoader theme { radius: "34px", borderWidth: "4px" } - } - ExtraExtraLarge -> - css - { "&:after": - nested - $ mkLoader theme { radius: "34px", borderWidth: "4px" } - } - } - ] - - makeColorShades { hue, white, black } = - let - hueDarker = darken 0.1 hue - - hueDarkest = darken 0.15 hue - - hueDisabled = lighten 0.4137 $ desaturate 0.1972 hue - - grey1 = lighten 0.7 black - - grey2 = lighten 0.82 black - in - { hue, hueDarker, hueDarkest, hueDisabled, grey1, grey2, white, black } - -buttonGroup :: Boolean -> StyleModifier -buttonGroup joined = - box - <<< _row - <<< style_ (css { label: str "buttonGroup" }) - <<< style_ - if not joined then - css - { label: str "notJoined" - , "& > *:not(:last-child)": - nested - $ css - { marginRight: px 8 - } - } - else - css - { label: str "joined" - , "& > *:not(:last-child)": - nested - $ css - { marginRight: px (-1) - , borderTopRightRadius: px 0 - , borderBottomRightRadius: px 0 - } - , "& > *:not(:first-child)": - nested - $ css - { borderTopLeftRadius: px 0 - , borderBottomLeftRadius: px 0 - } - , "& > *:focus, & > *:hover": - nested - $ css - { zIndex: px ziButtonGroup - } - } diff --git a/src/Lumi/Styles/Loader.purs b/src/Lumi/Styles/Loader.purs index a0a2bb36..62df2146 100644 --- a/src/Lumi/Styles/Loader.purs +++ b/src/Lumi/Styles/Loader.purs @@ -1,15 +1,22 @@ module Lumi.Styles.Loader where import Prelude + +import Lumi.Components.Color (Color) import Lumi.Styles (Style, StyleModifier, color, css, merge, str, style) import Lumi.Styles.Theme (LumiTheme(..)) import React.Basic.Emotion (nested) loader :: StyleModifier loader = - style \theme -> + style \(LumiTheme { colors }) -> ( merge - [ mkLoader theme { radius: "38px", borderWidth: "5px" } + [ mkLoader + { color: colors.black1 + , highlightColor: colors.black4 + , radius: "38px" + , borderWidth: "5px" + } , spin ] ) @@ -25,8 +32,14 @@ spin = } } -mkLoader :: LumiTheme -> { radius :: String, borderWidth :: String } -> Style -mkLoader (LumiTheme { colors }) { radius, borderWidth } = +mkLoader :: + { color :: Color + , highlightColor :: Color + , radius :: String + , borderWidth :: String + } -> + Style +mkLoader { color: c, highlightColor, radius, borderWidth } = css { boxSizing: str "border-box" , content: str "\"\"" @@ -35,8 +48,8 @@ mkLoader (LumiTheme { colors }) { radius, borderWidth } = , width: str radius , borderWidth: str borderWidth , borderStyle: str "solid" - , borderColor: color colors.black1 - , borderTopColor: color colors.black4 + , borderColor: color c + , borderTopColor: color highlightColor , borderRadius: str "50%" , animation: str "spin 1s infinite linear" , animationName: str "spin" diff --git a/src/Lumi/Styles/QRCode.purs b/src/Lumi/Styles/QRCode.purs deleted file mode 100644 index 0e2dfb71..00000000 --- a/src/Lumi/Styles/QRCode.purs +++ /dev/null @@ -1,15 +0,0 @@ -module Lumi.Styles.QRCode where - -import Prelude -import Lumi.Styles (StyleModifier, style_) -import Lumi.Styles.Box (box) -import React.Basic.Emotion (css, str) - -qrcode :: StyleModifier -qrcode = - box - <<< style_ - ( css - { label: str "qrcode" - } - ) From c8760a82d725a61564f4bd8263676d480376c61b Mon Sep 17 00:00:00 2001 From: Madeline Trotter Date: Sat, 8 Aug 2020 15:51:57 -0700 Subject: [PATCH 2/4] Additional button modifiers --- docs/Examples2/Button.example.purs | 37 +++--- docs/Examples2/ButtonGroup.example.purs | 70 ++++++------ src/Lumi/Components.purs | 2 +- src/Lumi/Components/EditableTable.purs | 24 ++-- src/Lumi/Components2/Button.purs | 145 ++++++++++++++---------- src/Lumi/Components2/Clip.purs | 10 +- src/Lumi/Styles/Loader.purs | 16 +-- 7 files changed, 162 insertions(+), 142 deletions(-) diff --git a/docs/Examples2/Button.example.purs b/docs/Examples2/Button.example.purs index 0ecb72ee..29fbaa52 100644 --- a/docs/Examples2/Button.example.purs +++ b/docs/Examples2/Button.example.purs @@ -5,14 +5,14 @@ import Prelude import Data.Array (intercalate) import Effect.Aff (Milliseconds(..), delay) import Effect.Class (liftEffect) -import Lumi.Components (propsModifier, ($$$)) +import Lumi.Components (($$$)) import Lumi.Components.Column (column_) import Lumi.Components.Example (example) import Lumi.Components.Icon (IconType(..), icon) import Lumi.Components.Size (Size(..)) import Lumi.Components.Spacing (Space(..), hspace, vspace) import Lumi.Components.Text (h2_, h4_) -import Lumi.Components2.Button (ButtonState(..), button, linkButton, resize, secondary) +import Lumi.Components2.Button (ButtonState(..), button, linkButton, onPress, resize, secondary, submit) import Lumi.Styles.Box (_interactive) import React.Basic.Classic (JSX) import React.Basic.DOM as R @@ -25,7 +25,8 @@ docs = $ intercalate [ vspace S16 ] [ [ example $ button - $ propsModifier _ { onPress = delay $ Milliseconds 1000.0 } + $ onPress do + delay $ Milliseconds 1000.0 $$$ [ column_ [ R.text "Click me" ] ] ] , [ h2_ "Disabled" @@ -63,21 +64,19 @@ docs = , example $ button $ _interactive - $ _ { content = [ R.text "Button" ] } + $$$ [ R.text "Button" ] ] , [ h4_ "Primary + Disabled" , example $ button - $ _ - { content = [ R.text "Button" ] - , state = Disabled - } + $ submit Disabled + $$$ [ R.text "Button" ] ] , [ h4_ "Secondary (outline)" , example $ button $ secondary - $ _ { content = [ R.text "Button" ] } + $$$ [ R.text "Button" ] ] , [ h4_ "Secondary Small" , example @@ -104,7 +103,7 @@ docs = , example $ button $ secondary - $ propsModifier _ { state = Disabled } + $ submit Disabled $$$ [ R.text "Button" ] ] , [ h4_ "Icon button" @@ -126,39 +125,41 @@ docs = , [ h4_ "Link style" , example $ linkButton - $ propsModifier _ { onPress = liftEffect do alert "asdf" =<< window } + $ onPress do + liftEffect do alert "asdf" =<< window $$$ [ R.text "Button w/ link style" ] , example $ linkButton - $ propsModifier _ { onPress = liftEffect do alert "asdf" =<< window } - $ propsModifier _ { state = Disabled } - $$$ [ R.text "Button w/ link style" ] + $ submit Disabled + $ onPress do + liftEffect do alert "asdf" =<< window + $$$ [ R.text "Button w/ link style (disabled)" ] ] , [ h4_ "Loading (Medium/default)" , example $ button - $ propsModifier _ { state = Loading } + $ submit Loading $$$ [ R.text "Save" ] ] , [ h4_ "Loading (Small) " , example $ button $ resize Small - $ propsModifier _ { state = Loading } + $ submit Loading $$$ [ R.text "Save" ] ] , [ h4_ "Loading (Large) " , example $ button $ resize Large - $ propsModifier _ { state = Loading } + $ submit Loading $$$ [ R.text "Save" ] ] , [ h4_ "Loading (ExtraLarge) " , example $ button $ resize ExtraLarge - $ propsModifier _ { state = Loading } + $ submit Loading $$$ [ R.text "Save" ] ] ] diff --git a/docs/Examples2/ButtonGroup.example.purs b/docs/Examples2/ButtonGroup.example.purs index 0e723289..10e91f84 100644 --- a/docs/Examples2/ButtonGroup.example.purs +++ b/docs/Examples2/ButtonGroup.example.purs @@ -20,45 +20,39 @@ docs = $ [ h2_ "Not Joined" , example $ buttonGroup - $ _ - { content = - [ button _ { content = [ R.text "Button" ] } - , button - $ secondary - $ _ { content = [ R.text "Button" ] } - ] - } + $$$ + [ button $$$ [ R.text "Button" ] + , button + $ secondary + $$$ [ R.text "Button" ] + ] , h2_ "Not Joined" , example $ buttonGroup - $ _ - { content = - [ button _ { content = [ R.text "Button" ] } - , button - $ secondary - $ _ { content = [ R.text "Button" ] } - , button - $ secondary - $ _ { content = [ R.text "Button" ] } - ] - } + $$$ + [ button $$$ [ R.text "Button" ] + , button + $ secondary + $$$ [ R.text "Button" ] + , button + $ secondary + $$$ [ R.text "Button" ] + ] , h2_ "Not Joined" , example $ buttonGroup - $ _ - { content = - [ button _ { content = [ R.text "Button" ] } - , nativeSelect - defaults - { options = [] - , onChange = mkEffectFn1 \_ -> log "onChange" - , value = "Foo bar" - } - , button - $ secondary - $ _ { content = [ R.text "Button" ] } - ] - } + $$$ + [ button $$$ [ R.text "Button" ] + , nativeSelect + defaults + { options = [] + , onChange = mkEffectFn1 \_ -> log "onChange" + , value = "Foo bar" + } + , button + $ secondary + $$$ [ R.text "Button" ] + ] , h2_ "Joined" , example $ buttonGroup @@ -66,10 +60,10 @@ docs = $$$ [ button $ secondary - $ _ { content = [ R.text "Button" ] } + $$$ [ R.text "Button" ] , button $ secondary - $ _ { content = [ R.text "Button" ] } + $$$ [ R.text "Button" ] ] , h2_ "Joined" , example @@ -78,12 +72,12 @@ docs = $$$ [ button $ secondary - $ _ { content = [ R.text "Button" ] } + $$$ [ R.text "Button" ] , button $ secondary - $ _ { content = [ R.text "Button" ] } + $$$ [ R.text "Button" ] , button $ secondary - $ _ { content = [ R.text "Button" ] } + $$$ [ R.text "Button" ] ] ] diff --git a/src/Lumi/Components.purs b/src/Lumi/Components.purs index 9e3d3409..2d9ae998 100644 --- a/src/Lumi/Components.purs +++ b/src/Lumi/Components.purs @@ -139,7 +139,7 @@ lumiElement (LumiInternalComponent { component, defaults, className }) modifyPro -- | Unsafely nulls out a value so the resulting html attributes are less noisy -- | Ex: `R.input { type: unsafeMaybeToNullableAttr Nothing }` avoids rendering -- | the `type` attribute while still validating the type of the Maybe's content --- | matches the type of the DOM field. It's slightly safer than using +-- | matches the type of the DOM field. It's only slightly safer than using -- | `unsafeCreateDOMComponent` to avoid DOM type checking entirely. unsafeMaybeToNullableAttr :: forall a. Maybe a -> a unsafeMaybeToNullableAttr = unsafeCoerce <<< toNullable diff --git a/src/Lumi/Components/EditableTable.purs b/src/Lumi/Components/EditableTable.purs index baafbf97..ea60cada 100644 --- a/src/Lumi/Components/EditableTable.purs +++ b/src/Lumi/Components/EditableTable.purs @@ -19,7 +19,7 @@ import Lumi.Components.Column (column_) import Lumi.Components.Icon (IconType(..), icon, icon_) import Lumi.Components.Text (nbsp) import Lumi.Components2.Box (row) -import Lumi.Components2.Button (linkButton, recolor, varButtonHueDarker, varButtonHueDarkest) +import Lumi.Components2.Button (linkButton, onPress, recolor, varButtonHueDarker, varButtonHueDarkest) import Lumi.Components2.Text as T import Lumi.Styles as S import Lumi.Styles.Box (FlexAlign(..), _align, _justify) @@ -78,9 +78,8 @@ defaultRemoveCell onRowRemove item = } } ) - $ _ { onPress = liftEffect do onRowRemove' item - , content = [ icon_ Bin ] - } + $ onPress do liftEffect do onRowRemove' item + $$$ [ icon_ Bin ] component :: forall row. Component (EditableTableProps row) component = createComponent "EditableTableExample" @@ -172,15 +171,14 @@ editableTable = makeStateless component render } } ) - $ _ { onPress = liftEffect onRowAdd - , content = - [ icon - { type_: Plus - , style: R.css { fontSize: "11px" } - } - , T.text $$$ nbsp <> nbsp <> addLabel - ] - } + $ onPress do liftEffect onRowAdd + $$$ + [ icon + { type_: Plus + , style: R.css { fontSize: "11px" } + } + , T.text $$$ nbsp <> nbsp <> addLabel + ] ] ] , colSpan: columnCount diff --git a/src/Lumi/Components2/Button.purs b/src/Lumi/Components2/Button.purs index 046657ce..dbfc631a 100644 --- a/src/Lumi/Components2/Button.purs +++ b/src/Lumi/Components2/Button.purs @@ -13,6 +13,8 @@ module Lumi.Components2.Button , varButtonHue, varButtonHueDarker, varButtonHueDarkest , varButtonHueDisabled, varButtonGrey1, varButtonGrey2 , varButtonBlack, varButtonWhite + + , submit, reset, onPress, autoFocus, tabIndex, ariaLabel ) where import Prelude @@ -25,7 +27,7 @@ import Effect.Aff (Aff, finally, launchAff_) import Effect.Class (liftEffect) import Effect.Unsafe (unsafePerformEffect) import Foreign.Object (fromHomogeneous) -import Lumi.Components (LumiComponent, PropsModifier, lumiComponent, unsafeMaybeToNullableAttr) +import Lumi.Components (LumiComponent, PropsModifier, lumiComponent, propsModifier, unsafeMaybeToNullableAttr) import Lumi.Components.Button (invisibleSpace) import Lumi.Components.Color (ColorMap, shade) import Lumi.Components.Size (Size(..)) @@ -59,9 +61,6 @@ type ButtonProps , onPress :: Aff Unit , type :: ButtonType , state :: ButtonState - -- Set `ariaLabel` when the button content is not legible text, - -- for example a button that only contains an X might set this - -- label to "Close". , ariaLabel :: Maybe String , content :: Array JSX ) @@ -124,21 +123,23 @@ button = primary >>> else Nothing , children: - [ Box.box _ - { className = "button-content" - , content = - if Array.length props.content == 0 then - [ R.text invisibleSpace ] -- preserves button size when content is empty - else - props.content - } + [ Box.box + $ _row + $ _align Center + $ _justify Center + $ _ { className = "button-content" + , content = + if Array.length props.content == 0 then + [ R.text invisibleSpace ] -- preserves button size when content is empty + else + props.content + } ] } where buttonStyle :: StyleModifier buttonStyle = box - <<< _row <<< _align Center <<< _justify Center <<< _interactive @@ -179,8 +180,8 @@ button = primary >>> , mkLoader { color: colors.white , highlightColor: colors.transparent - , radius: "16px" - , borderWidth: "2px" + , radius: px 16 + , borderWidth: px 2 } ] , "> .button-content": nested $ css { opacity: str "0" } @@ -188,7 +189,18 @@ button = primary >>> ] } -type ButtonModifier c = forall r. PropsModifier ( component :: c | r ) +type ButtonModifier c = + forall r. + PropsModifier + ( component :: c + , autoFocus :: Boolean + , tabIndex :: Maybe Int + , type :: ButtonType + , state :: ButtonState + , onPress :: Aff Unit + , ariaLabel :: Maybe String + | r + ) -- The default button style primary :: ButtonModifier Button @@ -258,7 +270,7 @@ secondary = resize :: Size -> ButtonModifier Button resize size = - style \(LumiTheme { fontSizes, lineHeightFactor, textMarginFactor }) -> + style \(LumiTheme { colors, fontSizes, lineHeightFactor, textMarginFactor }) -> css { "@media (min-width: 860px)": nested @@ -269,6 +281,8 @@ resize size = { fontSize: px fontSizes.subtext , padding: str "6px 16px" , height: px 28 + , "&[data-loading]": + loadingStyles colors { radius: px 12, borderWidth: px 2 } } Medium -> mempty @@ -277,58 +291,40 @@ resize size = { fontSize: px fontSizes.subsectionHeader , padding: str "12px 24px" , height: px 48 + , "&[data-loading]": + loadingStyles colors { radius: px 24, borderWidth: px 3 } } ExtraLarge -> css { fontSize: px fontSizes.sectionHeader , padding: str "16px 32px" , height: px 64 + , "&[data-loading]": + loadingStyles colors { radius: px 34, borderWidth: px 4 } } ExtraExtraLarge -> css { fontSize: px fontSizes.sectionHeader , padding: str "16px 32px" , height: px 64 + , "&[data-loading]": + loadingStyles colors { radius: px 34, borderWidth: px 4 } } ] } - - -- loadingStyles theme size = - -- merge - -- [ spin - -- , css - -- { label: str "loading" - -- , "&:after": nested $ mkLoader theme { radius: "16px", borderWidth: "2px" } - -- , "@media (min-width: 860px)": - -- nested case size of - -- Small -> - -- css - -- { "&:after": - -- nested - -- $ mkLoader theme { radius: "12px", borderWidth: "2px" } - -- } - -- Medium -> mempty - -- Large -> - -- css - -- { "&:after": - -- nested - -- $ mkLoader theme { radius: "24px", borderWidth: "3px" } - -- } - -- ExtraLarge -> - -- css - -- { "&:after": - -- nested - -- $ mkLoader theme { radius: "34px", borderWidth: "4px" } - -- } - -- ExtraExtraLarge -> - -- css - -- { "&:after": - -- nested - -- $ mkLoader theme { radius: "34px", borderWidth: "4px" } - -- } - -- } - -- ] - + where + loadingStyles colors { radius, borderWidth } = + nested + $ css + { "&:after": + nested + $ mkLoader + { color: colors.white + , highlightColor: colors.transparent + , radius + , borderWidth + } + } data LinkButton = LinkButton @@ -339,9 +335,6 @@ type LinkButtonProps , onPress :: Aff Unit , type :: ButtonType , state :: ButtonState - -- Set `ariaLabel` when the button content is not legible text, - -- for example a button that only contains an X might set this - -- label to "Close". , ariaLabel :: Maybe String , content :: Array JSX ) @@ -444,7 +437,7 @@ linkButton = recolor _.primary >>> } } -recolor :: forall b. (ColorMap Color -> Color) -> ButtonModifier b +recolor :: forall c. (ColorMap Color -> Color) -> ButtonModifier c recolor f = style ( \theme@(LumiTheme { colors: colors@{ black, white } }) -> @@ -488,6 +481,42 @@ varButtonBlack = var "--button-black" varButtonWhite :: StyleProperty varButtonWhite = var "--button-white" +-- | A form submit button. This helper takes the button state +-- | as an argument because a form's buttons are generally +-- | tied to the validity and `onSubmit` behavior of the form, +-- | rather than providing an `onPress` action to the button +-- | itself. +submit :: forall c. ButtonState -> ButtonModifier c +submit state = propsModifier _ { type = Submit, state = state } + +-- | A form reset button. This helper takes the button state +-- | as an argument because a form's buttons are generally +-- | tied to the validity and `onSubmit` behavior of the form, +-- | rather than providing an `onPress` action to the button +-- | itself. +reset :: forall c. ButtonState -> ButtonModifier c +reset state = propsModifier _ { type = Reset, state = state } + +-- | A non-form button with customized `onPress` behavior. The +-- | button will automatically display a loading state while +-- | the action is in-progress. +onPress :: forall c. Aff Unit -> ButtonModifier c +onPress a = propsModifier _ { onPress = a } + +-- | Auto-focus this button. Only one element on the page should +-- | have `autoFocus` set at a time. +autoFocus :: forall c. ButtonModifier c +autoFocus = propsModifier _ { autoFocus = true } + +tabIndex :: forall c. Int -> ButtonModifier c +tabIndex i = propsModifier _ { tabIndex = Just i } + +-- | Set `ariaLabel` when the button content is not legible text, +-- | for example a button that only contains an X might set this +-- | label to "Close". +ariaLabel :: forall c. String -> ButtonModifier c +ariaLabel l = propsModifier _ { ariaLabel = Just l } + ------------------------------------------------------ -- TODO: move to react-basic-emotion diff --git a/src/Lumi/Components2/Clip.purs b/src/Lumi/Components2/Clip.purs index 135cd721..378d8a07 100644 --- a/src/Lumi/Components2/Clip.purs +++ b/src/Lumi/Components2/Clip.purs @@ -13,10 +13,10 @@ import Effect.Class (liftEffect) import Effect.Console as Console import Effect.Uncurried (EffectFn1, EffectFn3, mkEffectFn1, runEffectFn3) import Effect.Unsafe (unsafePerformEffect) -import Lumi.Components (LumiComponent, lumiComponent) +import Lumi.Components (LumiComponent, lumiComponent, ($$$)) import Lumi.Components.Spacing (Space(..)) import Lumi.Components2.Box (box) -import Lumi.Components2.Button (linkButton, varButtonBlack) +import Lumi.Components2.Button (linkButton, onPress, varButtonBlack) import Lumi.Styles (style_, toCSS) import Lumi.Styles as S import Lumi.Styles.Box (FlexAlign(..), _align, _justify) @@ -59,10 +59,8 @@ clip = } ] ) - $ _ - { content = [ R.text if copied then "Copied!" else "Copy" ] - , onPress = liftEffect copy - } + $ onPress do liftEffect copy + $$$ [ R.text if copied then "Copied!" else "Copy" ] pure $ E.element R.div' { className: props.className diff --git a/src/Lumi/Styles/Loader.purs b/src/Lumi/Styles/Loader.purs index 62df2146..9f4d0d01 100644 --- a/src/Lumi/Styles/Loader.purs +++ b/src/Lumi/Styles/Loader.purs @@ -3,7 +3,7 @@ module Lumi.Styles.Loader where import Prelude import Lumi.Components.Color (Color) -import Lumi.Styles (Style, StyleModifier, color, css, merge, str, style) +import Lumi.Styles (Style, StyleModifier, StyleProperty, color, css, merge, px, str, style) import Lumi.Styles.Theme (LumiTheme(..)) import React.Basic.Emotion (nested) @@ -14,8 +14,8 @@ loader = [ mkLoader { color: colors.black1 , highlightColor: colors.black4 - , radius: "38px" - , borderWidth: "5px" + , radius: px 38 + , borderWidth: px 5 } , spin ] @@ -35,8 +35,8 @@ spin = mkLoader :: { color :: Color , highlightColor :: Color - , radius :: String - , borderWidth :: String + , radius :: StyleProperty + , borderWidth :: StyleProperty } -> Style mkLoader { color: c, highlightColor, radius, borderWidth } = @@ -44,9 +44,9 @@ mkLoader { color: c, highlightColor, radius, borderWidth } = { boxSizing: str "border-box" , content: str "\"\"" , display: str "inline-block" - , height: str radius - , width: str radius - , borderWidth: str borderWidth + , height: radius + , width: radius + , borderWidth: borderWidth , borderStyle: str "solid" , borderColor: color c , borderTopColor: color highlightColor From 1e9244e86b434805bde5817e249bccc2056754e8 Mon Sep 17 00:00:00 2001 From: Madeline Trotter Date: Sat, 8 Aug 2020 21:30:43 -0700 Subject: [PATCH 3/4] Add alternate content for loading link buttons --- bower.json | 2 +- docs/Examples2/Button.example.purs | 20 +++- docs/Examples2/Clip.example.purs | 1 - src/Lumi/Components/Button.purs | 32 ++++- src/Lumi/Components/EditableTable.purs | 2 +- src/Lumi/Components/Loader.purs | 24 +++- src/Lumi/Components2/Button.purs | 154 +++++++++++++++---------- src/Lumi/Components2/Clip.purs | 88 +++++--------- src/Lumi/Components2/Text.purs | 22 ++-- src/Lumi/Styles/Border.purs | 6 +- src/Lumi/Styles/Box.purs | 41 +++---- src/Lumi/Styles/Clip.purs | 1 + src/Lumi/Styles/Link.purs | 7 +- src/Lumi/Styles/Loader.purs | 43 +++---- 14 files changed, 244 insertions(+), 199 deletions(-) diff --git a/bower.json b/bower.json index 8666b17a..9b4b3955 100644 --- a/bower.json +++ b/bower.json @@ -32,7 +32,7 @@ "purescript-react-basic": "^15.0.0", "purescript-react-basic-dom": "lumihq/purescript-react-basic-dom#^2.0.0", "purescript-react-basic-classic": "lumihq/purescript-react-basic-classic#^1.0.1", - "purescript-react-basic-emotion": "^4.2.2", + "purescript-react-basic-emotion": "more-helpers", "purescript-react-basic-hooks": "^6.0.0", "purescript-react-dnd-basic": "^7.0.0", "purescript-record": ">= 1.0.0 < 3.0.0", diff --git a/docs/Examples2/Button.example.purs b/docs/Examples2/Button.example.purs index 29fbaa52..9a6f6362 100644 --- a/docs/Examples2/Button.example.purs +++ b/docs/Examples2/Button.example.purs @@ -2,6 +2,8 @@ module Lumi.Components2.Examples.Button where import Prelude +import Color (lighten) +import Color.Scheme.MaterialDesign as Colors import Data.Array (intercalate) import Effect.Aff (Milliseconds(..), delay) import Effect.Class (liftEffect) @@ -12,7 +14,9 @@ import Lumi.Components.Icon (IconType(..), icon) import Lumi.Components.Size (Size(..)) import Lumi.Components.Spacing (Space(..), hspace, vspace) import Lumi.Components.Text (h2_, h4_) -import Lumi.Components2.Button (ButtonState(..), button, linkButton, onPress, resize, secondary, submit) +import Lumi.Components2.Button (ButtonState(..), button, linkButton, loadingContent, onPress, resize, secondary, submit) +import Lumi.Styles (style_) +import Lumi.Styles as S import Lumi.Styles.Box (_interactive) import React.Basic.Classic (JSX) import React.Basic.DOM as R @@ -127,7 +131,21 @@ docs = $ linkButton $ onPress do liftEffect do alert "asdf" =<< window + $ loadingContent [ R.text "Loading..." ] $$$ [ R.text "Button w/ link style" ] + , example + $ linkButton + $ style_ + ( S.css + { borderColor: S.color $ lighten 0.4 Colors.purple + , borderStyle: S.solid + , borderSize: S.px 2 + } + ) + $ onPress do + delay $ Milliseconds 1000.0 + $ loadingContent [ R.text "Border size remains unchanged -->" ] + $$$ [ R.text "Link buttons retain their size when displaying their loading state (click me)" ] , example $ linkButton $ submit Disabled diff --git a/docs/Examples2/Clip.example.purs b/docs/Examples2/Clip.example.purs index a43db003..119cc356 100644 --- a/docs/Examples2/Clip.example.purs +++ b/docs/Examples2/Clip.example.purs @@ -28,6 +28,5 @@ docs = $$$ [ T.text $$$ "someone@email.com" ] ] } - , T.paragraph_ $$$ "The Clip behavior is also available as a React hook." ] } diff --git a/src/Lumi/Components/Button.purs b/src/Lumi/Components/Button.purs index 29a7deda..03789709 100644 --- a/src/Lumi/Components/Button.purs +++ b/src/Lumi/Components/Button.purs @@ -237,16 +237,40 @@ styles = jss } } , "&[data-loading=\"true\"]": - { "&:after": spinnerMixin { radius: "16px", borderWidth: "2px" } + { "&:after": + spinnerMixin + { color: colors.white + , highlightColor: colors.transparent + , radius: "16px" + , borderWidth: "2px" + } , "@media (min-width: $break-point-mobile)": { "&[data-size=\"small\"]": - { "&:after": spinnerMixin { radius: "12px", borderWidth: "2px" } + { "&:after": + spinnerMixin + { color: colors.white + , highlightColor: colors.transparent + , radius: "12px" + , borderWidth: "2px" + } } , "&[data-size=\"large\"]": - { "&:after": spinnerMixin { radius: "24px", borderWidth: "3px" } + { "&:after": + spinnerMixin + { color: colors.white + , highlightColor: colors.transparent + , radius: "24px" + , borderWidth: "3px" + } } , "&[data-size=\"extra-large\"]": - { "&:after": spinnerMixin { radius: "34px", borderWidth: "4px" } + { "&:after": + spinnerMixin + { color: colors.white + , highlightColor: colors.transparent + , radius: "34px" + , borderWidth: "4px" + } } } } diff --git a/src/Lumi/Components/EditableTable.purs b/src/Lumi/Components/EditableTable.purs index ea60cada..e1e40fa6 100644 --- a/src/Lumi/Components/EditableTable.purs +++ b/src/Lumi/Components/EditableTable.purs @@ -60,7 +60,7 @@ editableTableDefaults = defaultRemoveCell :: forall row. Maybe (row -> Effect Unit) -> row -> JSX defaultRemoveCell onRowRemove item = onRowRemove # Array.foldMap \onRowRemove' -> - linkButton -- TODO: this link button should be a new "icon button" style + linkButton $ recolor _.black1 $ S.style ( \(LumiTheme { colors }) -> diff --git a/src/Lumi/Components/Loader.purs b/src/Lumi/Components/Loader.purs index 9d7f4c9d..eb234e47 100644 --- a/src/Lumi/Components/Loader.purs +++ b/src/Lumi/Components/Loader.purs @@ -6,7 +6,7 @@ import Color (cssStringHSLA) import Data.Nullable (Nullable) import Effect.Unsafe (unsafePerformEffect) import JSS (JSS, jss) -import Lumi.Components.Color (colors) +import Lumi.Components.Color (Color, colors) import React.Basic.Classic (Component, JSX, createComponent, element, makeStateless) import React.Basic.DOM (CSS, unsafeCreateDOMComponent) @@ -32,7 +32,13 @@ styles :: JSS styles = jss { "@global": - { "lumi-loader": spinnerMixin { radius: "38px", borderWidth: "5px" } + { "lumi-loader": + spinnerMixin + { color: colors.black1 + , highlightColor: colors.black4 + , radius: "38px" + , borderWidth: "5px" + } , "@keyframes spin": { from: { transform: "rotate(0deg)" } , to: { transform: "rotate(360deg)" } @@ -40,16 +46,22 @@ styles = } } -spinnerMixin :: { radius :: String, borderWidth :: String } -> JSS -spinnerMixin { radius, borderWidth } = +spinnerMixin :: + { color :: Color + , highlightColor :: Color + , radius :: String + , borderWidth :: String + } -> + JSS +spinnerMixin { color: c, highlightColor, radius, borderWidth } = jss { boxSizing: "border-box" , content: "\"\"" , display: "inline-block" , height: radius , width: radius - , border: [ borderWidth, "solid", cssStringHSLA colors.black1 ] - , borderTopColor: cssStringHSLA colors.black4 + , border: [ borderWidth, "solid", cssStringHSLA c ] + , borderTopColor: cssStringHSLA highlightColor , borderRadius: "50%" , animation: "spin 1s infinite linear" , animationName: "spin" diff --git a/src/Lumi/Components2/Button.purs b/src/Lumi/Components2/Button.purs index dbfc631a..d5650a2a 100644 --- a/src/Lumi/Components2/Button.purs +++ b/src/Lumi/Components2/Button.purs @@ -7,7 +7,7 @@ module Lumi.Components2.Button , LinkButton , ButtonModifier - , primary, secondary, resize + , primary, secondary, resize, loadingContent , recolor , varButtonHue, varButtonHueDarker, varButtonHueDarkest @@ -32,9 +32,9 @@ import Lumi.Components.Button (invisibleSpace) import Lumi.Components.Color (ColorMap, shade) import Lumi.Components.Size (Size(..)) import Lumi.Components2.Box as Box -import Lumi.Styles (StyleModifier, StyleProperty, color, css, inherit, merge, nested, none, px, str, style, style_, toCSS) +import Lumi.Styles (StyleModifier, StyleProperty, absolute, color, css, default, ellipsis, hidden, inherit, inlineFlex, merge, nested, none, nowrap, pointer, px, px2, solid, str, style, style_, toCSS, underline, var) import Lumi.Styles.Box (FlexAlign(..), _align, _focusable, _interactive, _justify, _row, box) -import Lumi.Styles.Loader (mkLoader, spin) +import Lumi.Styles.Loader (mkLoader) import Lumi.Styles.Theme (LumiTheme(..), useTheme) import React.Basic.DOM as R import React.Basic.Emotion as E @@ -151,42 +151,39 @@ button = primary >>> , outline: none , minWidth: px 70 , lineHeight: px 1 - , whiteSpace: str "nowrap" - , textOverflow: str "ellipsis" - , overflow: str "hidden" + , whiteSpace: nowrap + , textOverflow: ellipsis + , overflow: hidden , borderRadius: px 3 , borderWidth: px 1 - , borderStyle: str "solid" + , borderStyle: solid , fontSize: px fontSizes.body - , padding: str "10px 20px" + , padding: px2 10 20 , height: px 40 , "@media (min-width: 860px)": nested $ css { fontSize: px fontSizes.body - , padding: str "6px 16px" + , padding: px2 6 16 , height: px 32 } - , "&:disabled": nested $ css { cursor: str "default" } + , "&:disabled": nested $ css { cursor: default } , "&[data-loading]": nested - $ merge - [ spin - , css - { "&:after": - nested - $ merge - [ css { position: str "absolute" } - , mkLoader - { color: colors.white - , highlightColor: colors.transparent - , radius: px 16 - , borderWidth: px 2 - } - ] - , "> .button-content": nested $ css { opacity: str "0" } - } - ] + $ css + { "&:after": + nested + $ merge + [ css { position: absolute } + , mkLoader + { color: colors.white + , highlightColor: colors.transparent + , radius: px 16 + , borderWidth: px 2 + } + ] + , "> .button-content": nested $ css { visibility: hidden } + } } type ButtonModifier c = @@ -279,7 +276,7 @@ resize size = Small -> css { fontSize: px fontSizes.subtext - , padding: str "6px 16px" + , padding: px2 6 16 , height: px 28 , "&[data-loading]": loadingStyles colors { radius: px 12, borderWidth: px 2 } @@ -289,7 +286,7 @@ resize size = Large -> css { fontSize: px fontSizes.subsectionHeader - , padding: str "12px 24px" + , padding: px2 12 24 , height: px 48 , "&[data-loading]": loadingStyles colors { radius: px 24, borderWidth: px 3 } @@ -297,7 +294,7 @@ resize size = ExtraLarge -> css { fontSize: px fontSizes.sectionHeader - , padding: str "16px 32px" + , padding: px2 16 32 , height: px 64 , "&[data-loading]": loadingStyles colors { radius: px 34, borderWidth: px 4 } @@ -305,7 +302,7 @@ resize size = ExtraExtraLarge -> css { fontSize: px fontSizes.sectionHeader - , padding: str "16px 32px" + , padding: px2 16 32 , height: px 64 , "&[data-loading]": loadingStyles colors { radius: px 34, borderWidth: px 4 } @@ -337,6 +334,7 @@ type LinkButtonProps , state :: ButtonState , ariaLabel :: Maybe String , content :: Array JSX + , loadingContent :: Maybe (Array JSX) ) linkButton :: LumiComponent LinkButtonProps @@ -354,11 +352,23 @@ linkButton = recolor _.primary >>> , state: Enabled , ariaLabel: Nothing , content: mempty + , loadingContent: Nothing } render props = React.do theme <- useTheme clickInProgress /\ setClickInProgress <- useState' false + let + loading = + clickInProgress || case props.state of + Enabled -> false + Disabled -> false + Loading -> true + disabled = + loading || case props.state of + Enabled -> false + Disabled -> true + Loading -> true pure $ E.element R.button' { _aria: @@ -378,38 +388,48 @@ linkButton = recolor _.primary >>> Button -> "button" Submit -> "submit" Reset -> "reset" - , disabled: - clickInProgress || - case props.state of - Enabled -> false - Disabled -> true - Loading -> true + , disabled + , _data: + unsafeMaybeToNullableAttr + if loading then + Just (fromHomogeneous { loading: "" }) + else + Nothing , children: - if Array.length props.content == 0 then - [ R.text invisibleSpace ] -- preserves button size when content is empty - else - props.content + [ props.loadingContent # Array.foldMap \lc -> + Box.box + $ _row + $ _justify Baseline + $ _ { className = "button-loading-content" + , content = lc + } + , Box.box + $ _row + $ _justify Baseline + $ _ { className = "button-content" + , content = props.content + } + ] } where linkButtonStyle :: StyleModifier linkButtonStyle = box - <<< _row - <<< _align Baseline <<< _interactive <<< _focusable - <<< style \(LumiTheme { fontSizes }) -> - css + <<< style_ + ( css { label: str "link-button" , appearance: none , outline: none , background: none , border: none - , display: str "inline-flex" - , whiteSpace: str "nowrap" - , textOverflow: str "ellipsis" - , overflow: str "hidden" - , fontSize: inherit -- TODO: Set fixed link button size? -- px fontSizes.body + , display: inlineFlex + , whiteSpace: nowrap + , textOverflow: ellipsis + , overflow: hidden + , fontSize: inherit -- A link button might appear in a paragraph of text + -- and should inherit its size accordingly , color: varButtonHue , textDecoration: none , "&:visited": @@ -421,8 +441,8 @@ linkButton = recolor _.primary >>> , "&:hover": nested $ css - { cursor: str "pointer" - , textDecoration: str "underline" + { cursor: pointer + , textDecoration: underline } , "&:disabled": nested @@ -431,11 +451,24 @@ linkButton = recolor _.primary >>> , "&:hover, &:active": nested $ css - { cursor: str "default" + { cursor: default , textDecoration: none } } + , "&[data-loading] > .button-loading-content + .button-content, &:not([data-loading]) > .button-loading-content": + -- Flattens the button content which is not currently active. + -- This preserves the button width regardless which state the + -- button is in. + nested $ css { height: px 0, overflow: hidden } } + ) + +-- | `loadingContent` sets the content to display while a link button +-- | is in its loading state. The size of the link button will always +-- | fit the larger content, regardless which state it's in. +loadingContent :: Array JSX -> forall r. PropsModifier ( component :: LinkButton, loadingContent :: Maybe (Array JSX) | r ) +loadingContent a = + propsModifier _ { loadingContent = Just a } recolor :: forall c. (ColorMap Color -> Color) -> ButtonModifier c recolor f = @@ -497,11 +530,12 @@ submit state = propsModifier _ { type = Submit, state = state } reset :: forall c. ButtonState -> ButtonModifier c reset state = propsModifier _ { type = Reset, state = state } --- | A non-form button with customized `onPress` behavior. The --- | button will automatically display a loading state while --- | the action is in-progress. +-- | A button with customized `onPress` behavior. The button will +-- | automatically display a loading state while the action is in-progress. +-- | Using `onPress` on a button multiple times chains the effects together +-- | from the first applied, out. onPress :: forall c. Aff Unit -> ButtonModifier c -onPress a = propsModifier _ { onPress = a } +onPress a = propsModifier \props -> props { onPress = props.onPress *> a } -- | Auto-focus this button. Only one element on the page should -- | have `autoFocus` set at a time. @@ -516,9 +550,3 @@ tabIndex i = propsModifier _ { tabIndex = Just i } -- | label to "Close". ariaLabel :: forall c. String -> ButtonModifier c ariaLabel l = propsModifier _ { ariaLabel = Just l } - ------------------------------------------------------- - --- TODO: move to react-basic-emotion -var :: String -> StyleProperty -var n = str ("var(" <> n <> ")") diff --git a/src/Lumi/Components2/Clip.purs b/src/Lumi/Components2/Clip.purs index 378d8a07..f1199674 100644 --- a/src/Lumi/Components2/Clip.purs +++ b/src/Lumi/Components2/Clip.purs @@ -2,33 +2,30 @@ module Lumi.Components2.Clip where import Prelude +import Data.Either (Either(..)) import Data.Foldable (for_) -import Data.Monoid (guard) -import Data.Newtype (class Newtype) import Data.Nullable (Nullable) import Data.Nullable as Nullable import Effect (Effect) -import Effect.Aff (Error, Milliseconds(..), delay, message) +import Effect.Aff (Aff, Error, Milliseconds(..), delay, makeAff, message, nonCanceler) import Effect.Class (liftEffect) import Effect.Console as Console import Effect.Uncurried (EffectFn1, EffectFn3, mkEffectFn1, runEffectFn3) import Effect.Unsafe (unsafePerformEffect) import Lumi.Components (LumiComponent, lumiComponent, ($$$)) -import Lumi.Components.Spacing (Space(..)) +import Lumi.Components.Spacing (Space(..), hspace) import Lumi.Components2.Box (box) -import Lumi.Components2.Button (linkButton, onPress, varButtonBlack) -import Lumi.Styles (style_, toCSS) +import Lumi.Components2.Button (linkButton, loadingContent, onPress) +import Lumi.Styles (toCSS) import Lumi.Styles as S -import Lumi.Styles.Box (FlexAlign(..), _align, _justify) +import Lumi.Styles.Box (FlexAlign(..), _align, _flex) import Lumi.Styles.Box as Styles.Box import Lumi.Styles.Clip as Styles.Clip import Lumi.Styles.Theme (LumiTheme(..), useTheme) import React.Basic.DOM as R import React.Basic.Emotion as E -import React.Basic.Hooks (Hook, JSX, Ref, UseState, coerceHook, readRefMaybe, useRef, useState, (/\), type (/\)) +import React.Basic.Hooks (JSX, Ref, readRefMaybe, useRef) import React.Basic.Hooks as React -import React.Basic.Hooks.Aff (UseAff, useAff) -import React.Basic.Hooks.ResetToken (ResetToken, UseResetToken, useResetToken) import Web.DOM (Node) type ClipProps @@ -41,26 +38,15 @@ clip = lumiComponent "Clip" defaults \props -> React.do theme@(LumiTheme { colors }) <- useTheme ref <- useRef Nullable.null - { copied, copy } <- useClip ref let - buttonWidth = "64px" copyButton = linkButton - $ style_ - ( E.merge - [ E.css - { marginLeft: E.prop S16 - , lineHeight: E.str "1.2" - } - , guard copied do - E.css - { color: varButtonBlack - , "&:hover": E.nested $ E.css { textDecoration: E.none } - } - ] - ) - $ onPress do liftEffect copy - $$$ [ R.text if copied then "Copied!" else "Copy" ] + $ S.style_ (S.css { "&:disabled": S.nested $ S.css { color: S.color colors.black1 } }) + $ onPress do + copy ref + delay $ Milliseconds 5000.0 + $ loadingContent [ box $ _flex $ _align End $$$ [ R.text "Copied!" ] ] + $$$ [ box $ _flex $ _align End $$$ [ R.text "Copy" ] ] pure $ E.element R.div' { className: props.className @@ -68,47 +54,31 @@ clip = , children: [ E.element R.div' { className: "" - , css: - theme - # toCSS (Styles.Box.box <<< Styles.Box._justify Center) - <> toCSS (S.style_ (S.css { flex: S.str $ "0 0 calc(100% - " <> buttonWidth <> ")", minWidth: S.str "0" })) + , css: theme # toCSS (Styles.Box.box <<< Styles.Box._justify Center) , ref , children: props.content } + , hspace S8 , box - $ _justify Center $ _align End - $ S.style_ (S.css { flex: S.str $ "0 0 " <> buttonWidth, minWidth: S.str buttonWidth }) - $ _ { content = [ copyButton ] } + $$$ [ copyButton ] ] } where defaults = { content: [] } -newtype UseClip hooks - = UseClip (UseAff (ResetToken /\ Boolean) Unit (UseState Boolean (UseResetToken hooks))) - -derive instance ntUseClip :: Newtype (UseClip hooks) _ - -useClip :: Ref (Nullable Node) -> Hook UseClip { copied :: Boolean, copy :: Effect Unit } -useClip nodeRef = - coerceHook React.do - token /\ resetToken <- useResetToken - copied /\ setCopied <- useState false - let - copy = do - node <- readRefMaybe nodeRef - for_ node - $ runEffectFn3 copyNodeContents - ( do - setCopied \_ -> true - resetToken - ) - (mkEffectFn1 $ Console.error <<< message) - useAff (token /\ copied) do - when copied do - delay $ Milliseconds 5000.0 - liftEffect $ setCopied \_ -> false - pure { copied, copy } +copy :: Ref (Nullable Node) -> Aff Unit +copy nodeRef = do + nodeM <- liftEffect do readRefMaybe nodeRef + for_ nodeM \node -> + makeAff \done -> do + runEffectFn3 copyNodeContents + ( done $ Right unit ) + ( mkEffectFn1 \e -> do + Console.error $ message e + done $ Right unit + ) + node + pure nonCanceler foreign import copyNodeContents :: EffectFn3 (Effect Unit) (EffectFn1 Error Unit) Node Unit diff --git a/src/Lumi/Components2/Text.purs b/src/Lumi/Components2/Text.purs index b0475555..d5861c5d 100644 --- a/src/Lumi/Components2/Text.purs +++ b/src/Lumi/Components2/Text.purs @@ -85,9 +85,9 @@ text = S.css { fontSize: maybe S.inherit (S.px <<< textFontSize theme <<< textTheme) ty , lineHeight: maybe S.inherit (S.px <<< textLineHeight theme <<< textTheme) ty - , whiteSpace: S.str "pre-wrap" - , margin: S.str "0" - , padding: S.str "0" + , whiteSpace: S.preWrap + , margin: S.px 0 + , padding: S.px 0 } textElement :: TextType -> TextElement @@ -141,9 +141,9 @@ truncate :: forall c. TextModifier c truncate = S.style_ $ S.css - { whiteSpace: S.str "nowrap" - , overflow: S.str "hidden" - , textOverflow: S.str "ellipsis" + { whiteSpace: S.nowrap + , overflow: S.hidden + , textOverflow: S.ellipsis } -- Paragraph @@ -203,9 +203,9 @@ paragraph = defaultParagraphStyle theme ty = S.merge [ S.css - { whiteSpace: S.str "pre-wrap" - , margin: S.str "0" - , padding: S.str "0" + { whiteSpace: S.preWrap + , margin: S.px 0 + , padding: S.px 0 } , S.toCSS (textStyle (textTheme (fromMaybe Body ty))) theme ] @@ -265,8 +265,8 @@ mkHeaderComponent el = S.merge [ S.css { fontWeight: S.str "400" - , padding: S.str "0" - , margin: S.str "0" + , padding: S.px 0 + , margin: S.px 0 } , S.toCSS (textStyle _.subsectionHeader) theme ] diff --git a/src/Lumi/Styles/Border.purs b/src/Lumi/Styles/Border.purs index da308977..660a47eb 100644 --- a/src/Lumi/Styles/Border.purs +++ b/src/Lumi/Styles/Border.purs @@ -3,7 +3,7 @@ module Lumi.Styles.Border where import Prelude import Lumi.Components.Spacing (Space(..)) -import Lumi.Styles (StyleModifier, style, style_) +import Lumi.Styles (StyleModifier, px2, solid, style, style_) import Lumi.Styles.Box (box) import Lumi.Styles.Box as Box import Lumi.Styles.Theme (LumiTheme(..)) @@ -17,8 +17,8 @@ border = { label: str "border" , borderWidth: px 1 , borderColor: color theme.colors.black4 - , borderStyle: str "solid" - , padding: str "8px 16px" + , borderStyle: solid + , padding: px2 8 16 } _round :: StyleModifier diff --git a/src/Lumi/Styles/Box.purs b/src/Lumi/Styles/Box.purs index 4b3ff933..796f4477 100644 --- a/src/Lumi/Styles/Box.purs +++ b/src/Lumi/Styles/Box.purs @@ -1,8 +1,9 @@ module Lumi.Styles.Box where import Prelude + import Color (cssStringHSLA) -import Lumi.Styles (StyleModifier, px, style, style_) +import Lumi.Styles (StyleModifier, baseline, borderBox, center, column, flex, flexEnd, flexStart, manipulation, minContent, none, pointer, px, row, spaceAround, spaceBetween, spaceEvenly, stretch, style, style_, wrap) import Lumi.Styles.Theme (LumiTheme(..)) import React.Basic.Emotion (class IsStyleProperty, css, nested, prop, str) @@ -11,11 +12,11 @@ box = style_ $ css { label: str "box" - , display: str "flex" - , flexDirection: str "column" - , boxSizing: str "border-box" + , display: flex + , flexDirection: column + , boxSizing: borderBox , minHeight: px 0 - , minWidth: str "min-content" + , minWidth: minContent , flex: str "0 0 auto" , margin: px 0 , padding: px 0 @@ -24,17 +25,17 @@ box = _row :: StyleModifier _row = style_ - $ css { flexDirection: str "row" } + $ css { flexDirection: row } _column :: StyleModifier _column = style_ - $ css { flexDirection: str "column" } + $ css { flexDirection: column } _wrap :: StyleModifier _wrap = style_ - $ css { flexWrap: str "wrap" } + $ css { flexWrap: wrap } _flex :: StyleModifier _flex = @@ -53,15 +54,15 @@ data FlexAlign instance isStylePropertyFlexAlign :: IsStyleProperty FlexAlign where prop a = - str case a of - Start -> "flex-start" - End -> "flex-end" - Center -> "center" - Stretch -> "stretch" - Baseline -> "baseline" - SpaceAround -> "space-around" - SpaceBetween -> "space-between" - SpaceEvenly -> "space-evenly" + case a of + Start -> flexStart + End -> flexEnd + Center -> center + Stretch -> stretch + Baseline -> baseline + SpaceAround -> spaceAround + SpaceBetween -> spaceBetween + SpaceEvenly -> spaceEvenly _justify :: FlexAlign -> StyleModifier _justify a = style_ $ css { justifyContent: prop a } @@ -76,9 +77,9 @@ _interactive :: StyleModifier _interactive = style_ $ css - $ { touchAction: str "manipulation" - , userSelect: str "none" - , cursor: str "pointer" + $ { touchAction: manipulation + , userSelect: none + , cursor: pointer } _focusable :: StyleModifier diff --git a/src/Lumi/Styles/Clip.purs b/src/Lumi/Styles/Clip.purs index 6a556633..943f6cf1 100644 --- a/src/Lumi/Styles/Clip.purs +++ b/src/Lumi/Styles/Clip.purs @@ -1,6 +1,7 @@ module Lumi.Styles.Clip where import Prelude + import Lumi.Styles (StyleModifier, style) import Lumi.Styles.Border (_round, border) import Lumi.Styles.Box (FlexAlign(..), _justify, _row) diff --git a/src/Lumi/Styles/Link.purs b/src/Lumi/Styles/Link.purs index 084c9f97..c8d04c58 100644 --- a/src/Lumi/Styles/Link.purs +++ b/src/Lumi/Styles/Link.purs @@ -1,7 +1,8 @@ module Lumi.Styles.Link where import Prelude -import Lumi.Styles (StyleModifier, color, nested, none, str, style) + +import Lumi.Styles (StyleModifier, color, nested, none, pointer, style, underline) import Lumi.Styles.Box (box) import Lumi.Styles.Theme (LumiTheme(..)) import React.Basic.Emotion (css) @@ -22,7 +23,7 @@ link = , "&:hover": nested $ css - { cursor: str "pointer" - , textDecoration: str "underline" + { cursor: pointer + , textDecoration: underline } } diff --git a/src/Lumi/Styles/Loader.purs b/src/Lumi/Styles/Loader.purs index 9f4d0d01..a4059a30 100644 --- a/src/Lumi/Styles/Loader.purs +++ b/src/Lumi/Styles/Loader.purs @@ -1,35 +1,26 @@ module Lumi.Styles.Loader where -import Prelude import Lumi.Components.Color (Color) -import Lumi.Styles (Style, StyleModifier, StyleProperty, color, css, merge, px, str, style) +import Lumi.Styles (Style, StyleModifier, StyleProperty, borderBox, color, css, inlineBlock, keyframes, percent, px, solid, str, style) import Lumi.Styles.Theme (LumiTheme(..)) -import React.Basic.Emotion (nested) loader :: StyleModifier loader = style \(LumiTheme { colors }) -> - ( merge - [ mkLoader - { color: colors.black1 - , highlightColor: colors.black4 - , radius: px 38 - , borderWidth: px 5 - } - , spin - ] + ( mkLoader + { color: colors.black1 + , highlightColor: colors.black4 + , radius: px 38 + , borderWidth: px 5 + } ) -spin :: Style +spin :: StyleProperty spin = - css - { "@keyframes spin": - nested - $ css - { from: nested $ css { transform: str "rotate(0deg)" } - , to: nested $ css { transform: str "rotate(360deg)" } - } + keyframes + { from: css { transform: str "rotate(0deg)" } + , to: css { transform: str "rotate(360deg)" } } mkLoader :: @@ -41,16 +32,16 @@ mkLoader :: Style mkLoader { color: c, highlightColor, radius, borderWidth } = css - { boxSizing: str "border-box" + { boxSizing: borderBox , content: str "\"\"" - , display: str "inline-block" + , display: inlineBlock , height: radius , width: radius , borderWidth: borderWidth - , borderStyle: str "solid" + , borderStyle: solid , borderColor: color c , borderTopColor: color highlightColor - , borderRadius: str "50%" - , animation: str "spin 1s infinite linear" - , animationName: str "spin" + , borderRadius: percent 50.0 + , animation: str "1s infinite linear" + , animationName: spin } From 8cad6510f466690ac1cf382a6cc1a43098808013 Mon Sep 17 00:00:00 2001 From: Madeline Trotter Date: Mon, 10 Aug 2020 13:45:11 -0700 Subject: [PATCH 4/4] PR feedback --- bower.json | 2 +- src/Lumi/Components2/Button.purs | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/bower.json b/bower.json index 9b4b3955..4637d8e8 100644 --- a/bower.json +++ b/bower.json @@ -32,7 +32,7 @@ "purescript-react-basic": "^15.0.0", "purescript-react-basic-dom": "lumihq/purescript-react-basic-dom#^2.0.0", "purescript-react-basic-classic": "lumihq/purescript-react-basic-classic#^1.0.1", - "purescript-react-basic-emotion": "more-helpers", + "purescript-react-basic-emotion": "^5.0.0", "purescript-react-basic-hooks": "^6.0.0", "purescript-react-dnd-basic": "^7.0.0", "purescript-record": ">= 1.0.0 < 3.0.0", diff --git a/src/Lumi/Components2/Button.purs b/src/Lumi/Components2/Button.purs index d5650a2a..e94613f1 100644 --- a/src/Lumi/Components2/Button.purs +++ b/src/Lumi/Components2/Button.purs @@ -14,7 +14,8 @@ module Lumi.Components2.Button , varButtonHueDisabled, varButtonGrey1, varButtonGrey2 , varButtonBlack, varButtonWhite - , submit, reset, onPress, autoFocus, tabIndex, ariaLabel + , submit, reset, onPress, onPress' + , autoFocus, tabIndex, ariaLabel ) where import Prelude @@ -537,6 +538,11 @@ reset state = propsModifier _ { type = Reset, state = state } onPress :: forall c. Aff Unit -> ButtonModifier c onPress a = propsModifier \props -> props { onPress = props.onPress *> a } +-- | Like `onPress` but allows additional control over how the provided +-- | behavior interacts with any existing behavior. +onPress' :: forall c. (Aff Unit -> Aff Unit) -> ButtonModifier c +onPress' f = propsModifier \props -> props { onPress = f props.onPress } + -- | Auto-focus this button. Only one element on the page should -- | have `autoFocus` set at a time. autoFocus :: forall c. ButtonModifier c