Add Nri.Checkbox

This commit is contained in:
Jasper Woudenberg 2018-01-22 17:20:02 +01:00
parent 4431f5f0c4
commit 5ef0f5174a
6 changed files with 901 additions and 0 deletions

10
src/AssetPath.elm Normal file
View File

@ -0,0 +1,10 @@
module AssetPath exposing (..)
type Asset
= Asset String
url : Asset -> String
url (Asset url) =
url

17
src/AssetPath/Css.elm Normal file
View File

@ -0,0 +1,17 @@
module AssetPath.Css exposing (url)
{-| Helper for constructing commonly-used CSS functions
that reference assets.
@docs url
-}
import AssetPath exposing (Asset)
{-| Given an `Asset`, wrap its URL in a call to `url()`.
-}
url : Asset -> String
url asset =
"url(" ++ (AssetPath.url asset) ++ ")"

50
src/Data/PremiumLevel.elm Normal file
View File

@ -0,0 +1,50 @@
module Data.PremiumLevel exposing (PremiumLevel(..), allowedFor, highest, lowest)
{-| @docs PremiumLevel, allowedFor, highest, lowest
-}
{-| -}
type PremiumLevel
= Free
| Premium
| PremiumWithWriting
{-| Is content of the required premium level accessbile by the actor?
-}
allowedFor : PremiumLevel -> PremiumLevel -> Bool
allowedFor requirement actor =
order requirement <= order actor
{-| The highest premium level in a list
-}
highest : List PremiumLevel -> Maybe PremiumLevel
highest privileges =
privileges
|> List.sortBy order
|> List.reverse
|> List.head
{-| The lowest premium level in a list
-}
lowest : List PremiumLevel -> Maybe PremiumLevel
lowest privileges =
privileges
|> List.sortBy order
|> List.head
order : PremiumLevel -> Int
order privileges =
case privileges of
PremiumWithWriting ->
2
Premium ->
1
Free ->
0

View File

@ -0,0 +1,38 @@
module Html.Attributes.Extra exposing (includeIf, none)
{-| Extras for working with Html.Attributes
@docs none, includeIf
-}
import Html exposing (Attribute)
import Html.Attributes as Attributes
import Json.Encode as Encode
{-| Represents an attribute with no semantic meaning, useful for conditionals.
This is implemented such that whenever Html.Attributes.Extra.none is encountered
by VirtualDom it will set a meaningless property on the element object itself to
null:
domNode['Html.Attributes.Extra.none'] = null
It's totally safe and lets us clean up conditional and maybe attributes
-}
none : Attribute msg
none =
Attributes.property "Html.Attributes.Extra.none" Encode.null
{-| conditionally include an attribute. Useful for CSS classes generated with
`UniqueClass`!
-}
includeIf : Bool -> Attribute msg -> Attribute msg
includeIf cond attr =
if cond then
attr
else
none

143
src/Html/Extra.elm Normal file
View File

