Add input field to provide colors for tag categories

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

@@ -8,6 +8,7 @@ module Comp.FixedDropdown exposing
     , initTuple
     , update
     , view
+    , viewString
     )
 
 import Html exposing (..)
@@ -101,6 +102,11 @@ view selected model =
         ]
 
 
+viewString : Maybe String -> Model String -> Html (Msg String)
+viewString selected model =
+    view (Maybe.map (\s -> Item s s) selected) model
+
+
 renderItems : Item a -> Html (Msg a)
 renderItems item =
     div [ class "item", onClick (SelectItem item) ]

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

@@ -0,0 +1,181 @@
+module Comp.MappingForm exposing
+    ( FormData
+    , Model
+    , Msg
+    , ViewOpts
+    , init
+    , update
+    , view
+    )
+
+import Comp.FixedDropdown
+import Dict exposing (Dict)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+import Util.Maybe
+
+
+type alias FormData =
+    Dict String String
+
+
+type alias Model =
+    { leftDropdown : Comp.FixedDropdown.Model String
+    , rightDropdown : Comp.FixedDropdown.Model String
+    , leftSelect : Maybe String
+    , rightSelect : Maybe String
+    }
+
+
+type Msg
+    = AddPair FormData
+    | DeleteItem FormData String
+    | EditItem String String
+    | LeftMsg (Comp.FixedDropdown.Msg String)
+    | RightMsg (Comp.FixedDropdown.Msg String)
+
+
+init : List String -> List String -> Model
+init leftSel rightSel =
+    { leftDropdown = Comp.FixedDropdown.initString leftSel
+    , rightDropdown = Comp.FixedDropdown.initString rightSel
+    , leftSelect = Nothing
+    , rightSelect = Nothing
+    }
+
+
+
+--- Update
+
+
+update : Msg -> Model -> ( Model, Maybe FormData )
+update msg model =
+    case msg of
+        AddPair data ->
+            case ( model.leftSelect, model.rightSelect ) of
+                ( Just l, Just r ) ->
+                    ( { model
+                        | leftSelect = Nothing
+                        , rightSelect = Nothing
+                      }
+                    , Just (Dict.insert l r data)
+                    )
+
+                _ ->
+                    ( model, Nothing )
+
+        DeleteItem data k ->
+            ( model, Just (Dict.remove k data) )
+
+        EditItem k v ->
+            ( { model
+                | leftSelect = Just k
+                , rightSelect = Just v
+              }
+            , Nothing
+            )
+
+        LeftMsg lm ->
+            let
+                ( m_, la ) =
+                    Comp.FixedDropdown.update lm model.leftDropdown
+            in
+            ( { model
+                | leftDropdown = m_
+                , leftSelect = Util.Maybe.withDefault model.leftSelect la
+              }
+            , Nothing
+            )
+
+        RightMsg lm ->
+            let
+                ( m_, la ) =
+                    Comp.FixedDropdown.update lm model.rightDropdown
+            in
+            ( { model
+                | rightDropdown = m_
+                , rightSelect = Util.Maybe.withDefault model.rightSelect la
+              }
+            , Nothing
+            )
+
+
+
+--- View
+
+
+type alias ViewOpts =
+    { renderItem : ( String, String ) -> 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 "fields" ]
+            [ div [ class "inline field" ]
+                [ Html.map LeftMsg
+                    (Comp.FixedDropdown.viewString
+                        model.leftSelect
+                        model.leftDropdown
+                    )
+                ]
+            , div [ class "inline field" ]
+                [ Html.map RightMsg
+                    (Comp.FixedDropdown.viewString
+                        model.rightSelect
+                        model.rightDropdown
+                    )
+                ]
+            , button
+                [ class "ui icon button"
+                , onClick (AddPair data)
+                , href "#"
+                ]
+                [ i [ class "add icon" ] []
+                ]
+            ]
+        , span
+            [ classList
+                [ ( "small-info", True )
+                , ( "invisible hidden", opts.description == Nothing )
+                ]
+            ]
+            [ Maybe.withDefault "" opts.description
+                |> text
+            ]
+        , renderFormData opts data
+        ]
+
+
+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)

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

@@ -2,40 +2,51 @@ module Comp.UiSettingsForm exposing
     ( Model
     , Msg
     , init
-    , initWith
     , update
     , view
     )
 
