Use a better way to select a color

modules/webapp/src/main/elm/Comp/ColorTagger.elm

@@ -0,0 +1,171 @@
+module Comp.ColorTagger exposing
+    ( Model
+    , Msg
+    , ViewOpts
+    , init
+    , update
+    , view
+    )
+
+import Comp.FixedDropdown
+import Data.Color exposing (Color)
+import Dict exposing (Dict)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+import Util.Maybe
+
+
+type alias FormData =
+    Dict String Color
+
+
+type alias Model =
+    { leftDropdown : Comp.FixedDropdown.Model String
+    , colors : List Color
+    , leftSelect : Maybe String
+    }
+
+
+type Msg
+    = AddPair FormData Color
+    | DeleteItem FormData String
+    | EditItem String Color
+    | LeftMsg (Comp.FixedDropdown.Msg String)
+
+
+init : List String -> List Color -> Model
+init leftSel colors =
+    { leftDropdown = Comp.FixedDropdown.initString leftSel
+    , colors = colors
+    , leftSelect = Nothing
+    }
+
+
+
+--- Update
+
+
+update : Msg -> Model -> ( Model, Maybe FormData )
+update msg model =
+    case msg of
+        AddPair data color ->
+            case model.leftSelect of
+                Just l ->
+                    ( model
+                    , Just (Dict.insert l color data)
+                    )
+
+                _ ->
+                    ( model, Nothing )
+
+        DeleteItem data k ->
+            ( model, Just (Dict.remove k data) )
+
+        EditItem k _ ->
+            ( { model
+                | leftSelect = Just k
+              }
+            , Nothing
+            )
+
+        LeftMsg lm ->
+            let
+                ( m_, la ) =
+                    Comp.FixedDropdown.update lm model.leftDropdown
+            in
+            ( { model
+                | leftDropdown = m_
+                , leftSelect = Util.Maybe.withDefault model.leftSelect la
+              }
+            , Nothing
+            )
+
+
+
+--- View
+
+
+type alias ViewOpts =
+    { renderItem : ( String, Color ) -> Html Msg
+    , label : String
+    , description : Maybe String
+    }
+
+
+view : FormData -> ViewOpts -> Model -> Html Msg
+view data opts model =
+    div [ class "field" ]
+        [ label [] [ text opts.label ]
+        , div [ class "inline field" ]
+            [ Html.map LeftMsg
+                (Comp.FixedDropdown.viewString
+                    model.leftSelect
+                    model.leftDropdown
+                )
+            ]
+        , div [ class "field" ]
+            [ chooseColor
+                (AddPair data)
+                Data.Color.all
+                Nothing
+            ]
+        , renderFormData opts data
+        , span
+            [ classList
+                [ ( "small-info", True )
+                , ( "invisible hidden", opts.description == Nothing )
+                ]
+            ]
+            [ Maybe.withDefault "" opts.description
+                |> text
+            ]
+        ]
+
+
+renderFormData : ViewOpts -> FormData -> Html Msg
+renderFormData opts data =
+    let
+        values =
+            Dict.toList data
+
+        renderItem ( k, v ) =
+            div [ class "item" ]
+                [ a
+                    [ class "link icon"
+                    , href "#"
+                    , onClick (DeleteItem data k)
+                    ]
+                    [ i [ class "trash icon" ] []
+                    ]
+                , a
+                    [ class "link icon"
+                    , href "#"
+                    , onClick (EditItem k v)
+                    ]
+                    [ i [ class "edit icon" ] []
+                    ]
+                , opts.renderItem ( k, v )
+                ]
+    in
+    div [ class "ui list" ]
+        (List.map renderItem values)
+
+
+chooseColor : (Color -> msg) -> List Color -> Maybe String -> Html msg
+chooseColor tagger colors mtext =
+    let
+        renderLabel color =
+            a
+                [ class ("ui large label " ++ Data.Color.toString color)
+                , href "#"
+                , onClick (tagger color)
+                ]
+                [ Maybe.withDefault
+                    (Data.Color.toString color)
+                    mtext
+                    |> text
+                ]
+    in
+    div [ class "ui labels" ] <|
+        List.map renderLabel colors

modules/webapp/src/main/elm/Comp/UiSettingsForm.elm

@@ -8,9 +8,9 @@ module Comp.UiSettingsForm exposing
 
 import Api
 import Api.Model.TagList exposing (TagList)
+import Comp.ColorTagger
 import Comp.IntField
-import Comp.MappingForm
+import Data.Color exposing (Color)
-import Data.Color
 import Data.Flags exposing (Flags)
 import Data.UiSettings exposing (StoredUiSettings, UiSettings)
 import Dict exposing (Dict)
