Use a better way to select a color

This commit is contained in:
Eike Kettner 2020-06-08 21:48:27 +02:00
parent 4c832dba35
commit 3ad9b24c2c
4 changed files with 196 additions and 19 deletions

View File

@ -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

View File

@ -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

View File

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

View File

@ -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