+import Api
+import Api.Model.TagList exposing (TagList)
 import Comp.IntField
+import Comp.MappingForm
+import Data.Color
+import Data.Flags exposing (Flags)
 import Data.UiSettings exposing (StoredUiSettings, UiSettings)
+import Dict exposing (Dict)
 import Html exposing (..)
 import Html.Attributes exposing (..)
+import Http
+import Util.List
 
 
 type alias Model =
     { defaults : UiSettings
     , input : StoredUiSettings
     , searchPageSizeModel : Comp.IntField.Model
+    , tagColorModel : Comp.MappingForm.Model
+    , tagColors : Dict String String
     }
 
 
-initWith : UiSettings -> Model
-initWith defaults =
-    { defaults = defaults
-    , input = Data.UiSettings.toStoredUiSettings defaults
-    , searchPageSizeModel =
-        Comp.IntField.init
-            (Just 10)
-            (Just 500)
-            False
-            "Item search page"
-    }
-
-
-init : Model
-init =
-    initWith Data.UiSettings.defaults
+init : Flags -> UiSettings -> ( Model, Cmd Msg )
+init flags defaults =
+    ( { defaults = defaults
+      , input = Data.UiSettings.toStoredUiSettings defaults
+      , searchPageSizeModel =
+            Comp.IntField.init
+                (Just 10)
+                (Just 500)
+                False
+                "Item search page"
+      , tagColorModel =
+            Comp.MappingForm.init
+                []
+                Data.Color.allString
+      , tagColors = Dict.empty
+      }
+    , Api.getTags flags "" GetTagsResp
+    )
 
 
 changeInput : (StoredUiSettings -> StoredUiSettings) -> Model -> StoredUiSettings
@@ -45,6 +56,8 @@ changeInput change model =
 
 type Msg
     = SearchPageSizeMsg Comp.IntField.Msg
+    | TagColorMsg Comp.MappingForm.Msg
+    | GetTagsResp (Result Http.Error TagList)
 
 
 getSettings : Model -> UiSettings
@@ -75,11 +88,53 @@ update msg model =
             in
             ( model_, nextSettings )
 
+        TagColorMsg lm ->
+            let
+                ( m_, d_ ) =
+                    Comp.MappingForm.update lm model.tagColorModel
+            in
+            ( { model
+                | tagColorModel = m_
+                , tagColors = Maybe.withDefault model.tagColors d_
+              }
+            , Nothing
+            )
+
+        GetTagsResp (Ok tl) ->
+            let
+                categories =
+                    List.filterMap .category tl.items
+                        |> Util.List.distinct
+            in
+            ( { model
+                | tagColorModel =
+                    Comp.MappingForm.init
+                        categories
+                        Data.Color.allString
+                , tagColors = Dict.empty
+              }
+            , Nothing
+            )
+
+        GetTagsResp (Err _) ->
+            ( model, Nothing )
+
 
 
 --- View
 
 
+tagColorViewOpts : Comp.MappingForm.ViewOpts
+tagColorViewOpts =
+    { renderItem =
+        \( k, v ) ->
+            span [ class ("ui label " ++ v) ]
+                [ text k ]
+    , label = "Choose color for tag categories"
+    , description = Just "Tags can be represented differently based on their category."
+    }
+
+
 view : Model -> Html Msg
 view model =
     div [ class "ui form" ]
@@ -87,7 +142,13 @@ view model =
             (Comp.IntField.viewWithInfo
                 "Maximum results in one page when searching items."
                 model.input.itemSearchPageSize
-                ""
+                "field"
                 model.searchPageSizeModel
             )
+        , Html.map TagColorMsg
+            (Comp.MappingForm.view
+                model.tagColors
+                tagColorViewOpts
+                model.tagColorModel
+            )
         ]

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

@@ -29,12 +29,18 @@ type Msg
     | SettingsSaved
 
 
-init : UiSettings -> Model
-init defaults =
-    { formModel = Comp.UiSettingsForm.initWith defaults
-    , settings = Nothing
-    , message = Nothing
-    }
+init : Flags -> UiSettings -> ( Model, Cmd Msg )
+init flags defaults =
+    let
+        ( fm, fc ) =
+            Comp.UiSettingsForm.init flags defaults
+    in
+    ( { formModel = fm
+      , settings = Nothing
+      , message = Nothing
+      }
+    , Cmd.map UiSettingsFormMsg fc
+    )