Allow providing values for custom fields in item detail

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

@@ -0,0 +1,343 @@
+module Comp.CustomFieldInput exposing
+    ( FieldResult(..)
+    , Model
+    , Msg
+    , UpdateResult
+    , init
+    , update
+    , view
+    )
+
+import Api.Model.CustomField exposing (CustomField)
+import Comp.DatePicker
+import Data.CustomFieldType exposing (CustomFieldType)
+import Date exposing (Date)
+import DatePicker exposing (DatePicker)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onCheck, onClick, onInput)
+
+
+type alias Model =
+    { fieldModel : FieldModel
+    , field : CustomField
+    }
+
+
+type alias FloatModel =
+    { input : String
+    , result : Result String Float
+    }
+
+
+type FieldModel
+    = TextField (Maybe String)
+    | NumberField FloatModel
+    | MoneyField FloatModel
+    | BoolField Bool
+    | DateField (Maybe Date) DatePicker
+
+
+type Msg
+    = NumberMsg String
+    | MoneyMsg String
+    | DateMsg DatePicker.Msg
+    | SetText String
+    | ToggleBool
+    | Remove
+
+
+fieldType : CustomField -> CustomFieldType
+fieldType field =
+    Data.CustomFieldType.fromString field.ftype
+        |> Maybe.withDefault Data.CustomFieldType.Text
+
+
+errorMsg : Model -> Maybe String
+errorMsg model =
+    let
+        floatModel =
+            case model.fieldModel of
+                NumberField fm ->
+                    Just fm
+
+                MoneyField fm ->
+                    Just fm
+
+                _ ->
+                    Nothing
+
+        getMsg res =
+            case res of
+                Ok _ ->
+                    Nothing
+
+                Err m ->
+                    Just m
+    in
+    Maybe.andThen getMsg (Maybe.map .result floatModel)
+
+
+init : CustomField -> ( Model, Cmd Msg )
+init field =
+    let
+        ( dm, dc ) =
+            Comp.DatePicker.init
+    in
+    ( { field = field
+      , fieldModel =
+            case fieldType field of
+                Data.CustomFieldType.Text ->
+                    TextField Nothing
+
+                Data.CustomFieldType.Numeric ->
+                    NumberField (FloatModel "" (Err "No number given"))
+
+                Data.CustomFieldType.Money ->
+                    MoneyField (FloatModel "" (Err "No amount given"))
+
+                Data.CustomFieldType.Boolean ->
+                    BoolField False
+
+                Data.CustomFieldType.Date ->
+                    DateField Nothing dm
+      }
+    , if fieldType field == Data.CustomFieldType.Date then
+        Cmd.map DateMsg dc
+
+      else
+        Cmd.none
+    )
+
+
+type FieldResult
+    = NoResult
+    | RemoveField
+    | Value String
+
+
+type alias UpdateResult =
+    { model : Model
+    , cmd : Cmd Msg
+    , result : FieldResult
+    , subs : Sub Msg
+    }
+
+
+updateFloatModel : String -> (Float -> Float) -> ( FloatModel, FieldResult )
+updateFloatModel msg rounding =
+    case String.toFloat msg of
+        Just n ->
+            let
+                fieldVal =
+                    if String.endsWith "." msg || String.endsWith ".0" msg then
+                        msg
+
+                    else
+                        String.fromFloat (rounding n)
+            in
+            ( { input = fieldVal
+              , result = Ok (rounding n)
+              }
+            , Value (String.fromFloat (rounding n))
+            )
+
+        Nothing ->
+            ( { input = msg
+              , result = Err ("Not a number: " ++ msg)
+              }
+            , NoResult
+            )
+
+
+roundScale2 : Float -> Float
+roundScale2 input =
+    (round (input * 100) |> toFloat) / 100
+
+
+update : Msg -> Model -> UpdateResult
+update msg model =
+    case ( msg, model.fieldModel ) of
+        ( SetText str, TextField _ ) ->
+            let
+                model_ =
+                    { model | fieldModel = TextField (Just str) }
+            in
+            UpdateResult model_ Cmd.none (Value str) Sub.none
+
+        ( NumberMsg str, NumberField _ ) ->
+            let
+                ( fm, res ) =
+                    updateFloatModel str identity
+
+                model_ =
+                    { model | fieldModel = NumberField fm }
+            in
+            UpdateResult model_ Cmd.none res Sub.none
+
+        ( MoneyMsg str, MoneyField _ ) ->
+            let
+                ( fm, res ) =
+                    updateFloatModel str roundScale2
+
+                model_ =
+                    { model | fieldModel = MoneyField fm }
+            in
+            UpdateResult model_ Cmd.none res Sub.none
+
+        ( ToggleBool, BoolField b ) ->
+            let
+                notb =
+                    not b
+
+                model_ =
+                    { model | fieldModel = BoolField notb }
+
+                value =
+                    if notb then
+                        "true"
+
+                    else
+                        "false"
+            in
+            UpdateResult model_ Cmd.none (Value value) Sub.none
+
+        ( DateMsg lm, DateField _ picker ) ->
+            let
+                ( picker_, event ) =
+                    Comp.DatePicker.updateDefault lm picker
+
+                ( newDate, value ) =
+                    case event of
+                        DatePicker.Picked date ->
+                            ( Just date, Value (Date.toIsoString date) )
+
+                        DatePicker.None ->
+                            ( Nothing, NoResult )
+
+                        DatePicker.FailedInput _ ->
+                            ( Nothing, NoResult )
+
+                model_ =
+                    { model | fieldModel = DateField newDate picker_ }
+            in
+            UpdateResult model_ Cmd.none value Sub.none
+
+        ( Remove, _ ) ->
+            UpdateResult model Cmd.none RemoveField Sub.none
+
+        -- no other possibilities, not well encoded here
+        _ ->
+            UpdateResult model Cmd.none NoResult Sub.none
+
+
+mkLabel : Model -> String
+mkLabel model =
+    Maybe.withDefault model.field.name model.field.label
+
+
+removeButton : String -> Html Msg
+removeButton classes =
+    a
+        [ class "ui icon button"
+        , class classes
+        , href "#"
+        , title "Remove this value"
+        , onClick Remove
+        ]
+        [ i [ class "trash alternate outline icon" ] []
+        ]
+
+
+view : String -> Maybe String -> Model -> Html Msg
+view classes icon model =
+    let
+        error =
+            errorMsg model
+    in
+    div
+        [ class classes
+        , classList
+            [ ( "error", error /= Nothing )
+            ]
+        ]
+        [ label []
+            [ mkLabel model |> text
+            ]
+        , makeInput icon model
+        , div
+            [ class "ui red pointing basic label"
+            , classList
+                [ ( "invisible hidden", error == Nothing )
+                ]
+            ]
+            [ Maybe.withDefault "" error |> text
+            ]
+        ]
+
+
+makeInput : Maybe String -> Model -> Html Msg
+makeInput icon model =
+    let
+        iconOr c =
+            Maybe.withDefault c icon
+    in
+    case model.fieldModel of
+        TextField v ->
+            div [ class "ui action left icon input" ]
+                [ input
+                    [ type_ "text"
+                    , Maybe.withDefault "" v |> value
+                    , onInput SetText
+                    ]
+                    []
+                , removeButton ""
+                , i [ class (iconOr "pen icon") ] []
+                ]
+
+        NumberField nm ->
+            div [ class "ui action left icon input" ]
+                [ input
+                    [ type_ "text"
+                    , value nm.input
+                    , onInput NumberMsg
+                    ]
+                    []
+                , removeButton ""
+                , i [ class (iconOr "hashtag icon") ] []
+                ]
+
+        MoneyField nm ->
+            div [ class "ui action left icon input" ]
+                [ input
+                    [ type_ "text"
+                    , value nm.input
+                    , onInput MoneyMsg
+                    ]
+                    []
+                , removeButton ""
+                , i [ class (iconOr "money bill icon") ] []
+                ]
+
+        BoolField b ->
+            div [ class "ui container" ]
+                [ div [ class "ui checkbox" ]
+                    [ input
+                        [ type_ "checkbox"
+                        , onCheck (\_ -> ToggleBool)
+                        , checked b
+                        ]
+                        []
+                    , label []
+                        [ text (mkLabel model)
+                        ]
+                    ]
+                , removeButton "right floated"
+                ]
+
+        DateField v dp ->
+            div [ class "ui action left icon input" ]
+                [ Html.map DateMsg (Comp.DatePicker.view v Comp.DatePicker.defaultSettings dp)
+                , removeButton ""
+                , i [ class (iconOr "calendar icon") ] []
+                ]

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

