Add input field to provide colors for tag categories

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

@@ -47,14 +47,17 @@ type alias Model =
     }
 
 
-init : Key -> Url -> Flags -> Model
+init : Key -> Url -> Flags -> ( Model, Cmd Msg )
 init key url flags =
     let
         page =
             Page.fromUrl url
                 |> Maybe.withDefault (defaultPage flags)
+
+        ( um, uc ) =
+            Page.UserSettings.Data.emptyModel flags
     in
-    { flags = flags
+    ( { flags = flags
       , key = key
       , page = page
       , version = Api.Model.VersionInfo.empty
@@ -62,7 +65,7 @@ init key url flags =
       , loginModel = Page.Login.Data.emptyModel
       , manageDataModel = Page.ManageData.Data.emptyModel
       , collSettingsModel = Page.CollectiveSettings.Data.emptyModel
-    , userSettingsModel = Page.UserSettings.Data.emptyModel flags
+      , userSettingsModel = um
       , queueModel = Page.Queue.Data.emptyModel
       , registerModel = Page.Register.Data.emptyModel
       , uploadModel = Page.Upload.Data.emptyModel
@@ -71,6 +74,8 @@ init key url flags =
       , navMenuOpen = False
       , subs = Sub.none
       }
+    , Cmd.map UserSettingsMsg uc
+    )
 
 
 type Msg

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,27 +2,36 @@ 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
+init : Flags -> UiSettings -> ( Model, Cmd Msg )
-initWith defaults =
+init flags defaults =
-    { defaults = defaults
+    ( { defaults = defaults
       , input = Data.UiSettings.toStoredUiSettings defaults
       , searchPageSizeModel =
             Comp.IntField.init
@@ -30,12 +39,14 @@ initWith defaults =
                 (Just 500)
                 False
                 "Item search page"
+      , tagColorModel =
+            Comp.MappingForm.init
+                []
+                Data.Color.allString
+      , tagColors = Dict.empty
       }
-
+    , Api.getTags flags "" GetTagsResp
-
+    )
-init : Model
-init =
-    initWith Data.UiSettings.defaults
 
 
 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 : Flags -> UiSettings -> ( Model, Cmd Msg )
-init defaults =
+init flags defaults =
-    { formModel = Comp.UiSettingsForm.initWith defaults
+    let
+        ( fm, fc ) =
+            Comp.UiSettingsForm.init flags defaults
+    in
+    ( { formModel = fm
       , settings = Nothing
       , message = Nothing
       }
+    , Cmd.map UiSettingsFormMsg fc
+    )
 
 
 

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

@@ -0,0 +1,134 @@
+module Data.Color exposing
+    ( Color
+    , all
+    , allString
+    , fromString
+    , toString
+    )
+
+
+type Color
+    = Red
+    | Orange
+    | Yellow
+    | Olive
+    | Green
+    | Teal
+    | Blue
+    | Violet
+    | Purple
+    | Pink
+    | Brown
+    | Grey
+    | Black
+
+
+all : List Color
+all =
+    [ Red
+    , Orange
+    , Yellow
+    , Olive
+    , Green
+    , Teal
+    , Blue
+    , Violet
+    , Purple
+    , Pink
+    , Brown
+    , Grey
+    ]
+
+
+allString : List String
+allString =
+    List.map toString all
+
+
+fromString : String -> Maybe Color
+fromString str =
+    case String.toLower str of
+        "red" ->
+            Just Red
+
+        "orange" ->
+            Just Orange
+
+        "yellow" ->
+            Just Yellow
+
+        "olive" ->
+            Just Olive
+
+        "green" ->
+            Just Green
+
+        "teal" ->
+            Just Teal
+
+        "blue" ->
+            Just Blue
+
+        "violet" ->
+            Just Violet
+
+        "purple" ->
+            Just Purple
+
+        "pink" ->
+            Just Pink
+
+        "brown" ->
+            Just Brown
+
+        "grey" ->
+            Just Grey
+
+        "black" ->
+            Just Black
+
+        _ ->
+            Nothing
+
+
+toString : Color -> String
+toString color =
+    case color of
+        Red ->
+            "red"
+
+        Orange ->
+            "orange"
+
+        Yellow ->
+            "yellow"
+
+        Olive ->
+            "olive"
+
+        Green ->
+            "green"
+
+        Teal ->
+            "teal"
+
+        Blue ->
+            "blue"
+
+        Violet ->
+            "violet"
+
+        Purple ->
+            "purple"
+
+        Pink ->
+            "pink"
+
+        Brown ->
+            "brown"
+
+        Grey ->
+            "grey"
+
+        Black ->
+            "black"

modules/webapp/src/main/elm/Main.elm

@@ -38,7 +38,7 @@ main =
 init : Flags -> Url -> Key -> ( Model, Cmd Msg )
 init flags url key =
     let
-        im =
+        ( im, ic ) =
             App.Data.init key url flags
 
         page =
@@ -62,6 +62,7 @@ init flags url key =
     ( m
     , Cmd.batch
         [ cmd
+        , ic
         , Api.versionInfo flags VersionResp
         , sessionCheck
         , Ports.getUiSettings flags

modules/webapp/src/main/elm/Page/UserSettings/Data.elm

@@ -26,16 +26,22 @@ type alias Model =
     }
 
 
-emptyModel : Flags -> Model
+emptyModel : Flags -> ( Model, Cmd Msg )
 emptyModel flags =
-    { currentTab = Nothing
+    let
+        ( um, uc ) =
+            Comp.UiSettingsManage.init flags Data.UiSettings.defaults
+    in
+    ( { currentTab = Nothing
       , changePassModel = Comp.ChangePasswordForm.emptyModel
       , emailSettingsModel = Comp.EmailSettingsManage.emptyModel
       , imapSettingsModel = Comp.ImapSettingsManage.emptyModel
       , notificationModel = Tuple.first (Comp.NotificationForm.init flags)
       , scanMailboxModel = Tuple.first (Comp.ScanMailboxManage.init flags)
-    , uiSettingsModel = Comp.UiSettingsManage.init Data.UiSettings.defaults
+      , uiSettingsModel = um
       }
+    , Cmd.map UiSettingsMsg uc
+    )
 
 
 type Tab

modules/webapp/src/main/elm/Page/UserSettings/Update.elm

@@ -97,8 +97,12 @@ update flags msg model =
             )
 
         GetUiSettings settings ->
-            ( { model | uiSettingsModel = Comp.UiSettingsManage.init settings }
+            let
-            , Cmd.none
+                ( um, uc ) =
+                    Comp.UiSettingsManage.init flags settings
+            in
+            ( { model | uiSettingsModel = um }
+            , Cmd.map UiSettingsMsg uc
             , Sub.none
             )