TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-06-04 14:15:59 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #217 from eikek/tag-component

Browse Source 
Tag component
This commit is contained in:
mergify[bot] 2020-08-08 14:46:10 +00:00 committed by GitHub
commit 27439530f0
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
24 changed files with 1670 additions and 462 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
modules/backend/src/main/scala/docspell/backend/ops/OCollective.scala
View File

@ -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,

25
modules/backend/src/main/scala/docspell/backend/ops/OItem.scala
View File

@ -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)

90
modules/restapi/src/main/resources/docspell-openapi.yml
View File

@ -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

5
modules/restserver/src/main/scala/docspell/restserver/conv/Conversions.scala
View File

@ -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(

6
modules/restserver/src/main/scala/docspell/restserver/routes/CollectiveRoutes.scala
View File

@ -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]

14
modules/restserver/src/main/scala/docspell/restserver/routes/ItemRoutes.scala
View File

@ -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]

33
modules/store/src/main/scala/docspell/store/queries/QCollective.scala
View File

@ -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(

8
modules/store/src/main/scala/docspell/store/records/RTagItem.scala
View File

@ -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

59
modules/webapp/src/main/elm/Api.elm
View File

@ -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

194
modules/webapp/src/main/elm/Comp/FolderSelect.elm Normal file
View File

@ -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
]
]
]

60
modules/webapp/src/main/elm/Comp/ItemCardList.elm
View File

@ -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,7 +171,7 @@ viewItem settings item =
"blue"
in
a
[ classList
([ classList
[ ( "ui fluid card", True )
, ( newColor, not isConfirmed )
]
@ -147,6 +179,8 @@ viewItem settings item =
, 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 [ class "meta" ]
[ div
, div
[ classList
[ ( "ui ribbon label", True )
[ ( "ui right corner label", True )
, ( newColor, True )
, ( "invisible", isConfirmed )
]
, title "New"
]
[ i [ class "exclamation icon" ] []
, text " New"
]
, span
[ classList
[ ( "right floated", not isConfirmed )
]
]
, div [ class "meta" ]
[ span []
[ Util.Time.formatDate item.date |> text
]
]

616
modules/webapp/src/main/elm/Comp/SearchMenu.elm
View File

@ -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,35 +608,26 @@ 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 segmentClass ]
[ div [ class "inline field" ]
[ div [ class "ui checkbox" ]
[ input
@ -635,80 +641,15 @@ view flags settings model =
]
]
]
, formHeaderHelp nameIcon "Names" ToggleNameHelp
, span
[ classList
[ ( "small-info", True )
, ( "invisible hidden", not model.showNameHelp )
]
, 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)
]
[ 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 "")
, div [ class segmentClass ]
[ formHeader (Icons.correspondentIcon "")
(case getDirection model of
Just Data.Direction.Incoming ->
"Sender"
@ -736,7 +677,71 @@ view flags settings model =
[ label [] [ text "Equipment" ]
, Html.map ConcEquipmentMsg (Comp.Dropdown.view settings model.concEquipmentModel)
]
, formHeader (Icons.dateIcon "") "Date"
]
, 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…"
]
[]
, span [ class "small-info" ]
[ text "Fulltext search in document contents and notes."
]
]
, div [ class "field" ]
[ label []
[ 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."
]
]
]
, div [ class segmentClass ]
[ formHeader (Icons.dateIcon "") "Date"
, div [ class "fields" ]
[ div [ class "field" ]
[ label []
@ -782,8 +787,11 @@ view flags settings model =
)
]
]
, formHeader (Icons.directionIcon "") "Direction"
]
, div [ class segmentClass ]
[ formHeader (Icons.directionIcon "") "Direction"
, div [ class "field" ]
[ Html.map DirectionMsg (Comp.Dropdown.view settings model.directionModel)
]
]
]

451
modules/webapp/src/main/elm/Comp/TagSelect.elm Normal file
View File

@ -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

101
modules/webapp/src/main/elm/Comp/UiSettingsForm.elm
View File

@ -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"
]

39
modules/webapp/src/main/elm/Data/UiSettings.elm
View File

@ -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

6
modules/webapp/src/main/elm/Page/CollectiveSettings/View.elm
View File

@ -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
]
]

4
modules/webapp/src/main/elm/Page/Home/Data.elm
View File

@ -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
}

35
modules/webapp/src/main/elm/Page/Home/Update.elm
View File

@ -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) ->

13
modules/webapp/src/main/elm/Page/Home/View.elm
View File

@ -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

50
modules/webapp/src/main/elm/Util/ExpandCollapse.elm Normal file
View File

@ -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 …" ]
]
]
]
]

11
modules/webapp/src/main/elm/Util/Folder.elm
View File

@ -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

99
modules/webapp/src/main/elm/Util/ItemDragDrop.elm Normal file
View File

@ -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

9
modules/webapp/src/main/elm/Util/Maybe.elm
View File

@ -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

22
modules/webapp/src/main/webjar/docspell.css
View File

@ -41,7 +41,7 @@
}
.default-layout .main-content {
margin-top: 45px;
margin-top: 44px;
padding-bottom: 2em;
}
@ -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 {