Fix and enhance custom-multi-input field

This commit is contained in:
Eike Kettner 2020-11-22 20:07:35 +01:00
parent 066c856981
commit 23b343649c
4 changed files with 175 additions and 92 deletions

View File

@ -1,13 +1,14 @@
module Comp.CustomFieldMultiInput exposing module Comp.CustomFieldMultiInput exposing
( FieldResult(..) ( Model
, Model
, Msg , Msg
, UpdateResult , UpdateResult
, ViewSettings , ViewSettings
, init , init
, initCmd , initCmd
, initWith , initWith
, isEmpty
, nonEmpty , nonEmpty
, reset
, setValues , setValues
, update , update
, view , view
@ -19,24 +20,49 @@ import Api.Model.CustomFieldList exposing (CustomFieldList)
import Api.Model.ItemFieldValue exposing (ItemFieldValue) import Api.Model.ItemFieldValue exposing (ItemFieldValue)
import Comp.CustomFieldInput import Comp.CustomFieldInput
import Comp.FixedDropdown import Comp.FixedDropdown
import Data.CustomFieldChange exposing (CustomFieldChange(..))
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Dict exposing (Dict) import Dict exposing (Dict)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
import Http import Http
import Util.List
import Util.Maybe import Util.Maybe
type alias Model = type alias Model =
{ fieldModels : Dict String Comp.CustomFieldInput.Model { fieldSelect : FieldSelect
, fieldSelect : FieldSelect , visibleFields : Dict String VisibleField
, visibleFields : List CustomField , allFields : List CustomField
, availableFields : List CustomField
} }
type alias FieldSelect =
{ selected : Maybe CustomField
, dropdown : Comp.FixedDropdown.Model CustomField
}
type alias VisibleField =
{ field : CustomField
, inputModel : Comp.CustomFieldInput.Model
}
visibleFields : Model -> List CustomField
visibleFields model =
Dict.toList model.visibleFields
|> List.map (Tuple.second >> .field)
|> List.sortBy .name
currentOptions : List CustomField -> Dict String VisibleField -> List CustomField
currentOptions all visible =
List.filter
(\e -> not <| Dict.member e.name visible)
all
type Msg type Msg
= CustomFieldInputMsg CustomField Comp.CustomFieldInput.Msg = CustomFieldInputMsg CustomField Comp.CustomFieldInput.Msg
| ApplyField CustomField | ApplyField CustomField
@ -47,30 +73,21 @@ type Msg
| SetValues (List ItemFieldValue) | SetValues (List ItemFieldValue)
type FieldResult
= NoResult
| FieldValueRemove CustomField
| FieldValueChange CustomField String
| FieldCreateNew
type alias FieldSelect =
{ selected : Maybe CustomField
, dropdown : Comp.FixedDropdown.Model CustomField
}
nonEmpty : Model -> Bool nonEmpty : Model -> Bool
nonEmpty model = nonEmpty model =
not (List.isEmpty model.availableFields && List.isEmpty model.visibleFields) not (isEmpty model)
isEmpty : Model -> Bool
isEmpty model =
List.isEmpty model.allFields
initWith : List CustomField -> Model initWith : List CustomField -> Model
initWith fields = initWith fields =
{ fieldModels = Dict.empty { fieldSelect = mkFieldSelect (currentOptions fields Dict.empty)
, fieldSelect = mkFieldSelect fields , visibleFields = Dict.empty
, visibleFields = [] , allFields = fields
, availableFields = fields
} }
@ -91,6 +108,18 @@ setValues values =
SetValues values SetValues values
reset : Model -> Model
reset model =
let
opts =
currentOptions model.allFields Dict.empty
in
{ model
| fieldSelect = mkFieldSelect opts
, visibleFields = Dict.empty
}
mkFieldSelect : List CustomField -> FieldSelect mkFieldSelect : List CustomField -> FieldSelect
mkFieldSelect fields = mkFieldSelect fields =
{ selected = Nothing { selected = Nothing
@ -106,7 +135,7 @@ type alias UpdateResult =
{ model : Model { model : Model
, cmd : Cmd Msg , cmd : Cmd Msg
, subs : Sub Msg , subs : Sub Msg
, result : FieldResult , result : CustomFieldChange
} }
@ -123,21 +152,16 @@ update msg model =
CustomFieldResp (Ok list) -> CustomFieldResp (Ok list) ->
let let
avail =
List.filter
(\e -> not <| Dict.member e.name model.fieldModels)
list.items
model_ = model_ =
{ model { model
| availableFields = avail | allFields = list.items
, fieldSelect = mkFieldSelect avail , fieldSelect = mkFieldSelect (currentOptions list.items model.visibleFields)
} }
in in
UpdateResult model_ Cmd.none Sub.none NoResult UpdateResult model_ Cmd.none Sub.none NoFieldChange
CustomFieldResp (Err _) -> CustomFieldResp (Err _) ->
UpdateResult model Cmd.none Sub.none NoResult UpdateResult model Cmd.none Sub.none NoFieldChange
FieldSelectMsg lm -> FieldSelectMsg lm ->
let let
@ -160,26 +184,18 @@ update msg model =
update (ApplyField field) model update (ApplyField field) model
Nothing -> Nothing ->
UpdateResult model_ Cmd.none Sub.none NoResult UpdateResult model_ Cmd.none Sub.none NoFieldChange
ApplyField f -> ApplyField f ->
let let
notSelected e =
e /= f && (not <| Dict.member e.name model.fieldModels)
( fm, fc ) = ( fm, fc ) =
Comp.CustomFieldInput.init f Comp.CustomFieldInput.init f
avail =
List.filter notSelected model.availableFields
visible = visible =
f Dict.insert f.name (VisibleField f fm) model.visibleFields
:: model.visibleFields
|> List.sortBy .name
fSelect = fSelect =
mkFieldSelect avail mkFieldSelect (currentOptions model.allFields visible)
-- have to re-state the open menu when this is invoked -- have to re-state the open menu when this is invoked
-- from a click in the dropdown -- from a click in the dropdown
@ -192,46 +208,43 @@ update msg model =
model_ = model_ =
{ model { model
| fieldSelect = { fSelect | dropdown = dropdownOpen } | fieldSelect = { fSelect | dropdown = dropdownOpen }
, availableFields = avail
, visibleFields = visible , visibleFields = visible
, fieldModels = Dict.insert f.name fm model.fieldModels
} }
cmd_ = cmd_ =
Cmd.map (CustomFieldInputMsg f) fc Cmd.map (CustomFieldInputMsg f) fc
in in
UpdateResult model_ cmd_ Sub.none NoResult UpdateResult model_ cmd_ Sub.none NoFieldChange
RemoveField f -> RemoveField f ->
let let
avail =
f :: model.availableFields
visible = visible =
List.filter (\e -> e /= f) model.visibleFields Dict.remove f.name model.visibleFields
model_ = model_ =
{ model { model
| availableFields = avail | visibleFields = visible
, visibleFields = visible , fieldSelect = mkFieldSelect (currentOptions model.allFields visible)
, fieldSelect = mkFieldSelect avail
} }
in in
UpdateResult model_ Cmd.none Sub.none (FieldValueRemove f) UpdateResult model_ Cmd.none Sub.none (FieldValueRemove f)
CustomFieldInputMsg field lm -> CustomFieldInputMsg f lm ->
let let
fieldModel = visibleField =
Dict.get field.name model.fieldModels Dict.get f.name model.visibleFields
in in
case fieldModel of case visibleField of
Just fm -> Just { field, inputModel } ->
let let
res = res =
Comp.CustomFieldInput.update lm fm Comp.CustomFieldInput.update lm inputModel
model_ = model_ =
{ model | fieldModels = Dict.insert field.name res.model model.fieldModels } { model
| visibleFields =
Dict.insert field.name (VisibleField field res.model) model.visibleFields
}
cmd_ = cmd_ =
Cmd.map (CustomFieldInputMsg field) res.cmd Cmd.map (CustomFieldInputMsg field) res.cmd
@ -245,7 +258,7 @@ update msg model =
FieldValueRemove field FieldValueRemove field
Comp.CustomFieldInput.NoResult -> Comp.CustomFieldInput.NoResult ->
NoResult NoFieldChange
in in
if res.result == Comp.CustomFieldInput.RemoveField then if res.result == Comp.CustomFieldInput.RemoveField then
update (RemoveField field) model_ update (RemoveField field) model_
@ -254,7 +267,7 @@ update msg model =
UpdateResult model_ cmd_ Sub.none result UpdateResult model_ cmd_ Sub.none result
Nothing -> Nothing ->
UpdateResult model Cmd.none Sub.none NoResult UpdateResult model Cmd.none Sub.none NoFieldChange
SetValues values -> SetValues values ->
let let
@ -265,33 +278,24 @@ update msg model =
let let
( fim, fic ) = ( fim, fic ) =
Comp.CustomFieldInput.initWith fv Comp.CustomFieldInput.initWith fv
f =
field fv
in in
( Dict.insert fv.name fim dict ( Dict.insert fv.name (VisibleField f fim) dict
, Cmd.map (CustomFieldInputMsg (field fv)) fic :: cmds , Cmd.map (CustomFieldInputMsg f) fic :: cmds
) )
( modelDict, cmdList ) = ( modelDict, cmdList ) =
List.foldl merge ( Dict.empty, [] ) values List.foldl merge ( Dict.empty, [] ) values
avail =
List.filter
(\e -> not <| Dict.member e.name modelDict)
(model.availableFields ++ model.visibleFields)
model_ = model_ =
{ model { model
| fieldModels = modelDict | fieldSelect = mkFieldSelect (currentOptions model.allFields modelDict)
, availableFields = avail , visibleFields = modelDict
, fieldSelect = mkFieldSelect avail
, visibleFields =
model.visibleFields
++ model.availableFields
|> List.filter (\e -> Dict.member e.name modelDict)
|> Util.List.distinct
|> List.sortBy .name
} }
in in
UpdateResult model_ (Cmd.batch cmdList) Sub.none NoResult UpdateResult model_ (Cmd.batch cmdList) Sub.none NoFieldChange
@ -308,7 +312,7 @@ view : ViewSettings -> Model -> Html Msg
view viewSettings model = view viewSettings model =
div [ class viewSettings.classes ] div [ class viewSettings.classes ]
(viewMenuBar viewSettings model (viewMenuBar viewSettings model
:: List.map (viewCustomField model) model.visibleFields :: List.map (viewCustomField model) (visibleFields model)
) )
@ -339,13 +343,13 @@ viewMenuBar viewSettings model =
viewCustomField : Model -> CustomField -> Html Msg viewCustomField : Model -> CustomField -> Html Msg
viewCustomField model field = viewCustomField model field =
let let
fieldModel = visibleField =
Dict.get field.name model.fieldModels Dict.get field.name model.visibleFields
in in
case fieldModel of case visibleField of
Just fm -> Just vf ->
Html.map (CustomFieldInputMsg field) Html.map (CustomFieldInputMsg field)
(Comp.CustomFieldInput.view "field" Nothing fm) (Comp.CustomFieldInput.view "field" Nothing vf.inputModel)
Nothing -> Nothing ->
span [] [] span [] []

View File

@ -18,11 +18,12 @@ import Api.Model.ItemProposals exposing (ItemProposals)
import Api.Model.ReferenceList exposing (ReferenceList) import Api.Model.ReferenceList exposing (ReferenceList)
import Api.Model.Tag exposing (Tag) import Api.Model.Tag exposing (Tag)
import Api.Model.TagList exposing (TagList) import Api.Model.TagList exposing (TagList)
import Comp.CustomFieldMultiInput exposing (FieldResult(..)) import Comp.CustomFieldMultiInput
import Comp.DatePicker import Comp.DatePicker
import Comp.DetailEdit import Comp.DetailEdit
import Comp.Dropdown exposing (isDropdownChangeMsg) import Comp.Dropdown exposing (isDropdownChangeMsg)
import Comp.ItemDetail.FormChange exposing (FormChange(..)) import Comp.ItemDetail.FormChange exposing (FormChange(..))
import Data.CustomFieldChange exposing (CustomFieldChange(..))
import Data.Direction exposing (Direction) import Data.Direction exposing (Direction)
import Data.Fields import Data.Fields
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
@ -568,7 +569,7 @@ update flags msg model =
change = change =
case res.result of case res.result of
NoResult -> NoFieldChange ->
NoFormChange NoFormChange
FieldValueRemove cf -> FieldValueRemove cf ->

View File

@ -14,7 +14,7 @@ import Api.Model.ReferenceList exposing (ReferenceList)
import Api.Model.Tag exposing (Tag) import Api.Model.Tag exposing (Tag)
import Browser.Navigation as Nav import Browser.Navigation as Nav
import Comp.AttachmentMeta import Comp.AttachmentMeta
import Comp.CustomFieldMultiInput exposing (FieldResult(..)) import Comp.CustomFieldMultiInput
import Comp.DatePicker import Comp.DatePicker
import Comp.DetailEdit import Comp.DetailEdit
import Comp.Dropdown exposing (isDropdownChangeMsg) import Comp.Dropdown exposing (isDropdownChangeMsg)
@ -41,6 +41,7 @@ import Comp.OrgForm
import Comp.PersonForm import Comp.PersonForm
import Comp.SentMails import Comp.SentMails
import Comp.YesNoDimmer import Comp.YesNoDimmer
import Data.CustomFieldChange exposing (CustomFieldChange(..))
import Data.Direction import Data.Direction
import Data.Fields exposing (Field) import Data.Fields exposing (Field)
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
@ -1301,7 +1302,7 @@ update key flags inav settings msg model =
action = action =
case result.result of case result.result of
NoResult -> NoFieldChange ->
Cmd.none Cmd.none
FieldValueRemove field -> FieldValueRemove field ->

View File

@ -0,0 +1,77 @@
module Data.CustomFieldChange exposing
( CustomFieldChange(..)
, CustomFieldValueCollect
, collectValues
, emptyCollect
, isValueChange
, toFieldValues
)
import Api.Model.CustomField exposing (CustomField)
import Api.Model.CustomFieldValue exposing (CustomFieldValue)
import Dict exposing (Dict)
type CustomFieldChange
= NoFieldChange
| FieldValueRemove CustomField
| FieldValueChange CustomField String
| FieldCreateNew
type CustomFieldValueCollect
= CustomFieldValueCollect (Dict String String)
emptyCollect : CustomFieldValueCollect
emptyCollect =
CustomFieldValueCollect Dict.empty
collectValues :
CustomFieldChange
-> CustomFieldValueCollect
-> CustomFieldValueCollect
collectValues change collector =
let
dict =
case collector of
CustomFieldValueCollect d ->
d
in
case change of
NoFieldChange ->
collector
FieldValueRemove f ->
CustomFieldValueCollect (Dict.remove f.id dict)
FieldValueChange f v ->
CustomFieldValueCollect (Dict.insert f.id v dict)
FieldCreateNew ->
collector
toFieldValues : CustomFieldValueCollect -> List CustomFieldValue
toFieldValues dict =
case dict of
CustomFieldValueCollect d ->
Dict.toList d
|> List.map (\( k, v ) -> CustomFieldValue k v)
isValueChange : CustomFieldChange -> Bool
isValueChange change =
case change of
NoFieldChange ->
False
FieldValueRemove _ ->
True
FieldValueChange _ _ ->
True
FieldCreateNew ->
False