Add new tags in item detail view

modules/webapp/src/main/elm/Api.elm

@@ -1,5 +1,6 @@
 module Api exposing
-    ( cancelJob
+    ( addTag
+    , cancelJob
     , changePassword
     , checkCalEvent
     , createImapSettings
@@ -693,7 +694,7 @@ getContacts flags kind q receive =
 
 
 
--- Tags
+--- Tags
 
 
 getTags : Flags -> String -> (Result Http.Error TagList -> msg) -> Cmd msg
@@ -732,7 +733,7 @@ deleteTag flags tag receive =
 
 
 
--- Equipments
+--- Equipments
 
 
 getEquipments : Flags -> String -> (Result Http.Error EquipmentList -> msg) -> Cmd msg
@@ -771,7 +772,7 @@ deleteEquip flags equip receive =
 
 
 
--- Organization
+--- Organization
 
 
 getOrgLight : Flags -> (Result Http.Error ReferenceList -> msg) -> Cmd msg
@@ -819,7 +820,7 @@ deleteOrg flags org receive =
 
 
 
--- Person
+--- Person
 
 
 getPersonsLight : Flags -> (Result Http.Error ReferenceList -> msg) -> Cmd msg
@@ -906,7 +907,7 @@ deleteSource flags src receive =
 
 
 
--- Users
+--- Users
 
 
 getUsers : Flags -> (Result Http.Error UserList -> msg) -> Cmd msg
@@ -958,7 +959,7 @@ deleteUser flags user receive =
 
 
 
--- Job Queue
+--- Job Queue
 
 
 cancelJob : Flags -> String -> (Result Http.Error BasicResult -> msg) -> Cmd msg
@@ -1008,7 +1009,7 @@ getJobQueueStateTask flags =
 
 
 
--- Item
+--- Item
 
 
 moveAttachmentBefore :
@@ -1055,6 +1056,16 @@ setTags flags item tags receive =
         }
 
 
+addTag : Flags -> String -> Tag -> (Result Http.Error BasicResult -> msg) -> Cmd msg
+addTag flags item tag receive =
+    Http2.authPost
+        { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/tags"
+        , account = getAccount flags
+        , body = Http.jsonBody (Api.Model.Tag.encode tag)
+        , expect = Http.expectJson receive Api.Model.BasicResult.decoder
+        }
+
+
 setDirection : Flags -> String -> DirectionValue -> (Result Http.Error BasicResult -> msg) -> Cmd msg
 setDirection flags item dir receive =
     Http2.authPut
@@ -1184,7 +1195,7 @@ getItemProposals flags item receive =
 
 
 
--- Helper
+--- Helper
 
 
 getAccount : Flags -> AuthResult

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

@@ -0,0 +1,362 @@
+module Comp.DetailEdit exposing
+    ( Model
+    , Msg
+    , Value(..)
+    , fold
+    , initEquip
+    , initOrg
+    , initPerson
+    , initTag
+    , initTagByName
+    , update
+    , view
+    , viewModal
+    )
+
+{-| Module for allowing to edit metadata in the item-edit menu.
+
+It is only possible to edit one thing at a time, suitable for being
+rendered in a modal.
+
+-}
+
+import Api
+import Api.Model.BasicResult exposing (BasicResult)
+import Api.Model.Equipment exposing (Equipment)
+import Api.Model.Organization exposing (Organization)
+import Api.Model.Person exposing (Person)
+import Api.Model.Tag exposing (Tag)
+import Comp.EquipmentForm
+import Comp.OrgForm
+import Comp.PersonForm
+import Comp.TagForm
+import Data.Flags exposing (Flags)
+import Data.Icons as Icons
+import Data.UiSettings exposing (UiSettings)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+import Http
+import Util.Http
+
+
+type alias Model =
+    { form : FormModel
+    , itemId : String
+    , submitting : Bool
+    , result : Maybe BasicResult
+    }
+
+
+type FormModel
+    = TM Comp.TagForm.Model
+    | PM Comp.PersonForm.Model
+    | OM Comp.OrgForm.Model
+    | EM Comp.EquipmentForm.Model
+
+
+fold :
+    (Comp.TagForm.Model -> a)
+    -> (Comp.PersonForm.Model -> a)
+    -> (Comp.OrgForm.Model -> a)
+    -> (Comp.EquipmentForm.Model -> a)
+    -> FormModel
+    -> a
+fold ft fp fo fe model =
+    case model of
+        TM tm ->
+            ft tm
+
+        PM pm ->
+            fp pm
+
+        OM om ->
+            fo om
+
+        EM em ->
+            fe em
+
+
+init : String -> FormModel -> Model
+init itemId fm =
+    { form = fm
+    , itemId = itemId
+    , submitting = False
+    , result = Nothing
+    }
+
+
+initEquip : String -> Comp.EquipmentForm.Model -> Model
+initEquip itemId em =
+    init itemId (EM em)
+
+
+initOrg : String -> Comp.OrgForm.Model -> Model
+initOrg itemId om =
+    init itemId (OM om)
+
+
+initPerson : String -> Comp.PersonForm.Model -> Model
+initPerson itemId pm =
+    init itemId (PM pm)
+
+
+initTag : String -> Comp.TagForm.Model -> Model
+initTag itemId tm =
+    init itemId (TM tm)
+
+
+initTagByName : String -> String -> Model
+initTagByName itemId name =
+    let
+        tm =
+            Comp.TagForm.emptyModel
+
+        tm_ =
+            { tm | name = name }
+    in
+    initTag itemId tm_
+
+
+type Msg
+    = TagMsg Comp.TagForm.Msg
+    | PersonMsg Comp.PersonForm.Msg
+    | OrgMsg Comp.OrgForm.Msg
+    | EquipMsg Comp.EquipmentForm.Msg
+    | Submit
+    | Cancel
+    | SubmitResp (Result Http.Error BasicResult)
+
+
+type Value
+    = SubmitTag Tag
+    | SubmitPerson Person
+    | SubmitOrg Organization
+    | SubmitEquip Equipment
+    | CancelForm
+
+
+makeValue : FormModel -> Value
+makeValue fm =
+    case fm of
+        TM tm ->
+            SubmitTag (Comp.TagForm.getTag tm)
+
+        PM pm ->
+            SubmitPerson (Comp.PersonForm.getPerson pm)
+
+        OM om ->
+            SubmitOrg (Comp.OrgForm.getOrg om)
+
+        EM em ->
+            SubmitEquip (Comp.EquipmentForm.getEquipment em)
+
+
+
+--- Update
+
+
+update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe Value )
+update flags msg model =
+    case msg of
+        Cancel ->
+            ( model, Cmd.none, Just CancelForm )
+
+        SubmitResp (Ok res) ->
+            ( { model
+                | result = Just res
+                , submitting = False
+              }
+            , Cmd.none
+            , Just (makeValue model.form)
+            )
+
+        SubmitResp (Err err) ->
+            ( { model
+                | result = Just (BasicResult False (Util.Http.errorToString err))
+                , submitting = False
+              }
+            , Cmd.none
+            , Nothing
+            )
+
+        Submit ->
+            case model.form of
+                TM tm ->
+                    let
+                        tag =
+                            Comp.TagForm.getTag tm
+                    in
+                    if Comp.TagForm.isValid tm then
+                        ( { model | submitting = True }
+                        , Api.addTag flags model.itemId tag SubmitResp
+                        , Nothing
+                        )
+
+                    else
+                        ( model, Cmd.none, Nothing )
+
+                _ ->
+                    Debug.todo "implement"
+
+        TagMsg lm ->
+            case model.form of
+                TM tm ->
+                    let
+                        ( tm_, tc_ ) =
+                            Comp.TagForm.update flags lm tm
+                    in
+                    ( { model | form = TM tm_ }
+                    , Cmd.map TagMsg tc_
+                    , Nothing
+                    )
+
+                _ ->
+                    ( model, Cmd.none, Nothing )
+
+        PersonMsg lm ->
+            case model.form of
+                PM pm ->
+                    let
+                        ( pm_, pc_ ) =
+                            Comp.PersonForm.update flags lm pm
+                    in
+                    ( { model | form = PM pm_ }
+                    , Cmd.map PersonMsg pc_
+                    , Nothing
+                    )
+
+                _ ->
+                    ( model, Cmd.none, Nothing )
+
+        OrgMsg lm ->
+            case model.form of
+                OM om ->
+                    let
+                        ( om_, oc_ ) =
+                            Comp.OrgForm.update flags lm om
+                    in
+                    ( { model | form = OM om_ }
+                    , Cmd.map OrgMsg oc_
+                    , Nothing
+                    )
+
+                _ ->
+                    ( model, Cmd.none, Nothing )
+
+        EquipMsg lm ->
+            case model.form of
+                EM em ->
+                    let
+                        ( em_, ec_ ) =
+                            Comp.EquipmentForm.update flags lm em
+                    in
+                    ( { model | form = EM em_ }
+                    , Cmd.map EquipMsg ec_
+                    , Nothing
+                    )
+
+                _ ->
+                    ( model, Cmd.none, Nothing )
+
+
+
+--- View
+
+
+view : UiSettings -> Model -> Html Msg
+view settings model =
+    div []
+        [ case model.form of
+            TM tm ->
+                Html.map TagMsg (Comp.TagForm.view tm)
+
+            PM pm ->
+                Html.map PersonMsg (Comp.PersonForm.view settings pm)
+
+            OM om ->
+                Html.map OrgMsg (Comp.OrgForm.view settings om)
+
+            EM em ->
+                Html.map EquipMsg (Comp.EquipmentForm.view em)
+        , div [ class "ui divider" ] []
+        , button
+            [ class "ui primary button"
+            , href "#"
+            , onClick Submit
+            , disabled model.submitting
+            ]
+            [ if model.submitting then
+                i [ class "ui spinner loading icon" ] []
+
+              else
+                text "Submit"
+            ]
+        , button
+            [ class "ui button"
+            , href "#"
+            , onClick Cancel
+            ]
+            [ text "Cancel"
+            ]
+        , div
+            [ classList
+                [ ( "ui message", True )
+                , ( "error", Maybe.map .success model.result == Just False )
+                , ( "success", Maybe.map .success model.result == Just True )
+                , ( "invisible hidden", model.result == Nothing )
+                ]
+            ]
+            [ Maybe.map .message model.result
+                |> Maybe.withDefault ""
+                |> text
+            ]
+        ]
+
+
+viewModal : UiSettings -> Maybe Model -> Html Msg
+viewModal settings mm =
+    let
+        hidden =
+            mm == Nothing
+
+        heading =
+            fold (\_ -> "Add Tag")
+                (\_ -> "Add Person")
+                (\_ -> "Add Organization")
+                (\_ -> "Add Equipment")
+
+        headIcon =
+            fold (\_ -> Icons.tagIcon)
+                (\_ -> Icons.personIcon)
+                (\_ -> Icons.organizationIcon)
+                (\_ -> Icons.equipmentIcon)
+    in
+    div
+        [ classList
+            [ ( "ui inverted modals page dimmer", True )
+            , ( "invisibe hidden", hidden )
+            , ( "active", not hidden )
+            ]
+        , style "display" "flex !important"
+        ]
+        [ div [ class "ui modal active" ]
+            [ div [ class "header" ]
+                [ Maybe.map .form mm
+                    |> Maybe.map headIcon
+                    |> Maybe.withDefault (i [] [])
+                , Maybe.map .form mm
+                    |> Maybe.map heading
+                    |> Maybe.withDefault ""
+                    |> text
+                ]
+            , div [ class "content" ]
+                [ case mm of
+                    Just model ->
+                        view settings model
+
+                    Nothing ->
+                        span [] []
+                ]
+            ]
+        ]

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