@@ -0,0 +1,273 @@
+module Comp.CustomFieldMultiInput exposing
+    ( Model
+    , Msg
+    , UpdateResult
+    , init
+    , initWith
+    , update
+    , view
+    )
+
+import Api
+import Api.Model.CustomField exposing (CustomField)
+import Api.Model.CustomFieldList exposing (CustomFieldList)
+import Comp.CustomFieldInput
+import Comp.FixedDropdown
+import Data.Flags exposing (Flags)
+import Dict exposing (Dict)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+import Http
+import Util.Maybe
+
+
+type alias Model =
+    { fieldModels : Dict String Comp.CustomFieldInput.Model
+    , fieldSelect :
+        { selected : Maybe CustomField
+        , dropdown : Comp.FixedDropdown.Model CustomField
+        }
+    , visibleFields : List CustomField
+    , availableFields : List CustomField
+    }
+
+
+type Msg
+    = CustomFieldInputMsg CustomField Comp.CustomFieldInput.Msg
+    | ApplyField CustomField
+    | RemoveField CustomField
+    | CreateNewField
+    | CustomFieldResp (Result Http.Error CustomFieldList)
+    | FieldSelectMsg (Comp.FixedDropdown.Msg CustomField)
+
+
+type FieldResult
+    = NoResult
+    | FieldValueRemove CustomField
+    | FieldValueChange CustomField String
+    | FieldCreateNew
+
+
+initWith : List CustomField -> Model
+initWith fields =
+    { fieldModels = Dict.empty
+    , fieldSelect =
+        { selected = List.head fields
+        , dropdown = Comp.FixedDropdown.init (List.map mkItem fields)
+        }
+    , visibleFields = []
+    , availableFields = fields
+    }
+
+
+init : Flags -> ( Model, Cmd Msg )
+init flags =
+    ( initWith []
+    , Api.getCustomFields flags "" CustomFieldResp
+    )
+
+
+
+--- Update
+
+
+type alias UpdateResult =
+    { model : Model
+    , cmd : Cmd Msg
+    , subs : Sub Msg
+    , result : FieldResult
+    }
+
+
+mkItem : CustomField -> Comp.FixedDropdown.Item CustomField
+mkItem f =
+    Comp.FixedDropdown.Item f (Maybe.withDefault f.name f.label)
+
+
+update : Msg -> Model -> UpdateResult
+update msg model =
+    case msg of
+        CreateNewField ->
+            UpdateResult model Cmd.none Sub.none FieldCreateNew
+
+        CustomFieldResp (Ok list) ->
+            let
+                model_ =
+                    { model
+                        | availableFields = list.items
+                        , fieldSelect =
+                            { selected = List.head list.items
+                            , dropdown = Comp.FixedDropdown.init (List.map mkItem list.items)
+                            }
+                    }
+            in
+            UpdateResult model_ Cmd.none Sub.none NoResult
+
+        CustomFieldResp (Err _) ->
+            UpdateResult model Cmd.none Sub.none NoResult
+
+        FieldSelectMsg lm ->
+            let
+                ( dm_, sel ) =
+                    Comp.FixedDropdown.update lm model.fieldSelect.dropdown
+
+                newF =
+                    Util.Maybe.or [ sel, model.fieldSelect.selected ]
+
+                model_ =
+                    { model
+                        | fieldSelect =
+                            { selected = newF
+                            , dropdown = dm_
+                            }
+                    }
+            in
+            UpdateResult model_ Cmd.none Sub.none NoResult
+
+        ApplyField f ->
+            let
+                notSelected e =
+                    e /= f
+
+                ( fm, fc ) =
+                    Comp.CustomFieldInput.init f
+
+                avail =
+                    List.filter notSelected model.availableFields
+
+                visible =
+                    f :: model.visibleFields
+
+                model_ =
+                    { model
+                        | fieldSelect =
+                            { selected = List.head avail
+                            , dropdown = Comp.FixedDropdown.init (List.map mkItem avail)
+                            }
+                        , availableFields = avail
+                        , visibleFields = visible
+                        , fieldModels = Dict.insert f.name fm model.fieldModels
+                    }
+
+                cmd_ =
+                    Cmd.map (CustomFieldInputMsg f) fc
+            in
+            UpdateResult model_ cmd_ Sub.none NoResult
+
+        RemoveField f ->
+            let
+                avail =
+                    f :: model.availableFields
+
+                visible =
+                    List.filter (\e -> e /= f) model.visibleFields
+
+                model_ =
+                    { model
+                        | availableFields = avail
+                        , visibleFields = visible
+                        , fieldSelect =
+                            { selected = List.head avail
+                            , dropdown = Comp.FixedDropdown.init (List.map mkItem avail)
+                            }
+                    }
+            in
+            UpdateResult model_ Cmd.none Sub.none (FieldValueRemove f)
+
+        CustomFieldInputMsg field lm ->
+            let
+                fieldModel =
+                    Dict.get field.name model.fieldModels
+            in
+            case fieldModel of
+                Just fm ->
+                    let
+                        res =
+                            Comp.CustomFieldInput.update lm fm
+
+                        model_ =
+                            { model | fieldModels = Dict.insert field.name res.model model.fieldModels }
+
+                        cmd_ =
+                            Cmd.map (CustomFieldInputMsg field) res.cmd
+
+                        result =
+                            case res.result of
+                                Comp.CustomFieldInput.Value str ->
+                                    FieldValueChange field str
+
+                                Comp.CustomFieldInput.RemoveField ->
+                                    FieldValueRemove field
+
+                                Comp.CustomFieldInput.NoResult ->
+                                    NoResult
+                    in
+                    if res.result == Comp.CustomFieldInput.RemoveField then
+                        update (RemoveField field) model_
+
+                    else
+                        UpdateResult model_ cmd_ Sub.none result
+
+                Nothing ->
+                    UpdateResult model Cmd.none Sub.none NoResult
+
+
+view : String -> Model -> Html Msg
+view classes model =
+    div [ class classes ]
+        (viewMenuBar model
+            :: List.map (viewCustomField model) model.visibleFields
+        )
+
+
+viewMenuBar : Model -> Html Msg
+viewMenuBar model =
+    let
+        { dropdown, selected } =
+            model.fieldSelect
+    in
+    div [ class "ui action input field" ]
+        [ Html.map FieldSelectMsg
+            (Comp.FixedDropdown.viewStyled "fluid" (Maybe.map mkItem selected) dropdown)
+        , a
+            [ class "ui primary icon button"
+            , href "#"
+            , case selected of
+                Just f ->
+                    onClick (ApplyField f)
+
+                Nothing ->
+                    class "disabled"
+            ]
+            [ i [ class "check icon" ] []
+            ]
+        , addFieldLink "" model
+        ]
+
+
+viewCustomField : Model -> CustomField -> Html Msg
+viewCustomField model field =
+    let
+        fieldModel =
+            Dict.get field.name model.fieldModels
+    in
+    case fieldModel of
+        Just fm ->
+            Html.map (CustomFieldInputMsg field)
+                (Comp.CustomFieldInput.view "field" Nothing fm)
+
+        Nothing ->
+            span [] []
+
+
+addFieldLink : String -> Model -> Html Msg
+addFieldLink classes _ =
+    a
+        [ class ("ui icon button " ++ classes)
+        , href "#"
+        , onClick CreateNewField
+        , title "Create a new custom field"
+        ]
+        [ i [ class "plus link icon" ] []
+        ]

modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm

@@ -24,6 +24,7 @@ import Api.Model.SentMails exposing (SentMails)
 import Api.Model.Tag exposing (Tag)
 import Api.Model.TagList exposing (TagList)
 import Comp.AttachmentMeta
+import Comp.CustomFieldMultiInput
 import Comp.DatePicker
 import Comp.DetailEdit
 import Comp.Dropdown
@@ -93,6 +94,7 @@ type alias Model =
     , modalEdit : Maybe Comp.DetailEdit.Model
     , attachRename : Maybe AttachmentRename
     , keyInputModel : Comp.KeyInput.Model
+    , customFieldsModel : Comp.CustomFieldMultiInput.Model
     }
 
 
@@ -194,6 +196,7 @@ emptyModel =
     , modalEdit = Nothing
     , attachRename = Nothing
     , keyInputModel = Comp.KeyInput.init
+    , customFieldsModel = Comp.CustomFieldMultiInput.initWith []
     }
 
 
@@ -279,6 +282,7 @@ type Msg
     | ToggleAttachMenu
     | UiSettingsUpdated
     | SetLinkTarget LinkTarget
+    | CustomFieldMsg Comp.CustomFieldMultiInput.Msg
 
 
 type SaveNameState

modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm

@@ -13,6 +13,7 @@ import Api.Model.ReferenceList exposing (ReferenceList)
 import Api.Model.Tag exposing (Tag)
 import Browser.Navigation as Nav
 import Comp.AttachmentMeta
