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..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, @@ -43,6 +45,9 @@ trait OCollective[F[_]] { object OCollective { + type TagCount = QCollective.TagCount + val TagCount = QCollective.TagCount + type InsightData = QCollective.InsightData val insightData = QCollective.InsightData @@ -113,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/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 2b23aab9..7833b28e 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 ] @@ -1360,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 ] @@ -2534,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. @@ -3050,16 +3130,16 @@ 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/Tag" count: type: integer format: int32 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..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,9 +31,12 @@ trait Conversions { d.incoming, d.outgoing, d.bytes, - TagCloud(d.tags.toList.map(p => NameCount(p._1, p._2))) + mkTagCloud(d.tags) ) + def mkTagCloud(tags: List[OCollective.TagCount]) = + TagCloud(tags.map(tc => TagCount(mkTag(tc.tag), tc.count))) + // attachment meta def mkAttachmentMeta(rm: RAttachmentMeta): AttachmentMeta = 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/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/queries/QCollective.scala b/modules/store/src/main/scala/docspell/store/queries/QCollective.scala index 4eb129d4..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,18 +11,17 @@ import doobie._ import doobie.implicits._ object QCollective { + case class TagCount(tag: RTag, count: Int) case class InsightData( incoming: Int, outgoing: Int, bytes: Long, - tags: Map[String, Int] + tags: List[TagCount] ) 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, @@ -51,23 +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.name.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" ++ 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)) + q3.query[TagCount].to[List] } def getContacts( 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 diff --git a/modules/webapp/src/main/elm/Api.elm b/modules/webapp/src/main/elm/Api.elm index db1b3aae..45b2adf0 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 @@ -91,6 +92,7 @@ module Api exposing , startOnceScanMailbox , startReIndex , submitNotifyDueItems + , toggleTags , updateNotifyDueItems , updateScanMailbox , upload @@ -147,7 +149,9 @@ 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) import Api.Model.User exposing (User) import Api.Model.UserList exposing (UserList) @@ -689,6 +693,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 +715,10 @@ newInvite flags req receive = } + +--- Login + + login : Flags -> UserPass -> (Result Http.Error AuthResult -> msg) -> Cmd msg login flags up receive = Http.post @@ -736,14 +748,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 +779,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 +841,10 @@ setCollectiveSettings flags settings receive = } + +--- Contacts + + getContacts : Flags -> Maybe ContactType @@ -1273,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/Comp/FolderSelect.elm b/modules/webapp/src/main/elm/Comp/FolderSelect.elm new file mode 100644 index 00000000..9ca36a80 --- /dev/null +++ b/modules/webapp/src/main/elm/Comp/FolderSelect.elm @@ -0,0 +1,194 @@ +module Comp.FolderSelect exposing + ( Model + , 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 Util.ExpandCollapse +import Util.ItemDragDrop as DD +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 + | FolderDDMsg DD.Msg + + +update : Msg -> Model -> ( Model, Maybe FolderItem ) +update msg model = + let + ( m, f, _ ) = + updateDrop DD.init msg model + in + ( m, f ) + + +updateDrop : + DD.Model + -> Msg + -> Model + -> ( Model, Maybe FolderItem, DD.DragDropData ) +updateDrop dropModel 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_, DD.DragDropData dropModel Nothing ) + + ToggleExpand -> + ( { model | expanded = not model.expanded } + , selectedFolder model + , DD.DragDropData dropModel Nothing + ) + + FolderDDMsg lm -> + let + ddd = + DD.update lm dropModel + in + ( model, selectedFolder model, ddd ) + + +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 = + viewDrop DD.init + + +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 + (classList + [ ( "header", True ) + , ( "current-drop-target", highlightDrop ) + ] + :: DD.droppable FolderDDMsg DD.FolderRemove + ) + [ text "Folders" + ] + , div [ class "ui relaxed list" ] + (renderItems dropModel constr model) + ] + ] + ] + + +renderItems : DD.Model -> Int -> Model -> List (Html Msg) +renderItems dropModel constr model = + if constr <= 0 then + List.map (viewItem dropModel model) model.all + + else if model.expanded then + List.map (viewItem dropModel model) model.all ++ collapseToggle constr model + + else + List.map (viewItem dropModel model) (List.take constr model.all) ++ expandToggle constr model + + +expandToggle : Int -> Model -> List (Html Msg) +expandToggle max model = + Util.ExpandCollapse.expandToggle + max + (List.length model.all) + ToggleExpand + + +collapseToggle : Int -> Model -> List (Html Msg) +collapseToggle max model = + Util.ExpandCollapse.collapseToggle + max + (List.length model.all) + ToggleExpand + + +viewItem : DD.Model -> Model -> FolderItem -> Html Msg +viewItem dropModel model item = + let + selected = + Just item.id == model.selected + + icon = + if selected then + "folder outline open icon" + + else + "folder outline icon" + + highlightDrop = + DD.getDropId dropModel == Just (DD.Folder item.id) + in + a + ([ classList + [ ( "item", True ) + , ( "active", selected ) + , ( "current-drop-target", highlightDrop ) + ] + , href "#" + , onClick (Toggle item) + ] + ++ DD.droppable FolderDDMsg (DD.Folder item.id) + ) + [ i [ class icon ] [] + , div [ class "content" ] + [ div [ class "header" ] + [ text item.name + ] + ] + ] diff --git a/modules/webapp/src/main/elm/Comp/ItemCardList.elm b/modules/webapp/src/main/elm/Comp/ItemCardList.elm index d818f35c..d7a018fc 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 ) @@ -21,6 +22,7 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onClick) import Markdown +import Util.ItemDragDrop as DD import Util.List import Util.String import Util.Time @@ -35,6 +37,7 @@ type Msg = SetResults ItemLightList | AddResults ItemLightList | SelectItem ItemLight + | ItemDDMsg DD.Msg init : Model @@ -60,28 +63,57 @@ 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 + } + + +updateDrag : + DD.Model + -> 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 + ddd = + DD.update lm dm + in + UpdateResult model Cmd.none Nothing ddd.model @@ -139,14 +171,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" @@ -157,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/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index ad4fbe5f..93d680f6 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -5,20 +5,24 @@ module Comp.SearchMenu exposing , getItemSearch , init , update + , updateDrop , view + , viewDrop ) 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) 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 @@ -28,10 +32,10 @@ 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 -import Util.Tag -import Util.Update @@ -39,16 +43,15 @@ import Util.Update type alias Model = - { tagInclModel : Comp.Dropdown.Model Tag - , tagExclModel : Comp.Dropdown.Model Tag - , tagCatInclModel : Comp.Dropdown.Model String - , tagCatExclModel : Comp.Dropdown.Model String + { tagSelectModel : Comp.TagSelect.Model + , tagSelection : Comp.TagSelect.Selection , directionModel : Comp.Dropdown.Model Direction , orgModel : Comp.Dropdown.Model IdName , 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 @@ -68,10 +71,8 @@ type alias Model = init : Model init = - { tagInclModel = Util.Tag.makeDropdownModel - , tagExclModel = Util.Tag.makeDropdownModel - , tagCatInclModel = Util.Tag.makeCatDropdownModel - , tagCatExclModel = Util.Tag.makeCatDropdownModel + { tagSelectModel = Comp.TagSelect.init [] + , tagSelection = Comp.TagSelect.emptySelection , directionModel = Comp.Dropdown.makeSingleList { makeOption = @@ -110,14 +111,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 @@ -135,36 +130,6 @@ init = } -type Msg - = Init - | TagIncMsg (Comp.Dropdown.Msg Tag) - | TagExcMsg (Comp.Dropdown.Msg Tag) - | 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 TagList) - | 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 - | FolderMsg (Comp.Dropdown.Msg IdName) - | GetFolderResp (Result Http.Error FolderList) - | TagCatIncMsg (Comp.Dropdown.Msg String) - | TagCatExcMsg (Comp.Dropdown.Msg String) - - getDirection : Model -> Maybe Direction getDirection model = let @@ -197,14 +162,17 @@ 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.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 , 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 @@ -217,8 +185,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 } @@ -226,19 +194,48 @@ getItemSearch model = -- Update +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 NextState = - { modelCmd : ( Model, Cmd Msg ) + { model : Model + , cmd : Cmd Msg , stateChange : Bool + , dragDrop : DD.DragDropData } -noChange : ( Model, Cmd Msg ) -> NextState -noChange p = - NextState p False - - update : Flags -> UiSettings -> Msg -> Model -> NextState -update flags settings msg model = +update = + updateDrop DD.init + + +updateDrop : DD.Model -> Flags -> UiSettings -> Msg -> Model -> NextState +updateDrop ddm flags settings msg model = case msg of Init -> let @@ -265,17 +262,19 @@ update flags settings msg model = ] ) in - noChange - ( mdp - , Cmd.batch - [ Api.getTags flags "" GetTagsResp + { model = mdp + , cmd = + Cmd.batch + [ Api.getTagCloud flags GetTagsResp , Api.getOrgLight flags GetOrgResp , Api.getEquipments flags "" GetEquipResp , Api.getPersonsLight flags GetPersonResp , Api.getFolders flags "" False GetFolderResp , cdp ] - ) + , stateChange = False + , dragDrop = DD.DragDropData ddm Nothing + } ResetForm -> let @@ -286,24 +285,26 @@ update flags settings msg model = GetTagsResp (Ok tags) -> let - tagList = - Comp.Dropdown.SetOptions tags.items + selectModel = + List.sortBy .count tags.items + |> List.reverse + |> Comp.TagSelect.init - catList = - Util.Tag.getCategories tags.items - |> Comp.Dropdown.SetOptions + 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 (TagCatExcMsg catList) >> .modelCmd - ] - model + { model = model_ + , cmd = Cmd.none + , stateChange = False + , dragDrop = DD.DragDropData ddm Nothing + } GetTagsResp (Err _) -> - noChange ( model, Cmd.none ) + { model = model + , cmd = Cmd.none + , stateChange = False + , dragDrop = DD.DragDropData ddm Nothing + } GetEquipResp (Ok equips) -> let @@ -313,7 +314,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.DragDropData ddm Nothing + } GetOrgResp (Ok orgs) -> let @@ -323,106 +328,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.DragDropData ddm Nothing + } GetPersonResp (Ok ps) -> let opts = Comp.Dropdown.SetOptions ps.items + + next1 = + updateDrop ddm flags settings (CorrPersonMsg opts) model + + next2 = + updateDrop next1.dragDrop.model 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.DragDropData ddm Nothing + } - TagIncMsg m -> + TagSelectMsg m -> let - ( m2, c2 ) = - Comp.Dropdown.update m model.tagInclModel + ( m_, sel, ddd ) = + Comp.TagSelect.updateDrop ddm m model.tagSelectModel in - NextState - ( { model | tagInclModel = m2 } - , Cmd.map TagIncMsg c2 - ) - (isDropdownChangeMsg m) - - TagExcMsg m -> - let - ( m2, c2 ) = - Comp.Dropdown.update m model.tagExclModel - in - NextState - ( { model | tagExclModel = m2 } - , Cmd.map TagExcMsg c2 - ) - (isDropdownChangeMsg m) + { model = + { model + | tagSelectModel = m_ + , tagSelection = sel + } + , cmd = Cmd.none + , stateChange = sel /= model.tagSelection + , dragDrop = ddd + } 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.DragDropData ddm Nothing + } 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.DragDropData ddm Nothing + } 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.DragDropData ddm Nothing + } 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.DragDropData ddm Nothing + } 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.DragDropData ddm Nothing + } 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.DragDropData ddm Nothing + } FromDateMsg m -> let @@ -437,11 +448,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.DragDropData ddm Nothing + } UntilDateMsg m -> let @@ -456,11 +467,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.DragDropData ddm Nothing + } FromDueDateMsg m -> let @@ -475,11 +486,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.DragDropData ddm Nothing + } UntilDueDateMsg m -> let @@ -494,98 +505,102 @@ 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.DragDropData ddm Nothing + } 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.DragDropData ddm Nothing + } 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.DragDropData ddm Nothing + } 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.DragDropData ddm Nothing + } KeyUpMsg (Just Enter) -> - NextState ( model, Cmd.none ) True + { model = model + , cmd = Cmd.none + , stateChange = True + , dragDrop = DD.DragDropData ddm Nothing + } KeyUpMsg _ -> - NextState ( model, Cmd.none ) False + { model = model + , cmd = Cmd.none + , stateChange = False + , dragDrop = DD.DragDropData ddm Nothing + } ToggleNameHelp -> - NextState ( { model | showNameHelp = not model.showNameHelp }, Cmd.none ) False + { model = { model | showNameHelp = not model.showNameHelp } + , cmd = Cmd.none + , stateChange = False + , dragDrop = DD.DragDropData ddm Nothing + } GetFolderResp (Ok fs) -> let - opts = - List.filter .isMember fs.items - |> List.map (\e -> IdName e.id e.name) - |> Comp.Dropdown.SetOptions + model_ = + { model + | folderList = + Util.Folder.onlyVisible flags fs.items + |> Comp.FolderSelect.init + } in - update flags settings (FolderMsg opts) model + { model = model_ + , cmd = Cmd.none + , stateChange = False + , dragDrop = DD.DragDropData ddm Nothing + } GetFolderResp (Err _) -> - noChange ( model, Cmd.none ) + { model = model + , cmd = Cmd.none + , stateChange = False + , dragDrop = DD.DragDropData ddm Nothing + } - FolderMsg lm -> + FolderSelectMsg lm -> let - ( m2, c2 ) = - Comp.Dropdown.update lm model.folderModel + ( fsm, sel, ddd ) = + Comp.FolderSelect.updateDrop ddm lm model.folderList in - NextState - ( { model | folderModel = m2 } - , Cmd.map FolderMsg c2 - ) - (isDropdownChangeMsg lm) - - 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) + { model = + { model + | folderList = fsm + , selectedFolder = sel + } + , cmd = Cmd.none + , stateChange = model.selectedFolder /= sel + , dragDrop = ddd + } @@ -593,197 +608,190 @@ update flags settings msg model = view : Flags -> UiSettings -> Model -> Html Msg -view flags settings model = +view = + viewDrop (DD.DragDropData DD.init Nothing) + + +viewDrop : DD.DragDropData -> Flags -> UiSettings -> Model -> Html Msg +viewDrop ddd 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.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) + ] + , 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." ] ] - ] - , 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)" ] - , 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) - ] - , 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.searchIcon "") "Content" - , div - [ classList - [ ( "field", True ) - , ( "invisible hidden", not flags.config.fullTextSearchEnabled ) - ] - ] - [ label [] [ text "Content Search" ] - , input - [ type_ "text" - , onInput SetFulltext - , Util.Html.onKeyUpCode KeyUpMsg - , model.fulltextModel |> Maybe.withDefault "" |> value - ] - [] - , span [ class "small-info" ] - [ text "Fulltext search in document contents 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.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 new file mode 100644 index 00000000..26fd1358 --- /dev/null +++ b/modules/webapp/src/main/elm/Comp/TagSelect.elm @@ -0,0 +1,451 @@ +module Comp.TagSelect exposing + ( Category + , Model + , Msg + , Selection + , emptySelection + , init + , update + , updateDrop + , view + , viewCats + , viewDrop + , viewTags + , viewTagsDrop + ) + +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) +import Util.ExpandCollapse +import Util.ItemDragDrop as DD + + +type alias Model = + { all : List TagCount + , 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 + , 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 + = ToggleTag String + | ToggleCat String + | ToggleExpandTags + | ToggleExpandCats + | TagDDMsg DD.Msg + + +type alias Selection = + { includeTags : List TagCount + , excludeTags : List TagCount + , includeCats : List Category + , excludeCats : List Category + } + + +emptySelection : Selection +emptySelection = + Selection [] [] [] [] + + +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 + next = + updateSelection id model.selectedTags + + model_ = + { model | selectedTags = next } + in + ( model_, getSelection model_, DD.DragDropData ddm Nothing ) + + ToggleCat name -> + let + next = + updateSelection name model.selectedCats + + model_ = + { model | selectedCats = next } + in + ( 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 = + 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 (mkId t) selected + + isIncluded t = + Dict.get (mkId t) selected + |> Maybe.withDefault False + in + List.filter selectedOnly items + |> List.partition isIncluded + + + +--- View + + +type SelState + = Include + | Exclude + | Deselect + + +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 + + Just False -> + Exclude + + Nothing -> + Deselect + + +viewTags : UiSettings -> Model -> Html Msg +viewTags = + viewTagsDrop DD.init + + +viewTagsDrop : DD.Model -> UiSettings -> Model -> Html Msg +viewTagsDrop ddm 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 ddm 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) + ] + ] + ] + + +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 "" + , div [ class "content" ] + [ div [ class "header" ] + [ text "Tags" + ] + , div [ class "ui relaxed list" ] + (renderTagItems ddm settings model) + ] + ] + , div [ class "item" ] + [ I.tagsIcon "" + , div [ class "content" ] + [ div [ class "header" ] + [ text "Categories" + ] + , div [ class "ui relaxed list" ] + (renderCatItems settings model) + ] + ] + ] + + +renderTagItems : DD.Model -> UiSettings -> Model -> List (Html Msg) +renderTagItems ddm 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 ddm settings model) model.all + + else if model.expandedTags then + List.map (viewTagItem ddm settings model) model.all ++ cps + + else + List.map (viewTagItem ddm 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 + state = + 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 : DD.Model -> UiSettings -> Model -> TagCount -> Html Msg +viewTagItem ddm settings model tag = + let + state = + tagState model tag.tag.id + + color = + Data.UiSettings.tagColorString tag.tag settings + + icon = + getIcon state color I.tagIcon + + dropActive = + DD.getDropId ddm == Just (DD.Tag tag.tag.id) + in + a + ([ 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 + [ classList + [ ( "header", state == Include ) + , ( "description", state /= Include ) + ] + ] + [ text tag.tag.name + , div [ class "ui right floated circular label" ] + [ text (String.fromInt tag.count) + ] + ] + ] + ] + + +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/Comp/UiSettingsForm.elm b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm index 0970e4c5..1ffe02fe 100644 --- a/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm +++ b/modules/webapp/src/main/elm/Comp/UiSettingsForm.elm @@ -30,6 +30,12 @@ type alias Model = , itemSearchNoteLength : Maybe Int , searchNoteLengthModel : Comp.IntField.Model , itemDetailNotesPosition : Pos + , searchMenuFolderCount : Maybe Int + , searchMenuFolderCountModel : Comp.IntField.Model + , searchMenuTagCount : Maybe Int + , searchMenuTagCountModel : Comp.IntField.Model + , searchMenuTagCatCount : Maybe Int + , searchMenuTagCatCountModel : Comp.IntField.Model } @@ -56,6 +62,27 @@ init flags settings = False "Max. Note Length" , itemDetailNotesPosition = settings.itemDetailNotesPosition + , searchMenuFolderCount = Just settings.searchMenuFolderCount + , searchMenuFolderCountModel = + Comp.IntField.init + (Just 0) + (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 ) @@ -68,6 +95,9 @@ type Msg | TogglePdfPreview | NoteLengthMsg Comp.IntField.Msg | SetNotesPosition Pos + | SearchMenuFolderMsg Comp.IntField.Msg + | SearchMenuTagMsg Comp.IntField.Msg + | SearchMenuTagCatMsg Comp.IntField.Msg @@ -109,6 +139,54 @@ update sett msg model = in ( model_, nextSettings ) + SearchMenuFolderMsg lm -> + let + ( m, n ) = + Comp.IntField.update lm model.searchMenuFolderCountModel + + nextSettings = + Maybe.map (\len -> { sett | searchMenuFolderCount = len }) n + + model_ = + { model + | searchMenuFolderCountModel = m + , searchMenuFolderCount = n + } + 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_ = @@ -204,6 +282,29 @@ view flags _ model = "field" model.searchNoteLengthModel ) + , 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. Use 0 to always show all." + model.searchMenuFolderCount + "field" + 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 be4d05da..80bd47e7 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 @@ -31,6 +33,9 @@ type alias StoredUiSettings = , nativePdfPreview : Bool , itemSearchNoteLength : Maybe Int , itemDetailNotesPosition : Maybe String + , searchMenuFolderCount : Maybe Int + , searchMenuTagCount : Maybe Int + , searchMenuTagCatCount : Maybe Int } @@ -47,6 +52,9 @@ type alias UiSettings = , nativePdfPreview : Bool , itemSearchNoteLength : Int , itemDetailNotesPosition : Pos + , searchMenuFolderCount : Int + , searchMenuTagCount : Int + , searchMenuTagCatCount : Int } @@ -85,6 +93,9 @@ defaults = , nativePdfPreview = False , itemSearchNoteLength = 0 , itemDetailNotesPosition = Top + , searchMenuFolderCount = 3 + , searchMenuTagCount = 6 + , searchMenuTagCatCount = 3 } @@ -106,6 +117,13 @@ merge given fallback = , itemDetailNotesPosition = choose (Maybe.andThen posFromString given.itemDetailNotesPosition) fallback.itemDetailNotesPosition + , searchMenuFolderCount = + choose given.searchMenuFolderCount + fallback.searchMenuFolderCount + , searchMenuTagCount = + choose given.searchMenuTagCount fallback.searchMenuTagCount + , searchMenuTagCatCount = + choose given.searchMenuTagCatCount fallback.searchMenuTagCatCount } @@ -123,16 +141,27 @@ toStoredUiSettings settings = , nativePdfPreview = settings.nativePdfPreview , itemSearchNoteLength = Just settings.itemSearchNoteLength , itemDetailNotesPosition = Just (posToString settings.itemDetailNotesPosition) + , searchMenuFolderCount = Just settings.searchMenuFolderCount + , searchMenuTagCount = Just settings.searchMenuTagCount + , searchMenuTagCatCount = Just settings.searchMenuTagCatCount } +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 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 ] ] diff --git a/modules/webapp/src/main/elm/Page/Home/Data.elm b/modules/webapp/src/main/elm/Page/Home/Data.elm index 7c29924f..b8661b96 100644 --- a/modules/webapp/src/main/elm/Page/Home/Data.elm +++ b/modules/webapp/src/main/elm/Page/Home/Data.elm @@ -23,6 +23,7 @@ import Data.UiSettings exposing (UiSettings) import Http import Throttle exposing (Throttle) import Util.Html exposing (KeyCode(..)) +import Util.ItemDragDrop as DD type alias Model = @@ -39,6 +40,7 @@ type alias Model = , searchType : SearchType , searchTypeForm : SearchType , contentOnlySearch : Maybe String + , dragDropData : DD.DragDropData } @@ -67,6 +69,8 @@ init flags = , searchType = BasicSearch , searchTypeForm = defaultSearchType flags , contentOnlySearch = Nothing + , dragDropData = + 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 6384d1c6..69ce2d41 100644 --- a/modules/webapp/src/main/elm/Page/Home/Update.elm +++ b/modules/webapp/src/main/elm/Page/Home/Update.elm @@ -11,6 +11,7 @@ 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 @@ -39,10 +40,21 @@ update key flags settings msg model = SearchMenuMsg m -> let nextState = - Comp.SearchMenu.update flags settings m model.searchMenuModel + Comp.SearchMenu.updateDrop + model.dragDropData.model + flags + settings + m + model.searchMenuModel + + dropCmd = + DD.makeUpdateCmd flags (\_ -> DoSearch) nextState.dragDrop.dropped 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 +66,22 @@ update key flags settings msg model = ( m2 , Cmd.batch [ c2 - , Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd) + , Cmd.map SearchMenuMsg nextState.cmd + , dropCmd ] , s2 ) ItemCardListMsg m -> let - ( m2, c2, mitem ) = - Comp.ItemCardList.update flags m model.itemListModel + result = + Comp.ItemCardList.updateDrag model.dragDropData.model + flags + m + model.itemListModel cmd = - case mitem of + case result.selected of Just item -> Page.set key (ItemDetailPage item.id) @@ -73,8 +89,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 = DD.DragDropData result.dragModel Nothing + } + , 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..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,8 +62,13 @@ view flags settings model = ] ] ] - , div [ class "ui attached fluid segment" ] - [ Html.map SearchMenuMsg (Comp.SearchMenu.view flags settings model.searchMenuModel) + , div [ class "" ] + [ Html.map SearchMenuMsg + (Comp.SearchMenu.viewDrop model.dragDropData + flags + settings + model.searchMenuModel + ) ] ] , div 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 …" ] + ] + ] + ] + ] 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 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..f9a2d6ba --- /dev/null +++ b/modules/webapp/src/main/elm/Util/ItemDragDrop.elm @@ -0,0 +1,99 @@ +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 Api.Model.StringList exposing (StringList) +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 tid -> + Api.toggleTags flags dropped.itemId (StringList [ tid ]) receive + + 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/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 diff --git a/modules/webapp/src/main/webjar/docspell.css b/modules/webapp/src/main/webjar/docspell.css index e64155a0..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; } @@ -166,10 +166,15 @@ 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, .header.current-drop-target, .item.current-drop-target { 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 {