@@ -25,6 +25,7 @@ import Api.Model.TagList exposing (TagList)
 import Browser.Navigation as Nav
 import Comp.AttachmentMeta
 import Comp.DatePicker
+import Comp.DetailEdit
 import Comp.Dropdown exposing (isDropdownChangeMsg)
 import Comp.Dropzone
 import Comp.ItemMail
@@ -93,6 +94,7 @@ type alias Model =
     , errored : Set String
     , loading : Set String
     , attachDD : DD.Model String String
+    , modalEdit : Maybe Comp.DetailEdit.Model
     }
 
 
@@ -179,6 +181,7 @@ emptyModel =
     , errored = Set.empty
     , loading = Set.empty
     , attachDD = DD.init
+    , modalEdit = Nothing
     }
 
 
@@ -242,10 +245,13 @@ type Msg
     | AddFilesProgress String Http.Progress
     | AddFilesReset
     | AttachDDMsg (DD.Msg String String)
+    | ModalEditMsg Comp.DetailEdit.Msg
+    | StartTagModal
+    | CloseModal
 
 
 
--- update
+--- Update
 
 
 getOptions : Flags -> Cmd Msg
@@ -511,6 +517,7 @@ update key flags next msg model =
                 , itemDate = item.itemDate
                 , dueDate = item.dueDate
                 , visibleAttach = 0