+import Comp.CustomFieldMultiInput
 import Comp.DatePicker
 import Comp.DetailEdit
 import Comp.Dropdown exposing (isDropdownChangeMsg)
@@ -72,14 +73,24 @@ update key flags inav settings msg model =
 
                 ( im, ic ) =
                     Comp.ItemMail.init flags
+
+                ( cm, cc ) =
+                    Comp.CustomFieldMultiInput.init flags
             in
             resultModelCmd
-                ( { model | itemDatePicker = dp, dueDatePicker = dp, itemMail = im, visibleAttach = 0 }
+                ( { model
+                    | itemDatePicker = dp
+                    , dueDatePicker = dp
+                    , itemMail = im
+                    , visibleAttach = 0
+                    , customFieldsModel = cm
+                  }
                 , Cmd.batch
                     [ getOptions flags
                     , Cmd.map ItemDatePickerMsg dpc
                     , Cmd.map DueDatePickerMsg dpc
                     , Cmd.map ItemMailMsg ic
+                    , Cmd.map CustomFieldMsg cc
                     , Api.getSentMails flags model.item.id SentMailsResp
                     ]
                 )
@@ -1270,6 +1281,26 @@ update key flags inav settings msg model =
             , linkTarget = lt
             }
 
+        CustomFieldMsg lm ->
+            let
+                result =
+                    Comp.CustomFieldMultiInput.update lm model.customFieldsModel
+
+                model_ =
+                    { model | customFieldsModel = result.model }
+
+                cmd_ =
+                    Cmd.map CustomFieldMsg result.cmd
+
+                sub_ =
+                    Sub.map CustomFieldMsg result.subs
+            in
+            { model = model_
+            , cmd = cmd_
+            , sub = sub_
+            , linkTarget = Comp.LinkTarget.LinkNone
+            }
+
 
 
 --- Helper