@@ -24,8 +24,8 @@ import Util.List
 type alias Model =
     { itemSearchPageSize : Maybe Int
     , searchPageSizeModel : Comp.IntField.Model
-    , tagColors : Dict String String
+    , tagColors : Dict String Color
-    , tagColorModel : Comp.MappingForm.Model
+    , tagColorModel : Comp.ColorTagger.Model
     , nativePdfPreview : Bool
     }
 
@@ -41,9 +41,9 @@ init flags settings =
                 "Page size"
       , tagColors = settings.tagCategoryColors
       , tagColorModel =
-            Comp.MappingForm.init
+            Comp.ColorTagger.init
                 []
-                Data.Color.allString
+                Data.Color.all
       , nativePdfPreview = settings.nativePdfPreview
       }
     , Api.getTags flags "" GetTagsResp
@@ -52,7 +52,7 @@ init flags settings =
 
 type Msg
     = SearchPageSizeMsg Comp.IntField.Msg
-    | TagColorMsg Comp.MappingForm.Msg
+    | TagColorMsg Comp.ColorTagger.Msg
     | GetTagsResp (Result Http.Error TagList)
     | TogglePdfPreview
 
@@ -83,7 +83,7 @@ update sett msg model =
         TagColorMsg lm ->
             let
                 ( m_, d_ ) =
-                    Comp.MappingForm.update lm model.tagColorModel
+                    Comp.ColorTagger.update lm model.tagColorModel
 
                 nextSettings =
                     Maybe.map (\tc -> { sett | tagCategoryColors = tc }) d_
@@ -113,9 +113,9 @@ update sett msg model =
             in
             ( { model
                 | tagColorModel =
-                    Comp.MappingForm.init
+                    Comp.ColorTagger.init
                         categories
-                        Data.Color.allString
+                        Data.Color.all
               }
             , Nothing
             )
@@ -128,11 +128,11 @@ update sett msg model =
 --- View
 
 
-tagColorViewOpts : Comp.MappingForm.ViewOpts
+tagColorViewOpts : Comp.ColorTagger.ViewOpts
 tagColorViewOpts =
     { renderItem =
         \( k, v ) ->
-            span [ class ("ui label " ++ v) ]
+            span [ class ("ui label " ++ Data.Color.toString v) ]
                 [ text k ]
     , label = "Choose color for tag categories"
     , description = Just "Tags can be represented differently based on their category."
@@ -140,7 +140,7 @@ tagColorViewOpts =
 
 
 view : UiSettings -> Model -> Html Msg
-view settings model =
+view _ model =
     div [ class "ui form" ]
         [ div [ class "ui dividing header" ]
             [ text "Item Search"
@@ -172,7 +172,7 @@ view settings model =
             [ text "Tag Category Colors"
             ]
         , Html.map TagColorMsg
-            (Comp.MappingForm.view
+            (Comp.ColorTagger.view
                 model.tagColors
                 tagColorViewOpts
                 model.tagColorModel

modules/webapp/src/main/elm/Data/Color.elm

@@ -1,5 +1,5 @@
 module Data.Color exposing
-    ( Color
+    ( Color(..)
     , all
     , allString
     , fromString

modules/webapp/src/main/elm/Data/UiSettings.elm

@@ -38,7 +38,7 @@ default value, converting the StoredUiSettings into a UiSettings.
 -}
 type alias UiSettings =
     { itemSearchPageSize : Int
-    , tagCategoryColors : Dict String String
+    , tagCategoryColors : Dict String Color
     , nativePdfPreview : Bool
     }
 
@@ -56,7 +56,12 @@ merge given fallback =
     { itemSearchPageSize =
         choose given.itemSearchPageSize fallback.itemSearchPageSize
     , tagCategoryColors =
-        Dict.union (Dict.fromList given.tagCategoryColors)
+        Dict.union
+            (Dict.fromList given.tagCategoryColors
+                |> Dict.map (\_ -> Data.Color.fromString)
+                |> Dict.filter (\_ -> \mc -> mc /= Nothing)
+                |> Dict.map (\_ -> Maybe.withDefault Data.Color.Grey)
+            )
             fallback.tagCategoryColors
     , nativePdfPreview = given.nativePdfPreview
     }
@@ -70,7 +75,9 @@ mergeDefaults given =
 toStoredUiSettings : UiSettings -> StoredUiSettings
 toStoredUiSettings settings =
     { itemSearchPageSize = Just settings.itemSearchPageSize
-    , tagCategoryColors = Dict.toList settings.tagCategoryColors
+    , tagCategoryColors =
+        Dict.map (\_ -> Data.Color.toString) settings.tagCategoryColors
+            |> Dict.toList
     , nativePdfPreview = settings.nativePdfPreview
     }
 
@@ -80,7 +87,6 @@ tagColor tag settings =
     let
         readColor c =
             Dict.get c settings.tagCategoryColors
-                |> Maybe.andThen Data.Color.fromString
     in
     Maybe.andThen readColor tag.category