From 459647f83f07999e4df067da185ab2f70746de1a Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Thu, 11 Jun 2020 21:52:10 +0200 Subject: [PATCH] Add new tags in item detail view --- modules/webapp/src/main/elm/Api.elm | 29 +- .../webapp/src/main/elm/Comp/DetailEdit.elm | 362 ++++++++++++++++++ .../webapp/src/main/elm/Comp/ItemDetail.elm | 57 ++- 3 files changed, 436 insertions(+), 12 deletions(-) create mode 100644 modules/webapp/src/main/elm/Comp/DetailEdit.elm diff --git a/modules/webapp/src/main/elm/Api.elm b/modules/webapp/src/main/elm/Api.elm index 760b3324..8ad6ec93 100644 --- a/modules/webapp/src/main/elm/Api.elm +++ b/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 diff --git a/modules/webapp/src/main/elm/Comp/DetailEdit.elm b/modules/webapp/src/main/elm/Comp/DetailEdit.elm new file mode 100644 index 00000000..225f6af5 --- /dev/null +++ b/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 [] [] + ] + ] + ] diff --git a/modules/webapp/src/main/elm/Comp/ItemDetail.elm b/modules/webapp/src/main/elm/Comp/ItemDetail.elm index 26fd79de..be3b214c 100644 --- a/modules/webapp/src/main/elm/Comp/ItemDetail.elm +++ b/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) ]