@ -0,0 +1,143 @@
module Html.Extra exposing (..)
{-| For all utils involving HTML.
@docs role, noOpHref, noOpHrefUrl
@docs onEsc, onEnter, onKeyUp, onEnterAndSpace
@docs textFromList, oxfordifyWithHtml, nbsp
-}
import Char
import Html exposing (Attribute, Html, span, text)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Decode
{-| Convenience for defining role attributes, e.g. <div role="tabpanel">
-}
role : String -> Attribute msg
role =
attribute "role"
{-| -}
noOpHref : Attribute a
noOpHref =
href noOpHrefUrl
{-| This is a better choice for a no-op than "#" because "#" changes your
location bar. See <http://stackoverflow.com/a/20676911> for more details.
-}
noOpHrefUrl : String
noOpHrefUrl =
"javascript:void(0)"
{-| -}
onEsc : a -> a -> Attribute a
onEsc onEscAction onOtherKey =
on "keyup"
(Json.Decode.map
(\keyCode ->
if keyCode == 27 then
onEscAction
else
onOtherKey
)
keyCode
)
{-| -}
onEnter : a -> Attribute a
onEnter onEnterAction =
onKeyUp defaultOptions
(\keyCode ->
if keyCode == 13 then
Just onEnterAction
else
Nothing
)
{-| "Buttons" should trigger on Enter and on Space.
-}
onEnterAndSpace : msg -> Attribute msg
onEnterAndSpace msg =
onKeyUp defaultOptions
(\keyCode ->
if keyCode == 13 || keyCode == 32 then
Just msg
else
Nothing
)
{-| Convert a keycode into a message on keyup
-}
onKeyUp : Options -> (Int -> Maybe a) -> Attribute a
onKeyUp options toMaybeMsg =
onWithOptions "keyup" options <|
Json.Decode.andThen
(\keyCode ->
keyCode
|> toMaybeMsg
|> Maybe.map Json.Decode.succeed
|> Maybe.withDefault (Json.Decode.fail (toString keyCode))
)
keyCode
{-| Takes a list of strings, joins them with a space and returns it as a Html.text.
textFromList ["Hello", "World"] == text [ String.join " " ["Hello", "World" ] ]
-}
textFromList : List String -> Html msg
textFromList =
String.join " " >> text
{-| -}
oxfordifyWithHtml : String -> String -> List (Html msg) -> List (Html msg)
oxfordifyWithHtml pre post items =
let
textSpan string =
span [] [ text string ]
final centrals =
[ textSpan pre ] ++ centrals ++ [ textSpan post ]
in
case items of
[] ->
[]
[ single ] ->
final [ single ]
[ first, second ] ->
final [ first, textSpan " and ", second ]
many ->
let
beforeAnd =
List.take (List.length many - 1) many
afterAnd =
List.drop (List.length many - 1) many
|> List.head
|> Maybe.withDefault (textSpan "")
in
final (List.intersperse (textSpan ", ") beforeAnd ++ [ textSpan ", and ", afterAnd ])
{-| Workaround for `Html.text "&nbsp;"` not working in elm.
-}
nbsp : Html msg
nbsp =
Char.fromCode 160
|> String.fromChar
|> Html.text

643
src/Nri/Checkbox.elm Normal file
View File

