diff --git a/modules/webapp/src/main/elm/Comp/ColorTagger.elm b/modules/webapp/src/main/elm/Comp/ColorTagger.elm new file mode 100644 index 00000000..114cea05 --- /dev/null +++ b/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 diff --git a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm index 79dc6915..4b256e13 100644 --- a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm +++ b/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 +import Data.Color exposing (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 - , tagColorModel : Comp.MappingForm.Model + , tagColors : Dict String Color + , 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 diff --git a/modules/webapp/src/main/elm/Data/Color.elm b/modules/webapp/src/main/elm/Data/Color.elm index 84508ae5..d366f992 100644 --- a/modules/webapp/src/main/elm/Data/Color.elm +++ b/modules/webapp/src/main/elm/Data/Color.elm @@ -1,5 +1,5 @@ module Data.Color exposing - ( Color + ( Color(..) , all , allString , fromString diff --git a/modules/webapp/src/main/elm/Data/UiSettings.elm b/modules/webapp/src/main/elm/Data/UiSettings.elm index 1628d65b..91b7be97 100644 --- a/modules/webapp/src/main/elm/Data/UiSettings.elm +++ b/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