Adds Block.V2

deprecated-modules.csv

@@ -1,4 +1,5 @@
 Nri.Ui.Balloon.V1,upgrade to V2
+Nri.Ui.Block.V1,upgrade to V2
 Nri.Ui.Checkbox.V6,upgrade to V7
 Nri.Ui.Mark.V1,upgrade to V2
 Nri.Ui.Tabs.V6,upgrade to V7

elm.json

@@ -14,6 +14,7 @@
         "Nri.Ui.Balloon.V1",
         "Nri.Ui.Balloon.V2",
         "Nri.Ui.Block.V1",
+        "Nri.Ui.Block.V2",
         "Nri.Ui.BreadCrumbs.V2",
         "Nri.Ui.Button.V10",
         "Nri.Ui.Carousel.V1",

forbidden-imports.toml

@@ -41,6 +41,9 @@ hint = 'upgrade to V3'
 [forbidden."Nri.Ui.Balloon.V1"]
 hint = 'upgrade to V2'
 
+[forbidden."Nri.Ui.Block.V1"]
+hint = 'upgrade to V2'
+
 [forbidden."Nri.Ui.BreadCrumbs.V1"]
 hint = 'upgrade to V2'
 

src/Nri/Ui/Block/V2.elm

@@ -0,0 +1,545 @@
+module Nri.Ui.Block.V2 exposing
+    ( view, Attribute
+    , plaintext, content
+    , Content, phrase, blank
+    , string
+    , emphasize, label, labelHeight
+    , yellow, cyan, magenta, green, blue, purple, brown
+    , class, id
+    , labelId, labelContentId
+    , getLabelHeights
+    )
+
+{-|
+
+@docs view, Attribute
+
+
+## Content
+
+@docs plaintext, content
+@docs Content, phrase, blank
+
+
+### Deprecated
+
+@docs string
+
+
+## Content customization
+
+@docs emphasize, label, labelHeight
+
+
+### Visual customization
+
+@docs yellow, cyan, magenta, green, blue, purple, brown
+
+
+### General attributes
+
+@docs class, id
+
+
+## Accessors
+
+You will need these helpers if you want to prevent label overlaps. (Which is to say -- anytime you have labels!)
+
+@docs labelId, labelContentId
+@docs getLabelHeights
+
+-}
+
+import Accessibility.Styled exposing (..)
+import Browser.Dom as Dom
+import Css exposing (Color)
+import Dict exposing (Dict)
+import Html.Styled.Attributes as Attributes exposing (css)
+import List.Extra
+import Nri.Ui.Colors.V1 as Colors
+import Nri.Ui.Html.Attributes.V2 as AttributesExtra exposing (nriDescription)
+import Nri.Ui.Mark.V2 as Mark exposing (Mark)
+import Nri.Ui.MediaQuery.V1 as MediaQuery
+
+
+{-|
+
+    Block.view [ Block.plaintext "Hello, world!" ]
+
+-}
+view : List Attribute -> List (Html msg)
+view attributes =
+    attributes
+        |> List.foldl (\(Attribute attribute) b -> attribute b) defaultConfig
+        |> render
+
+
+
+-- Attributes
+
+
+{-| Provide the main content of the block as a plain-text string. You can also use `content` for more complex cases, including a blank appearing within an emphasis.
+-}
+plaintext : String -> Attribute
+plaintext content_ =
+    Attribute <| \config -> { config | content = parseString content_ }
+
+
+{-| Use `content` for more complex block views, for instance when a blank appears within an emphasis block. Prefer to use `plaintext` when possible for better readability.
+
+    Block.view
+        [ Block.emphasize
+        , Block.content [ Block.string "Hello, ", Block.blank, Block.string "!" ]
+        ]
+
+-}
+content : List Content -> Attribute
+content content_ =
+    Attribute <| \config -> { config | content = content_ }
+
+
+{-| Mark content as emphasized.
+-}
+emphasize : Attribute
+emphasize =
+    Attribute <| \config -> { config | theme = Just Emphasis }
+
+
+{-| -}
+label : String -> Attribute
+label label_ =
+    Attribute <| \config -> { config | label = Just label_ }
+
+
+{-| Use `getLabelHeights` to calculate what these values should be.
+-}
+labelHeight : Maybe { totalHeight : Float, arrowHeight : Float } -> Attribute
+labelHeight offset =
+    Attribute <| \config -> { config | labelHeight = offset }
+
+
+{-| -}
+labelId : String -> String
+labelId labelId_ =
+    labelId_ ++ "-label"
+
+
+{-| -}
+labelContentId : String -> String
+labelContentId labelId_ =
+    labelId_ ++ "-label-content"
+
+
+{-|
+
+    Pass in a list of the Block ids that you care about (use `Block.id` to attach these ids).
+
+    - First, we add ids to block with labels with `Block.id`.
+    - Say we added `Block.id "example-id"`, then we will use `Browser.Dom.getElement (Block.labelId "example-id")` and `Browser.Dom.getElement (Block.labelContentId "example-id")` to construct a record in the shape { label : Dom.Element, labelContent : Dom.Element }. We store this record in a dictionary keyed by ids (e.g., "example-id") with measurements for all other labels.
+    - Pass a list of all the block ids and the dictionary of measurements to `getLabelHeights`. `getLabelHeights` will return a dictionary of values (keyed by ids) that we will then pass directly to `labelHeight` for positioning.
+
+-}
+getLabelHeights :
+    List String
+    -> Dict String { label : Dom.Element, labelContent : Dom.Element }
+    -> Dict String { totalHeight : Float, arrowHeight : Float }
+getLabelHeights ids labelMeasurementsById =
+    let
+        startingArrowHeight =
+            8
+    in
+    ids
+        |> List.filterMap
+            (\idString ->
+                case Dict.get idString labelMeasurementsById of
+                    Just measurement ->
+                        Just ( idString, measurement )
+
+                    Nothing ->
+                        Nothing
+            )
+        |> splitByOverlaps
+        |> List.concatMap
+            (\row ->
+                row
+                    -- Put the widest elements higher visually to avoid overlaps
+                    |> List.sortBy (Tuple.second >> .labelContent >> .element >> .width)
+                    |> List.foldl
+                        (\( idString, e ) ( height, acc ) ->
+                            ( height + e.labelContent.element.height
+                            , ( idString
+                              , { totalHeight = height + e.labelContent.element.height + 8, arrowHeight = height }
+                              )
+                                :: acc
+                            )
+                        )
+                        ( startingArrowHeight, [] )
+                    |> Tuple.second
+            )
+        |> Dict.fromList
+
+
+{-| Group the elements whose bottom edges are at the same height. This ensures that we only offset labels against other labels in the same visual line of content.
+
+Then, for elements in the same row, group elements with horizontal overlaps .
+
+-}
+splitByOverlaps : List ( id, { a | label : Dom.Element } ) -> List (List ( id, { a | label : Dom.Element } ))
+splitByOverlaps =
+    -- consider the elements from top to bottom
+    groupWithSort (\( _, a ) -> a.label.element.y + a.label.element.height)
+        (\( _, a ) ( _, b ) ->
+            (a.label.element.y + a.label.element.height) == (b.label.element.y + b.label.element.height)
+        )
+        >> List.concatMap
+            -- consider the elements from left to right
+            (groupWithSort (\( _, a ) -> a.label.element.x)
+                (\( _, a ) ( _, b ) ->
+                    (a.label.element.x + a.label.element.width) >= b.label.element.x
+                )
+            )
+
+
+groupWithSort : (a -> comparable) -> (a -> a -> Bool) -> List a -> List (List a)
+groupWithSort sortBy groupBy =
+    List.sortBy sortBy
+        >> List.Extra.groupWhile groupBy
+        >> List.map (\( first, rem ) -> first :: rem)
+
+
+
+-- Content
+
+
+{-| -}
+type Content
+    = String_ String
+    | Blank
+
+
+parseString : String -> List Content
+parseString =
+    String.split " "
+        >> List.intersperse " "
+        >> List.map String_
+
+
+renderContent : { config | class : Maybe String, id : Maybe String } -> Content -> List Css.Style -> Html msg
+renderContent config content_ markStyles =
+    span
+        [ css (Css.whiteSpace Css.preWrap :: markStyles)
+        , nriDescription "block-segment-container"
+        , AttributesExtra.maybe Attributes.class config.class
+        , AttributesExtra.maybe Attributes.id config.id
+        ]
+        (case content_ of
+            String_ str ->
+                [ text str ]
+
+            Blank ->
+                [ viewBlank [] { class = Nothing, id = Nothing } ]
+        )
+
+
+{-| DEPRECATED -- prefer `phrase`.
+-}
+string : String -> Content
+string =
+    String_
+
+
+{-| -}
+phrase : String -> List Content
+phrase =
+    parseString
+
+
+{-| You will only need to use this helper if you're also using `content` to construct a more complex Block. For a less complex blank Block, don't include content or plaintext in the list of attributes.
+-}
+blank : Content
+blank =
+    Blank
+
+
+
+-- Color themes
+
+
+{-| -}
+type Theme
+    = Emphasis
+    | Yellow
+    | Cyan
+    | Magenta
+    | Green
+    | Blue
+    | Purple
+    | Brown
+
+
+themeToPalette : Theme -> Palette
+themeToPalette theme =
+    case theme of
+        Emphasis ->
+            defaultPalette
+
+        Yellow ->
+            { backgroundColor = Colors.highlightYellow
+            , borderColor = Colors.highlightYellowDark
+            }
+
+        Cyan ->
+            { backgroundColor = Colors.highlightCyan
+            , borderColor = Colors.highlightCyanDark
+            }
+
+        Magenta ->
+            { backgroundColor = Colors.highlightMagenta
+            , borderColor = Colors.highlightMagentaDark
+            }
+
+        Green ->
+            { backgroundColor = Colors.highlightGreen
+            , borderColor = Colors.highlightGreenDark
+            }
+
+        Blue ->
+            { backgroundColor = Colors.highlightBlue
+            , borderColor = Colors.highlightBlueDark
+            }
+
+        Purple ->
+            { backgroundColor = Colors.highlightPurple
+            , borderColor = Colors.highlightPurpleDark
+            }
+
+        Brown ->
+            { backgroundColor = Colors.highlightBrown
+            , borderColor = Colors.highlightBrownDark
+            }
+
+
+type alias Palette =
+    { backgroundColor : Color, borderColor : Color }
+
+
+defaultPalette : Palette
+defaultPalette =
+    { backgroundColor = Colors.highlightYellow
+    , borderColor = Colors.highlightYellowDark
+    }
+
+
+toMark : Maybe String -> Maybe Palette -> Maybe Mark
+toMark label_ palette =
+    case ( label_, palette ) of
+        ( _, Just { backgroundColor, borderColor } ) ->
+            let
+                borderWidth =
+                    Css.px 1
+
+                borderStyle =
+                    Css.dashed
+            in
+            Just
+                { name = label_
+                , startStyles =
+                    [ Css.borderLeft3 borderWidth borderStyle borderColor
+                    , Css.paddingLeft (Css.px 2)
+                    ]
+                , styles =
+                    [ Css.paddingTop topBottomSpace
+                    , Css.paddingBottom topBottomSpace
+                    , Css.backgroundColor backgroundColor
+                    , Css.borderTop3 borderWidth borderStyle borderColor
+                    , Css.borderBottom3 borderWidth borderStyle borderColor
+                    , MediaQuery.highContrastMode
+                        [ Css.property "background-color" "Mark"
+                        , Css.property "color" "MarkText"
+                        , Css.property "forced-color-adjust" "none"
+                        ]
+                    ]
+                , endStyles =
+                    [ Css.borderRight3 borderWidth borderStyle borderColor
+                    , Css.paddingRight (Css.px 2)
+                    ]
+                }
+
+        ( Just l, Nothing ) ->
+            Just
+                { name = Just l
+                , startStyles = []
+                , styles = []
+                , endStyles = []
+                }
+
+        ( Nothing, Nothing ) ->
+            Nothing
+
+
+topBottomSpace : Css.Px
+topBottomSpace =
+    Css.px 4
+
+
+{-| -}
+yellow : Attribute
+yellow =
+    Attribute (\config -> { config | theme = Just Yellow })
+
+
+{-| -}
+cyan : Attribute
+cyan =
+    Attribute (\config -> { config | theme = Just Cyan })
+
+
+{-| -}
+magenta : Attribute
+magenta =
+    Attribute (\config -> { config | theme = Just Magenta })
+
+
+{-| -}
+green : Attribute
+green =
+    Attribute (\config -> { config | theme = Just Green })
+
+
+{-| -}
+blue : Attribute
+blue =
+    Attribute (\config -> { config | theme = Just Blue })
+
+
+{-| -}
+purple : Attribute
+purple =
+    Attribute (\config -> { config | theme = Just Purple })
+
+
+{-| -}
+brown : Attribute
+brown =
+    Attribute (\config -> { config | theme = Just Brown })
+
+
+{-| -}
+class : String -> Attribute
+class class_ =
+    Attribute (\config -> { config | class = Just class_ })
+
+
+{-| -}
+id : String -> Attribute
+id id_ =
+    Attribute (\config -> { config | id = Just id_ })
+
+
+
+-- Internals
+
+
+{-| -}
+type Attribute
+    = Attribute (Config -> Config)
+
+
+defaultConfig : Config
+defaultConfig =
+    { content = []
+    , label = Nothing
+    , labelId = Nothing
+    , labelHeight = Nothing
+    , theme = Nothing
+    , class = Nothing
+    , id = Nothing
+    }
+
+
+type alias Config =
+    { content : List Content
+    , label : Maybe String
+    , labelId : Maybe String
+    , labelHeight : Maybe { totalHeight : Float, arrowHeight : Float }
+    , theme : Maybe Theme
+    , class : Maybe String
+    , id : Maybe String
+    }
+
+
+render : Config -> List (Html msg)
+render config =
+    let
+        maybePalette =
+            Maybe.map themeToPalette config.theme
+
+        palette =
+            Maybe.withDefault defaultPalette maybePalette
+
+        maybeMark =
+            toMark config.label maybePalette
+    in
+    case config.content of
+        [] ->
+            case maybeMark of
+                Just mark ->
+                    Mark.viewWithBalloonTags
+                        { renderSegment = renderContent config
+                        , backgroundColor = palette.backgroundColor
+                        , maybeMarker = Just mark
+                        , labelHeight = config.labelHeight
+                        , labelId = Maybe.map labelId config.id
+                        , labelContentId = Maybe.map labelContentId config.id
+                        }
+                        [ Blank ]
+
+                Nothing ->
+                    [ viewBlank
+                        [ Css.paddingTop topBottomSpace
+                        , Css.paddingBottom topBottomSpace
+                        ]
+                        config
+                    ]
+
+        _ ->
+            Mark.viewWithBalloonTags
+                { renderSegment = renderContent config
+                , backgroundColor = palette.backgroundColor
+                , maybeMarker = maybeMark
+                , labelHeight = config.labelHeight
+                , labelId = Maybe.map labelId config.id
+                , labelContentId = Maybe.map labelContentId config.id
+                }
+                config.content
+
+
+viewBlank : List Css.Style -> { config | class : Maybe String, id : Maybe String } -> Html msg
+viewBlank styles config =
+    span
+        [ css
+            [ Css.border3 (Css.px 2) Css.dashed Colors.navy
+            , MediaQuery.highContrastMode
+                [ Css.property "border-color" "CanvasText"
+                , Css.property "background-color" "Canvas"
+                ]
+            , Css.backgroundColor Colors.white
+            , Css.minWidth (Css.px 80)
+            , Css.display Css.inlineBlock
+            , Css.borderRadius (Css.px 4)
+            , Css.lineHeight (Css.int 1)
+            , Css.batch styles
+            ]
+        , AttributesExtra.maybe Attributes.class config.class
+        , AttributesExtra.maybe Attributes.id config.id
+        ]
+        [ span
+            [ css
+                [ Css.overflowX Css.hidden
+                , Css.width (Css.px 0)
+                , Css.display Css.inlineBlock
+                , Css.verticalAlign Css.bottom
+                ]
+            ]
+            [ text "blank" ]
+        ]