+                , modalEdit = Nothing
               }
             , Cmd.batch
                 [ c1
@@ -1202,9 +1209,43 @@ update key flags next msg model =
             in
             noSub ( { model | attachDD = model_ }, cmd )
 
+        ModalEditMsg lm ->
+            case model.modalEdit of
+                Just mm ->
+                    let
+                        ( mm_, mc_, mv ) =
+                            Comp.DetailEdit.update flags lm mm
+
+                        ( model_, cmd_ ) =
+                            case mv of
+                                Just Comp.DetailEdit.CancelForm ->
+                                    ( { model | modalEdit = Nothing }, Cmd.none )
+
+                                Just _ ->
+                                    ( model, Api.itemDetail flags model.item.id GetItemResp )
+
+                                Nothing ->
+                                    ( { model | modalEdit = Just mm_ }, Cmd.none )
+                    in
+                    noSub ( model_, Cmd.batch [ cmd_, Cmd.map ModalEditMsg mc_ ] )
+
+                Nothing ->
+                    noSub ( model, Cmd.none )
+
+        StartTagModal ->
+            noSub
+                ( { model
+                    | modalEdit = Just (Comp.DetailEdit.initTagByName model.item.id "")
+                  }
+                , Cmd.none
+                )
+
+        CloseModal ->
+            noSub ( { model | modalEdit = Nothing }, Cmd.none )
 
 
--- view
+
+--- View
 
 
 actionInputDatePicker : DatePicker.Settings
@@ -1219,7 +1260,8 @@ actionInputDatePicker =
 view : { prev : Maybe String, next : Maybe String } -> UiSettings -> Model -> Html Msg
 view inav settings model =
     div []
-        [ renderItemInfo settings model
+        [ Html.map ModalEditMsg (Comp.DetailEdit.viewModal settings model.modalEdit)
+        , renderItemInfo settings model
         , div
             [ classList
                 [ ( "ui ablue-comp menu", True )
@@ -1822,6 +1864,15 @@ renderEditForm settings model =
                 [ label []
                     [ Icons.tagsIcon
                     , text "Tags"
+                    , span [ class "right-float" ]
+                        [ a
+                            [ class "icon link"
+                            , href "#"
+                            , onClick StartTagModal
+                            ]
+                            [ i [ class "add link icon" ] []
+                            ]
+                        ]
                     ]
                 , Html.map TagDropdownMsg (Comp.Dropdown.view settings model.tagModel)
                 ]