Add Nri.Checkbox

src/AssetPath.elm

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

src/AssetPath/Css.elm

@@ -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) ++ ")"

src/Data/PremiumLevel.elm

@@ -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

src/Html/Attributes/Extra.elm

@@ -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

src/Html/Extra.elm

@@ -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

src/Nri/Checkbox.elm

@@ -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
+    }