styleguide-app/Examples/Block.elm

@@ -19,7 +19,7 @@ import Example exposing (Example)
 import Html.Styled exposing (..)
 import Html.Styled.Attributes exposing (css)
 import Markdown
-import Nri.Ui.Block.V1 as Block
+import Nri.Ui.Block.V2 as Block
 import Nri.Ui.Button.V10 as Button
 import Nri.Ui.Fonts.V1 as Fonts
 import Nri.Ui.Heading.V3 as Heading

styleguide-app/Examples/QuestionBox.elm

@@ -20,7 +20,7 @@ import Html.Styled.Attributes as Attributes exposing (css)
 import Json.Decode
 import Json.Encode as Encode
 import Markdown
-import Nri.Ui.Block.V1 as Block
+import Nri.Ui.Block.V2 as Block
 import Nri.Ui.Button.V10 as Button
 import Nri.Ui.Colors.V1 as Colors
 import Nri.Ui.Heading.V3 as Heading

tests/Spec/Nri/Ui/Block.elm

@@ -5,7 +5,7 @@ import Dict
 import Expect
 import Html.Attributes as Attributes
 import Html.Styled
-import Nri.Ui.Block.V1 as Block
+import Nri.Ui.Block.V2 as Block
 import Test exposing (..)
 import Test.Html.Query as Query
 import Test.Html.Selector as Selector
@@ -13,7 +13,7 @@ import Test.Html.Selector as Selector
 
 spec : Test
 spec =
-    describe "Nri.Ui.Block.V1"
+    describe "Nri.Ui.Block.V2"
         [ describe "content" contentSpec
         , describe "id" idSpec
         , describe "getLabelHeights" getLabelHeightsSpec

tests/elm-verify-examples.json

@@ -10,6 +10,7 @@
         "Nri.Ui.Balloon.V1",
         "Nri.Ui.Balloon.V2",
         "Nri.Ui.Block.V1",
+        "Nri.Ui.Block.V2",
         "Nri.Ui.BreadCrumbs.V2",
         "Nri.Ui.Button.V10",
         "Nri.Ui.Carousel.V1",