@ -0,0 +1,643 @@
module Nri.Checkbox
exposing
( ColorTheme(..)
, IsSelected(..)
, Model
, PremiumConfig
, Theme(..)
, disabled
, keyframeCss
, premium
, styles
, view
, viewAttention
, viewWithLabel
)
{-| @docs Model, Theme, ColorTheme
@docs view, viewWithLabel, viewAttention, disabled
@docs IsSelected
@docs keyframeCss, styles
## Premium
@docs PremiumConfig, premium
-}
import AssetPath.Css
import Accessibility exposing (..)
import Accessibility.Aria exposing (controls)
import Accessibility.Widget as Widget
import AssetPath exposing (Asset(..))
import Css exposing (..)
import Css.Elements
import Data.PremiumLevel as PremiumLevel exposing (PremiumLevel(..))
import Html
import Html.Attributes as Attributes
import Html.Attributes.Extra as Attributes
import Html.Events as Events exposing (defaultOptions)
import Html.Extra exposing (onEnter, onKeyUp)
import Json.Decode
import Json.Encode
import Nri.Accessibility as Accessibility
import Nri.Colors as Colors
import Nri.Stylers
import Nri.Styles
{-|
- isChecked : Maybe Bool
- Just True == Checked (rendered checkmark)
- Just False == Not Checked (rendered blank)
- Nothing == Indeterminate (rendered dash)
-}
type alias Model msg =
{ identifier : String
, label : String
, setterMsg : Bool -> msg
, isChecked : Maybe Bool
, disabled : Bool
, theme : Theme
, noOpMsg : msg
}
customView : List CssClasses -> Bool -> Model msg -> Html msg
customView modifierClasses showLabels model =
let
containerClasses =
List.concat
[ [ Container ]
, modifierClasses
, case model.theme of
Square Gray ->
[ SquareClass, GrayClass ]
Square Orange ->
[ SquareClass, OrangeClass ]
Square Default ->
[ SquareClass ]
Locked ->
[ LockedClass ]
LockOnInside ->
[ LockOnInsideClass ]
Unlockable ->
[ UnlockableClass ]
Round hideLabelText ->
if hideLabelText then
[ RoundClass, HiddenLabelText ]
else
[ RoundClass ]
Disabled ->
[ SquareClass, Opacified ]
Premium ->
[ SquareClass, PremiumClass ]
]
in
Html.span
[ styles.class containerClasses
, Attributes.id <| model.identifier ++ "-container"
, -- This is necessary to prevent event propagation.
-- See https://github.com/elm-lang/html/issues/96
Attributes.map (always model.noOpMsg) <|
Events.onWithOptions "click"
{ defaultOptions | stopPropagation = True }
(Json.Decode.succeed "stop click propagation")
]
[ checkbox model.identifier
model.isChecked
[ Widget.label model.label
, styles.class [ Checkbox ]
, Events.onCheck model.setterMsg
, Attributes.id model.identifier
, Attributes.disabled model.disabled
]
, Html.label
[ Attributes.for model.identifier
, getLabelClass model.isChecked
, controls model.identifier
, Widget.disabled model.disabled
, Widget.checked model.isChecked
, if not model.disabled then
Attributes.tabindex 0
else
Attributes.none
, if not model.disabled then
Html.Extra.onKeyUp
{ defaultOptions | preventDefault = True }
(\keyCode ->
-- 32 is the space bar, 13 is enter
if (keyCode == 32 || keyCode == 13) && not model.disabled then
Just <| model.setterMsg (Maybe.map not model.isChecked |> Maybe.withDefault True)
else
Nothing
)
else
Attributes.none
]
[ span
[ styles.class
(if showLabels then
[]
else
[ LabelText ]
)
]
[ Html.text model.label ]
]
]
{-| Shows a checkbox (the label is only used for accessibility hints)
-}
view : Model msg -> Html msg
view model =
customView [] False model
{-| Shows a checkbox and its label text
-}
viewWithLabel : Model msg -> Html msg
viewWithLabel model =
customView [] True model
{-| Show a disabled checkbox.
-}
disabled : String -> String -> Html msg
disabled identifier labelText =
span
[ styles.class [ Container, SquareClass, Opacified ]
, Attributes.id <| identifier ++ "-container"
]
[ checkbox identifier
(Just False)
[ Widget.label labelText
, styles.class [ Checkbox ]
, Attributes.id identifier
, Attributes.disabled True
]
, label
[ Attributes.for identifier
, getLabelClass (Just False)
]
[ Html.text labelText
]
]
{-| -}
type IsSelected
= Selected
| NotSelected
| PartiallySelected
{-|
- `onChange`: A message for when the user toggles the checkbox
- `onLockedClick`: A message for when the user clicks a checkbox they don't have PremiumLevel for.
If you get this message, you should show an `Nri.Premium.Model.view`
-}
type alias PremiumConfig msg =
{ label : String
, id : String
, selected : IsSelected
, disabled : Bool
, teacherPremiumLevel : PremiumLevel
, contentPremiumLevel : PremiumLevel
, showFlagWhenLocked : Bool
, onChange : Bool -> msg
, onLockedClick : msg
, noOpMsg : msg
}
{-| A checkbox that should be used for premium content
This checkbox is locked when the premium level of the content is greater than the premium level of the teacher
-}
premium : PremiumConfig msg -> Html msg
premium config =
let
isLocked =
not <|
PremiumLevel.allowedFor
config.contentPremiumLevel
config.teacherPremiumLevel
isChecked =
case config.selected of
Selected ->
Just True
NotSelected ->
Just False
PartiallySelected ->
Nothing
modifierClasses =
List.concat
[ if config.showFlagWhenLocked && config.contentPremiumLevel /= Free then
[ PremiumClass ]
else
[]
, if config.disabled then
[ Opacified ]
else
[]
]
theme =
if isLocked then
LockOnInside
else if config.contentPremiumLevel /= Free then
Premium
else
Square Default
in
customView modifierClasses
True
{ identifier = config.id
, label = config.label
, setterMsg =
if isLocked then
\_ -> config.onLockedClick
else
config.onChange
, isChecked = isChecked
, disabled = config.disabled
, theme = theme
, noOpMsg = config.noOpMsg
}
{-| -}
viewAttention : Model msg -> Html msg
viewAttention model =
customView [ WithPulsing ] False model
getLabelClass : Maybe Bool -> Html.Attribute msg
getLabelClass maybeChecked =
styles.class
[ Label
, case maybeChecked of
Just True ->
Checked
Just False ->
Unchecked
Nothing ->
Indeterminate
]
indeterminateAttr : Html.Attribute msg
indeterminateAttr =
Attributes.property "indeterminate" (Json.Encode.bool True)
type CssClasses
= Container
| Checkbox
| Unchecked
| Checked
| Indeterminate
| SquareClass
| RoundClass
| GrayClass
| OrangeClass
| LockedClass
| LockOnInsideClass
| UnlockableClass
| Label
| HiddenLabelText
| LabelText
| WithPulsing
| Opacified
| PremiumClass
type CheckboxImage
= CheckboxUnchecked
| CheckboxChecked
| CheckboxCheckedPartially
| PremiumUnlocked
| PremiumFlag
| CheckWhite
| PremiumLocked
| PremiumKey
| CheckboxLockOnInside
{-| -}
type Theme
= Square ColorTheme
| Round Bool
| Locked
| LockOnInside
| Unlockable
| Disabled
| Premium
{-| -}
type ColorTheme
= Default
| Gray
| Orange
mainSnippet : List Snippet
mainSnippet =
[ Css.class Container
[ display block
, height inherit
, descendants
[ Css.Elements.label
[ display inlineBlock
, verticalAlign middle
, minHeight (px 42) -- container height
, padding2 (px 13) zero
, Nri.Stylers.makeFont (px 16) Colors.gray20
, property "background-position" "left center"
, property "background-repeat" "no-repeat"
]
, Css.Elements.input [ display none ]
, selector ":disabled + label"
[ cursor auto
]
]
]
, Css.class Checkbox
[ cursor pointer ]
, Css.class Label
[ cursor pointer
, outline none
]
]
square : Assets r -> List Snippet
square assets =
[ Css.class SquareClass
[ children
[ Css.Elements.label
[ paddingLeft (px (29 + 6)) -- checkbox width + padding
]
, Css.class Unchecked [ backgroundImage assets CheckboxUnchecked ]
, Css.class Checked [ backgroundImage assets CheckboxChecked ]
, Css.class Indeterminate [ backgroundImage assets CheckboxCheckedPartially ]
]
]
]
gray : List Snippet
gray =
[ Css.class GrayClass
[ children
[ Css.Elements.label [ color Colors.gray45 ] ]
]
]
orange : Assets r -> List Snippet
orange assets =
[ Css.class OrangeClass
[ children
[ Css.Elements.label
[ color Colors.ochre
, displayFlex
, alignItems center
]
, selector "label::after"
[ property "content" "''"
, width (px 26)
, height (px 24)
, marginLeft (px 8)
, backgroundImage assets PremiumUnlocked
]
]
]
]
round : Assets r -> List Snippet
round assets =
[ Css.class RoundClass
[ children
[ Css.Elements.label
[ displayFlex
, alignItems center
, property "cursor" "pointer"
]
, selector "label::before"
[ property "content" "''"
, width (px 24)
, height (px 24)
, marginRight (px 8)
, borderRadius (pct 100)
]
, selector ".checkbox-Unchecked::before"
[ border3 (px 2) solid Colors.blue
, backgroundColor Colors.white
]
, selector ".checkbox-Checked::before"
[ backgroundColor Colors.green
, border3 (px 2) solid Colors.green
, backgroundImage assets CheckWhite
, property "background-repeat" "no-repeat"
, property "background-position" "center center"
]
, selector ":disabled + label"
[ property "cursor" "auto"
]
]
]
, Css.class WithPulsing
[ property "-webkit-animation" "pulsate 1s infinite"
, property "-moz-animation" "pulsate 1s infinite"
, property "animation" "pulsate 1s infinite"
]
]
locked : Assets r -> List Snippet
locked assets =
[ Css.class LockedClass
[ descendants
[ Css.Elements.label
[ paddingLeft (px (29 + 6)) -- checkbox width + padding
, backgroundImage assets PremiumLocked
, property "cursor" "auto"
]
]
]
]
lockOnInside : Assets r -> List Snippet
lockOnInside assets =
[ Css.class LockOnInsideClass
[ descendants
[ Css.Elements.label
[ paddingLeft (px 35)
, backgroundImage assets CheckboxLockOnInside
, backgroundSize (px 24)
, backgroundRepeat noRepeat
, property "cursor" "pointer"
]
]
]
]
unlockable : Assets r -> List Snippet
unlockable assets =
[ Css.class UnlockableClass
[ descendants
[ Css.Elements.label
[ paddingLeft (px (29 + 6)) -- checkbox width + padding
, backgroundImage assets PremiumKey
, property "cursor" "auto"
]
]
]
]
premiumStyles : Assets r -> List Snippet
premiumStyles assets =
[ Css.class PremiumClass
[ children
[ Css.Elements.label
[ displayFlex
, alignItems center
]
, selector "label::after"
[ property "content" "''"
, display inlineBlock
, width (px 26)
, height (px 24)
, marginLeft (px 8)
, backgroundImage assets PremiumFlag
, backgroundRepeat noRepeat
, backgroundPosition Css.center
]
]
]
]
opacified : List Snippet
opacified =
[ Css.class Opacified
[ descendants [ everything [ opacity (num 0.4) ] ] ]
]
hiddenLabelText : List Snippet
hiddenLabelText =
[ Css.class LabelText
[ Accessibility.invisibleText
]
]
backgroundImage : Assets r -> CheckboxImage -> Css.Style
backgroundImage assets checkboxImage =
property "background-image" (AssetPath.Css.url <| checkboxAssetPath assets checkboxImage)
checkboxAssetPath : Assets r -> CheckboxImage -> Asset
checkboxAssetPath assets checkboxImage =
case checkboxImage of
CheckboxUnchecked ->
assets.checkboxUnchecked_svg
CheckboxChecked ->
assets.checkboxChecked_svg
CheckboxCheckedPartially ->
assets.checkboxCheckedPartially_svg
PremiumUnlocked ->
assets.iconPremiumUnlocked_png
CheckWhite ->
assets.iconCheck_png
PremiumLocked ->
assets.iconPremiumLocked_png
CheckboxLockOnInside ->
assets.checkboxLockOnInside_svg
PremiumKey ->
assets.iconPremiumKey_png
PremiumFlag ->
assets.iconPremiumFlag_svg
{-| -}
keyframeCss : Nri.Styles.Keyframe
keyframeCss =
Nri.Styles.keyframes "pulsate"
[ ( "0%", "transform: scale(1, 1);" )
, ( "50%", "transform: scale(1.2);" )
, ( "100%", "transform: scale(1, 1);" )
]
{-| -}
styles : Nri.Styles.StylesWithAssets Never CssClasses msg (Assets r)
styles =
(\assets ->
[ mainSnippet
, square assets
, gray
, orange assets
, round assets
, locked assets
, lockOnInside assets
, unlockable assets
, hiddenLabelText
, opacified
, premiumStyles assets
]
|> List.concat
)
|> Nri.Styles.stylesWithAssets "checkbox-"
{-| The assets used in this module.
-}
type alias Assets r =
{ r
| checkboxUnchecked_svg : Asset
, checkboxChecked_svg : Asset
, checkboxCheckedPartially_svg : Asset
, iconPremiumUnlocked_png : Asset
, iconCheck_png : Asset
, iconPremiumLocked_png : Asset
, checkboxLockOnInside_svg : Asset
, iconPremiumKey_png : Asset
, iconPremiumFlag_svg : Asset
}