modules/webapp/src/main/elm/Comp/ItemDetail/View.elm

@@ -4,6 +4,7 @@ import Api
 import Api.Model.Attachment exposing (Attachment)
 import Api.Model.IdName exposing (IdName)
 import Comp.AttachmentMeta
+import Comp.CustomFieldMultiInput
 import Comp.DatePicker
 import Comp.DetailEdit
 import Comp.Dropdown
@@ -730,16 +731,7 @@ renderEditForm settings model =
     in
     div [ class "ui attached segment" ]
         [ div [ class "ui form warning" ]
-            [ optional [ Data.Fields.Tag ] <|
-                div [ class "field" ]
-                    [ label []
-                        [ Icons.tagsIcon "grey"
-                        , text "Tags"
-                        , addIconLink "Add new tag" StartTagModal
-                        ]
-                    , Html.map TagDropdownMsg (Comp.Dropdown.view settings model.tagModel)
-                    ]
-            , div [ class " field" ]
+            [ div [ class " field" ]
                 [ label [] [ text "Name" ]
                 , div [ class "ui icon input" ]
                     [ input [ type_ "text", value model.nameModel, onInput SetName ] []
@@ -753,6 +745,15 @@ renderEditForm settings model =
                         []
                     ]
                 ]
+            , optional [ Data.Fields.Tag ] <|
+                div [ class "field" ]
+                    [ label []
+                        [ Icons.tagsIcon "grey"
+                        , text "Tags"
+                        , addIconLink "Add new tag" StartTagModal
+                        ]
+                    , Html.map TagDropdownMsg (Comp.Dropdown.view settings model.tagModel)
+                    ]
             , optional [ Data.Fields.Folder ] <|
                 div [ class "field" ]
                     [ label []
@@ -773,21 +774,26 @@ item visible. This message will disappear then.
                       """
                         ]
                     ]
-            , optional [ Data.Fields.Direction ] <|
-                div [ class "field" ]
-                    [ label []
-                        [ Icons.directionIcon "grey"
-                        , text "Direction"
-                        ]
-                    , Html.map DirDropdownMsg (Comp.Dropdown.view settings model.directionModel)
+            , optional [ Data.Fields.CustomFields ] <|
+                h4 [ class "ui dividing header" ]
+                    [ Icons.customFieldIcon ""
+                    , text "Custom Fields"
+                    ]
+            , optional [ Data.Fields.CustomFields ] <|
+                Html.map CustomFieldMsg
+                    (Comp.CustomFieldMultiInput.view "field" model.customFieldsModel)
+            , optional [ Data.Fields.DueDate, Data.Fields.Date ] <|
+                h4 [ class "ui dividing header" ]
+                    [ Icons.dateIcon ""
+                    , text "Dates"
                     ]
             , optional [ Data.Fields.Date ] <|
                 div [ class "field" ]
                     [ label []
                         [ Icons.dateIcon "grey"
-                        , text "Date"
+                        , text "Item Date"
                         ]
-                    , div [ class "ui action input" ]
+                    , div [ class "ui left icon action input" ]
                         [ Html.map ItemDatePickerMsg
                             (Comp.DatePicker.viewTime
                                 model.itemDate
@@ -797,6 +803,7 @@ item visible. This message will disappear then.
                         , a [ class "ui icon button", href "", onClick RemoveDate ]
                             [ i [ class "trash alternate outline icon" ] []
                             ]
+                        , Icons.dateIcon ""
                         ]
                     , renderItemDateSuggestions model
                     ]
@@ -806,7 +813,7 @@ item visible. This message will disappear then.
                         [ Icons.dueDateIcon "grey"
                         , text "Due Date"
                         ]
-                    , div [ class "ui action input" ]
+                    , div [ class "ui left icon action input" ]
                         [ Html.map DueDatePickerMsg
                             (Comp.DatePicker.viewTime
                                 model.dueDate
@@ -815,6 +822,7 @@ item visible. This message will disappear then.
                             )
                         , a [ class "ui icon button", href "", onClick RemoveDueDate ]
                             [ i [ class "trash alternate outline icon" ] [] ]
+                        , Icons.dueDateIcon ""
                         ]
                     , renderDueDateSuggestions model
                     ]
@@ -878,6 +886,14 @@ item visible. This message will disappear then.
                     , Html.map ConcEquipMsg (Comp.Dropdown.view settings model.concEquipModel)
                     , renderConcEquipSuggestions model
                     ]
+            , optional [ Data.Fields.Direction ] <|
+                div [ class "field" ]
+                    [ label []
+                        [ Icons.directionIcon "grey"
+                        , text "Direction"
+                        ]
+                    , Html.map DirDropdownMsg (Comp.Dropdown.view settings model.directionModel)
+                    ]
             ]
         ]
 

modules/webapp/src/main/webjar/docspell.css

@@ -235,6 +235,17 @@ textarea.markdown-editor {
     background-color: aliceblue;
 }
 
+.default-layout .ui.action.input .elm-datepicker--container {
+    width: 100%;
+}
+.default-layout .ui.action.input .elm-datepicker--container input.elm-datepicker--input {
+    width: 100%;
+    padding-left: 2.67142857em;
+    padding-right: 1em;
+    border-top-right-radius: 0;
+    border-bottom-right-radius: 0;
+}
+
 .ui.dimmer.keep-small {
     justify-content: start;
 }