TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-06-02 21:42:52 +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
]
]
]

80
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,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
]
]

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

File diff suppressed because it is too large Load Diff

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

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

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