NoRedInk/noredink-ui
1
1
Fork 0
mirror of https://github.com/NoRedInk/noredink-ui.git synced 2024-09-21 20:27:36 +03:00
Code Issues Packages Projects Releases Wiki Activity

Adds list as a first class option

Browse Source
This commit is contained in:
Tessa Kelly 2024-01-29 13:19:12 -07:00
parent 91ba33f5c4
commit a730301fc4
1 changed files with 96 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

160
component-catalog/src/Debug/Control.elm
View File

@ -43,7 +43,12 @@ type Control a
type ControlView a
= NoView
| SingleView (Html (Control a))
| FieldViews (List ( String, Html (Control a) ))
| FieldViews FieldViewsStyle (List ( String, Html (Control a) ))
type FieldViewsStyle
= Record
| List
{-| A `Control` that has a static value (and no UI).
@ -257,32 +262,7 @@ record : a -> Control a
record fn =
Control
{ currentValue = \() -> fn
, view = \() -> FieldViews []
}
{-| Used with [`record`](#record) or [`list`](#list) to create a `Control`.
-}
field : String -> Control a -> Control (a -> b) -> Control b
field name (Control control) (Control pipeline) =
Control
{ currentValue = \() -> pipeline.currentValue () (control.currentValue ())
, view =
\() ->
let
otherFields =
case pipeline.view () of
FieldViews fs ->
List.map (Tuple.mapSecond (\x -> Html.map (field name (Control control)) x))
fs
_ ->
[]
newView =
view_ (\v -> field name v (Control pipeline)) (Control control)
in
FieldViews (( name, newView ) :: otherFields)
, view = \() -> FieldViews Record []
}
@ -295,7 +275,37 @@ field name (Control control) (Control pipeline) =
-}
list : Control (List a)
list =
record []
Control
{ currentValue = \() -> []
, view = \() -> FieldViews List []
}
{-| Used with [`record`](#record) or [`list`](#list) to create a `Control`.
-}
field : String -> Control a -> Control (a -> b) -> Control b
field name (Control control) (Control pipeline) =
Control
{ currentValue = \() -> pipeline.currentValue () (control.currentValue ())
, view =
\() ->
let
( style, otherFields ) =
case pipeline.view () of
FieldViews style_ fs ->
( style_
, List.map (Tuple.mapSecond (\x -> Html.map (field name (Control control)) x))
fs
)
_ ->
( Record, [] )
newView =
view_ (\v -> field name v (Control pipeline)) (Control control)
in
FieldViews style (( name, newView ) :: otherFields)
}
{-| Transform the value produced by a `Control`.
@ -345,8 +355,8 @@ mapView fn controlView =
SingleView v ->
SingleView (Html.map (map fn) v)
FieldViews fs ->
FieldViews
FieldViews style fs ->
FieldViews style
(List.map (Tuple.mapSecond (Html.map (map fn))) fs)
@ -375,43 +385,11 @@ view_ msg (Control c) =
SingleView v ->
Html.map msg v
FieldViews fs ->
let
fieldRow index ( name, fieldView ) =
Html.label
[ Html.Attributes.style "display" "table-row"
, Html.Attributes.style "vertical-align" "text-top"
]
[ Html.span
[ Html.Attributes.style "display" "table-cell"
]
[ Html.text
(if index == 0 then
"{"
else
","
)
]
, Html.span
[ Html.Attributes.style "display" "table-cell"
, Html.Attributes.style "text-align" "right"
]
[ Html.text name ]
, Html.span
[ Html.Attributes.style "display" "table-cell"
]
[ Html.text " = " ]
, Html.div
[ Html.Attributes.style "display" "table-cell"
]
[ fieldView ]
]
in
FieldViews Record fs ->
List.concat
[ fs
|> List.reverse
|> List.indexedMap fieldRow
|> List.indexedMap (fieldRow '{')
, [ Html.div
[ Html.Attributes.style "display" "table-row"
]
@ -427,3 +405,57 @@ view_ msg (Control c) =
, Html.Attributes.style "border-spacing" "2px"
]
|> Html.map msg
FieldViews List fs ->
List.concat
[ fs
|> List.reverse
|> List.indexedMap (fieldRow '[')
, [ Html.div
[ Html.Attributes.style "display" "table-row"
]
[ Html.div
[ Html.Attributes.style "display" "table-cell"
]
[ Html.text "]" ]
]
]
]
|> Html.div
[ Html.Attributes.style "display" "table"
, Html.Attributes.style "border-spacing" "2px"
]
|> Html.map msg
fieldRow : Char -> Int -> ( String, Html msg ) -> Html msg
fieldRow openingChar index ( name, fieldView ) =
Html.label
[ Html.Attributes.style "display" "table-row"
, Html.Attributes.style "vertical-align" "text-top"
]
[ Html.span
[ Html.Attributes.style "display" "table-cell"
]
[ Html.text
(if index == 0 then
String.fromChar openingChar
else
","
)
]
, Html.span
[ Html.Attributes.style "display" "table-cell"
, Html.Attributes.style "text-align" "right"
]
[ Html.text name ]
, Html.span
[ Html.Attributes.style "display" "table-cell"
]
[ Html.text " = " ]
, Html.div
[ Html.Attributes.style "display" "table-cell"
]
[ fieldView ]
]