From 873d9fafc311cc2d877dc1224ae3ca93e027cf68 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Fri, 7 Aug 2020 23:39:55 +0200 Subject: [PATCH 01/15] Add better folder field to search menu and re-order fields --- .../webapp/src/main/elm/Comp/FolderSelect.elm | 173 ++++++++++++++++++ .../webapp/src/main/elm/Comp/SearchMenu.elm | 141 +++++++------- 2 files changed, 244 insertions(+), 70 deletions(-) create mode 100644 modules/webapp/src/main/elm/Comp/FolderSelect.elm diff --git a/modules/webapp/src/main/elm/Comp/FolderSelect.elm b/modules/webapp/src/main/elm/Comp/FolderSelect.elm new file mode 100644 index 00000000..7907c715 --- /dev/null +++ b/modules/webapp/src/main/elm/Comp/FolderSelect.elm @@ -0,0 +1,173 @@ +module Comp.FolderSelect exposing + ( Model + , Msg + , init + , update + , view + ) + +import Api.Model.FolderItem exposing (FolderItem) +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (onClick) +import Util.List + + +type alias Model = + { all : List FolderItem + , selected : Maybe String + , expanded : Bool + } + + +init : List FolderItem -> Model +init all = + { all = List.sortBy .name all + , selected = Nothing + , expanded = False + } + + + +--- Update + + +type Msg + = Toggle FolderItem + | ToggleExpand + + +update : Msg -> Model -> ( Model, Maybe FolderItem ) +update msg model = + case msg of + Toggle item -> + let + selection = + if model.selected == Just item.id then + Nothing + + else + Just item.id + + model_ = + { model | selected = selection } + in + ( model_, selectedFolder model_ ) + + ToggleExpand -> + ( { model | expanded = not model.expanded } + , selectedFolder model + ) + + +selectedFolder : Model -> Maybe FolderItem +selectedFolder model = + let + isSelected f = + Just f.id == model.selected + in + Util.List.find isSelected model.all + + + +--- View + + +view : Int -> Model -> Html Msg +view constr model = + div [ class "ui list" ] + [ div [ class "item" ] + [ i [ class "folder open icon" ] [] + , div [ class "content" ] + [ div [ class "header" ] + [ text "All" + ] + , div [ class "ui relaxed list" ] + (renderItems constr model) + ] + ] + ] + + +renderItems : Int -> Model -> List (Html Msg) +renderItems constr model = + if constr <= 0 then + List.map (viewItem model) model.all + + else if model.expanded then + List.map (viewItem model) model.all ++ collapseToggle constr model + + else + List.map (viewItem model) (List.take constr model.all) ++ expandToggle constr model + + +expandToggle : Int -> Model -> List (Html Msg) +expandToggle max model = + if max > List.length model.all then + [] + + else + [ a + [ class "item" + , onClick ToggleExpand + , href "#" + ] + [ i [ class "angle down icon" ] [] + , div [ class "content" ] + [ div [ class "description" ] + [ em [] [ text "Show More …" ] + ] + ] + ] + ] + + +collapseToggle : Int -> Model -> List (Html Msg) +collapseToggle max model = + if max > List.length model.all then + [] + + else + [ a + [ class "item" + , onClick ToggleExpand + , href "#" + ] + [ i [ class "angle up icon" ] [] + , div [ class "content" ] + [ div [ class "description" ] + [ em [] [ text "Show Less …" ] + ] + ] + ] + ] + + +viewItem : Model -> FolderItem -> Html Msg +viewItem model item = + let + selected = + Just item.id == model.selected + + icon = + if selected then + "folder outline open icon" + + else + "folder outline icon" + in + a + [ classList + [ ( "item", True ) + , ( "active", selected ) + ] + , href "#" + , onClick (Toggle item) + ] + [ i [ class icon ] [] + , div [ class "content" ] + [ div [ class "header" ] + [ text item.name + ] + ] + ] diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index ad4fbe5f..cc308830 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -11,6 +11,7 @@ module Comp.SearchMenu exposing import Api import Api.Model.Equipment exposing (Equipment) import Api.Model.EquipmentList exposing (EquipmentList) +import Api.Model.FolderItem exposing (FolderItem) import Api.Model.FolderList exposing (FolderList) import Api.Model.IdName exposing (IdName) import Api.Model.ItemSearch exposing (ItemSearch) @@ -19,6 +20,7 @@ import Api.Model.Tag exposing (Tag) import Api.Model.TagList exposing (TagList) import Comp.DatePicker import Comp.Dropdown exposing (isDropdownChangeMsg) +import Comp.FolderSelect import Data.Direction exposing (Direction) import Data.Flags exposing (Flags) import Data.Icons as Icons @@ -48,7 +50,8 @@ type alias Model = , corrPersonModel : Comp.Dropdown.Model IdName , concPersonModel : Comp.Dropdown.Model IdName , concEquipmentModel : Comp.Dropdown.Model Equipment - , folderModel : Comp.Dropdown.Model IdName + , folderList : Comp.FolderSelect.Model + , selectedFolder : Maybe FolderItem , inboxCheckbox : Bool , fromDateModel : DatePicker , fromDate : Maybe Int @@ -110,14 +113,8 @@ init = , labelColor = \_ -> \_ -> "" , placeholder = "Choose an equipment" } - , folderModel = - Comp.Dropdown.makeModel - { multiple = False - , searchable = \n -> n > 5 - , makeOption = \e -> { value = e.id, text = e.name, additional = "" } - , labelColor = \_ -> \_ -> "" - , placeholder = "Only items in folder" - } + , folderList = Comp.FolderSelect.init [] + , selectedFolder = Nothing , inboxCheckbox = False , fromDateModel = Comp.DatePicker.emptyModel , fromDate = Nothing @@ -159,7 +156,7 @@ type Msg | ResetForm | KeyUpMsg (Maybe KeyCode) | ToggleNameHelp - | FolderMsg (Comp.Dropdown.Msg IdName) + | FolderSelectMsg Comp.FolderSelect.Msg | GetFolderResp (Result Http.Error FolderList) | TagCatIncMsg (Comp.Dropdown.Msg String) | TagCatExcMsg (Comp.Dropdown.Msg String) @@ -203,8 +200,11 @@ getItemSearch model = , corrOrg = Comp.Dropdown.getSelected model.orgModel |> List.map .id |> List.head , concPerson = Comp.Dropdown.getSelected model.concPersonModel |> List.map .id |> List.head , concEquip = Comp.Dropdown.getSelected model.concEquipmentModel |> List.map .id |> List.head - , folder = Comp.Dropdown.getSelected model.folderModel |> List.map .id |> List.head - , direction = Comp.Dropdown.getSelected model.directionModel |> List.head |> Maybe.map Data.Direction.toString + , folder = model.selectedFolder |> Maybe.map .id + , direction = + Comp.Dropdown.getSelected model.directionModel + |> List.head + |> Maybe.map Data.Direction.toString , inbox = model.inboxCheckbox , dateFrom = model.fromDate , dateUntil = model.untilDate @@ -544,26 +544,29 @@ update flags settings msg model = GetFolderResp (Ok fs) -> let - opts = - List.filter .isMember fs.items - |> List.map (\e -> IdName e.id e.name) - |> Comp.Dropdown.SetOptions + model_ = + { model | folderList = Comp.FolderSelect.init fs.items } in - update flags settings (FolderMsg opts) model + NextState + ( model_, Cmd.none ) + False GetFolderResp (Err _) -> noChange ( model, Cmd.none ) - FolderMsg lm -> + FolderSelectMsg lm -> let - ( m2, c2 ) = - Comp.Dropdown.update lm model.folderModel + ( fsm, sel ) = + Comp.FolderSelect.update lm model.folderList in NextState - ( { model | folderModel = m2 } - , Cmd.map FolderMsg c2 + ( { model + | folderList = fsm + , selectedFolder = sel + } + , Cmd.none ) - (isDropdownChangeMsg lm) + (model.selectedFolder /= sel) TagCatIncMsg m -> let @@ -635,43 +638,6 @@ view flags settings model = ] ] ] - , formHeaderHelp nameIcon "Names" ToggleNameHelp - , span - [ classList - [ ( "small-info", True ) - , ( "invisible hidden", not model.showNameHelp ) - ] - ] - [ text "Use wildcards " - , code [] [ text "*" ] - , text " at beginning or end. Added automatically if not " - , text "present and not quoted. Press " - , em [] [ text "Enter" ] - , text " to start searching." - ] - , div [ class "field" ] - [ label [] [ text "Names" ] - , input - [ type_ "text" - , onInput SetAllName - , Util.Html.onKeyUpCode KeyUpMsg - , model.allNameModel |> Maybe.withDefault "" |> value - ] - [] - , span - [ classList - [ ( "small-info", True ) - , ( "invisible hidden", not model.showNameHelp ) - ] - ] - [ text "Looks in correspondents, concerned entities, item name and notes." - ] - ] - , formHeader (Icons.folderIcon "") "Folder" - , div [ class "field" ] - [ label [] [ text "Folder" ] - , Html.map FolderMsg (Comp.Dropdown.view settings model.folderModel) - ] , formHeader (Icons.tagsIcon "") "Tags" , div [ class "field" ] [ label [] [ text "Include (and)" ] @@ -689,23 +655,39 @@ view flags settings model = [ label [] [ text "Category Exclude (or)" ] , Html.map TagCatExcMsg (Comp.Dropdown.view settings model.tagCatExclModel) ] - , formHeader (Icons.searchIcon "") "Content" - , div + , formHeader (Icons.folderIcon "") "Folder" + , Html.map FolderSelectMsg + (Comp.FolderSelect.view settings.searchMenuFolders model.folderList) + , formHeaderHelp nameIcon "Names" ToggleNameHelp + , span [ classList - [ ( "field", True ) - , ( "invisible hidden", not flags.config.fullTextSearchEnabled ) + [ ( "small-info", True ) + , ( "invisible hidden", not model.showNameHelp ) ] ] - [ label [] [ text "Content Search" ] - , input + [ text "Use wildcards " + , code [] [ text "*" ] + , text " at beginning or end. Added automatically if not " + , text "present and not quoted. Press " + , em [] [ text "Enter" ] + , text " to start searching." + ] + , div [ class "field" ] + [ input [ type_ "text" - , onInput SetFulltext + , onInput SetAllName , Util.Html.onKeyUpCode KeyUpMsg - , model.fulltextModel |> Maybe.withDefault "" |> value + , model.allNameModel |> Maybe.withDefault "" |> value + , placeholder "Search in various names…" ] [] - , span [ class "small-info" ] - [ text "Fulltext search in document contents and notes." + , span + [ classList + [ ( "small-info", True ) + , ( "invisible hidden", not model.showNameHelp ) + ] + ] + [ text "Looks in correspondents, concerned entities, item name and notes." ] ] , formHeader (Icons.correspondentIcon "") @@ -736,6 +718,25 @@ view flags settings model = [ label [] [ text "Equipment" ] , Html.map ConcEquipmentMsg (Comp.Dropdown.view settings model.concEquipmentModel) ] + , formHeader (Icons.searchIcon "") "Content" + , div + [ classList + [ ( "field", True ) + , ( "invisible hidden", not flags.config.fullTextSearchEnabled ) + ] + ] + [ input + [ type_ "text" + , onInput SetFulltext + , Util.Html.onKeyUpCode KeyUpMsg + , model.fulltextModel |> Maybe.withDefault "" |> value + , placeholder "Fulltext search in results…" + ] + [] + , span [ class "small-info" ] + [ text "Fulltext search in document contents and notes." + ] + ] , formHeader (Icons.dateIcon "") "Date" , div [ class "fields" ] [ div [ class "field" ] From c8ad9bf11f2cf80208f28b461ca60494ddd86407 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 00:06:23 +0200 Subject: [PATCH 02/15] Put number of folders to display in ui settings --- .../src/main/elm/Comp/UiSettingsForm.elm | 35 +++++++++++++++++++ .../webapp/src/main/elm/Data/UiSettings.elm | 7 ++++ modules/webapp/src/main/elm/Util/Maybe.elm | 9 +++-- 3 files changed, 46 insertions(+), 5 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm index 0970e4c5..dbdedc66 100644 --- a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm +++ b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm @@ -30,6 +30,8 @@ type alias Model = , itemSearchNoteLength : Maybe Int , searchNoteLengthModel : Comp.IntField.Model , itemDetailNotesPosition : Pos + , searchMenuFolders : Maybe Int + , searchMenuFoldersModel : Comp.IntField.Model } @@ -56,6 +58,13 @@ init flags settings = False "Max. Note Length" , itemDetailNotesPosition = settings.itemDetailNotesPosition + , searchMenuFolders = Just settings.searchMenuFolders + , searchMenuFoldersModel = + Comp.IntField.init + (Just 0) + (Just 2000) + False + "Number of folders in search menu" } , Api.getTags flags "" GetTagsResp ) @@ -68,6 +77,7 @@ type Msg | TogglePdfPreview | NoteLengthMsg Comp.IntField.Msg | SetNotesPosition Pos + | SearchMenuFolderMsg Comp.IntField.Msg @@ -109,6 +119,22 @@ update sett msg model = in ( model_, nextSettings ) + SearchMenuFolderMsg lm -> + let + ( m, n ) = + Comp.IntField.update lm model.searchMenuFoldersModel + + nextSettings = + Maybe.map (\len -> { sett | searchMenuFolders = len }) n + + model_ = + { model + | searchMenuFoldersModel = m + , searchMenuFolders = n + } + in + ( model_, nextSettings ) + SetNotesPosition pos -> let model_ = @@ -204,6 +230,15 @@ view flags _ model = "field" model.searchNoteLengthModel ) + , div [ class "ui dividing header" ] + [ text "Search Menu" ] + , Html.map SearchMenuFolderMsg + (Comp.IntField.viewWithInfo + "How many folders to display in search menu at once. Other folders can be expanded." + model.searchMenuFolders + "field" + model.searchMenuFoldersModel + ) , div [ class "ui dividing header" ] [ text "Item Detail" ] diff --git a/modules/webapp/src/main/elm/Data/UiSettings.elm b/modules/webapp/src/main/elm/Data/UiSettings.elm index be4d05da..77954000 100644 --- a/modules/webapp/src/main/elm/Data/UiSettings.elm +++ b/modules/webapp/src/main/elm/Data/UiSettings.elm @@ -31,6 +31,7 @@ type alias StoredUiSettings = , nativePdfPreview : Bool , itemSearchNoteLength : Maybe Int , itemDetailNotesPosition : Maybe String + , searchMenuFolders : Maybe Int } @@ -47,6 +48,7 @@ type alias UiSettings = , nativePdfPreview : Bool , itemSearchNoteLength : Int , itemDetailNotesPosition : Pos + , searchMenuFolders : Int } @@ -85,6 +87,7 @@ defaults = , nativePdfPreview = False , itemSearchNoteLength = 0 , itemDetailNotesPosition = Top + , searchMenuFolders = 5 } @@ -106,6 +109,9 @@ merge given fallback = , itemDetailNotesPosition = choose (Maybe.andThen posFromString given.itemDetailNotesPosition) fallback.itemDetailNotesPosition + , searchMenuFolders = + choose given.searchMenuFolders + fallback.searchMenuFolders } @@ -123,6 +129,7 @@ toStoredUiSettings settings = , nativePdfPreview = settings.nativePdfPreview , itemSearchNoteLength = Just settings.itemSearchNoteLength , itemDetailNotesPosition = Just (posToString settings.itemDetailNotesPosition) + , searchMenuFolders = Just settings.searchMenuFolders } diff --git a/modules/webapp/src/main/elm/Util/Maybe.elm b/modules/webapp/src/main/elm/Util/Maybe.elm index e1310b5a..1d792992 100644 --- a/modules/webapp/src/main/elm/Util/Maybe.elm +++ b/modules/webapp/src/main/elm/Util/Maybe.elm @@ -57,13 +57,12 @@ fromString str = filter : (a -> Bool) -> Maybe a -> Maybe a filter predicate ma = - case ma of - Just v -> + let + check v = if predicate v then Just v else Nothing - - Nothing -> - Nothing + in + Maybe.andThen check ma From a4796f3f7f53b7ddc2982d7a84b05db08903743e Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 00:41:20 +0200 Subject: [PATCH 03/15] Return more tag details with item insights --- .../docspell/backend/ops/OCollective.scala | 3 +++ .../src/main/resources/docspell-openapi.yml | 24 +++++++++++++++---- .../restserver/conv/Conversions.scala | 5 +++- .../docspell/store/queries/QCollective.scala | 11 +++++---- .../main/elm/Page/CollectiveSettings/View.elm | 6 ++--- 5 files changed, 36 insertions(+), 13 deletions(-) diff --git a/modules/backend/src/main/scala/docspell/backend/ops/OCollective.scala b/modules/backend/src/main/scala/docspell/backend/ops/OCollective.scala index 72e82f50..79f41d2b 100644 --- a/modules/backend/src/main/scala/docspell/backend/ops/OCollective.scala +++ b/modules/backend/src/main/scala/docspell/backend/ops/OCollective.scala @@ -43,6 +43,9 @@ trait OCollective[F[_]] { object OCollective { + type TagCount = QCollective.TagCount + val TagCount = QCollective.TagCount + type InsightData = QCollective.InsightData val insightData = QCollective.InsightData diff --git a/modules/restapi/src/main/resources/docspell-openapi.yml b/modules/restapi/src/main/resources/docspell-openapi.yml index 2b23aab9..10bd2488 100644 --- a/modules/restapi/src/main/resources/docspell-openapi.yml +++ b/modules/restapi/src/main/resources/docspell-openapi.yml @@ -3050,19 +3050,33 @@ components: items: type: array items: - $ref: "#/components/schemas/NameCount" - NameCount: + $ref: "#/components/schemas/TagCount" + TagCount: description: | Generic structure for counting something. required: - - name + - tag - count properties: - name: - type: string + tag: + $ref: "#/components/schemas/TagLight" count: type: integer format: int32 + TagLight: + description: | + A subset of tag properties. + required: + - id + - name + properties: + id: + type: string + format: ident + name: + type: string + category: + type: string AttachmentMeta: description: | Extracted meta data of an attachment. diff --git a/modules/restserver/src/main/scala/docspell/restserver/conv/Conversions.scala b/modules/restserver/src/main/scala/docspell/restserver/conv/Conversions.scala index ef732d30..fc05d14b 100644 --- a/modules/restserver/src/main/scala/docspell/restserver/conv/Conversions.scala +++ b/modules/restserver/src/main/scala/docspell/restserver/conv/Conversions.scala @@ -31,9 +31,12 @@ trait Conversions { d.incoming, d.outgoing, d.bytes, - TagCloud(d.tags.toList.map(p => NameCount(p._1, p._2))) + TagCloud(d.tags.map(tc => TagCount(mkTagLight(tc), tc.count))) ) + def mkTagLight(t: OCollective.TagCount): TagLight = + TagLight(t.id, t.name, t.category) + // attachment meta def mkAttachmentMeta(rm: RAttachmentMeta): AttachmentMeta = AttachmentMeta( diff --git a/modules/store/src/main/scala/docspell/store/queries/QCollective.scala b/modules/store/src/main/scala/docspell/store/queries/QCollective.scala index 4eb129d4..fbe814dc 100644 --- a/modules/store/src/main/scala/docspell/store/queries/QCollective.scala +++ b/modules/store/src/main/scala/docspell/store/queries/QCollective.scala @@ -11,12 +11,13 @@ import doobie._ import doobie.implicits._ object QCollective { + case class TagCount(id: Ident, name: String, category: Option[String], count: Int) case class InsightData( incoming: Int, outgoing: Int, bytes: Long, - tags: Map[String, Int] + tags: List[TagCount] ) def getInsights(coll: Ident): ConnectionIO[InsightData] = { @@ -52,7 +53,9 @@ object QCollective { ) as t""".query[Option[Long]].unique val q3 = fr"SELECT" ++ commas( + TC.tid.prefix("t").f, TC.name.prefix("t").f, + TC.category.prefix("t").f, fr"count(" ++ RC.itemId.prefix("r").f ++ fr")" ) ++ fr"FROM" ++ RTagItem.table ++ fr"r" ++ @@ -60,14 +63,14 @@ object QCollective { .prefix("r") .is(TC.tid.prefix("t")) ++ fr"WHERE" ++ TC.cid.prefix("t").is(coll) ++ - fr"GROUP BY" ++ TC.name.prefix("t").f + fr"GROUP BY" ++ commas(TC.name.prefix("t").f, TC.tid.prefix("t").f, TC.category.prefix("t").f) for { n0 <- q0 n1 <- q1 n2 <- fileSize - n3 <- q3.query[(String, Int)].to[Vector] - } yield InsightData(n0, n1, n2.getOrElse(0L), Map.from(n3)) + n3 <- q3.query[TagCount].to[List] + } yield InsightData(n0, n1, n2.getOrElse(0L), n3) } def getContacts( diff --git a/modules/webapp/src/main/elm/Page/CollectiveSettings/View.elm b/modules/webapp/src/main/elm/Page/CollectiveSettings/View.elm index 09afa7cd..513e2719 100644 --- a/modules/webapp/src/main/elm/Page/CollectiveSettings/View.elm +++ b/modules/webapp/src/main/elm/Page/CollectiveSettings/View.elm @@ -1,6 +1,6 @@ module Page.CollectiveSettings.View exposing (view) -import Api.Model.NameCount exposing (NameCount) +import Api.Model.TagCount exposing (TagCount) import Comp.CollectiveSettingsForm import Comp.SourceManage import Comp.UserManage @@ -145,14 +145,14 @@ viewInsights model = ] -makeTagStats : NameCount -> Html Msg +makeTagStats : TagCount -> Html Msg makeTagStats nc = div [ class "ui statistic" ] [ div [ class "value" ] [ String.fromInt nc.count |> text ] , div [ class "label" ] - [ text nc.name + [ text nc.tag.name ] ] From 1c8b66194b272952f8c50c55aaa8952db7493c73 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 07:56:55 +0200 Subject: [PATCH 04/15] Add a route to return used tags This is part of the `/insights` route without queries for file usage. --- .../docspell/backend/ops/OCollective.scala | 5 +++ .../src/main/resources/docspell-openapi.yml | 33 ++++++++++-------- .../restserver/conv/Conversions.scala | 6 ++-- .../restserver/routes/CollectiveRoutes.scala | 6 ++++ .../docspell/store/queries/QCollective.scala | 34 +++++++++++-------- 5 files changed, 52 insertions(+), 32 deletions(-) diff --git a/modules/backend/src/main/scala/docspell/backend/ops/OCollective.scala b/modules/backend/src/main/scala/docspell/backend/ops/OCollective.scala index 79f41d2b..715e8110 100644 --- a/modules/backend/src/main/scala/docspell/backend/ops/OCollective.scala +++ b/modules/backend/src/main/scala/docspell/backend/ops/OCollective.scala @@ -27,6 +27,8 @@ trait OCollective[F[_]] { def insights(collective: Ident): F[InsightData] + def tagCloud(collective: Ident): F[List[TagCount]] + def changePassword( accountId: AccountId, current: Password, @@ -116,6 +118,9 @@ object OCollective { def insights(collective: Ident): F[InsightData] = store.transact(QCollective.getInsights(collective)) + def tagCloud(collective: Ident): F[List[TagCount]] = + store.transact(QCollective.tagCloud(collective)) + def changePassword( accountId: AccountId, current: Password, diff --git a/modules/restapi/src/main/resources/docspell-openapi.yml b/modules/restapi/src/main/resources/docspell-openapi.yml index 10bd2488..b14b28d4 100644 --- a/modules/restapi/src/main/resources/docspell-openapi.yml +++ b/modules/restapi/src/main/resources/docspell-openapi.yml @@ -460,6 +460,7 @@ paths: responses: 200: description: Ok + /sec/tag: get: tags: [ Tags ] @@ -1011,6 +1012,22 @@ paths: application/json: schema: $ref: "#/components/schemas/ItemInsights" + /sec/collective/cloud: + get: + tags: [ Collective ] + summary: Summary of used tags. + description: | + Returns all tags and how often each has been applied. + security: + - authTokenHeader: [] + responses: + 200: + description: Ok + content: + application/json: + schema: + $ref: "#/components/schemas/TagCloud" + /sec/collective/contacts: get: tags: [ Collective ] @@ -3059,24 +3076,10 @@ components: - count properties: tag: - $ref: "#/components/schemas/TagLight" + $ref: "#/components/schemas/Tag" count: type: integer format: int32 - TagLight: - description: | - A subset of tag properties. - required: - - id - - name - properties: - id: - type: string - format: ident - name: - type: string - category: - type: string AttachmentMeta: description: | Extracted meta data of an attachment. diff --git a/modules/restserver/src/main/scala/docspell/restserver/conv/Conversions.scala b/modules/restserver/src/main/scala/docspell/restserver/conv/Conversions.scala index fc05d14b..f2f131f0 100644 --- a/modules/restserver/src/main/scala/docspell/restserver/conv/Conversions.scala +++ b/modules/restserver/src/main/scala/docspell/restserver/conv/Conversions.scala @@ -31,11 +31,11 @@ trait Conversions { d.incoming, d.outgoing, d.bytes, - TagCloud(d.tags.map(tc => TagCount(mkTagLight(tc), tc.count))) + mkTagCloud(d.tags) ) - def mkTagLight(t: OCollective.TagCount): TagLight = - TagLight(t.id, t.name, t.category) + def mkTagCloud(tags: List[OCollective.TagCount]) = + TagCloud(tags.map(tc => TagCount(mkTag(tc.tag), tc.count))) // attachment meta def mkAttachmentMeta(rm: RAttachmentMeta): AttachmentMeta = diff --git a/modules/restserver/src/main/scala/docspell/restserver/routes/CollectiveRoutes.scala b/modules/restserver/src/main/scala/docspell/restserver/routes/CollectiveRoutes.scala index 5294e8a6..6163b48b 100644 --- a/modules/restserver/src/main/scala/docspell/restserver/routes/CollectiveRoutes.scala +++ b/modules/restserver/src/main/scala/docspell/restserver/routes/CollectiveRoutes.scala @@ -28,6 +28,12 @@ object CollectiveRoutes { resp <- Ok(Conversions.mkItemInsights(ins)) } yield resp + case GET -> Root / "cloud" => + for { + cloud <- backend.collective.tagCloud(user.account.collective) + resp <- Ok(Conversions.mkTagCloud(cloud)) + } yield resp + case req @ POST -> Root / "settings" => for { settings <- req.as[CollectiveSettings] diff --git a/modules/store/src/main/scala/docspell/store/queries/QCollective.scala b/modules/store/src/main/scala/docspell/store/queries/QCollective.scala index fbe814dc..2dc94e05 100644 --- a/modules/store/src/main/scala/docspell/store/queries/QCollective.scala +++ b/modules/store/src/main/scala/docspell/store/queries/QCollective.scala @@ -11,7 +11,7 @@ import doobie._ import doobie.implicits._ object QCollective { - case class TagCount(id: Ident, name: String, category: Option[String], count: Int) + case class TagCount(tag: RTag, count: Int) case class InsightData( incoming: Int, @@ -22,8 +22,6 @@ object QCollective { def getInsights(coll: Ident): ConnectionIO[InsightData] = { val IC = RItem.Columns - val TC = RTag.Columns - val RC = RTagItem.Columns val q0 = selectCount( IC.id, RItem.table, @@ -52,25 +50,33 @@ object QCollective { inner join filemeta m on m.id = a.file_id where a.id in (select aid from attachs) ) as t""".query[Option[Long]].unique + for { + n0 <- q0 + n1 <- q1 + n2 <- fileSize + n3 <- tagCloud(coll) + } yield InsightData(n0, n1, n2.getOrElse(0L), n3) + } + + def tagCloud(coll: Ident): ConnectionIO[List[TagCount]] = { + val TC = RTag.Columns + val RC = RTagItem.Columns + val q3 = fr"SELECT" ++ commas( - TC.tid.prefix("t").f, - TC.name.prefix("t").f, - TC.category.prefix("t").f, - fr"count(" ++ RC.itemId.prefix("r").f ++ fr")" + TC.all.map(_.prefix("t").f) ++ Seq(fr"count(" ++ RC.itemId.prefix("r").f ++ fr")") ) ++ fr"FROM" ++ RTagItem.table ++ fr"r" ++ fr"INNER JOIN" ++ RTag.table ++ fr"t ON" ++ RC.tagId .prefix("r") .is(TC.tid.prefix("t")) ++ fr"WHERE" ++ TC.cid.prefix("t").is(coll) ++ - fr"GROUP BY" ++ commas(TC.name.prefix("t").f, TC.tid.prefix("t").f, TC.category.prefix("t").f) + fr"GROUP BY" ++ commas( + TC.name.prefix("t").f, + TC.tid.prefix("t").f, + TC.category.prefix("t").f + ) - for { - n0 <- q0 - n1 <- q1 - n2 <- fileSize - n3 <- q3.query[TagCount].to[List] - } yield InsightData(n0, n1, n2.getOrElse(0L), n3) + q3.query[TagCount].to[List] } def getContacts( From 3642b95f8cb7b54b45ad7e4c1e41cb805ffc3bfa Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 09:23:48 +0200 Subject: [PATCH 05/15] Add a better tag selection field --- modules/webapp/src/main/elm/Api.elm | 47 ++++- .../webapp/src/main/elm/Comp/SearchMenu.elm | 76 ++++---- .../webapp/src/main/elm/Comp/TagSelect.elm | 180 ++++++++++++++++++ 3 files changed, 251 insertions(+), 52 deletions(-) create mode 100644 modules/webapp/src/main/elm/Comp/TagSelect.elm diff --git a/modules/webapp/src/main/elm/Api.elm b/modules/webapp/src/main/elm/Api.elm index db1b3aae..317aa53c 100644 --- a/modules/webapp/src/main/elm/Api.elm +++ b/modules/webapp/src/main/elm/Api.elm @@ -51,6 +51,7 @@ module Api exposing , getScanMailbox , getSentMails , getSources + , getTagCloud , getTags , getUsers , itemDetail @@ -148,6 +149,7 @@ import Api.Model.SimpleMail exposing (SimpleMail) import Api.Model.Source exposing (Source) import Api.Model.SourceList exposing (SourceList) import Api.Model.Tag exposing (Tag) +import Api.Model.TagCloud exposing (TagCloud) import Api.Model.TagList exposing (TagList) import Api.Model.User exposing (User) import Api.Model.UserList exposing (UserList) @@ -689,6 +691,10 @@ uploadSingle flags sourceId meta track files receive = } + +--- Registration + + register : Flags -> Registration -> (Result Http.Error BasicResult -> msg) -> Cmd msg register flags reg receive = Http.post @@ -707,6 +713,10 @@ newInvite flags req receive = } + +--- Login + + login : Flags -> UserPass -> (Result Http.Error AuthResult -> msg) -> Cmd msg login flags up receive = Http.post @@ -736,14 +746,6 @@ loginSession flags receive = } -versionInfo : Flags -> (Result Http.Error VersionInfo -> msg) -> Cmd msg -versionInfo flags receive = - Http.get - { url = flags.config.baseUrl ++ "/api/info/version" - , expect = Http.expectJson receive Api.Model.VersionInfo.decoder - } - - refreshSession : Flags -> (Result Http.Error AuthResult -> msg) -> Cmd msg refreshSession flags receive = case flags.account of @@ -775,6 +777,31 @@ refreshSessionTask flags = } + +--- Version + + +versionInfo : Flags -> (Result Http.Error VersionInfo -> msg) -> Cmd msg +versionInfo flags receive = + Http.get + { url = flags.config.baseUrl ++ "/api/info/version" + , expect = Http.expectJson receive Api.Model.VersionInfo.decoder + } + + + +--- Collective + + +getTagCloud : Flags -> (Result Http.Error TagCloud -> msg) -> Cmd msg +getTagCloud flags receive = + Http2.authGet + { url = flags.config.baseUrl ++ "/api/v1/sec/collective/cloud" + , account = getAccount flags + , expect = Http.expectJson receive Api.Model.TagCloud.decoder + } + + getInsights : Flags -> (Result Http.Error ItemInsights -> msg) -> Cmd msg getInsights flags receive = Http2.authGet @@ -812,6 +839,10 @@ setCollectiveSettings flags settings receive = } + +--- Contacts + + getContacts : Flags -> Maybe ContactType diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index cc308830..5c28f62c 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -17,10 +17,11 @@ import Api.Model.IdName exposing (IdName) import Api.Model.ItemSearch exposing (ItemSearch) import Api.Model.ReferenceList exposing (ReferenceList) import Api.Model.Tag exposing (Tag) -import Api.Model.TagList exposing (TagList) +import Api.Model.TagCloud exposing (TagCloud) import Comp.DatePicker import Comp.Dropdown exposing (isDropdownChangeMsg) import Comp.FolderSelect +import Comp.TagSelect import Data.Direction exposing (Direction) import Data.Flags exposing (Flags) import Data.Icons as Icons @@ -41,8 +42,8 @@ import Util.Update type alias Model = - { tagInclModel : Comp.Dropdown.Model Tag - , tagExclModel : Comp.Dropdown.Model Tag + { tagSelectModel : Comp.TagSelect.Model + , tagSelection : Comp.TagSelect.Selection , tagCatInclModel : Comp.Dropdown.Model String , tagCatExclModel : Comp.Dropdown.Model String , directionModel : Comp.Dropdown.Model Direction @@ -71,8 +72,8 @@ type alias Model = init : Model init = - { tagInclModel = Util.Tag.makeDropdownModel - , tagExclModel = Util.Tag.makeDropdownModel + { tagSelectModel = Comp.TagSelect.init [] + , tagSelection = Comp.TagSelect.emptySelection , tagCatInclModel = Util.Tag.makeCatDropdownModel , tagCatExclModel = Util.Tag.makeCatDropdownModel , directionModel = @@ -134,8 +135,7 @@ init = type Msg = Init - | TagIncMsg (Comp.Dropdown.Msg Tag) - | TagExcMsg (Comp.Dropdown.Msg Tag) + | TagSelectMsg Comp.TagSelect.Msg | DirectionMsg (Comp.Dropdown.Msg Direction) | OrgMsg (Comp.Dropdown.Msg IdName) | CorrPersonMsg (Comp.Dropdown.Msg IdName) @@ -146,7 +146,7 @@ type Msg | FromDueDateMsg Comp.DatePicker.Msg | UntilDueDateMsg Comp.DatePicker.Msg | ToggleInbox - | GetTagsResp (Result Http.Error TagList) + | GetTagsResp (Result Http.Error TagCloud) | GetOrgResp (Result Http.Error ReferenceList) | GetEquipResp (Result Http.Error EquipmentList) | GetPersonResp (Result Http.Error ReferenceList) @@ -194,8 +194,8 @@ getItemSearch model = "*" ++ s ++ "*" in { e - | tagsInclude = Comp.Dropdown.getSelected model.tagInclModel |> List.map .id - , tagsExclude = Comp.Dropdown.getSelected model.tagExclModel |> List.map .id + | tagsInclude = model.tagSelection.include |> List.map .tag |> List.map .id + , tagsExclude = model.tagSelection.exclude |> List.map .tag |> List.map .id , corrPerson = Comp.Dropdown.getSelected model.corrPersonModel |> List.map .id |> List.head , corrOrg = Comp.Dropdown.getSelected model.orgModel |> List.map .id |> List.head , concPerson = Comp.Dropdown.getSelected model.concPersonModel |> List.map .id |> List.head @@ -268,7 +268,7 @@ update flags settings msg model = noChange ( mdp , Cmd.batch - [ Api.getTags flags "" GetTagsResp + [ Api.getTagCloud flags GetTagsResp , Api.getOrgLight flags GetOrgResp , Api.getEquipments flags "" GetEquipResp , Api.getPersonsLight flags GetPersonResp @@ -286,21 +286,24 @@ update flags settings msg model = GetTagsResp (Ok tags) -> let - tagList = - Comp.Dropdown.SetOptions tags.items - catList = - Util.Tag.getCategories tags.items + Util.Tag.getCategories (List.map .tag tags.items) |> Comp.Dropdown.SetOptions + + selectModel = + List.sortBy .count tags.items + |> List.reverse + |> Comp.TagSelect.init + + model_ = + { model | tagSelectModel = selectModel } in noChange <| Util.Update.andThen1 - [ update flags settings (TagIncMsg tagList) >> .modelCmd - , update flags settings (TagExcMsg tagList) >> .modelCmd - , update flags settings (TagCatIncMsg catList) >> .modelCmd + [ update flags settings (TagCatIncMsg catList) >> .modelCmd , update flags settings (TagCatExcMsg catList) >> .modelCmd ] - model + model_ GetTagsResp (Err _) -> noChange ( model, Cmd.none ) @@ -340,27 +343,19 @@ update flags settings msg model = GetPersonResp (Err _) -> noChange ( model, Cmd.none ) - TagIncMsg m -> + TagSelectMsg m -> let - ( m2, c2 ) = - Comp.Dropdown.update m model.tagInclModel + ( m_, sel ) = + Comp.TagSelect.update m model.tagSelectModel in NextState - ( { model | tagInclModel = m2 } - , Cmd.map TagIncMsg c2 + ( { model + | tagSelectModel = m_ + , tagSelection = sel + } + , Cmd.none ) - (isDropdownChangeMsg m) - - TagExcMsg m -> - let - ( m2, c2 ) = - Comp.Dropdown.update m model.tagExclModel - in - NextState - ( { model | tagExclModel = m2 } - , Cmd.map TagExcMsg c2 - ) - (isDropdownChangeMsg m) + (sel /= model.tagSelection) DirectionMsg m -> let @@ -639,14 +634,7 @@ view flags settings model = ] ] , formHeader (Icons.tagsIcon "") "Tags" - , div [ class "field" ] - [ label [] [ text "Include (and)" ] - , Html.map TagIncMsg (Comp.Dropdown.view settings model.tagInclModel) - ] - , div [ class "field" ] - [ label [] [ text "Exclude (or)" ] - , Html.map TagExcMsg (Comp.Dropdown.view settings model.tagExclModel) - ] + , Html.map TagSelectMsg (Comp.TagSelect.view settings model.tagSelectModel) , div [ class "field" ] [ label [] [ text "Category Include (and)" ] , Html.map TagCatIncMsg (Comp.Dropdown.view settings model.tagCatInclModel) diff --git a/modules/webapp/src/main/elm/Comp/TagSelect.elm b/modules/webapp/src/main/elm/Comp/TagSelect.elm new file mode 100644 index 00000000..2af7567b --- /dev/null +++ b/modules/webapp/src/main/elm/Comp/TagSelect.elm @@ -0,0 +1,180 @@ +module Comp.TagSelect exposing + ( Model + , Msg + , Selection + , emptySelection + , init + , update + , view + ) + +import Api.Model.TagCount exposing (TagCount) +import Data.Icons as I +import Data.UiSettings exposing (UiSettings) +import Dict exposing (Dict) +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (onClick) + + +type alias Model = + { all : List TagCount + , selected : Dict String Bool + , expanded : Bool + } + + +init : List TagCount -> Model +init tags = + { all = tags + , selected = Dict.empty + , expanded = False + } + + + +--- Update + + +type Msg + = Toggle String + | ToggleExpand + + +type alias Selection = + { include : List TagCount + , exclude : List TagCount + } + + +emptySelection : Selection +emptySelection = + Selection [] [] + + +update : Msg -> Model -> ( Model, Selection ) +update msg model = + case msg of + Toggle id -> + let + current = + Dict.get id model.selected + + next = + case current of + Nothing -> + Dict.insert id True model.selected + + Just True -> + Dict.insert id False model.selected + + Just False -> + Dict.remove id model.selected + + model_ = + { model | selected = next } + in + ( model_, getSelection model_ ) + + ToggleExpand -> + ( { model | expanded = not model.expanded } + , getSelection model + ) + + +getSelection : Model -> Selection +getSelection model = + let + selectedOnly t = + Dict.member t.tag.id model.selected + + isIncluded t = + Dict.get t.tag.id model.selected + |> Maybe.withDefault False + + ( incl, excl ) = + List.filter selectedOnly model.all + |> List.partition isIncluded + in + Selection incl excl + + + +--- View + + +type SelState + = Include + | Exclude + | Deselect + + +selState : Model -> String -> SelState +selState model id = + case Dict.get id model.selected of + Just True -> + Include + + Just False -> + Exclude + + Nothing -> + Deselect + + +view : UiSettings -> Model -> Html Msg +view settings model = + div [ class "ui list" ] + [ div [ class "item" ] + [ I.tagIcon "" + , div [ class "content" ] + [ div [ class "header" ] + [ text "Tags" + ] + , div [ class "ui relaxed list" ] + (List.map (viewItem settings model) model.all) + ] + ] + ] + + +viewItem : UiSettings -> Model -> TagCount -> Html Msg +viewItem settings model tag = + let + state = + selState model tag.tag.id + + color = + Data.UiSettings.tagColorString tag.tag settings + + icon = + case state of + Include -> + i [ class ("check icon " ++ color) ] [] + + Exclude -> + i [ class ("minus icon " ++ color) ] [] + + Deselect -> + I.tagIcon color + in + a + [ class "item" + , href "#" + , onClick (Toggle tag.tag.id) + ] + [ icon + , div [ class "content" ] + [ div + [ classList + [ ( "header", state == Include ) + , ( "description", state /= Include ) + ] + ] + [ text tag.tag.name + , div [ class "ui right floated circular label" ] + [ text (String.fromInt tag.count) + ] + ] + ] + ] From 7c8c2f856f8bb58354939c68d4d5ca716d953449 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 10:20:43 +0200 Subject: [PATCH 06/15] Include tag categories into the new tag selection field --- .../webapp/src/main/elm/Comp/FolderSelect.elm | 2 +- .../webapp/src/main/elm/Comp/SearchMenu.elm | 59 +---- .../webapp/src/main/elm/Comp/TagSelect.elm | 233 ++++++++++++++---- .../webapp/src/main/elm/Data/UiSettings.elm | 20 +- 4 files changed, 204 insertions(+), 110 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/FolderSelect.elm b/modules/webapp/src/main/elm/Comp/FolderSelect.elm index 7907c715..0af88e01 100644 --- a/modules/webapp/src/main/elm/Comp/FolderSelect.elm +++ b/modules/webapp/src/main/elm/Comp/FolderSelect.elm @@ -80,7 +80,7 @@ view constr model = [ i [ class "folder open icon" ] [] , div [ class "content" ] [ div [ class "header" ] - [ text "All" + [ text "Folders" ] , div [ class "ui relaxed list" ] (renderItems constr model) diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index 5c28f62c..29118524 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -16,7 +16,6 @@ import Api.Model.FolderList exposing (FolderList) import Api.Model.IdName exposing (IdName) import Api.Model.ItemSearch exposing (ItemSearch) import Api.Model.ReferenceList exposing (ReferenceList) -import Api.Model.Tag exposing (Tag) import Api.Model.TagCloud exposing (TagCloud) import Comp.DatePicker import Comp.Dropdown exposing (isDropdownChangeMsg) @@ -33,7 +32,6 @@ import Html.Events exposing (onCheck, onClick, onInput) import Http import Util.Html exposing (KeyCode(..)) import Util.Maybe -import Util.Tag import Util.Update @@ -44,8 +42,6 @@ import Util.Update type alias Model = { tagSelectModel : Comp.TagSelect.Model , tagSelection : Comp.TagSelect.Selection - , tagCatInclModel : Comp.Dropdown.Model String - , tagCatExclModel : Comp.Dropdown.Model String , directionModel : Comp.Dropdown.Model Direction , orgModel : Comp.Dropdown.Model IdName , corrPersonModel : Comp.Dropdown.Model IdName @@ -74,8 +70,6 @@ init : Model init = { tagSelectModel = Comp.TagSelect.init [] , tagSelection = Comp.TagSelect.emptySelection - , tagCatInclModel = Util.Tag.makeCatDropdownModel - , tagCatExclModel = Util.Tag.makeCatDropdownModel , directionModel = Comp.Dropdown.makeSingleList { makeOption = @@ -158,8 +152,6 @@ type Msg | ToggleNameHelp | FolderSelectMsg Comp.FolderSelect.Msg | GetFolderResp (Result Http.Error FolderList) - | TagCatIncMsg (Comp.Dropdown.Msg String) - | TagCatExcMsg (Comp.Dropdown.Msg String) getDirection : Model -> Maybe Direction @@ -194,8 +186,8 @@ getItemSearch model = "*" ++ s ++ "*" in { e - | tagsInclude = model.tagSelection.include |> List.map .tag |> List.map .id - , tagsExclude = model.tagSelection.exclude |> List.map .tag |> List.map .id + | tagsInclude = model.tagSelection.includeTags |> List.map .tag |> List.map .id + , tagsExclude = model.tagSelection.excludeTags |> List.map .tag |> List.map .id , corrPerson = Comp.Dropdown.getSelected model.corrPersonModel |> List.map .id |> List.head , corrOrg = Comp.Dropdown.getSelected model.orgModel |> List.map .id |> List.head , concPerson = Comp.Dropdown.getSelected model.concPersonModel |> List.map .id |> List.head @@ -217,8 +209,8 @@ getItemSearch model = model.allNameModel |> Maybe.map amendWildcards , fullText = model.fulltextModel - , tagCategoriesInclude = Comp.Dropdown.getSelected model.tagCatInclModel - , tagCategoriesExclude = Comp.Dropdown.getSelected model.tagCatExclModel + , tagCategoriesInclude = model.tagSelection.includeCats |> List.map .name + , tagCategoriesExclude = model.tagSelection.excludeCats |> List.map .name } @@ -286,10 +278,6 @@ update flags settings msg model = GetTagsResp (Ok tags) -> let - catList = - Util.Tag.getCategories (List.map .tag tags.items) - |> Comp.Dropdown.SetOptions - selectModel = List.sortBy .count tags.items |> List.reverse @@ -298,12 +286,7 @@ update flags settings msg model = model_ = { model | tagSelectModel = selectModel } in - noChange <| - Util.Update.andThen1 - [ update flags settings (TagCatIncMsg catList) >> .modelCmd - , update flags settings (TagCatExcMsg catList) >> .modelCmd - ] - model_ + noChange ( model_, Cmd.none ) GetTagsResp (Err _) -> noChange ( model, Cmd.none ) @@ -563,28 +546,6 @@ update flags settings msg model = ) (model.selectedFolder /= sel) - TagCatIncMsg m -> - let - ( m2, c2 ) = - Comp.Dropdown.update m model.tagCatInclModel - in - NextState - ( { model | tagCatInclModel = m2 } - , Cmd.map TagCatIncMsg c2 - ) - (isDropdownChangeMsg m) - - TagCatExcMsg m -> - let - ( m2, c2 ) = - Comp.Dropdown.update m model.tagCatExclModel - in - NextState - ( { model | tagCatExclModel = m2 } - , Cmd.map TagCatExcMsg c2 - ) - (isDropdownChangeMsg m) - -- View @@ -633,17 +594,7 @@ view flags settings model = ] ] ] - , formHeader (Icons.tagsIcon "") "Tags" , Html.map TagSelectMsg (Comp.TagSelect.view settings model.tagSelectModel) - , div [ class "field" ] - [ label [] [ text "Category Include (and)" ] - , Html.map TagCatIncMsg (Comp.Dropdown.view settings model.tagCatInclModel) - ] - , div [ class "field" ] - [ label [] [ text "Category Exclude (or)" ] - , Html.map TagCatExcMsg (Comp.Dropdown.view settings model.tagCatExclModel) - ] - , formHeader (Icons.folderIcon "") "Folder" , Html.map FolderSelectMsg (Comp.FolderSelect.view settings.searchMenuFolders model.folderList) , formHeaderHelp nameIcon "Names" ToggleNameHelp diff --git a/modules/webapp/src/main/elm/Comp/TagSelect.elm b/modules/webapp/src/main/elm/Comp/TagSelect.elm index 2af7567b..ff8649b1 100644 --- a/modules/webapp/src/main/elm/Comp/TagSelect.elm +++ b/modules/webapp/src/main/elm/Comp/TagSelect.elm @@ -1,5 +1,6 @@ module Comp.TagSelect exposing - ( Model + ( Category + , Model , Msg , Selection , emptySelection @@ -19,84 +20,154 @@ import Html.Events exposing (onClick) type alias Model = { all : List TagCount - , selected : Dict String Bool - , expanded : Bool + , categories : List Category + , selectedTags : Dict String Bool + , selectedCats : Dict String Bool + , expandedTags : Bool + , expandedCats : Bool + } + + +type alias Category = + { name : String + , count : Int } init : List TagCount -> Model init tags = { all = tags - , selected = Dict.empty - , expanded = False + , categories = sumCategories tags + , selectedTags = Dict.empty + , selectedCats = Dict.empty + , expandedTags = False + , expandedCats = False } +sumCategories : List TagCount -> List Category +sumCategories tags = + let + filterCat tc = + Maybe.map (\cat -> Category cat tc.count) tc.tag.category + + withCats = + List.filterMap filterCat tags + + sum cat mc = + Maybe.map ((+) cat.count) mc + |> Maybe.withDefault cat.count + |> Just + + sumCounts cat dict = + Dict.update cat.name (sum cat) dict + + cats = + List.foldl sumCounts Dict.empty withCats + in + Dict.toList cats + |> List.map (\( n, c ) -> Category n c) + + --- Update type Msg - = Toggle String - | ToggleExpand + = ToggleTag String + | ToggleCat String + | ToggleExpandTags + | ToggleExpandCats type alias Selection = - { include : List TagCount - , exclude : List TagCount + { includeTags : List TagCount + , excludeTags : List TagCount + , includeCats : List Category + , excludeCats : List Category } emptySelection : Selection emptySelection = - Selection [] [] + Selection [] [] [] [] update : Msg -> Model -> ( Model, Selection ) update msg model = case msg of - Toggle id -> + ToggleTag id -> let - current = - Dict.get id model.selected - next = - case current of - Nothing -> - Dict.insert id True model.selected - - Just True -> - Dict.insert id False model.selected - - Just False -> - Dict.remove id model.selected + updateSelection id model.selectedTags model_ = - { model | selected = next } + { model | selectedTags = next } in ( model_, getSelection model_ ) - ToggleExpand -> - ( { model | expanded = not model.expanded } + ToggleCat name -> + let + next = + updateSelection name model.selectedCats + + model_ = + { model | selectedCats = next } + in + ( model_, getSelection model_ ) + + ToggleExpandTags -> + ( { model | expandedTags = not model.expandedTags } , getSelection model ) + ToggleExpandCats -> + ( { model | expandedCats = not model.expandedCats } + , getSelection model + ) + + +updateSelection : String -> Dict String Bool -> Dict String Bool +updateSelection id selected = + let + current = + Dict.get id selected + in + case current of + Nothing -> + Dict.insert id True selected + + Just True -> + Dict.insert id False selected + + Just False -> + Dict.remove id selected + getSelection : Model -> Selection getSelection model = + let + ( inclTags, exclTags ) = + getSelection1 (\t -> t.tag.id) model.selectedTags model.all + + ( inclCats, exclCats ) = + getSelection1 (\c -> c.name) model.selectedCats model.categories + in + Selection inclTags exclTags inclCats exclCats + + +getSelection1 : (a -> String) -> Dict String Bool -> List a -> ( List a, List a ) +getSelection1 mkId selected items = let selectedOnly t = - Dict.member t.tag.id model.selected + Dict.member (mkId t) selected isIncluded t = - Dict.get t.tag.id model.selected + Dict.get (mkId t) selected |> Maybe.withDefault False - - ( incl, excl ) = - List.filter selectedOnly model.all - |> List.partition isIncluded in - Selection incl excl + List.filter selectedOnly items + |> List.partition isIncluded @@ -109,9 +180,22 @@ type SelState | Deselect -selState : Model -> String -> SelState -selState model id = - case Dict.get id model.selected of +tagState : Model -> String -> SelState +tagState model id = + case Dict.get id model.selectedTags of + Just True -> + Include + + Just False -> + Exclude + + Nothing -> + Deselect + + +catState : Model -> String -> SelState +catState model name = + case Dict.get name model.selectedCats of Just True -> Include @@ -132,36 +216,72 @@ view settings model = [ text "Tags" ] , div [ class "ui relaxed list" ] - (List.map (viewItem settings model) model.all) + (List.map (viewTagItem settings model) model.all) + ] + ] + , div [ class "item" ] + [ I.tagsIcon "" + , div [ class "content" ] + [ div [ class "header" ] + [ text "Categories" + ] + , div [ class "ui relaxed list" ] + (List.map (viewCategoryItem settings model) model.categories) ] ] ] -viewItem : UiSettings -> Model -> TagCount -> Html Msg -viewItem settings model tag = +viewCategoryItem : UiSettings -> Model -> Category -> Html Msg +viewCategoryItem settings model cat = let state = - selState model tag.tag.id + catState model cat.name + + color = + Data.UiSettings.catColorString settings cat.name + + icon = + getIcon state color I.tagsIcon + in + a + [ class "item" + , href "#" + , onClick (ToggleCat cat.name) + ] + [ icon + , div [ class "content" ] + [ div + [ classList + [ ( "header", state == Include ) + , ( "description", state /= Include ) + ] + ] + [ text cat.name + , div [ class "ui right floated circular label" ] + [ text (String.fromInt cat.count) + ] + ] + ] + ] + + +viewTagItem : UiSettings -> Model -> TagCount -> Html Msg +viewTagItem settings model tag = + let + state = + tagState model tag.tag.id color = Data.UiSettings.tagColorString tag.tag settings icon = - case state of - Include -> - i [ class ("check icon " ++ color) ] [] - - Exclude -> - i [ class ("minus icon " ++ color) ] [] - - Deselect -> - I.tagIcon color + getIcon state color I.tagIcon in a [ class "item" , href "#" - , onClick (Toggle tag.tag.id) + , onClick (ToggleTag tag.tag.id) ] [ icon , div [ class "content" ] @@ -178,3 +298,16 @@ viewItem settings model tag = ] ] ] + + +getIcon : SelState -> String -> (String -> Html msg) -> Html msg +getIcon state color default = + case state of + Include -> + i [ class ("check icon " ++ color) ] [] + + Exclude -> + i [ class ("minus icon " ++ color) ] [] + + Deselect -> + default color diff --git a/modules/webapp/src/main/elm/Data/UiSettings.elm b/modules/webapp/src/main/elm/Data/UiSettings.elm index 77954000..a13cc8a7 100644 --- a/modules/webapp/src/main/elm/Data/UiSettings.elm +++ b/modules/webapp/src/main/elm/Data/UiSettings.elm @@ -2,6 +2,8 @@ module Data.UiSettings exposing ( Pos(..) , StoredUiSettings , UiSettings + , catColor + , catColorString , defaults , merge , mergeDefaults @@ -133,13 +135,21 @@ toStoredUiSettings settings = } +catColor : UiSettings -> String -> Maybe Color +catColor settings c = + Dict.get c settings.tagCategoryColors + + tagColor : Tag -> UiSettings -> Maybe Color tagColor tag settings = - let - readColor c = - Dict.get c settings.tagCategoryColors - in - Maybe.andThen readColor tag.category + Maybe.andThen (catColor settings) tag.category + + +catColorString : UiSettings -> String -> String +catColorString settings name = + catColor settings name + |> Maybe.map Data.Color.toString + |> Maybe.withDefault "" tagColorString : Tag -> UiSettings -> String From 4c57d165013ec5f6e785d9730fe705b380ed9827 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 10:23:08 +0200 Subject: [PATCH 07/15] Rename ui setting field --- .../webapp/src/main/elm/Comp/SearchMenu.elm | 2 +- .../src/main/elm/Comp/UiSettingsForm.elm | 20 +++++++++---------- .../webapp/src/main/elm/Data/UiSettings.elm | 14 ++++++------- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index 29118524..f991aeac 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -596,7 +596,7 @@ view flags settings model = ] , Html.map TagSelectMsg (Comp.TagSelect.view settings model.tagSelectModel) , Html.map FolderSelectMsg - (Comp.FolderSelect.view settings.searchMenuFolders model.folderList) + (Comp.FolderSelect.view settings.searchMenuFolderCount model.folderList) , formHeaderHelp nameIcon "Names" ToggleNameHelp , span [ classList diff --git a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm index dbdedc66..6d6879bb 100644 --- a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm +++ b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm @@ -30,8 +30,8 @@ type alias Model = , itemSearchNoteLength : Maybe Int , searchNoteLengthModel : Comp.IntField.Model , itemDetailNotesPosition : Pos - , searchMenuFolders : Maybe Int - , searchMenuFoldersModel : Comp.IntField.Model + , searchMenuFolderCount : Maybe Int + , searchMenuFolderCountModel : Comp.IntField.Model } @@ -58,8 +58,8 @@ init flags settings = False "Max. Note Length" , itemDetailNotesPosition = settings.itemDetailNotesPosition - , searchMenuFolders = Just settings.searchMenuFolders - , searchMenuFoldersModel = + , searchMenuFolderCount = Just settings.searchMenuFolderCount + , searchMenuFolderCountModel = Comp.IntField.init (Just 0) (Just 2000) @@ -122,15 +122,15 @@ update sett msg model = SearchMenuFolderMsg lm -> let ( m, n ) = - Comp.IntField.update lm model.searchMenuFoldersModel + Comp.IntField.update lm model.searchMenuFolderCountModel nextSettings = - Maybe.map (\len -> { sett | searchMenuFolders = len }) n + Maybe.map (\len -> { sett | searchMenuFolderCount = len }) n model_ = { model - | searchMenuFoldersModel = m - , searchMenuFolders = n + | searchMenuFolderCountModel = m + , searchMenuFolderCount = n } in ( model_, nextSettings ) @@ -235,9 +235,9 @@ view flags _ model = , Html.map SearchMenuFolderMsg (Comp.IntField.viewWithInfo "How many folders to display in search menu at once. Other folders can be expanded." - model.searchMenuFolders + model.searchMenuFolderCount "field" - model.searchMenuFoldersModel + model.searchMenuFolderCountModel ) , div [ class "ui dividing header" ] [ text "Item Detail" diff --git a/modules/webapp/src/main/elm/Data/UiSettings.elm b/modules/webapp/src/main/elm/Data/UiSettings.elm index a13cc8a7..00c76c5a 100644 --- a/modules/webapp/src/main/elm/Data/UiSettings.elm +++ b/modules/webapp/src/main/elm/Data/UiSettings.elm @@ -33,7 +33,7 @@ type alias StoredUiSettings = , nativePdfPreview : Bool , itemSearchNoteLength : Maybe Int , itemDetailNotesPosition : Maybe String - , searchMenuFolders : Maybe Int + , searchMenuFolderCount : Maybe Int } @@ -50,7 +50,7 @@ type alias UiSettings = , nativePdfPreview : Bool , itemSearchNoteLength : Int , itemDetailNotesPosition : Pos - , searchMenuFolders : Int + , searchMenuFolderCount : Int } @@ -89,7 +89,7 @@ defaults = , nativePdfPreview = False , itemSearchNoteLength = 0 , itemDetailNotesPosition = Top - , searchMenuFolders = 5 + , searchMenuFolderCount = 4 } @@ -111,9 +111,9 @@ merge given fallback = , itemDetailNotesPosition = choose (Maybe.andThen posFromString given.itemDetailNotesPosition) fallback.itemDetailNotesPosition - , searchMenuFolders = - choose given.searchMenuFolders - fallback.searchMenuFolders + , searchMenuFolderCount = + choose given.searchMenuFolderCount + fallback.searchMenuFolderCount } @@ -131,7 +131,7 @@ toStoredUiSettings settings = , nativePdfPreview = settings.nativePdfPreview , itemSearchNoteLength = Just settings.itemSearchNoteLength , itemDetailNotesPosition = Just (posToString settings.itemDetailNotesPosition) - , searchMenuFolders = Just settings.searchMenuFolders + , searchMenuFolderCount = Just settings.searchMenuFolderCount } From f0a5f84c8b17695604b19dc4e62859f1e169eca6 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 11:16:45 +0200 Subject: [PATCH 08/15] Define how many tags to see in ui settings --- .../webapp/src/main/elm/Comp/FolderSelect.elm | 43 +-- .../webapp/src/main/elm/Comp/SearchMenu.elm | 305 +++++++++--------- .../webapp/src/main/elm/Comp/TagSelect.elm | 115 ++++++- .../src/main/elm/Comp/UiSettingsForm.elm | 68 +++- .../webapp/src/main/elm/Data/UiSettings.elm | 14 +- .../src/main/elm/Util/ExpandCollapse.elm | 50 +++ 6 files changed, 405 insertions(+), 190 deletions(-) create mode 100644 modules/webapp/src/main/elm/Util/ExpandCollapse.elm diff --git a/modules/webapp/src/main/elm/Comp/FolderSelect.elm b/modules/webapp/src/main/elm/Comp/FolderSelect.elm index 0af88e01..6784ba0d 100644 --- a/modules/webapp/src/main/elm/Comp/FolderSelect.elm +++ b/modules/webapp/src/main/elm/Comp/FolderSelect.elm @@ -10,6 +10,7 @@ import Api.Model.FolderItem exposing (FolderItem) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) +import Util.ExpandCollapse import Util.List @@ -103,44 +104,18 @@ renderItems constr model = expandToggle : Int -> Model -> List (Html Msg) expandToggle max model = - if max > List.length model.all then - [] - - else - [ a - [ class "item" - , onClick ToggleExpand - , href "#" - ] - [ i [ class "angle down icon" ] [] - , div [ class "content" ] - [ div [ class "description" ] - [ em [] [ text "Show More …" ] - ] - ] - ] - ] + Util.ExpandCollapse.expandToggle + max + (List.length model.all) + ToggleExpand collapseToggle : Int -> Model -> List (Html Msg) collapseToggle max model = - if max > List.length model.all then - [] - - else - [ a - [ class "item" - , onClick ToggleExpand - , href "#" - ] - [ i [ class "angle up icon" ] [] - , div [ class "content" ] - [ div [ class "description" ] - [ em [] [ text "Show Less …" ] - ] - ] - ] - ] + Util.ExpandCollapse.collapseToggle + max + (List.length model.all) + ToggleExpand viewItem : Model -> FolderItem -> Html Msg diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index f991aeac..db3bfa89 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -555,175 +555,182 @@ view : Flags -> UiSettings -> Model -> Html Msg view flags settings model = let formHeader icon headline = - div [ class "ui small dividing header" ] + div [ class "ui tiny header" ] [ icon , div [ class "content" ] [ text headline ] ] - formHeaderHelp icon headline tagger = - div [ class "ui small dividing header" ] - [ a - [ class "right-float" - , href "#" - , onClick tagger - ] - [ i [ class "small grey help link icon" ] [] - ] - , icon - , div [ class "content" ] - [ text headline - ] - ] - - nameIcon = - i [ class "left align icon" ] [] + segmentClass = + "ui vertical segment" in div [ class "ui form" ] - [ div [ class "inline field" ] - [ div [ class "ui checkbox" ] - [ input - [ type_ "checkbox" - , onCheck (\_ -> ToggleInbox) - , checked model.inboxCheckbox + [ div [ class segmentClass ] + [ div [ class "inline field" ] + [ div [ class "ui checkbox" ] + [ input + [ type_ "checkbox" + , onCheck (\_ -> ToggleInbox) + , checked model.inboxCheckbox + ] + [] + , label [] + [ text "Only New" + ] + ] + ] + ] + , div [ class segmentClass ] + [ Html.map TagSelectMsg (Comp.TagSelect.viewTags settings model.tagSelectModel) + , Html.map TagSelectMsg (Comp.TagSelect.viewCats settings model.tagSelectModel) + , Html.map FolderSelectMsg + (Comp.FolderSelect.view settings.searchMenuFolderCount model.folderList) + ] + , div [ class segmentClass ] + [ formHeader (Icons.correspondentIcon "") + (case getDirection model of + Just Data.Direction.Incoming -> + "Sender" + + Just Data.Direction.Outgoing -> + "Recipient" + + Nothing -> + "Correspondent" + ) + , div [ class "field" ] + [ label [] [ text "Organization" ] + , Html.map OrgMsg (Comp.Dropdown.view settings model.orgModel) + ] + , div [ class "field" ] + [ label [] [ text "Person" ] + , Html.map CorrPersonMsg (Comp.Dropdown.view settings model.corrPersonModel) + ] + , formHeader Icons.concernedIcon "Concerned" + , div [ class "field" ] + [ label [] [ text "Person" ] + , Html.map ConcPersonMsg (Comp.Dropdown.view settings model.concPersonModel) + ] + , div [ class "field" ] + [ label [] [ text "Equipment" ] + , Html.map ConcEquipmentMsg (Comp.Dropdown.view settings model.concEquipmentModel) + ] + ] + , div [ class segmentClass ] + [ formHeader (Icons.searchIcon "") "Text Search" + , div + [ classList + [ ( "field", True ) + , ( "invisible hidden", not flags.config.fullTextSearchEnabled ) + ] + ] + [ label [] [ text "Fulltext Search" ] + , input + [ type_ "text" + , onInput SetFulltext + , Util.Html.onKeyUpCode KeyUpMsg + , model.fulltextModel |> Maybe.withDefault "" |> value + , placeholder "Fulltext search in results…" ] [] - , label [] - [ text "Only New" + , span [ class "small-info" ] + [ text "Fulltext search in document contents and notes." ] ] - ] - , Html.map TagSelectMsg (Comp.TagSelect.view settings model.tagSelectModel) - , Html.map FolderSelectMsg - (Comp.FolderSelect.view settings.searchMenuFolderCount model.folderList) - , formHeaderHelp nameIcon "Names" ToggleNameHelp - , span - [ classList - [ ( "small-info", True ) - , ( "invisible hidden", not model.showNameHelp ) - ] - ] - [ text "Use wildcards " - , code [] [ text "*" ] - , text " at beginning or end. Added automatically if not " - , text "present and not quoted. Press " - , em [] [ text "Enter" ] - , text " to start searching." - ] - , div [ class "field" ] - [ input - [ type_ "text" - , onInput SetAllName - , Util.Html.onKeyUpCode KeyUpMsg - , model.allNameModel |> Maybe.withDefault "" |> value - , placeholder "Search in various names…" - ] - [] - , span - [ classList - [ ( "small-info", True ) - , ( "invisible hidden", not model.showNameHelp ) - ] - ] - [ text "Looks in correspondents, concerned entities, item name and notes." - ] - ] - , formHeader (Icons.correspondentIcon "") - (case getDirection model of - Just Data.Direction.Incoming -> - "Sender" - - Just Data.Direction.Outgoing -> - "Recipient" - - Nothing -> - "Correspondent" - ) - , div [ class "field" ] - [ label [] [ text "Organization" ] - , Html.map OrgMsg (Comp.Dropdown.view settings model.orgModel) - ] - , div [ class "field" ] - [ label [] [ text "Person" ] - , Html.map CorrPersonMsg (Comp.Dropdown.view settings model.corrPersonModel) - ] - , formHeader Icons.concernedIcon "Concerned" - , div [ class "field" ] - [ label [] [ text "Person" ] - , Html.map ConcPersonMsg (Comp.Dropdown.view settings model.concPersonModel) - ] - , div [ class "field" ] - [ label [] [ text "Equipment" ] - , Html.map ConcEquipmentMsg (Comp.Dropdown.view settings model.concEquipmentModel) - ] - , formHeader (Icons.searchIcon "") "Content" - , div - [ classList - [ ( "field", True ) - , ( "invisible hidden", not flags.config.fullTextSearchEnabled ) - ] - ] - [ input - [ type_ "text" - , onInput SetFulltext - , Util.Html.onKeyUpCode KeyUpMsg - , model.fulltextModel |> Maybe.withDefault "" |> value - , placeholder "Fulltext search in results…" - ] - [] - , span [ class "small-info" ] - [ text "Fulltext search in document contents and notes." - ] - ] - , formHeader (Icons.dateIcon "") "Date" - , div [ class "fields" ] - [ div [ class "field" ] - [ label [] - [ text "From" - ] - , Html.map FromDateMsg - (Comp.DatePicker.viewTimeDefault - model.fromDate - model.fromDateModel - ) - ] , div [ class "field" ] [ label [] - [ text "To" + [ text "Names" + , a + [ class "right-float" + , href "#" + , onClick ToggleNameHelp + ] + [ i [ class "small grey help link icon" ] [] + ] + ] + , input + [ type_ "text" + , onInput SetAllName + , Util.Html.onKeyUpCode KeyUpMsg + , model.allNameModel |> Maybe.withDefault "" |> value + , placeholder "Search in various names…" + ] + [] + , span + [ classList + [ ( "small-info", True ) + ] + ] + [ text "Looks in correspondents, concerned entities, item name and notes." + ] + , p + [ classList + [ ( "small-info", True ) + , ( "invisible hidden", not model.showNameHelp ) + ] + ] + [ text "Use wildcards " + , code [] [ text "*" ] + , text " at beginning or end. They are added automatically on both sides " + , text "if not present in the search term and the term is not quoted. Press " + , em [] [ text "Enter" ] + , text " to start searching." ] - , Html.map UntilDateMsg - (Comp.DatePicker.viewTimeDefault - model.untilDate - model.untilDateModel - ) ] ] - , formHeader (Icons.dueDateIcon "") "Due Date" - , div [ class "fields" ] - [ div [ class "field" ] - [ label [] - [ text "Due From" + , div [ class segmentClass ] + [ formHeader (Icons.dateIcon "") "Date" + , div [ class "fields" ] + [ div [ class "field" ] + [ label [] + [ text "From" + ] + , Html.map FromDateMsg + (Comp.DatePicker.viewTimeDefault + model.fromDate + model.fromDateModel + ) + ] + , div [ class "field" ] + [ label [] + [ text "To" + ] + , Html.map UntilDateMsg + (Comp.DatePicker.viewTimeDefault + model.untilDate + model.untilDateModel + ) ] - , Html.map FromDueDateMsg - (Comp.DatePicker.viewTimeDefault - model.fromDueDate - model.fromDueDateModel - ) ] + , formHeader (Icons.dueDateIcon "") "Due Date" + , div [ class "fields" ] + [ div [ class "field" ] + [ label [] + [ text "Due From" + ] + , Html.map FromDueDateMsg + (Comp.DatePicker.viewTimeDefault + model.fromDueDate + model.fromDueDateModel + ) + ] + , div [ class "field" ] + [ label [] + [ text "Due To" + ] + , Html.map UntilDueDateMsg + (Comp.DatePicker.viewTimeDefault + model.untilDueDate + model.untilDueDateModel + ) + ] + ] + ] + , div [ class segmentClass ] + [ formHeader (Icons.directionIcon "") "Direction" , div [ class "field" ] - [ label [] - [ text "Due To" - ] - , Html.map UntilDueDateMsg - (Comp.DatePicker.viewTimeDefault - model.untilDueDate - model.untilDueDateModel - ) + [ Html.map DirectionMsg (Comp.Dropdown.view settings model.directionModel) ] ] - , formHeader (Icons.directionIcon "") "Direction" - , div [ class "field" ] - [ Html.map DirectionMsg (Comp.Dropdown.view settings model.directionModel) - ] ] diff --git a/modules/webapp/src/main/elm/Comp/TagSelect.elm b/modules/webapp/src/main/elm/Comp/TagSelect.elm index ff8649b1..b683f626 100644 --- a/modules/webapp/src/main/elm/Comp/TagSelect.elm +++ b/modules/webapp/src/main/elm/Comp/TagSelect.elm @@ -6,7 +6,10 @@ module Comp.TagSelect exposing , emptySelection , init , update - , view + , view1 + , view2 + , viewCats + , viewTags ) import Api.Model.TagCount exposing (TagCount) @@ -16,6 +19,7 @@ import Dict exposing (Dict) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) +import Util.ExpandCollapse type alias Model = @@ -206,8 +210,8 @@ catState model name = Deselect -view : UiSettings -> Model -> Html Msg -view settings model = +viewTags : UiSettings -> Model -> Html Msg +viewTags settings model = div [ class "ui list" ] [ div [ class "item" ] [ I.tagIcon "" @@ -216,7 +220,39 @@ view settings model = [ text "Tags" ] , div [ class "ui relaxed list" ] - (List.map (viewTagItem settings model) model.all) + (renderTagItems settings model) + ] + ] + ] + + +viewCats : UiSettings -> Model -> Html Msg +viewCats settings model = + div [ class "ui list" ] + [ div [ class "item" ] + [ I.tagsIcon "" + , div [ class "content" ] + [ div [ class "header" ] + [ text "Categories" + ] + , div [ class "ui relaxed list" ] + (renderCatItems settings model) + ] + ] + ] + + +view1 : UiSettings -> Model -> Html Msg +view1 settings model = + div [ class "ui list" ] + [ div [ class "item" ] + [ I.tagIcon "" + , div [ class "content" ] + [ div [ class "header" ] + [ text "Tags" + ] + , div [ class "ui relaxed list" ] + (renderTagItems settings model) ] ] , div [ class "item" ] @@ -226,12 +262,81 @@ view settings model = [ text "Categories" ] , div [ class "ui relaxed list" ] - (List.map (viewCategoryItem settings model) model.categories) + (renderCatItems settings model) ] ] ] +view2 : UiSettings -> Model -> List (Html Msg) +view2 settings model = + [ viewTags settings model + , viewCats settings model + ] + + +renderTagItems : UiSettings -> Model -> List (Html Msg) +renderTagItems settings model = + let + tags = + model.all + + max = + settings.searchMenuTagCount + + exp = + Util.ExpandCollapse.expandToggle + max + (List.length tags) + ToggleExpandTags + + cps = + Util.ExpandCollapse.collapseToggle + max + (List.length tags) + ToggleExpandTags + in + if max <= 0 then + List.map (viewTagItem settings model) model.all + + else if model.expandedTags then + List.map (viewTagItem settings model) model.all ++ cps + + else + List.map (viewTagItem settings model) (List.take max model.all) ++ exp + + +renderCatItems : UiSettings -> Model -> List (Html Msg) +renderCatItems settings model = + let + cats = + model.categories + + max = + settings.searchMenuTagCatCount + + exp = + Util.ExpandCollapse.expandToggle + max + (List.length cats) + ToggleExpandCats + + cps = + Util.ExpandCollapse.collapseToggle + max + (List.length cats) + ToggleExpandCats + in + if max <= 0 then + List.map (viewCategoryItem settings model) model.categories + + else if model.expandedCats then + List.map (viewCategoryItem settings model) model.categories ++ cps + + else + List.map (viewCategoryItem settings model) (List.take max model.categories) ++ exp + + viewCategoryItem : UiSettings -> Model -> Category -> Html Msg viewCategoryItem settings model cat = let diff --git a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm index 6d6879bb..1ffe02fe 100644 --- a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm +++ b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm @@ -32,6 +32,10 @@ type alias Model = , itemDetailNotesPosition : Pos , searchMenuFolderCount : Maybe Int , searchMenuFolderCountModel : Comp.IntField.Model + , searchMenuTagCount : Maybe Int + , searchMenuTagCountModel : Comp.IntField.Model + , searchMenuTagCatCount : Maybe Int + , searchMenuTagCatCountModel : Comp.IntField.Model } @@ -65,6 +69,20 @@ init flags settings = (Just 2000) False "Number of folders in search menu" + , searchMenuTagCount = Just settings.searchMenuTagCount + , searchMenuTagCountModel = + Comp.IntField.init + (Just 0) + (Just 2000) + False + "Number of tags in search menu" + , searchMenuTagCatCount = Just settings.searchMenuTagCatCount + , searchMenuTagCatCountModel = + Comp.IntField.init + (Just 0) + (Just 2000) + False + "Number of categories in search menu" } , Api.getTags flags "" GetTagsResp ) @@ -78,6 +96,8 @@ type Msg | NoteLengthMsg Comp.IntField.Msg | SetNotesPosition Pos | SearchMenuFolderMsg Comp.IntField.Msg + | SearchMenuTagMsg Comp.IntField.Msg + | SearchMenuTagCatMsg Comp.IntField.Msg @@ -135,6 +155,38 @@ update sett msg model = in ( model_, nextSettings ) + SearchMenuTagMsg lm -> + let + ( m, n ) = + Comp.IntField.update lm model.searchMenuTagCountModel + + nextSettings = + Maybe.map (\len -> { sett | searchMenuTagCount = len }) n + + model_ = + { model + | searchMenuTagCountModel = m + , searchMenuTagCount = n + } + in + ( model_, nextSettings ) + + SearchMenuTagCatMsg lm -> + let + ( m, n ) = + Comp.IntField.update lm model.searchMenuTagCatCountModel + + nextSettings = + Maybe.map (\len -> { sett | searchMenuTagCatCount = len }) n + + model_ = + { model + | searchMenuTagCatCountModel = m + , searchMenuTagCatCount = n + } + in + ( model_, nextSettings ) + SetNotesPosition pos -> let model_ = @@ -232,9 +284,23 @@ view flags _ model = ) , div [ class "ui dividing header" ] [ text "Search Menu" ] + , Html.map SearchMenuTagMsg + (Comp.IntField.viewWithInfo + "How many tags to display in search menu at once. Others can be expanded. Use 0 to always show all." + model.searchMenuTagCount + "field" + model.searchMenuTagCountModel + ) + , Html.map SearchMenuTagCatMsg + (Comp.IntField.viewWithInfo + "How many categories to display in search menu at once. Others can be expanded. Use 0 to always show all." + model.searchMenuTagCatCount + "field" + model.searchMenuTagCatCountModel + ) , Html.map SearchMenuFolderMsg (Comp.IntField.viewWithInfo - "How many folders to display in search menu at once. Other folders can be expanded." + "How many folders to display in search menu at once. Other folders can be expanded. Use 0 to always show all." model.searchMenuFolderCount "field" model.searchMenuFolderCountModel diff --git a/modules/webapp/src/main/elm/Data/UiSettings.elm b/modules/webapp/src/main/elm/Data/UiSettings.elm index 00c76c5a..80bd47e7 100644 --- a/modules/webapp/src/main/elm/Data/UiSettings.elm +++ b/modules/webapp/src/main/elm/Data/UiSettings.elm @@ -34,6 +34,8 @@ type alias StoredUiSettings = , itemSearchNoteLength : Maybe Int , itemDetailNotesPosition : Maybe String , searchMenuFolderCount : Maybe Int + , searchMenuTagCount : Maybe Int + , searchMenuTagCatCount : Maybe Int } @@ -51,6 +53,8 @@ type alias UiSettings = , itemSearchNoteLength : Int , itemDetailNotesPosition : Pos , searchMenuFolderCount : Int + , searchMenuTagCount : Int + , searchMenuTagCatCount : Int } @@ -89,7 +93,9 @@ defaults = , nativePdfPreview = False , itemSearchNoteLength = 0 , itemDetailNotesPosition = Top - , searchMenuFolderCount = 4 + , searchMenuFolderCount = 3 + , searchMenuTagCount = 6 + , searchMenuTagCatCount = 3 } @@ -114,6 +120,10 @@ merge given fallback = , searchMenuFolderCount = choose given.searchMenuFolderCount fallback.searchMenuFolderCount + , searchMenuTagCount = + choose given.searchMenuTagCount fallback.searchMenuTagCount + , searchMenuTagCatCount = + choose given.searchMenuTagCatCount fallback.searchMenuTagCatCount } @@ -132,6 +142,8 @@ toStoredUiSettings settings = , itemSearchNoteLength = Just settings.itemSearchNoteLength , itemDetailNotesPosition = Just (posToString settings.itemDetailNotesPosition) , searchMenuFolderCount = Just settings.searchMenuFolderCount + , searchMenuTagCount = Just settings.searchMenuTagCount + , searchMenuTagCatCount = Just settings.searchMenuTagCatCount } diff --git a/modules/webapp/src/main/elm/Util/ExpandCollapse.elm b/modules/webapp/src/main/elm/Util/ExpandCollapse.elm new file mode 100644 index 00000000..aa4fb0db --- /dev/null +++ b/modules/webapp/src/main/elm/Util/ExpandCollapse.elm @@ -0,0 +1,50 @@ +module Util.ExpandCollapse exposing + ( collapseToggle + , expandToggle + ) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (onClick) + + +expandToggle : Int -> Int -> msg -> List (Html msg) +expandToggle max all m = + if max >= all then + [] + + else + [ a + [ class "item" + , onClick m + , href "#" + ] + [ i [ class "angle down icon" ] [] + , div [ class "content" ] + [ div [ class "description" ] + [ em [] [ text "Show More …" ] + ] + ] + ] + ] + + +collapseToggle : Int -> Int -> msg -> List (Html msg) +collapseToggle max all m = + if max >= all then + [] + + else + [ a + [ class "item" + , onClick m + , href "#" + ] + [ i [ class "angle up icon" ] [] + , div [ class "content" ] + [ div [ class "description" ] + [ em [] [ text "Show Less …" ] + ] + ] + ] + ] From 9c50a8536322613bdea882681f7be0e8fe597091 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 13:20:29 +0200 Subject: [PATCH 09/15] Prepare drag-drop for items into folders --- .../webapp/src/main/elm/Comp/FolderSelect.elm | 79 ++++- .../webapp/src/main/elm/Comp/ItemCardList.elm | 69 +++- .../webapp/src/main/elm/Comp/SearchMenu.elm | 331 +++++++++++------- .../webapp/src/main/elm/Page/Home/Data.elm | 7 +- .../webapp/src/main/elm/Page/Home/Update.elm | 31 +- .../webapp/src/main/elm/Page/Home/View.elm | 7 +- modules/webapp/src/main/webjar/docspell.css | 2 +- 7 files changed, 357 insertions(+), 169 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/FolderSelect.elm b/modules/webapp/src/main/elm/Comp/FolderSelect.elm index 6784ba0d..a1126041 100644 --- a/modules/webapp/src/main/elm/Comp/FolderSelect.elm +++ b/modules/webapp/src/main/elm/Comp/FolderSelect.elm @@ -3,13 +3,16 @@ module Comp.FolderSelect exposing , Msg , init , update + , updateDrop , view + , viewDrop ) import Api.Model.FolderItem exposing (FolderItem) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) +import Html5.DragDrop as DD import Util.ExpandCollapse import Util.List @@ -36,10 +39,24 @@ init all = type Msg = Toggle FolderItem | ToggleExpand + | FolderDDMsg (DD.Msg String String) update : Msg -> Model -> ( Model, Maybe FolderItem ) update msg model = + let + ( m, f, _ ) = + updateDrop DD.init msg model + in + ( m, f ) + + +updateDrop : + DD.Model String String + -> Msg + -> Model + -> ( Model, Maybe FolderItem, DD.Model String String ) +updateDrop dropModel msg model = case msg of Toggle item -> let @@ -53,13 +70,36 @@ update msg model = model_ = { model | selected = selection } in - ( model_, selectedFolder model_ ) + ( model_, selectedFolder model_, dropModel ) ToggleExpand -> ( { model | expanded = not model.expanded } , selectedFolder model + , dropModel ) + FolderDDMsg lm -> + let + ( dm_, result ) = + DD.update lm dropModel + + _ = + case result of + Just ( item, folder, _ ) -> + let + _ = + Debug.log "item menu" item + + _ = + Debug.log "folder menu" folder + in + Cmd.none + + Nothing -> + Cmd.none + in + ( model, selectedFolder model, dm_ ) + selectedFolder : Model -> Maybe FolderItem selectedFolder model = @@ -75,7 +115,12 @@ selectedFolder model = view : Int -> Model -> Html Msg -view constr model = +view = + viewDrop DD.init + + +viewDrop : DD.Model String String -> Int -> Model -> Html Msg +viewDrop dropModel constr model = div [ class "ui list" ] [ div [ class "item" ] [ i [ class "folder open icon" ] [] @@ -84,22 +129,22 @@ view constr model = [ text "Folders" ] , div [ class "ui relaxed list" ] - (renderItems constr model) + (renderItems dropModel constr model) ] ] ] -renderItems : Int -> Model -> List (Html Msg) -renderItems constr model = +renderItems : DD.Model String String -> Int -> Model -> List (Html Msg) +renderItems dropModel constr model = if constr <= 0 then - List.map (viewItem model) model.all + List.map (viewItem dropModel model) model.all else if model.expanded then - List.map (viewItem model) model.all ++ collapseToggle constr model + List.map (viewItem dropModel model) model.all ++ collapseToggle constr model else - List.map (viewItem model) (List.take constr model.all) ++ expandToggle constr model + List.map (viewItem dropModel model) (List.take constr model.all) ++ expandToggle constr model expandToggle : Int -> Model -> List (Html Msg) @@ -118,8 +163,8 @@ collapseToggle max model = ToggleExpand -viewItem : Model -> FolderItem -> Html Msg -viewItem model item = +viewItem : DD.Model String String -> Model -> FolderItem -> Html Msg +viewItem dropModel model item = let selected = Just item.id == model.selected @@ -130,15 +175,21 @@ viewItem model item = else "folder outline icon" + + highlightDrop = + DD.getDropId dropModel == Just item.id in a - [ classList + ([ classList [ ( "item", True ) , ( "active", selected ) + , ( "current-drop-target", highlightDrop ) ] - , href "#" - , onClick (Toggle item) - ] + , href "#" + , onClick (Toggle item) + ] + ++ DD.droppable FolderDDMsg item.id + ) [ i [ class icon ] [] , div [ class "content" ] [ div [ class "header" ] diff --git a/modules/webapp/src/main/elm/Comp/ItemCardList.elm b/modules/webapp/src/main/elm/Comp/ItemCardList.elm index d818f35c..3a46c5c0 100644 --- a/modules/webapp/src/main/elm/Comp/ItemCardList.elm +++ b/modules/webapp/src/main/elm/Comp/ItemCardList.elm @@ -5,6 +5,7 @@ module Comp.ItemCardList exposing , nextItem , prevItem , update + , updateDrag , view ) @@ -20,6 +21,7 @@ import Data.UiSettings exposing (UiSettings) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) +import Html5.DragDrop as DD import Markdown import Util.List import Util.String @@ -35,6 +37,7 @@ type Msg = SetResults ItemLightList | AddResults ItemLightList | SelectItem ItemLight + | ItemDDMsg (DD.Msg String String) init : Model @@ -60,28 +63,72 @@ prevItem model id = update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe ItemLight ) -update _ msg model = +update flags msg model = + let + res = + updateDrag DD.init flags msg model + in + ( res.model, res.cmd, res.selected ) + + +type alias UpdateResult = + { model : Model + , cmd : Cmd Msg + , selected : Maybe ItemLight + , dragModel : DD.Model String String + } + + +updateDrag : + DD.Model String String + -> Flags + -> Msg + -> Model + -> UpdateResult +updateDrag dm _ msg model = case msg of SetResults list -> let newModel = { model | results = list } in - ( newModel, Cmd.none, Nothing ) + UpdateResult newModel Cmd.none Nothing dm AddResults list -> if list.groups == [] then - ( model, Cmd.none, Nothing ) + UpdateResult model Cmd.none Nothing dm else let newModel = { model | results = Data.Items.concat model.results list } in - ( newModel, Cmd.none, Nothing ) + UpdateResult newModel Cmd.none Nothing dm SelectItem item -> - ( model, Cmd.none, Just item ) + UpdateResult model Cmd.none (Just item) dm + + ItemDDMsg lm -> + let + ( dm_, result ) = + DD.update lm dm + + _ = + case result of + Just ( item, folder, _ ) -> + let + _ = + Debug.log "item card" item + + _ = + Debug.log "folder card" folder + in + Cmd.none + + Nothing -> + Cmd.none + in + UpdateResult model Cmd.none Nothing dm_ @@ -139,14 +186,16 @@ viewItem settings item = "blue" in a - [ classList + ([ classList [ ( "ui fluid card", True ) , ( newColor, not isConfirmed ) ] - , id item.id - , href "#" - , onClick (SelectItem item) - ] + , id item.id + , href "#" + , onClick (SelectItem item) + ] + ++ DD.draggable ItemDDMsg item.id + ) [ div [ class "content" ] [ div [ class "header" diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index db3bfa89..a5a6ddb6 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -1,11 +1,14 @@ module Comp.SearchMenu exposing - ( Model + ( DragDropData + , Model , Msg(..) , NextState , getItemSearch , init , update + , updateDrop , view + , viewDrop ) import Api @@ -29,6 +32,7 @@ import DatePicker exposing (DatePicker) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onCheck, onClick, onInput) +import Html5.DragDrop as DD import Http import Util.Html exposing (KeyCode(..)) import Util.Maybe @@ -127,33 +131,6 @@ init = } -type Msg - = Init - | TagSelectMsg Comp.TagSelect.Msg - | DirectionMsg (Comp.Dropdown.Msg Direction) - | OrgMsg (Comp.Dropdown.Msg IdName) - | CorrPersonMsg (Comp.Dropdown.Msg IdName) - | ConcPersonMsg (Comp.Dropdown.Msg IdName) - | ConcEquipmentMsg (Comp.Dropdown.Msg Equipment) - | FromDateMsg Comp.DatePicker.Msg - | UntilDateMsg Comp.DatePicker.Msg - | FromDueDateMsg Comp.DatePicker.Msg - | UntilDueDateMsg Comp.DatePicker.Msg - | ToggleInbox - | GetTagsResp (Result Http.Error TagCloud) - | GetOrgResp (Result Http.Error ReferenceList) - | GetEquipResp (Result Http.Error EquipmentList) - | GetPersonResp (Result Http.Error ReferenceList) - | SetName String - | SetAllName String - | SetFulltext String - | ResetForm - | KeyUpMsg (Maybe KeyCode) - | ToggleNameHelp - | FolderSelectMsg Comp.FolderSelect.Msg - | GetFolderResp (Result Http.Error FolderList) - - getDirection : Model -> Maybe Direction getDirection model = let @@ -218,19 +195,53 @@ getItemSearch model = -- Update -type alias NextState = - { modelCmd : ( Model, Cmd Msg ) - , stateChange : Bool +type Msg + = Init + | TagSelectMsg Comp.TagSelect.Msg + | DirectionMsg (Comp.Dropdown.Msg Direction) + | OrgMsg (Comp.Dropdown.Msg IdName) + | CorrPersonMsg (Comp.Dropdown.Msg IdName) + | ConcPersonMsg (Comp.Dropdown.Msg IdName) + | ConcEquipmentMsg (Comp.Dropdown.Msg Equipment) + | FromDateMsg Comp.DatePicker.Msg + | UntilDateMsg Comp.DatePicker.Msg + | FromDueDateMsg Comp.DatePicker.Msg + | UntilDueDateMsg Comp.DatePicker.Msg + | ToggleInbox + | GetTagsResp (Result Http.Error TagCloud) + | GetOrgResp (Result Http.Error ReferenceList) + | GetEquipResp (Result Http.Error EquipmentList) + | GetPersonResp (Result Http.Error ReferenceList) + | SetName String + | SetAllName String + | SetFulltext String + | ResetForm + | KeyUpMsg (Maybe KeyCode) + | ToggleNameHelp + | FolderSelectMsg Comp.FolderSelect.Msg + | GetFolderResp (Result Http.Error FolderList) + + +type alias DragDropData = + { folderDrop : DD.Model String String } -noChange : ( Model, Cmd Msg ) -> NextState -noChange p = - NextState p False +type alias NextState = + { model : Model + , cmd : Cmd Msg + , stateChange : Bool + , dragDrop : DragDropData + } update : Flags -> UiSettings -> Msg -> Model -> NextState -update flags settings msg model = +update = + updateDrop (DragDropData DD.init) + + +updateDrop : DragDropData -> Flags -> UiSettings -> Msg -> Model -> NextState +updateDrop dd flags settings msg model = case msg of Init -> let @@ -257,9 +268,9 @@ update flags settings msg model = ] ) in - noChange - ( mdp - , Cmd.batch + { model = mdp + , cmd = + Cmd.batch [ Api.getTagCloud flags GetTagsResp , Api.getOrgLight flags GetOrgResp , Api.getEquipments flags "" GetEquipResp @@ -267,7 +278,9 @@ update flags settings msg model = , Api.getFolders flags "" False GetFolderResp , cdp ] - ) + , stateChange = False + , dragDrop = dd + } ResetForm -> let @@ -286,10 +299,18 @@ update flags settings msg model = model_ = { model | tagSelectModel = selectModel } in - noChange ( model_, Cmd.none ) + { model = model_ + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } GetTagsResp (Err _) -> - noChange ( model, Cmd.none ) + { model = model + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } GetEquipResp (Ok equips) -> let @@ -299,7 +320,11 @@ update flags settings msg model = update flags settings (ConcEquipmentMsg opts) model GetEquipResp (Err _) -> - noChange ( model, Cmd.none ) + { model = model + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } GetOrgResp (Ok orgs) -> let @@ -309,98 +334,112 @@ update flags settings msg model = update flags settings (OrgMsg opts) model GetOrgResp (Err _) -> - noChange ( model, Cmd.none ) + { model = model + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } GetPersonResp (Ok ps) -> let opts = Comp.Dropdown.SetOptions ps.items + + next1 = + updateDrop dd flags settings (CorrPersonMsg opts) model + + next2 = + updateDrop next1.dragDrop flags settings (ConcPersonMsg opts) next1.model in - noChange <| - Util.Update.andThen1 - [ update flags settings (CorrPersonMsg opts) >> .modelCmd - , update flags settings (ConcPersonMsg opts) >> .modelCmd - ] - model + next2 GetPersonResp (Err _) -> - noChange ( model, Cmd.none ) + { model = model + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } TagSelectMsg m -> let ( m_, sel ) = Comp.TagSelect.update m model.tagSelectModel in - NextState - ( { model + { model = + { model | tagSelectModel = m_ , tagSelection = sel - } - , Cmd.none - ) - (sel /= model.tagSelection) + } + , cmd = Cmd.none + , stateChange = sel /= model.tagSelection + , dragDrop = dd + } DirectionMsg m -> let ( m2, c2 ) = Comp.Dropdown.update m model.directionModel in - NextState - ( { model | directionModel = m2 } - , Cmd.map DirectionMsg c2 - ) - (isDropdownChangeMsg m) + { model = { model | directionModel = m2 } + , cmd = Cmd.map DirectionMsg c2 + , stateChange = isDropdownChangeMsg m + , dragDrop = dd + } OrgMsg m -> let ( m2, c2 ) = Comp.Dropdown.update m model.orgModel in - NextState - ( { model | orgModel = m2 } - , Cmd.map OrgMsg c2 - ) - (isDropdownChangeMsg m) + { model = { model | orgModel = m2 } + , cmd = Cmd.map OrgMsg c2 + , stateChange = isDropdownChangeMsg m + , dragDrop = dd + } CorrPersonMsg m -> let ( m2, c2 ) = Comp.Dropdown.update m model.corrPersonModel in - NextState - ( { model | corrPersonModel = m2 } - , Cmd.map CorrPersonMsg c2 - ) - (isDropdownChangeMsg m) + { model = { model | corrPersonModel = m2 } + , cmd = Cmd.map CorrPersonMsg c2 + , stateChange = isDropdownChangeMsg m + , dragDrop = dd + } ConcPersonMsg m -> let ( m2, c2 ) = Comp.Dropdown.update m model.concPersonModel in - NextState - ( { model | concPersonModel = m2 } - , Cmd.map ConcPersonMsg c2 - ) - (isDropdownChangeMsg m) + { model = { model | concPersonModel = m2 } + , cmd = Cmd.map ConcPersonMsg c2 + , stateChange = isDropdownChangeMsg m + , dragDrop = dd + } ConcEquipmentMsg m -> let ( m2, c2 ) = Comp.Dropdown.update m model.concEquipmentModel in - NextState - ( { model | concEquipmentModel = m2 } - , Cmd.map ConcEquipmentMsg c2 - ) - (isDropdownChangeMsg m) + { model = { model | concEquipmentModel = m2 } + , cmd = Cmd.map ConcEquipmentMsg c2 + , stateChange = isDropdownChangeMsg m + , dragDrop = dd + } ToggleInbox -> let current = model.inboxCheckbox in - NextState ( { model | inboxCheckbox = not current }, Cmd.none ) True + { model = { model | inboxCheckbox = not current } + , cmd = Cmd.none + , stateChange = True + , dragDrop = dd + } FromDateMsg m -> let @@ -415,11 +454,11 @@ update flags settings msg model = _ -> Nothing in - NextState - ( { model | fromDateModel = dp, fromDate = nextDate } - , Cmd.none - ) - (model.fromDate /= nextDate) + { model = { model | fromDateModel = dp, fromDate = nextDate } + , cmd = Cmd.none + , stateChange = model.fromDate /= nextDate + , dragDrop = dd + } UntilDateMsg m -> let @@ -434,11 +473,11 @@ update flags settings msg model = _ -> Nothing in - NextState - ( { model | untilDateModel = dp, untilDate = nextDate } - , Cmd.none - ) - (model.untilDate /= nextDate) + { model = { model | untilDateModel = dp, untilDate = nextDate } + , cmd = Cmd.none + , stateChange = model.untilDate /= nextDate + , dragDrop = dd + } FromDueDateMsg m -> let @@ -453,11 +492,11 @@ update flags settings msg model = _ -> Nothing in - NextState - ( { model | fromDueDateModel = dp, fromDueDate = nextDate } - , Cmd.none - ) - (model.fromDueDate /= nextDate) + { model = { model | fromDueDateModel = dp, fromDueDate = nextDate } + , cmd = Cmd.none + , stateChange = model.fromDueDate /= nextDate + , dragDrop = dd + } UntilDueDateMsg m -> let @@ -472,79 +511,98 @@ update flags settings msg model = _ -> Nothing in - NextState - ( { model | untilDueDateModel = dp, untilDueDate = nextDate } - , Cmd.none - ) - (model.untilDueDate /= nextDate) + { model = { model | untilDueDateModel = dp, untilDueDate = nextDate } + , cmd = Cmd.none + , stateChange = model.untilDueDate /= nextDate + , dragDrop = dd + } SetName str -> let next = Util.Maybe.fromString str in - NextState - ( { model | nameModel = next } - , Cmd.none - ) - False + { model = { model | nameModel = next } + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } SetAllName str -> let next = Util.Maybe.fromString str in - NextState - ( { model | allNameModel = next } - , Cmd.none - ) - False + { model = { model | allNameModel = next } + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } SetFulltext str -> let next = Util.Maybe.fromString str in - NextState - ( { model | fulltextModel = next } - , Cmd.none - ) - False + { model = { model | fulltextModel = next } + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } KeyUpMsg (Just Enter) -> - NextState ( model, Cmd.none ) True + { model = model + , cmd = Cmd.none + , stateChange = True + , dragDrop = dd + } KeyUpMsg _ -> - NextState ( model, Cmd.none ) False + { model = model + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } ToggleNameHelp -> - NextState ( { model | showNameHelp = not model.showNameHelp }, Cmd.none ) False + { model = { model | showNameHelp = not model.showNameHelp } + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } GetFolderResp (Ok fs) -> let model_ = { model | folderList = Comp.FolderSelect.init fs.items } in - NextState - ( model_, Cmd.none ) - False + { model = model_ + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } GetFolderResp (Err _) -> - noChange ( model, Cmd.none ) + { model = model + , cmd = Cmd.none + , stateChange = False + , dragDrop = dd + } FolderSelectMsg lm -> let - ( fsm, sel ) = - Comp.FolderSelect.update lm model.folderList + ( fsm, sel, dd_ ) = + Comp.FolderSelect.updateDrop dd.folderDrop lm model.folderList in - NextState - ( { model + { model = + { model | folderList = fsm , selectedFolder = sel - } - , Cmd.none - ) - (model.selectedFolder /= sel) + } + , cmd = Cmd.none + , stateChange = model.selectedFolder /= sel + , dragDrop = { dd | folderDrop = dd_ } + } @@ -552,7 +610,12 @@ update flags settings msg model = view : Flags -> UiSettings -> Model -> Html Msg -view flags settings model = +view = + viewDrop (DragDropData DD.init) + + +viewDrop : DragDropData -> Flags -> UiSettings -> Model -> Html Msg +viewDrop ddd flags settings model = let formHeader icon headline = div [ class "ui tiny header" ] @@ -585,7 +648,7 @@ view flags settings model = [ Html.map TagSelectMsg (Comp.TagSelect.viewTags settings model.tagSelectModel) , Html.map TagSelectMsg (Comp.TagSelect.viewCats settings model.tagSelectModel) , Html.map FolderSelectMsg - (Comp.FolderSelect.view settings.searchMenuFolderCount model.folderList) + (Comp.FolderSelect.viewDrop ddd.folderDrop settings.searchMenuFolderCount model.folderList) ] , div [ class segmentClass ] [ formHeader (Icons.correspondentIcon "") diff --git a/modules/webapp/src/main/elm/Page/Home/Data.elm b/modules/webapp/src/main/elm/Page/Home/Data.elm index 7c29924f..f492d04b 100644 --- a/modules/webapp/src/main/elm/Page/Home/Data.elm +++ b/modules/webapp/src/main/elm/Page/Home/Data.elm @@ -16,10 +16,11 @@ import Api.Model.ItemLightList exposing (ItemLightList) import Api.Model.ItemSearch import Comp.FixedDropdown import Comp.ItemCardList -import Comp.SearchMenu +import Comp.SearchMenu exposing (DragDropData) import Data.Flags exposing (Flags) import Data.Items import Data.UiSettings exposing (UiSettings) +import Html5.DragDrop as DD import Http import Throttle exposing (Throttle) import Util.Html exposing (KeyCode(..)) @@ -39,6 +40,7 @@ type alias Model = , searchType : SearchType , searchTypeForm : SearchType , contentOnlySearch : Maybe String + , dragDropData : DragDropData } @@ -67,6 +69,9 @@ init flags = , searchType = BasicSearch , searchTypeForm = defaultSearchType flags , contentOnlySearch = Nothing + , dragDropData = + { folderDrop = DD.init + } } diff --git a/modules/webapp/src/main/elm/Page/Home/Update.elm b/modules/webapp/src/main/elm/Page/Home/Update.elm index 6384d1c6..93c44afb 100644 --- a/modules/webapp/src/main/elm/Page/Home/Update.elm +++ b/modules/webapp/src/main/elm/Page/Home/Update.elm @@ -6,6 +6,7 @@ import Comp.ItemCardList import Comp.SearchMenu import Data.Flags exposing (Flags) import Data.UiSettings exposing (UiSettings) +import Html5.DragDrop as DD import Page exposing (Page(..)) import Page.Home.Data exposing (..) import Throttle @@ -39,10 +40,18 @@ update key flags settings msg model = SearchMenuMsg m -> let nextState = - Comp.SearchMenu.update flags settings m model.searchMenuModel + Comp.SearchMenu.updateDrop + model.dragDropData + flags + settings + m + model.searchMenuModel newModel = - { model | searchMenuModel = Tuple.first nextState.modelCmd } + { model + | searchMenuModel = nextState.model + , dragDropData = nextState.dragDrop + } ( m2, c2, s2 ) = if nextState.stateChange && not model.searchInProgress then @@ -54,18 +63,21 @@ update key flags settings msg model = ( m2 , Cmd.batch [ c2 - , Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd) + , Cmd.map SearchMenuMsg nextState.cmd ] , s2 ) ItemCardListMsg m -> let - ( m2, c2, mitem ) = - Comp.ItemCardList.update flags m model.itemListModel + result = + Comp.ItemCardList.updateDrag model.dragDropData.folderDrop + flags + m + model.itemListModel cmd = - case mitem of + case result.selected of Just item -> Page.set key (ItemDetailPage item.id) @@ -73,8 +85,11 @@ update key flags settings msg model = Cmd.none in withSub - ( { model | itemListModel = m2 } - , Cmd.batch [ Cmd.map ItemCardListMsg c2, cmd ] + ( { model + | itemListModel = result.model + , dragDropData = { folderDrop = result.dragModel } + } + , Cmd.batch [ Cmd.map ItemCardListMsg result.cmd, cmd ] ) ItemSearchResp (Ok list) -> diff --git a/modules/webapp/src/main/elm/Page/Home/View.elm b/modules/webapp/src/main/elm/Page/Home/View.elm index 2981d79d..25365f45 100644 --- a/modules/webapp/src/main/elm/Page/Home/View.elm +++ b/modules/webapp/src/main/elm/Page/Home/View.elm @@ -63,7 +63,12 @@ view flags settings model = ] ] , div [ class "ui attached fluid segment" ] - [ Html.map SearchMenuMsg (Comp.SearchMenu.view flags settings model.searchMenuModel) + [ Html.map SearchMenuMsg + (Comp.SearchMenu.viewDrop model.dragDropData + flags + settings + model.searchMenuModel + ) ] ] , div diff --git a/modules/webapp/src/main/webjar/docspell.css b/modules/webapp/src/main/webjar/docspell.css index e64155a0..32e904fd 100644 --- a/modules/webapp/src/main/webjar/docspell.css +++ b/modules/webapp/src/main/webjar/docspell.css @@ -166,7 +166,7 @@ textarea.markdown-editor { background: rgba(240,248,255,0.4); } -.default-layout .ui.menu .item.current-drop-target { +.default-layout .ui.menu .item.current-drop-target, a.item.current-drop-target { background: rgba(0,0,0,0.2); } From d6d16e39bd61e7c697a6ca14d47143f8d73a3188 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 14:03:36 +0200 Subject: [PATCH 10/15] Drag-drop items into folders in list view --- .../webapp/src/main/elm/Comp/FolderSelect.elm | 53 +++++----- .../webapp/src/main/elm/Comp/ItemCardList.elm | 27 ++--- .../webapp/src/main/elm/Comp/SearchMenu.elm | 85 ++++++++-------- .../webapp/src/main/elm/Page/Home/Data.elm | 9 +- .../webapp/src/main/elm/Page/Home/Update.elm | 21 +++- .../webapp/src/main/elm/Util/ItemDragDrop.elm | 98 +++++++++++++++++++ modules/webapp/src/main/webjar/docspell.css | 2 +- 7 files changed, 189 insertions(+), 106 deletions(-) create mode 100644 modules/webapp/src/main/elm/Util/ItemDragDrop.elm diff --git a/modules/webapp/src/main/elm/Comp/FolderSelect.elm b/modules/webapp/src/main/elm/Comp/FolderSelect.elm index a1126041..9ca36a80 100644 --- a/modules/webapp/src/main/elm/Comp/FolderSelect.elm +++ b/modules/webapp/src/main/elm/Comp/FolderSelect.elm @@ -12,8 +12,8 @@ import Api.Model.FolderItem exposing (FolderItem) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) -import Html5.DragDrop as DD import Util.ExpandCollapse +import Util.ItemDragDrop as DD import Util.List @@ -39,7 +39,7 @@ init all = type Msg = Toggle FolderItem | ToggleExpand - | FolderDDMsg (DD.Msg String String) + | FolderDDMsg DD.Msg update : Msg -> Model -> ( Model, Maybe FolderItem ) @@ -52,10 +52,10 @@ update msg model = updateDrop : - DD.Model String String + DD.Model -> Msg -> Model - -> ( Model, Maybe FolderItem, DD.Model String String ) + -> ( Model, Maybe FolderItem, DD.DragDropData ) updateDrop dropModel msg model = case msg of Toggle item -> @@ -70,35 +70,20 @@ updateDrop dropModel msg model = model_ = { model | selected = selection } in - ( model_, selectedFolder model_, dropModel ) + ( model_, selectedFolder model_, DD.DragDropData dropModel Nothing ) ToggleExpand -> ( { model | expanded = not model.expanded } , selectedFolder model - , dropModel + , DD.DragDropData dropModel Nothing ) FolderDDMsg lm -> let - ( dm_, result ) = + ddd = DD.update lm dropModel - - _ = - case result of - Just ( item, folder, _ ) -> - let - _ = - Debug.log "item menu" item - - _ = - Debug.log "folder menu" folder - in - Cmd.none - - Nothing -> - Cmd.none in - ( model, selectedFolder model, dm_ ) + ( model, selectedFolder model, ddd ) selectedFolder : Model -> Maybe FolderItem @@ -119,13 +104,23 @@ view = viewDrop DD.init -viewDrop : DD.Model String String -> Int -> Model -> Html Msg +viewDrop : DD.Model -> Int -> Model -> Html Msg viewDrop dropModel constr model = + let + highlightDrop = + DD.getDropId dropModel == Just DD.FolderRemove + in div [ class "ui list" ] [ div [ class "item" ] [ i [ class "folder open icon" ] [] , div [ class "content" ] - [ div [ class "header" ] + [ div + (classList + [ ( "header", True ) + , ( "current-drop-target", highlightDrop ) + ] + :: DD.droppable FolderDDMsg DD.FolderRemove + ) [ text "Folders" ] , div [ class "ui relaxed list" ] @@ -135,7 +130,7 @@ viewDrop dropModel constr model = ] -renderItems : DD.Model String String -> Int -> Model -> List (Html Msg) +renderItems : DD.Model -> Int -> Model -> List (Html Msg) renderItems dropModel constr model = if constr <= 0 then List.map (viewItem dropModel model) model.all @@ -163,7 +158,7 @@ collapseToggle max model = ToggleExpand -viewItem : DD.Model String String -> Model -> FolderItem -> Html Msg +viewItem : DD.Model -> Model -> FolderItem -> Html Msg viewItem dropModel model item = let selected = @@ -177,7 +172,7 @@ viewItem dropModel model item = "folder outline icon" highlightDrop = - DD.getDropId dropModel == Just item.id + DD.getDropId dropModel == Just (DD.Folder item.id) in a ([ classList @@ -188,7 +183,7 @@ viewItem dropModel model item = , href "#" , onClick (Toggle item) ] - ++ DD.droppable FolderDDMsg item.id + ++ DD.droppable FolderDDMsg (DD.Folder item.id) ) [ i [ class icon ] [] , div [ class "content" ] diff --git a/modules/webapp/src/main/elm/Comp/ItemCardList.elm b/modules/webapp/src/main/elm/Comp/ItemCardList.elm index 3a46c5c0..6f11d8a4 100644 --- a/modules/webapp/src/main/elm/Comp/ItemCardList.elm +++ b/modules/webapp/src/main/elm/Comp/ItemCardList.elm @@ -21,8 +21,8 @@ import Data.UiSettings exposing (UiSettings) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) -import Html5.DragDrop as DD import Markdown +import Util.ItemDragDrop as DD import Util.List import Util.String import Util.Time @@ -37,7 +37,7 @@ type Msg = SetResults ItemLightList | AddResults ItemLightList | SelectItem ItemLight - | ItemDDMsg (DD.Msg String String) + | ItemDDMsg DD.Msg init : Model @@ -75,12 +75,12 @@ type alias UpdateResult = { model : Model , cmd : Cmd Msg , selected : Maybe ItemLight - , dragModel : DD.Model String String + , dragModel : DD.Model } updateDrag : - DD.Model String String + DD.Model -> Flags -> Msg -> Model @@ -110,25 +110,10 @@ updateDrag dm _ msg model = ItemDDMsg lm -> let - ( dm_, result ) = + ddd = DD.update lm dm - - _ = - case result of - Just ( item, folder, _ ) -> - let - _ = - Debug.log "item card" item - - _ = - Debug.log "folder card" folder - in - Cmd.none - - Nothing -> - Cmd.none in - UpdateResult model Cmd.none Nothing dm_ + UpdateResult model Cmd.none Nothing ddd.model diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index a5a6ddb6..fb7aeb67 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -1,6 +1,5 @@ module Comp.SearchMenu exposing - ( DragDropData - , Model + ( Model , Msg(..) , NextState , getItemSearch @@ -32,11 +31,10 @@ import DatePicker exposing (DatePicker) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onCheck, onClick, onInput) -import Html5.DragDrop as DD import Http import Util.Html exposing (KeyCode(..)) +import Util.ItemDragDrop as DD import Util.Maybe -import Util.Update @@ -222,26 +220,21 @@ type Msg | GetFolderResp (Result Http.Error FolderList) -type alias DragDropData = - { folderDrop : DD.Model String String - } - - type alias NextState = { model : Model , cmd : Cmd Msg , stateChange : Bool - , dragDrop : DragDropData + , dragDrop : DD.DragDropData } update : Flags -> UiSettings -> Msg -> Model -> NextState update = - updateDrop (DragDropData DD.init) + updateDrop DD.init -updateDrop : DragDropData -> Flags -> UiSettings -> Msg -> Model -> NextState -updateDrop dd flags settings msg model = +updateDrop : DD.Model -> Flags -> UiSettings -> Msg -> Model -> NextState +updateDrop ddm flags settings msg model = case msg of Init -> let @@ -279,7 +272,7 @@ updateDrop dd flags settings msg model = , cdp ] , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } ResetForm -> @@ -302,14 +295,14 @@ updateDrop dd flags settings msg model = { model = model_ , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } GetTagsResp (Err _) -> { model = model , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } GetEquipResp (Ok equips) -> @@ -323,7 +316,7 @@ updateDrop dd flags settings msg model = { model = model , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } GetOrgResp (Ok orgs) -> @@ -337,7 +330,7 @@ updateDrop dd flags settings msg model = { model = model , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } GetPersonResp (Ok ps) -> @@ -346,10 +339,10 @@ updateDrop dd flags settings msg model = Comp.Dropdown.SetOptions ps.items next1 = - updateDrop dd flags settings (CorrPersonMsg opts) model + updateDrop ddm flags settings (CorrPersonMsg opts) model next2 = - updateDrop next1.dragDrop flags settings (ConcPersonMsg opts) next1.model + updateDrop next1.dragDrop.model flags settings (ConcPersonMsg opts) next1.model in next2 @@ -357,7 +350,7 @@ updateDrop dd flags settings msg model = { model = model , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } TagSelectMsg m -> @@ -372,7 +365,7 @@ updateDrop dd flags settings msg model = } , cmd = Cmd.none , stateChange = sel /= model.tagSelection - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } DirectionMsg m -> @@ -383,7 +376,7 @@ updateDrop dd flags settings msg model = { model = { model | directionModel = m2 } , cmd = Cmd.map DirectionMsg c2 , stateChange = isDropdownChangeMsg m - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } OrgMsg m -> @@ -394,7 +387,7 @@ updateDrop dd flags settings msg model = { model = { model | orgModel = m2 } , cmd = Cmd.map OrgMsg c2 , stateChange = isDropdownChangeMsg m - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } CorrPersonMsg m -> @@ -405,7 +398,7 @@ updateDrop dd flags settings msg model = { model = { model | corrPersonModel = m2 } , cmd = Cmd.map CorrPersonMsg c2 , stateChange = isDropdownChangeMsg m - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } ConcPersonMsg m -> @@ -416,7 +409,7 @@ updateDrop dd flags settings msg model = { model = { model | concPersonModel = m2 } , cmd = Cmd.map ConcPersonMsg c2 , stateChange = isDropdownChangeMsg m - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } ConcEquipmentMsg m -> @@ -427,7 +420,7 @@ updateDrop dd flags settings msg model = { model = { model | concEquipmentModel = m2 } , cmd = Cmd.map ConcEquipmentMsg c2 , stateChange = isDropdownChangeMsg m - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } ToggleInbox -> @@ -438,7 +431,7 @@ updateDrop dd flags settings msg model = { model = { model | inboxCheckbox = not current } , cmd = Cmd.none , stateChange = True - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } FromDateMsg m -> @@ -457,7 +450,7 @@ updateDrop dd flags settings msg model = { model = { model | fromDateModel = dp, fromDate = nextDate } , cmd = Cmd.none , stateChange = model.fromDate /= nextDate - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } UntilDateMsg m -> @@ -476,7 +469,7 @@ updateDrop dd flags settings msg model = { model = { model | untilDateModel = dp, untilDate = nextDate } , cmd = Cmd.none , stateChange = model.untilDate /= nextDate - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } FromDueDateMsg m -> @@ -495,7 +488,7 @@ updateDrop dd flags settings msg model = { model = { model | fromDueDateModel = dp, fromDueDate = nextDate } , cmd = Cmd.none , stateChange = model.fromDueDate /= nextDate - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } UntilDueDateMsg m -> @@ -514,7 +507,7 @@ updateDrop dd flags settings msg model = { model = { model | untilDueDateModel = dp, untilDueDate = nextDate } , cmd = Cmd.none , stateChange = model.untilDueDate /= nextDate - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } SetName str -> @@ -525,7 +518,7 @@ updateDrop dd flags settings msg model = { model = { model | nameModel = next } , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } SetAllName str -> @@ -536,7 +529,7 @@ updateDrop dd flags settings msg model = { model = { model | allNameModel = next } , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } SetFulltext str -> @@ -547,28 +540,28 @@ updateDrop dd flags settings msg model = { model = { model | fulltextModel = next } , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } KeyUpMsg (Just Enter) -> { model = model , cmd = Cmd.none , stateChange = True - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } KeyUpMsg _ -> { model = model , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } ToggleNameHelp -> { model = { model | showNameHelp = not model.showNameHelp } , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } GetFolderResp (Ok fs) -> @@ -579,20 +572,20 @@ updateDrop dd flags settings msg model = { model = model_ , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } GetFolderResp (Err _) -> { model = model , cmd = Cmd.none , stateChange = False - , dragDrop = dd + , dragDrop = DD.DragDropData ddm Nothing } FolderSelectMsg lm -> let - ( fsm, sel, dd_ ) = - Comp.FolderSelect.updateDrop dd.folderDrop lm model.folderList + ( fsm, sel, ddd ) = + Comp.FolderSelect.updateDrop ddm lm model.folderList in { model = { model @@ -601,7 +594,7 @@ updateDrop dd flags settings msg model = } , cmd = Cmd.none , stateChange = model.selectedFolder /= sel - , dragDrop = { dd | folderDrop = dd_ } + , dragDrop = ddd } @@ -611,10 +604,10 @@ updateDrop dd flags settings msg model = view : Flags -> UiSettings -> Model -> Html Msg view = - viewDrop (DragDropData DD.init) + viewDrop (DD.DragDropData DD.init Nothing) -viewDrop : DragDropData -> Flags -> UiSettings -> Model -> Html Msg +viewDrop : DD.DragDropData -> Flags -> UiSettings -> Model -> Html Msg viewDrop ddd flags settings model = let formHeader icon headline = @@ -648,7 +641,7 @@ viewDrop ddd flags settings model = [ Html.map TagSelectMsg (Comp.TagSelect.viewTags settings model.tagSelectModel) , Html.map TagSelectMsg (Comp.TagSelect.viewCats settings model.tagSelectModel) , Html.map FolderSelectMsg - (Comp.FolderSelect.viewDrop ddd.folderDrop settings.searchMenuFolderCount model.folderList) + (Comp.FolderSelect.viewDrop ddd.model settings.searchMenuFolderCount model.folderList) ] , div [ class segmentClass ] [ formHeader (Icons.correspondentIcon "") diff --git a/modules/webapp/src/main/elm/Page/Home/Data.elm b/modules/webapp/src/main/elm/Page/Home/Data.elm index f492d04b..b8661b96 100644 --- a/modules/webapp/src/main/elm/Page/Home/Data.elm +++ b/modules/webapp/src/main/elm/Page/Home/Data.elm @@ -16,14 +16,14 @@ import Api.Model.ItemLightList exposing (ItemLightList) import Api.Model.ItemSearch import Comp.FixedDropdown import Comp.ItemCardList -import Comp.SearchMenu exposing (DragDropData) +import Comp.SearchMenu import Data.Flags exposing (Flags) import Data.Items import Data.UiSettings exposing (UiSettings) -import Html5.DragDrop as DD import Http import Throttle exposing (Throttle) import Util.Html exposing (KeyCode(..)) +import Util.ItemDragDrop as DD type alias Model = @@ -40,7 +40,7 @@ type alias Model = , searchType : SearchType , searchTypeForm : SearchType , contentOnlySearch : Maybe String - , dragDropData : DragDropData + , dragDropData : DD.DragDropData } @@ -70,8 +70,7 @@ init flags = , searchTypeForm = defaultSearchType flags , contentOnlySearch = Nothing , dragDropData = - { folderDrop = DD.init - } + DD.DragDropData DD.init Nothing } diff --git a/modules/webapp/src/main/elm/Page/Home/Update.elm b/modules/webapp/src/main/elm/Page/Home/Update.elm index 93c44afb..b424abb0 100644 --- a/modules/webapp/src/main/elm/Page/Home/Update.elm +++ b/modules/webapp/src/main/elm/Page/Home/Update.elm @@ -6,12 +6,12 @@ import Comp.ItemCardList import Comp.SearchMenu import Data.Flags exposing (Flags) import Data.UiSettings exposing (UiSettings) -import Html5.DragDrop as DD import Page exposing (Page(..)) import Page.Home.Data exposing (..) import Throttle import Time import Util.Html exposing (KeyCode(..)) +import Util.ItemDragDrop as DD import Util.Maybe import Util.String import Util.Update @@ -41,12 +41,24 @@ update key flags settings msg model = let nextState = Comp.SearchMenu.updateDrop - model.dragDropData + model.dragDropData.model flags settings m model.searchMenuModel + dropCmd = + case nextState.dragDrop.dropped of + Just dropped -> + let + _ = + Debug.log "item/folder" dropped + in + DD.makeUpdateCmd flags (\_ -> DoSearch) nextState.dragDrop.dropped + + Nothing -> + Cmd.none + newModel = { model | searchMenuModel = nextState.model @@ -64,6 +76,7 @@ update key flags settings msg model = , Cmd.batch [ c2 , Cmd.map SearchMenuMsg nextState.cmd + , dropCmd ] , s2 ) @@ -71,7 +84,7 @@ update key flags settings msg model = ItemCardListMsg m -> let result = - Comp.ItemCardList.updateDrag model.dragDropData.folderDrop + Comp.ItemCardList.updateDrag model.dragDropData.model flags m model.itemListModel @@ -87,7 +100,7 @@ update key flags settings msg model = withSub ( { model | itemListModel = result.model - , dragDropData = { folderDrop = result.dragModel } + , dragDropData = DD.DragDropData result.dragModel Nothing } , Cmd.batch [ Cmd.map ItemCardListMsg result.cmd, cmd ] ) diff --git a/modules/webapp/src/main/elm/Util/ItemDragDrop.elm b/modules/webapp/src/main/elm/Util/ItemDragDrop.elm new file mode 100644 index 00000000..31fa704b --- /dev/null +++ b/modules/webapp/src/main/elm/Util/ItemDragDrop.elm @@ -0,0 +1,98 @@ +module Util.ItemDragDrop exposing + ( DragDropData + , Dropped + , ItemDrop(..) + , Model + , Msg + , draggable + , droppable + , getDropId + , init + , makeUpdateCmd + , update + ) + +import Api +import Api.Model.BasicResult exposing (BasicResult) +import Api.Model.OptionalId exposing (OptionalId) +import Data.Flags exposing (Flags) +import Html exposing (Attribute) +import Html5.DragDrop as DD +import Http + + +type ItemDrop + = Tag String + | Folder String + | FolderRemove + + +type alias Model = + DD.Model String ItemDrop + + +type alias Msg = + DD.Msg String ItemDrop + + +type alias Dropped = + { itemId : String + , target : ItemDrop + } + + +type alias DragDropData = + { model : Model + , dropped : Maybe Dropped + } + + +init : Model +init = + DD.init + + +update : Msg -> Model -> DragDropData +update msg model = + let + ( m, res ) = + DD.update msg model + in + DragDropData m (Maybe.map (\( id, t, _ ) -> Dropped id t) res) + + +makeUpdateCmd : + Flags + -> (Result Http.Error BasicResult -> msg) + -> Maybe Dropped + -> Cmd msg +makeUpdateCmd flags receive droppedMaybe = + case droppedMaybe of + Just dropped -> + case dropped.target of + Folder fid -> + Api.setFolder flags dropped.itemId (OptionalId (Just fid)) receive + + FolderRemove -> + Api.setFolder flags dropped.itemId (OptionalId Nothing) receive + + Tag _ -> + Cmd.none + + Nothing -> + Cmd.none + + +droppable : (Msg -> msg) -> ItemDrop -> List (Attribute msg) +droppable tagger dropId = + DD.droppable tagger dropId + + +draggable : (Msg -> msg) -> String -> List (Attribute msg) +draggable tagger itemId = + DD.draggable tagger itemId + + +getDropId : Model -> Maybe ItemDrop +getDropId model = + DD.getDropId model diff --git a/modules/webapp/src/main/webjar/docspell.css b/modules/webapp/src/main/webjar/docspell.css index 32e904fd..8ae37e61 100644 --- a/modules/webapp/src/main/webjar/docspell.css +++ b/modules/webapp/src/main/webjar/docspell.css @@ -166,7 +166,7 @@ textarea.markdown-editor { background: rgba(240,248,255,0.4); } -.default-layout .ui.menu .item.current-drop-target, a.item.current-drop-target { +.default-layout .ui.menu .item.current-drop-target, .header.current-drop-target, .item.current-drop-target { background: rgba(0,0,0,0.2); } From b1ef0c55af1de4e20ea48521a9aed7c2f77d6d8b Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 14:16:13 +0200 Subject: [PATCH 11/15] Show only visible folders in search menu --- modules/webapp/src/main/elm/Comp/SearchMenu.elm | 7 ++++++- modules/webapp/src/main/elm/Util/Folder.elm | 11 +++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index fb7aeb67..af14a7c7 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -32,6 +32,7 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onCheck, onClick, onInput) import Http +import Util.Folder import Util.Html exposing (KeyCode(..)) import Util.ItemDragDrop as DD import Util.Maybe @@ -567,7 +568,11 @@ updateDrop ddm flags settings msg model = GetFolderResp (Ok fs) -> let model_ = - { model | folderList = Comp.FolderSelect.init fs.items } + { model + | folderList = + Util.Folder.onlyVisible flags fs.items + |> Comp.FolderSelect.init + } in { model = model_ , cmd = Cmd.none diff --git a/modules/webapp/src/main/elm/Util/Folder.elm b/modules/webapp/src/main/elm/Util/Folder.elm index 64ea2572..ba32bb67 100644 --- a/modules/webapp/src/main/elm/Util/Folder.elm +++ b/modules/webapp/src/main/elm/Util/Folder.elm @@ -1,6 +1,7 @@ module Util.Folder exposing ( isFolderMember , mkFolderOption + , onlyVisible ) import Api.Model.FolderItem exposing (FolderItem) @@ -51,3 +52,13 @@ isFolderMember allFolders selected = in Maybe.map .isMember folder |> Maybe.withDefault True + + +onlyVisible : Flags -> List FolderItem -> List FolderItem +onlyVisible flags folders = + let + isVisible folder = + folder.isMember + || (Maybe.map .user flags.account == Just folder.owner.name) + in + List.filter isVisible folders From f86f64436583c03202a46c4b57d273de21fb2576 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 14:34:26 +0200 Subject: [PATCH 12/15] Prepare for drag-drop items into tags in list view --- .../webapp/src/main/elm/Comp/SearchMenu.elm | 8 +- .../webapp/src/main/elm/Comp/TagSelect.elm | 87 +++++++++++++------ .../webapp/src/main/elm/Util/ItemDragDrop.elm | 4 + 3 files changed, 68 insertions(+), 31 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index af14a7c7..93d680f6 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -356,8 +356,8 @@ updateDrop ddm flags settings msg model = TagSelectMsg m -> let - ( m_, sel ) = - Comp.TagSelect.update m model.tagSelectModel + ( m_, sel, ddd ) = + Comp.TagSelect.updateDrop ddm m model.tagSelectModel in { model = { model @@ -366,7 +366,7 @@ updateDrop ddm flags settings msg model = } , cmd = Cmd.none , stateChange = sel /= model.tagSelection - , dragDrop = DD.DragDropData ddm Nothing + , dragDrop = ddd } DirectionMsg m -> @@ -643,7 +643,7 @@ viewDrop ddd flags settings model = ] ] , div [ class segmentClass ] - [ Html.map TagSelectMsg (Comp.TagSelect.viewTags settings model.tagSelectModel) + [ Html.map TagSelectMsg (Comp.TagSelect.viewTagsDrop ddd.model settings model.tagSelectModel) , Html.map TagSelectMsg (Comp.TagSelect.viewCats settings model.tagSelectModel) , Html.map FolderSelectMsg (Comp.FolderSelect.viewDrop ddd.model settings.searchMenuFolderCount model.folderList) diff --git a/modules/webapp/src/main/elm/Comp/TagSelect.elm b/modules/webapp/src/main/elm/Comp/TagSelect.elm index b683f626..26fd1358 100644 --- a/modules/webapp/src/main/elm/Comp/TagSelect.elm +++ b/modules/webapp/src/main/elm/Comp/TagSelect.elm @@ -6,10 +6,12 @@ module Comp.TagSelect exposing , emptySelection , init , update - , view1 - , view2 + , updateDrop + , view , viewCats + , viewDrop , viewTags + , viewTagsDrop ) import Api.Model.TagCount exposing (TagCount) @@ -20,6 +22,7 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) import Util.ExpandCollapse +import Util.ItemDragDrop as DD type alias Model = @@ -82,6 +85,7 @@ type Msg | ToggleCat String | ToggleExpandTags | ToggleExpandCats + | TagDDMsg DD.Msg type alias Selection = @@ -99,6 +103,15 @@ emptySelection = update : Msg -> Model -> ( Model, Selection ) update msg model = + let + ( m, s, _ ) = + updateDrop DD.init msg model + in + ( m, s ) + + +updateDrop : DD.Model -> Msg -> Model -> ( Model, Selection, DD.DragDropData ) +updateDrop ddm msg model = case msg of ToggleTag id -> let @@ -108,7 +121,7 @@ update msg model = model_ = { model | selectedTags = next } in - ( model_, getSelection model_ ) + ( model_, getSelection model_, DD.DragDropData ddm Nothing ) ToggleCat name -> let @@ -118,18 +131,27 @@ update msg model = model_ = { model | selectedCats = next } in - ( model_, getSelection model_ ) + ( model_, getSelection model_, DD.DragDropData ddm Nothing ) ToggleExpandTags -> ( { model | expandedTags = not model.expandedTags } , getSelection model + , DD.DragDropData ddm Nothing ) ToggleExpandCats -> ( { model | expandedCats = not model.expandedCats } , getSelection model + , DD.DragDropData ddm Nothing ) + TagDDMsg lm -> + let + ddd = + DD.update lm ddm + in + ( model, getSelection model, ddd ) + updateSelection : String -> Dict String Bool -> Dict String Bool updateSelection id selected = @@ -211,7 +233,12 @@ catState model name = viewTags : UiSettings -> Model -> Html Msg -viewTags settings model = +viewTags = + viewTagsDrop DD.init + + +viewTagsDrop : DD.Model -> UiSettings -> Model -> Html Msg +viewTagsDrop ddm settings model = div [ class "ui list" ] [ div [ class "item" ] [ I.tagIcon "" @@ -220,7 +247,7 @@ viewTags settings model = [ text "Tags" ] , div [ class "ui relaxed list" ] - (renderTagItems settings model) + (renderTagItems ddm settings model) ] ] ] @@ -242,8 +269,13 @@ viewCats settings model = ] -view1 : UiSettings -> Model -> Html Msg -view1 settings model = +view : UiSettings -> Model -> Html Msg +view = + viewDrop DD.init + + +viewDrop : DD.Model -> UiSettings -> Model -> Html Msg +viewDrop ddm settings model = div [ class "ui list" ] [ div [ class "item" ] [ I.tagIcon "" @@ -252,7 +284,7 @@ view1 settings model = [ text "Tags" ] , div [ class "ui relaxed list" ] - (renderTagItems settings model) + (renderTagItems ddm settings model) ] ] , div [ class "item" ] @@ -268,15 +300,8 @@ view1 settings model = ] -view2 : UiSettings -> Model -> List (Html Msg) -view2 settings model = - [ viewTags settings model - , viewCats settings model - ] - - -renderTagItems : UiSettings -> Model -> List (Html Msg) -renderTagItems settings model = +renderTagItems : DD.Model -> UiSettings -> Model -> List (Html Msg) +renderTagItems ddm settings model = let tags = model.all @@ -297,13 +322,13 @@ renderTagItems settings model = ToggleExpandTags in if max <= 0 then - List.map (viewTagItem settings model) model.all + List.map (viewTagItem ddm settings model) model.all else if model.expandedTags then - List.map (viewTagItem settings model) model.all ++ cps + List.map (viewTagItem ddm settings model) model.all ++ cps else - List.map (viewTagItem settings model) (List.take max model.all) ++ exp + List.map (viewTagItem ddm settings model) (List.take max model.all) ++ exp renderCatItems : UiSettings -> Model -> List (Html Msg) @@ -371,8 +396,8 @@ viewCategoryItem settings model cat = ] -viewTagItem : UiSettings -> Model -> TagCount -> Html Msg -viewTagItem settings model tag = +viewTagItem : DD.Model -> UiSettings -> Model -> TagCount -> Html Msg +viewTagItem ddm settings model tag = let state = tagState model tag.tag.id @@ -382,12 +407,20 @@ viewTagItem settings model tag = icon = getIcon state color I.tagIcon + + dropActive = + DD.getDropId ddm == Just (DD.Tag tag.tag.id) in a - [ class "item" - , href "#" - , onClick (ToggleTag tag.tag.id) - ] + ([ classList + [ ( "item", True ) + , ( "current-drop-target", dropActive ) + ] + , href "#" + , onClick (ToggleTag tag.tag.id) + ] + ++ DD.droppable TagDDMsg (DD.Tag tag.tag.id) + ) [ icon , div [ class "content" ] [ div diff --git a/modules/webapp/src/main/elm/Util/ItemDragDrop.elm b/modules/webapp/src/main/elm/Util/ItemDragDrop.elm index 31fa704b..834d22e0 100644 --- a/modules/webapp/src/main/elm/Util/ItemDragDrop.elm +++ b/modules/webapp/src/main/elm/Util/ItemDragDrop.elm @@ -77,6 +77,10 @@ makeUpdateCmd flags receive droppedMaybe = Api.setFolder flags dropped.itemId (OptionalId Nothing) receive Tag _ -> + let + _ = + Debug.log "dropped" dropped + in Cmd.none Nothing -> From 06ad9ac46c18f71652c6a492405c99ff2e2d5b9d Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 15:03:28 +0200 Subject: [PATCH 13/15] Add routes to conveniently set/toggle tags --- .../scala/docspell/backend/ops/OItem.scala | 25 ++++++++ .../src/main/resources/docspell-openapi.yml | 63 +++++++++++++++++++ .../restserver/routes/ItemRoutes.scala | 14 +++++ .../docspell/store/records/RTagItem.scala | 8 +++ 4 files changed, 110 insertions(+) diff --git a/modules/backend/src/main/scala/docspell/backend/ops/OItem.scala b/modules/backend/src/main/scala/docspell/backend/ops/OItem.scala index 133991ae..4919fdfe 100644 --- a/modules/backend/src/main/scala/docspell/backend/ops/OItem.scala +++ b/modules/backend/src/main/scala/docspell/backend/ops/OItem.scala @@ -26,6 +26,9 @@ trait OItem[F[_]] { /** Apply all tags to the given item. Tags must exist, but can be IDs or names. */ def linkTags(item: Ident, tags: List[String], collective: Ident): F[UpdateResult] + /** Toggles tags of the given item. Tags must exist, but can be IDs or names. */ + def toggleTags(item: Ident, tags: List[String], collective: Ident): F[UpdateResult] + def setDirection(item: Ident, direction: Direction, collective: Ident): F[AddResult] def setFolder(item: Ident, folder: Option[Ident], collective: Ident): F[AddResult] @@ -115,6 +118,28 @@ object OItem { store.transact(db) } + def toggleTags( + item: Ident, + tags: List[String], + collective: Ident + ): F[UpdateResult] = + tags.distinct match { + case Nil => UpdateResult.success.pure[F] + case kws => + val db = + (for { + _ <- OptionT(RItem.checkByIdAndCollective(item, collective)) + given <- OptionT.liftF(RTag.findAllByNameOrId(kws, collective)) + exist <- OptionT.liftF(RTagItem.findAllIn(item, given.map(_.tagId))) + remove = given.map(_.tagId).toSet.intersect(exist.map(_.tagId).toSet) + toadd = given.map(_.tagId).diff(exist.map(_.tagId)) + _ <- OptionT.liftF(RTagItem.setAllTags(item, toadd)) + _ <- OptionT.liftF(RTagItem.removeAllTags(item, remove.toSeq)) + } yield UpdateResult.success).getOrElse(UpdateResult.notFound) + + store.transact(db) + } + def setTags(item: Ident, tagIds: List[Ident], collective: Ident): F[AddResult] = { val db = for { cid <- RItem.getCollective(item) diff --git a/modules/restapi/src/main/resources/docspell-openapi.yml b/modules/restapi/src/main/resources/docspell-openapi.yml index b14b28d4..7833b28e 100644 --- a/modules/restapi/src/main/resources/docspell-openapi.yml +++ b/modules/restapi/src/main/resources/docspell-openapi.yml @@ -1377,6 +1377,59 @@ paths: application/json: schema: $ref: "#/components/schemas/BasicResult" + + /sec/item/{id}/taglink: + post: + tags: [Item] + summary: Link existing tags to an item. + description: | + Sets all given tags to the item. The tags must exist, + otherwise they are ignored. The tags may be specified as names + or ids. + security: + - authTokenHeader: [] + parameters: + - $ref: "#/components/parameters/id" + requestBody: + content: + application/json: + schema: + $ref: "#/components/schemas/StringList" + responses: + 200: + description: Ok + content: + application/json: + schema: + $ref: "#/components/schemas/BasicResult" + + /sec/item/{id}/tagtoggle: + post: + tags: [Item] + summary: Toggles existing tags to an item. + description: | + Toggles all given tags of the item. The tags must exist, + otherwise they are ignored. The tags may be specified as names + or ids. Tags are either removed or linked from/to the item, + depending on whether the item currently is tagged with the + corresponding tag. + security: + - authTokenHeader: [] + parameters: + - $ref: "#/components/parameters/id" + requestBody: + content: + application/json: + schema: + $ref: "#/components/schemas/StringList" + responses: + 200: + description: Ok + content: + application/json: + schema: + $ref: "#/components/schemas/BasicResult" + /sec/item/{id}/direction: put: tags: [ Item ] @@ -2551,6 +2604,16 @@ paths: components: schemas: + StringList: + description: | + A simple list of strings. + required: + - items + properties: + items: + type: array + items: + type: string FolderList: description: | A list of folders with their member counts. diff --git a/modules/restserver/src/main/scala/docspell/restserver/routes/ItemRoutes.scala b/modules/restserver/src/main/scala/docspell/restserver/routes/ItemRoutes.scala index d94ef314..8f51d79a 100644 --- a/modules/restserver/src/main/scala/docspell/restserver/routes/ItemRoutes.scala +++ b/modules/restserver/src/main/scala/docspell/restserver/routes/ItemRoutes.scala @@ -142,6 +142,20 @@ object ItemRoutes { resp <- Ok(Conversions.basicResult(res, "Tag added.")) } yield resp + case req @ PUT -> Root / Ident(id) / "taglink" => + for { + tags <- req.as[StringList] + res <- backend.item.linkTags(id, tags.items, user.account.collective) + resp <- Ok(Conversions.basicResult(res, "Tags linked")) + } yield resp + + case req @ POST -> Root / Ident(id) / "tagtoggle" => + for { + tags <- req.as[StringList] + res <- backend.item.toggleTags(id, tags.items, user.account.collective) + resp <- Ok(Conversions.basicResult(res, "Tags linked")) + } yield resp + case req @ PUT -> Root / Ident(id) / "direction" => for { dir <- req.as[DirectionValue] diff --git a/modules/store/src/main/scala/docspell/store/records/RTagItem.scala b/modules/store/src/main/scala/docspell/store/records/RTagItem.scala index 35050225..706e64b4 100644 --- a/modules/store/src/main/scala/docspell/store/records/RTagItem.scala +++ b/modules/store/src/main/scala/docspell/store/records/RTagItem.scala @@ -55,6 +55,14 @@ object RTagItem { Vector.empty.pure[ConnectionIO] } + def removeAllTags(item: Ident, tags: Seq[Ident]): ConnectionIO[Int] = + NonEmptyList.fromList(tags.toList) match { + case None => + 0.pure[ConnectionIO] + case Some(nel) => + deleteFrom(table, and(itemId.is(item), tagId.isIn(nel))).update.run + } + def setAllTags(item: Ident, tags: Seq[Ident]): ConnectionIO[Int] = if (tags.isEmpty) 0.pure[ConnectionIO] else From 000d1aff2b99e1fba5e57d6cd37a21ef941f4939 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 15:50:54 +0200 Subject: [PATCH 14/15] Toggle tags via drag-drop from list view --- modules/webapp/src/main/elm/Api.elm | 12 ++++++++++++ modules/webapp/src/main/elm/Page/Home/Update.elm | 11 +---------- modules/webapp/src/main/elm/Util/ItemDragDrop.elm | 9 +++------ 3 files changed, 16 insertions(+), 16 deletions(-) diff --git a/modules/webapp/src/main/elm/Api.elm b/modules/webapp/src/main/elm/Api.elm index 317aa53c..45b2adf0 100644 --- a/modules/webapp/src/main/elm/Api.elm +++ b/modules/webapp/src/main/elm/Api.elm @@ -92,6 +92,7 @@ module Api exposing , startOnceScanMailbox , startReIndex , submitNotifyDueItems + , toggleTags , updateNotifyDueItems , updateScanMailbox , upload @@ -148,6 +149,7 @@ import Api.Model.SentMails exposing (SentMails) import Api.Model.SimpleMail exposing (SimpleMail) import Api.Model.Source exposing (Source) import Api.Model.SourceList exposing (SourceList) +import Api.Model.StringList exposing (StringList) import Api.Model.Tag exposing (Tag) import Api.Model.TagCloud exposing (TagCloud) import Api.Model.TagList exposing (TagList) @@ -1304,6 +1306,16 @@ setTags flags item tags receive = } +toggleTags : Flags -> String -> StringList -> (Result Http.Error BasicResult -> msg) -> Cmd msg +toggleTags flags item tags receive = + Http2.authPost + { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/tagtoggle" + , account = getAccount flags + , body = Http.jsonBody (Api.Model.StringList.encode tags) + , expect = Http.expectJson receive Api.Model.BasicResult.decoder + } + + addTag : Flags -> String -> Tag -> (Result Http.Error BasicResult -> msg) -> Cmd msg addTag flags item tag receive = Http2.authPost diff --git a/modules/webapp/src/main/elm/Page/Home/Update.elm b/modules/webapp/src/main/elm/Page/Home/Update.elm index b424abb0..69ce2d41 100644 --- a/modules/webapp/src/main/elm/Page/Home/Update.elm +++ b/modules/webapp/src/main/elm/Page/Home/Update.elm @@ -48,16 +48,7 @@ update key flags settings msg model = model.searchMenuModel dropCmd = - case nextState.dragDrop.dropped of - Just dropped -> - let - _ = - Debug.log "item/folder" dropped - in - DD.makeUpdateCmd flags (\_ -> DoSearch) nextState.dragDrop.dropped - - Nothing -> - Cmd.none + DD.makeUpdateCmd flags (\_ -> DoSearch) nextState.dragDrop.dropped newModel = { model diff --git a/modules/webapp/src/main/elm/Util/ItemDragDrop.elm b/modules/webapp/src/main/elm/Util/ItemDragDrop.elm index 834d22e0..f9a2d6ba 100644 --- a/modules/webapp/src/main/elm/Util/ItemDragDrop.elm +++ b/modules/webapp/src/main/elm/Util/ItemDragDrop.elm @@ -15,6 +15,7 @@ module Util.ItemDragDrop exposing import Api import Api.Model.BasicResult exposing (BasicResult) import Api.Model.OptionalId exposing (OptionalId) +import Api.Model.StringList exposing (StringList) import Data.Flags exposing (Flags) import Html exposing (Attribute) import Html5.DragDrop as DD @@ -76,12 +77,8 @@ makeUpdateCmd flags receive droppedMaybe = FolderRemove -> Api.setFolder flags dropped.itemId (OptionalId Nothing) receive - Tag _ -> - let - _ = - Debug.log "dropped" dropped - in - Cmd.none + Tag tid -> + Api.toggleTags flags dropped.itemId (StringList [ tid ]) receive Nothing -> Cmd.none From 75c958281e4d4eb9467c2b65e9768dc7a3d70b82 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Sat, 8 Aug 2020 16:38:52 +0200 Subject: [PATCH 15/15] Redesign search/landing page --- .../webapp/src/main/elm/Comp/ItemCardList.elm | 26 ++++++++----------- .../webapp/src/main/elm/Page/Home/View.elm | 6 ++--- modules/webapp/src/main/webjar/docspell.css | 22 ++++++++++++---- 3 files changed, 31 insertions(+), 23 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/ItemCardList.elm b/modules/webapp/src/main/elm/Comp/ItemCardList.elm index 6f11d8a4..d7a018fc 100644 --- a/modules/webapp/src/main/elm/Comp/ItemCardList.elm +++ b/modules/webapp/src/main/elm/Comp/ItemCardList.elm @@ -191,22 +191,18 @@ viewItem settings item = , Util.String.underscoreToSpace item.name |> text ] + , div + [ classList + [ ( "ui right corner label", True ) + , ( newColor, True ) + , ( "invisible", isConfirmed ) + ] + , title "New" + ] + [ i [ class "exclamation icon" ] [] + ] , div [ class "meta" ] - [ div - [ classList - [ ( "ui ribbon label", True ) - , ( newColor, True ) - , ( "invisible", isConfirmed ) - ] - ] - [ i [ class "exclamation icon" ] [] - , text " New" - ] - , span - [ classList - [ ( "right floated", not isConfirmed ) - ] - ] + [ span [] [ Util.Time.formatDate item.date |> text ] ] diff --git a/modules/webapp/src/main/elm/Page/Home/View.elm b/modules/webapp/src/main/elm/Page/Home/View.elm index 25365f45..e7083f57 100644 --- a/modules/webapp/src/main/elm/Page/Home/View.elm +++ b/modules/webapp/src/main/elm/Page/Home/View.elm @@ -19,14 +19,14 @@ view flags settings model = div [ class "home-page ui padded grid" ] [ div [ classList - [ ( "sixteen wide mobile six wide tablet four wide computer column" + [ ( "sixteen wide mobile six wide tablet four wide computer search-menu column" , True ) , ( "invisible hidden", model.menuCollapsed ) ] ] [ div - [ class "ui top attached ablue-comp icon menu" + [ class "ui ablue-comp icon menu" ] [ a [ class "borderless item" @@ -62,7 +62,7 @@ view flags settings model = ] ] ] - , div [ class "ui attached fluid segment" ] + , div [ class "" ] [ Html.map SearchMenuMsg (Comp.SearchMenu.viewDrop model.dragDropData flags diff --git a/modules/webapp/src/main/webjar/docspell.css b/modules/webapp/src/main/webjar/docspell.css index 8ae37e61..98cce2e3 100644 --- a/modules/webapp/src/main/webjar/docspell.css +++ b/modules/webapp/src/main/webjar/docspell.css @@ -41,12 +41,12 @@ } .default-layout .main-content { - margin-top: 45px; + margin-top: 44px; padding-bottom: 2em; } .default-layout .top-menu { - background: aliceblue; + background: aliceblue; box-shadow: 1px 1px 0px 0px black; } @@ -170,6 +170,11 @@ textarea.markdown-editor { background: rgba(0,0,0,0.2); } +.default-layout .search-menu { + border-bottom: 2px solid #d8dfe5; + border-right: 2px solid #d8dfe5; + background-color: aliceblue; +} .ui.dimmer.keep-small { justify-content: start; @@ -198,14 +203,21 @@ label span.muted { } .ui.ablue-comp.menu, .ui.menu .ablue-comp.item { - background-color: #fff7f0; + background-color: rgba(255, 247, 240, 1); } .ui.ablue-comp.header { - background-color: #fff7f0; + background-color: rgba(255, 247, 240, 1); } .ui.ablue-shade.menu, .ui.menu .ablue-shade.item { - background-color: #d8dfe5; + background-color: rgba(216, 223, 229, 1); +} + +.ablue-bg { + background-color: aliceblue; +} +.ablue-shade-bg { + background-color: rgba(216, 223, 229, 1); } .ui.selectable.pointer.table tr {