Merge pull request #217 from eikek/tag-component

Tag component

modules/backend/src/main/scala/docspell/backend/ops/OCollective.scala

@@ -27,6 +27,8 @@ trait OCollective[F[_]] {
 
   def insights(collective: Ident): F[InsightData]
 
+  def tagCloud(collective: Ident): F[List[TagCount]]
+
   def changePassword(
       accountId: AccountId,
       current: Password,
@@ -43,6 +45,9 @@ trait OCollective[F[_]] {
 
 object OCollective {
 
+  type TagCount = QCollective.TagCount
+  val TagCount = QCollective.TagCount
+
   type InsightData = QCollective.InsightData
   val insightData = QCollective.InsightData
 
@@ -113,6 +118,9 @@ object OCollective {
       def insights(collective: Ident): F[InsightData] =
         store.transact(QCollective.getInsights(collective))
 
+      def tagCloud(collective: Ident): F[List[TagCount]] =
+        store.transact(QCollective.tagCloud(collective))
+
       def changePassword(
           accountId: AccountId,
           current: Password,

modules/backend/src/main/scala/docspell/backend/ops/OItem.scala

@@ -26,6 +26,9 @@ trait OItem[F[_]] {
   /** Apply all tags to the given item. Tags must exist, but can be IDs or names. */
   def linkTags(item: Ident, tags: List[String], collective: Ident): F[UpdateResult]
 
+  /** Toggles tags of the given item. Tags must exist, but can be IDs or names. */
+  def toggleTags(item: Ident, tags: List[String], collective: Ident): F[UpdateResult]
+
   def setDirection(item: Ident, direction: Direction, collective: Ident): F[AddResult]
 
   def setFolder(item: Ident, folder: Option[Ident], collective: Ident): F[AddResult]
@@ -115,6 +118,28 @@ object OItem {
               store.transact(db)
           }
 
+        def toggleTags(
+            item: Ident,
+            tags: List[String],
+            collective: Ident
+        ): F[UpdateResult] =
+          tags.distinct match {
+            case Nil => UpdateResult.success.pure[F]
+            case kws =>
+              val db =
+                (for {
+                  _     <- OptionT(RItem.checkByIdAndCollective(item, collective))
+                  given <- OptionT.liftF(RTag.findAllByNameOrId(kws, collective))
+                  exist <- OptionT.liftF(RTagItem.findAllIn(item, given.map(_.tagId)))
+                  remove = given.map(_.tagId).toSet.intersect(exist.map(_.tagId).toSet)
+                  toadd  = given.map(_.tagId).diff(exist.map(_.tagId))
+                  _ <- OptionT.liftF(RTagItem.setAllTags(item, toadd))
+                  _ <- OptionT.liftF(RTagItem.removeAllTags(item, remove.toSeq))
+                } yield UpdateResult.success).getOrElse(UpdateResult.notFound)
+
+              store.transact(db)
+          }
+
         def setTags(item: Ident, tagIds: List[Ident], collective: Ident): F[AddResult] = {
           val db = for {
             cid <- RItem.getCollective(item)

modules/restapi/src/main/resources/docspell-openapi.yml

@@ -460,6 +460,7 @@ paths:
       responses:
         200:
           description: Ok
+
   /sec/tag:
     get:
       tags: [ Tags ]
@@ -1011,6 +1012,22 @@ paths:
             application/json:
               schema:
                 $ref: "#/components/schemas/ItemInsights"
+  /sec/collective/cloud:
+    get:
+      tags: [ Collective ]
+      summary: Summary of used tags.
+      description: |
+        Returns all tags and how often each has been applied.
+      security:
+        - authTokenHeader: []
+      responses:
+        200:
+          description: Ok
+          content:
+            application/json:
+              schema:
+                $ref: "#/components/schemas/TagCloud"
+
   /sec/collective/contacts:
     get:
       tags: [ Collective ]
@@ -1360,6 +1377,59 @@ paths:
             application/json:
               schema:
                 $ref: "#/components/schemas/BasicResult"
+
+  /sec/item/{id}/taglink:
+    post:
+      tags: [Item]
+      summary: Link existing tags to an item.
+      description: |
+        Sets all given tags to the item. The tags must exist,
+        otherwise they are ignored. The tags may be specified as names
+        or ids.
+      security:
+        - authTokenHeader: []
+      parameters:
+        - $ref: "#/components/parameters/id"
+      requestBody:
+        content:
+          application/json:
+            schema:
+              $ref: "#/components/schemas/StringList"
+      responses:
+        200:
+          description: Ok
+          content:
+            application/json:
+              schema:
+                $ref: "#/components/schemas/BasicResult"
+
+  /sec/item/{id}/tagtoggle:
+    post:
+      tags: [Item]
+      summary: Toggles existing tags to an item.
+      description: |
+        Toggles all given tags of the item. The tags must exist,
+        otherwise they are ignored. The tags may be specified as names
+        or ids. Tags are either removed or linked from/to the item,
+        depending on whether the item currently is tagged with the
+        corresponding tag.
+      security:
+        - authTokenHeader: []
+      parameters:
+        - $ref: "#/components/parameters/id"
+      requestBody:
+        content:
+          application/json:
+            schema:
+              $ref: "#/components/schemas/StringList"
+      responses:
+        200:
+          description: Ok
+          content:
+            application/json:
+              schema:
+                $ref: "#/components/schemas/BasicResult"
+
   /sec/item/{id}/direction:
     put:
       tags: [ Item ]
@@ -2534,6 +2604,16 @@ paths:
 
 components:
   schemas:
+    StringList:
+      description: |
+        A simple list of strings.
+      required:
+        - items
+      properties:
+        items:
+          type: array
+          items:
+            type: string
     FolderList:
       description: |
         A list of folders with their member counts.
@@ -3050,16 +3130,16 @@ components:
         items:
           type: array
           items:
-            $ref: "#/components/schemas/NameCount"
+            $ref: "#/components/schemas/TagCount"
-    NameCount:
+    TagCount:
       description: |
         Generic structure for counting something.
       required:
-        - name
+        - tag
         - count
       properties:
-        name:
+        tag:
-          type: string
+          $ref: "#/components/schemas/Tag"
         count:
           type: integer
           format: int32

modules/restserver/src/main/scala/docspell/restserver/conv/Conversions.scala

@@ -31,9 +31,12 @@ trait Conversions {
       d.incoming,
       d.outgoing,
       d.bytes,
-      TagCloud(d.tags.toList.map(p => NameCount(p._1, p._2)))
+      mkTagCloud(d.tags)
     )
 
+  def mkTagCloud(tags: List[OCollective.TagCount]) =
+    TagCloud(tags.map(tc => TagCount(mkTag(tc.tag), tc.count)))
+
   // attachment meta
   def mkAttachmentMeta(rm: RAttachmentMeta): AttachmentMeta =
     AttachmentMeta(

modules/restserver/src/main/scala/docspell/restserver/routes/CollectiveRoutes.scala

@@ -28,6 +28,12 @@ object CollectiveRoutes {
           resp <- Ok(Conversions.mkItemInsights(ins))
         } yield resp
 
+      case GET -> Root / "cloud" =>
+        for {
+          cloud <- backend.collective.tagCloud(user.account.collective)
+          resp  <- Ok(Conversions.mkTagCloud(cloud))
+        } yield resp
+
       case req @ POST -> Root / "settings" =>
         for {
           settings <- req.as[CollectiveSettings]

modules/restserver/src/main/scala/docspell/restserver/routes/ItemRoutes.scala

@@ -142,6 +142,20 @@ object ItemRoutes {
           resp <- Ok(Conversions.basicResult(res, "Tag added."))
         } yield resp
 
+      case req @ PUT -> Root / Ident(id) / "taglink" =>
+        for {
+          tags <- req.as[StringList]
+          res  <- backend.item.linkTags(id, tags.items, user.account.collective)
+          resp <- Ok(Conversions.basicResult(res, "Tags linked"))
+        } yield resp
+
+      case req @ POST -> Root / Ident(id) / "tagtoggle" =>
+        for {
+          tags <- req.as[StringList]
+          res  <- backend.item.toggleTags(id, tags.items, user.account.collective)
+          resp <- Ok(Conversions.basicResult(res, "Tags linked"))
+        } yield resp
+
       case req @ PUT -> Root / Ident(id) / "direction" =>
         for {
           dir  <- req.as[DirectionValue]

modules/store/src/main/scala/docspell/store/queries/QCollective.scala

@@ -11,18 +11,17 @@ import doobie._
 import doobie.implicits._
 
 object QCollective {
+  case class TagCount(tag: RTag, count: Int)
 
   case class InsightData(
       incoming: Int,
       outgoing: Int,
       bytes: Long,
-      tags: Map[String, Int]
+      tags: List[TagCount]
   )
 
   def getInsights(coll: Ident): ConnectionIO[InsightData] = {
     val IC = RItem.Columns
-    val TC = RTag.Columns
-    val RC = RTagItem.Columns
     val q0 = selectCount(
       IC.id,
       RItem.table,
@@ -51,23 +50,33 @@ object QCollective {
          inner join filemeta m on m.id = a.file_id where a.id in (select aid from attachs)
       ) as t""".query[Option[Long]].unique
 
+    for {
+      n0 <- q0
+      n1 <- q1
+      n2 <- fileSize
+      n3 <- tagCloud(coll)
+    } yield InsightData(n0, n1, n2.getOrElse(0L), n3)
+  }
+
+  def tagCloud(coll: Ident): ConnectionIO[List[TagCount]] = {
+    val TC = RTag.Columns
+    val RC = RTagItem.Columns
+
     val q3 = fr"SELECT" ++ commas(
-      TC.name.prefix("t").f,
+      TC.all.map(_.prefix("t").f) ++ Seq(fr"count(" ++ RC.itemId.prefix("r").f ++ fr")")
-      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 {
+    q3.query[TagCount].to[List]
-      n0 <- q0
-      n1 <- q1
-      n2 <- fileSize
-      n3 <- q3.query[(String, Int)].to[Vector]
-    } yield InsightData(n0, n1, n2.getOrElse(0L), Map.from(n3))
   }
 
   def getContacts(

modules/store/src/main/scala/docspell/store/records/RTagItem.scala

@@ -55,6 +55,14 @@ object RTagItem {
         Vector.empty.pure[ConnectionIO]
     }
 
+  def removeAllTags(item: Ident, tags: Seq[Ident]): ConnectionIO[Int] =
+    NonEmptyList.fromList(tags.toList) match {
+      case None =>
+        0.pure[ConnectionIO]
+      case Some(nel) =>
+        deleteFrom(table, and(itemId.is(item), tagId.isIn(nel))).update.run
+    }
+
   def setAllTags(item: Ident, tags: Seq[Ident]): ConnectionIO[Int] =
     if (tags.isEmpty) 0.pure[ConnectionIO]
     else

modules/webapp/src/main/elm/Api.elm

@@ -51,6 +51,7 @@ module Api exposing
     , getScanMailbox
     , getSentMails
     , getSources
+    , getTagCloud
     , getTags
     , getUsers
     , itemDetail
@@ -91,6 +92,7 @@ module Api exposing
     , startOnceScanMailbox
     , startReIndex
     , submitNotifyDueItems
+    , toggleTags
     , updateNotifyDueItems
     , updateScanMailbox
     , upload
@@ -147,7 +149,9 @@ import Api.Model.SentMails exposing (SentMails)
 import Api.Model.SimpleMail exposing (SimpleMail)
 import Api.Model.Source exposing (Source)
 import Api.Model.SourceList exposing (SourceList)
+import Api.Model.StringList exposing (StringList)
 import Api.Model.Tag exposing (Tag)
+import Api.Model.TagCloud exposing (TagCloud)
 import Api.Model.TagList exposing (TagList)
 import Api.Model.User exposing (User)
 import Api.Model.UserList exposing (UserList)
@@ -689,6 +693,10 @@ uploadSingle flags sourceId meta track files receive =
         }
 
 
+
+--- Registration
+
+
 register : Flags -> Registration -> (Result Http.Error BasicResult -> msg) -> Cmd msg
 register flags reg receive =
     Http.post
@@ -707,6 +715,10 @@ newInvite flags req receive =
         }
 
 
+
+--- Login
+
+
 login : Flags -> UserPass -> (Result Http.Error AuthResult -> msg) -> Cmd msg
 login flags up receive =
     Http.post
@@ -736,14 +748,6 @@ loginSession flags receive =
         }
 
 
-versionInfo : Flags -> (Result Http.Error VersionInfo -> msg) -> Cmd msg
-versionInfo flags receive =
-    Http.get
-        { url = flags.config.baseUrl ++ "/api/info/version"
-        , expect = Http.expectJson receive Api.Model.VersionInfo.decoder
-        }
-
-
 refreshSession : Flags -> (Result Http.Error AuthResult -> msg) -> Cmd msg
 refreshSession flags receive =
     case flags.account of
@@ -775,6 +779,31 @@ refreshSessionTask flags =
         }
 
 
+
+--- Version
+
+
+versionInfo : Flags -> (Result Http.Error VersionInfo -> msg) -> Cmd msg
+versionInfo flags receive =
+    Http.get
+        { url = flags.config.baseUrl ++ "/api/info/version"
+        , expect = Http.expectJson receive Api.Model.VersionInfo.decoder
+        }
+
+
+
+--- Collective
+
+
+getTagCloud : Flags -> (Result Http.Error TagCloud -> msg) -> Cmd msg
+getTagCloud flags receive =
+    Http2.authGet
+        { url = flags.config.baseUrl ++ "/api/v1/sec/collective/cloud"
+        , account = getAccount flags
+        , expect = Http.expectJson receive Api.Model.TagCloud.decoder
+        }
+
+
 getInsights : Flags -> (Result Http.Error ItemInsights -> msg) -> Cmd msg
 getInsights flags receive =
     Http2.authGet
@@ -812,6 +841,10 @@ setCollectiveSettings flags settings receive =
         }
 
 
+
+--- Contacts
+
+
 getContacts :
     Flags
     -> Maybe ContactType
@@ -1273,6 +1306,16 @@ setTags flags item tags receive =
         }
 
 
+toggleTags : Flags -> String -> StringList -> (Result Http.Error BasicResult -> msg) -> Cmd msg
+toggleTags flags item tags receive =
+    Http2.authPost
+        { url = flags.config.baseUrl ++ "/api/v1/sec/item/" ++ item ++ "/tagtoggle"
+        , account = getAccount flags
+        , body = Http.jsonBody (Api.Model.StringList.encode tags)
+        , expect = Http.expectJson receive Api.Model.BasicResult.decoder
+        }
+
+
 addTag : Flags -> String -> Tag -> (Result Http.Error BasicResult -> msg) -> Cmd msg
 addTag flags item tag receive =
     Http2.authPost

modules/webapp/src/main/elm/Comp/FolderSelect.elm

@@ -0,0 +1,194 @@
+module Comp.FolderSelect exposing
+    ( Model
+    , Msg
+    , init
+    , update
+    , updateDrop
+    , view
+    , viewDrop
+    )
+
+import Api.Model.FolderItem exposing (FolderItem)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+import Util.ExpandCollapse
+import Util.ItemDragDrop as DD
+import Util.List
+
+
+type alias Model =
+    { all : List FolderItem
+    , selected : Maybe String
+    , expanded : Bool
+    }
+
+
+init : List FolderItem -> Model
+init all =
+    { all = List.sortBy .name all
+    , selected = Nothing
+    , expanded = False
+    }
+
+
+
+--- Update
+
+
+type Msg
+    = Toggle FolderItem
+    | ToggleExpand
+    | FolderDDMsg DD.Msg
+
+
+update : Msg -> Model -> ( Model, Maybe FolderItem )
+update msg model =
+    let
+        ( m, f, _ ) =
+            updateDrop DD.init msg model
+    in
+    ( m, f )
+
+
+updateDrop :
+    DD.Model
+    -> Msg
+    -> Model
+    -> ( Model, Maybe FolderItem, DD.DragDropData )
+updateDrop dropModel msg model =
+    case msg of
+        Toggle item ->
+            let
+                selection =
+                    if model.selected == Just item.id then
+                        Nothing
+
+                    else
+                        Just item.id
+
+                model_ =
+                    { model | selected = selection }
+            in
+            ( model_, selectedFolder model_, DD.DragDropData dropModel Nothing )
+
+        ToggleExpand ->
+            ( { model | expanded = not model.expanded }
+            , selectedFolder model
+            , DD.DragDropData dropModel Nothing
+            )
+
+        FolderDDMsg lm ->
+            let
+                ddd =
+                    DD.update lm dropModel
+            in
+            ( model, selectedFolder model, ddd )
+
+
+selectedFolder : Model -> Maybe FolderItem
+selectedFolder model =
+    let
+        isSelected f =
+            Just f.id == model.selected
+    in
+    Util.List.find isSelected model.all
+
+
+
+--- View
+
+
+view : Int -> Model -> Html Msg
+view =
+    viewDrop DD.init
+
+
+viewDrop : DD.Model -> Int -> Model -> Html Msg
+viewDrop dropModel constr model =
+    let
+        highlightDrop =
+            DD.getDropId dropModel == Just DD.FolderRemove
+    in
+    div [ class "ui list" ]
+        [ div [ class "item" ]
+            [ i [ class "folder open icon" ] []
+            , div [ class "content" ]
+                [ div
+                    (classList
+                        [ ( "header", True )
+                        , ( "current-drop-target", highlightDrop )
+                        ]
+                        :: DD.droppable FolderDDMsg DD.FolderRemove
+                    )
+                    [ text "Folders"
+                    ]
+                , div [ class "ui relaxed list" ]
+                    (renderItems dropModel constr model)
+                ]
+            ]
+        ]
+
+
+renderItems : DD.Model -> Int -> Model -> List (Html Msg)
+renderItems dropModel constr model =
+    if constr <= 0 then
+        List.map (viewItem dropModel model) model.all
+
+    else if model.expanded then
+        List.map (viewItem dropModel model) model.all ++ collapseToggle constr model
+
+    else
+        List.map (viewItem dropModel model) (List.take constr model.all) ++ expandToggle constr model
+
+
+expandToggle : Int -> Model -> List (Html Msg)
+expandToggle max model =
+    Util.ExpandCollapse.expandToggle
+        max
+        (List.length model.all)
+        ToggleExpand
+
+
+collapseToggle : Int -> Model -> List (Html Msg)
+collapseToggle max model =
+    Util.ExpandCollapse.collapseToggle
+        max
+        (List.length model.all)
+        ToggleExpand
+
+
+viewItem : DD.Model -> Model -> FolderItem -> Html Msg
+viewItem dropModel model item =
+    let
+        selected =
+            Just item.id == model.selected
+
+        icon =
+            if selected then
+                "folder outline open icon"
+
+            else
+                "folder outline icon"
+
+        highlightDrop =
+            DD.getDropId dropModel == Just (DD.Folder item.id)
+    in
+    a
+        ([ classList
+            [ ( "item", True )
+            , ( "active", selected )
+            , ( "current-drop-target", highlightDrop )
+            ]
+         , href "#"
+         , onClick (Toggle item)
+         ]
+            ++ DD.droppable FolderDDMsg (DD.Folder item.id)
+        )
+        [ i [ class icon ] []
+        , div [ class "content" ]
+            [ div [ class "header" ]
+                [ text item.name
+                ]
+            ]
+        ]

modules/webapp/src/main/elm/Comp/ItemCardList.elm

@@ -5,6 +5,7 @@ module Comp.ItemCardList exposing
     , nextItem
     , prevItem
     , update
+    , updateDrag
     , view
     )
 
@@ -21,6 +22,7 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (onClick)
 import Markdown
+import Util.ItemDragDrop as DD
 import Util.List
 import Util.String
 import Util.Time
@@ -35,6 +37,7 @@ type Msg
     = SetResults ItemLightList
     | AddResults ItemLightList
     | SelectItem ItemLight
+    | ItemDDMsg DD.Msg
 
 
 init : Model
@@ -60,28 +63,57 @@ prevItem model id =
 
 
 update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe ItemLight )
-update _ msg model =
+update flags msg model =
+    let
+        res =
+            updateDrag DD.init flags msg model
+    in
+    ( res.model, res.cmd, res.selected )
+
+
+type alias UpdateResult =
+    { model : Model
+    , cmd : Cmd Msg
+    , selected : Maybe ItemLight
+    , dragModel : DD.Model
+    }
+
+
+updateDrag :
+    DD.Model
+    -> Flags
+    -> Msg
+    -> Model
+    -> UpdateResult
+updateDrag dm _ msg model =
     case msg of
         SetResults list ->
             let
                 newModel =
                     { model | results = list }
             in
-            ( newModel, Cmd.none, Nothing )
+            UpdateResult newModel Cmd.none Nothing dm
 
         AddResults list ->
             if list.groups == [] then
-                ( model, Cmd.none, Nothing )
+                UpdateResult model Cmd.none Nothing dm
 
             else
                 let
                     newModel =
                         { model | results = Data.Items.concat model.results list }
                 in
-                ( newModel, Cmd.none, Nothing )
+                UpdateResult newModel Cmd.none Nothing dm
 
         SelectItem item ->
-            ( model, Cmd.none, Just item )
+            UpdateResult model Cmd.none (Just item) dm
+
+        ItemDDMsg lm ->
+            let
+                ddd =
+                    DD.update lm dm
+            in
+            UpdateResult model Cmd.none Nothing ddd.model
 
 
 
@@ -139,14 +171,16 @@ viewItem settings item =
             "blue"
     in
     a
-        [ classList
+        ([ classList
             [ ( "ui fluid card", True )
             , ( newColor, not isConfirmed )
             ]
-        , id item.id
+         , id item.id
-        , href "#"
+         , href "#"
-        , onClick (SelectItem item)
+         , 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
+                [ span []
-                    [ classList
-                        [ ( "ui ribbon label", True )
-                        , ( newColor, True )
-                        , ( "invisible", isConfirmed )
-                        ]
-                    ]
-                    [ i [ class "exclamation icon" ] []
-                    , text " New"
-                    ]
-                , span
-                    [ classList
-                        [ ( "right floated", not isConfirmed )
-                        ]
-                    ]
                     [ Util.Time.formatDate item.date |> text
                     ]
                 ]

modules/webapp/src/main/elm/Comp/TagSelect.elm

@@ -0,0 +1,451 @@
+module Comp.TagSelect exposing
+    ( Category
+    , Model
+    , Msg
+    , Selection
+    , emptySelection
+    , init
+    , update
+    , updateDrop
+    , view
+    , viewCats
+    , viewDrop
+    , viewTags
+    , viewTagsDrop
+    )
+
+import Api.Model.TagCount exposing (TagCount)
+import Data.Icons as I
+import Data.UiSettings exposing (UiSettings)
+import Dict exposing (Dict)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+import Util.ExpandCollapse
+import Util.ItemDragDrop as DD
+
+
+type alias Model =
+    { all : List TagCount
+    , categories : List Category
+    , selectedTags : Dict String Bool
+    , selectedCats : Dict String Bool
+    , expandedTags : Bool
+    , expandedCats : Bool
+    }
+
+
+type alias Category =
+    { name : String
+    , count : Int
+    }
+
+
+init : List TagCount -> Model
+init tags =
+    { all = tags
+    , categories = sumCategories tags
+    , selectedTags = Dict.empty
+    , selectedCats = Dict.empty
+    , expandedTags = False
+    , expandedCats = False
+    }
+
+
+sumCategories : List TagCount -> List Category
+sumCategories tags =
+    let
+        filterCat tc =
+            Maybe.map (\cat -> Category cat tc.count) tc.tag.category
+
+        withCats =
+            List.filterMap filterCat tags
+
+        sum cat mc =
+            Maybe.map ((+) cat.count) mc
+                |> Maybe.withDefault cat.count
+                |> Just
+
+        sumCounts cat dict =
+            Dict.update cat.name (sum cat) dict
+
+        cats =
+            List.foldl sumCounts Dict.empty withCats
+    in
+    Dict.toList cats
+        |> List.map (\( n, c ) -> Category n c)
+
+
+
+--- Update
+
+
+type Msg
+    = ToggleTag String
+    | ToggleCat String
+    | ToggleExpandTags
+    | ToggleExpandCats
+    | TagDDMsg DD.Msg
+
+
+type alias Selection =
+    { includeTags : List TagCount
+    , excludeTags : List TagCount
+    , includeCats : List Category
+    , excludeCats : List Category
+    }
+
+
+emptySelection : Selection
+emptySelection =
+    Selection [] [] [] []
+
+
+update : Msg -> Model -> ( Model, Selection )
+update msg model =
+    let
+        ( m, s, _ ) =
+            updateDrop DD.init msg model
+    in
+    ( m, s )
+
+
+updateDrop : DD.Model -> Msg -> Model -> ( Model, Selection, DD.DragDropData )
+updateDrop ddm msg model =
+    case msg of
+        ToggleTag id ->
+            let
+                next =
+                    updateSelection id model.selectedTags
+
+                model_ =
+                    { model | selectedTags = next }
+            in
+            ( model_, getSelection model_, DD.DragDropData ddm Nothing )
+
+        ToggleCat name ->
+            let
+                next =
+                    updateSelection name model.selectedCats
+
+                model_ =
+                    { model | selectedCats = next }
+            in
+            ( model_, getSelection model_, DD.DragDropData ddm Nothing )
+
+        ToggleExpandTags ->
+            ( { model | expandedTags = not model.expandedTags }
+            , getSelection model
+            , DD.DragDropData ddm Nothing
+            )
+
+        ToggleExpandCats ->
+            ( { model | expandedCats = not model.expandedCats }
+            , getSelection model
+            , DD.DragDropData ddm Nothing
+            )
+
+        TagDDMsg lm ->
+            let
+                ddd =
+                    DD.update lm ddm
+            in
+            ( model, getSelection model, ddd )
+
+
+updateSelection : String -> Dict String Bool -> Dict String Bool
+updateSelection id selected =
+    let
+        current =
+            Dict.get id selected
+    in
+    case current of
+        Nothing ->
+            Dict.insert id True selected
+
+        Just True ->
+            Dict.insert id False selected
+
+        Just False ->
+            Dict.remove id selected
+
+
+getSelection : Model -> Selection
+getSelection model =
+    let
+        ( inclTags, exclTags ) =
+            getSelection1 (\t -> t.tag.id) model.selectedTags model.all
+
+        ( inclCats, exclCats ) =
+            getSelection1 (\c -> c.name) model.selectedCats model.categories
+    in
+    Selection inclTags exclTags inclCats exclCats
+
+
+getSelection1 : (a -> String) -> Dict String Bool -> List a -> ( List a, List a )
+getSelection1 mkId selected items =
+    let
+        selectedOnly t =
+            Dict.member (mkId t) selected
+
+        isIncluded t =
+            Dict.get (mkId t) selected
+                |> Maybe.withDefault False
+    in
+    List.filter selectedOnly items
+        |> List.partition isIncluded
+
+
+
+--- View
+
+
+type SelState
+    = Include
+    | Exclude
+    | Deselect
+
+
+tagState : Model -> String -> SelState
+tagState model id =
+    case Dict.get id model.selectedTags of
+        Just True ->
+            Include
+
+        Just False ->
+            Exclude
+
+        Nothing ->
+            Deselect
+
+
+catState : Model -> String -> SelState
+catState model name =
+    case Dict.get name model.selectedCats of
+        Just True ->
+            Include
+
+        Just False ->
+            Exclude
+
+        Nothing ->
+            Deselect
+
+
+viewTags : UiSettings -> Model -> Html Msg
+viewTags =
+    viewTagsDrop DD.init
+
+
+viewTagsDrop : DD.Model -> UiSettings -> Model -> Html Msg
+viewTagsDrop ddm settings model =
+    div [ class "ui list" ]
+        [ div [ class "item" ]
+            [ I.tagIcon ""
+            , div [ class "content" ]
+                [ div [ class "header" ]
+                    [ text "Tags"
+                    ]
+                , div [ class "ui relaxed list" ]
+                    (renderTagItems ddm settings model)
+                ]
+            ]
+        ]
+
+
+viewCats : UiSettings -> Model -> Html Msg
+viewCats settings model =
+    div [ class "ui list" ]
+        [ div [ class "item" ]
+            [ I.tagsIcon ""
+            , div [ class "content" ]
+                [ div [ class "header" ]
+                    [ text "Categories"
+                    ]
+                , div [ class "ui relaxed list" ]
+                    (renderCatItems settings model)
+                ]
+            ]
+        ]
+
+
+view : UiSettings -> Model -> Html Msg
+view =
+    viewDrop DD.init
+
+
+viewDrop : DD.Model -> UiSettings -> Model -> Html Msg
+viewDrop ddm settings model =
+    div [ class "ui list" ]
+        [ div [ class "item" ]
+            [ I.tagIcon ""
+            , div [ class "content" ]
+                [ div [ class "header" ]
+                    [ text "Tags"
+                    ]
+                , div [ class "ui relaxed list" ]
+                    (renderTagItems ddm settings model)
+                ]
+            ]
+        , div [ class "item" ]
+            [ I.tagsIcon ""
+            , div [ class "content" ]
+                [ div [ class "header" ]
+                    [ text "Categories"
+                    ]
+                , div [ class "ui relaxed list" ]
+                    (renderCatItems settings model)
+                ]
+            ]
+        ]
+
+
+renderTagItems : DD.Model -> UiSettings -> Model -> List (Html Msg)
+renderTagItems ddm settings model =
+    let
+        tags =
+            model.all
+
+        max =
+            settings.searchMenuTagCount
+
+        exp =
+            Util.ExpandCollapse.expandToggle
+                max
+                (List.length tags)
+                ToggleExpandTags
+
+        cps =
+            Util.ExpandCollapse.collapseToggle
+                max
+                (List.length tags)
+                ToggleExpandTags
+    in
+    if max <= 0 then
+        List.map (viewTagItem ddm settings model) model.all
+
+    else if model.expandedTags then
+        List.map (viewTagItem ddm settings model) model.all ++ cps
+
+    else
+        List.map (viewTagItem ddm settings model) (List.take max model.all) ++ exp
+
+
+renderCatItems : UiSettings -> Model -> List (Html Msg)
+renderCatItems settings model =
+    let
+        cats =
+            model.categories
+
+        max =
+            settings.searchMenuTagCatCount
+
+        exp =
+            Util.ExpandCollapse.expandToggle
+                max
+                (List.length cats)
+                ToggleExpandCats
+
+        cps =
+            Util.ExpandCollapse.collapseToggle
+                max
+                (List.length cats)
+                ToggleExpandCats
+    in
+    if max <= 0 then
+        List.map (viewCategoryItem settings model) model.categories
+
+    else if model.expandedCats then
+        List.map (viewCategoryItem settings model) model.categories ++ cps
+
+    else
+        List.map (viewCategoryItem settings model) (List.take max model.categories) ++ exp
+
+
+viewCategoryItem : UiSettings -> Model -> Category -> Html Msg
+viewCategoryItem settings model cat =
+    let
+        state =
+            catState model cat.name
+
+        color =
+            Data.UiSettings.catColorString settings cat.name
+
+        icon =
+            getIcon state color I.tagsIcon
+    in
+    a
+        [ class "item"
+        , href "#"
+        , onClick (ToggleCat cat.name)
+        ]
+        [ icon
+        , div [ class "content" ]
+            [ div
+                [ classList
+                    [ ( "header", state == Include )
+                    , ( "description", state /= Include )
+                    ]
+                ]
+                [ text cat.name
+                , div [ class "ui right floated circular label" ]
+                    [ text (String.fromInt cat.count)
+                    ]
+                ]
+            ]
+        ]
+
+
+viewTagItem : DD.Model -> UiSettings -> Model -> TagCount -> Html Msg
+viewTagItem ddm settings model tag =
+    let
+        state =
+            tagState model tag.tag.id
+
+        color =
+            Data.UiSettings.tagColorString tag.tag settings
+
+        icon =
+            getIcon state color I.tagIcon
+
+        dropActive =
+            DD.getDropId ddm == Just (DD.Tag tag.tag.id)
+    in
+    a
+        ([ classList
+            [ ( "item", True )
+            , ( "current-drop-target", dropActive )
+            ]
+         , href "#"
+         , onClick (ToggleTag tag.tag.id)
+         ]
+            ++ DD.droppable TagDDMsg (DD.Tag tag.tag.id)
+        )
+        [ icon
+        , div [ class "content" ]
+            [ div
+                [ classList
+                    [ ( "header", state == Include )
+                    , ( "description", state /= Include )
+                    ]
+                ]
+                [ text tag.tag.name
+                , div [ class "ui right floated circular label" ]
+                    [ text (String.fromInt tag.count)
+                    ]
+                ]
+            ]
+        ]
+
+
+getIcon : SelState -> String -> (String -> Html msg) -> Html msg
+getIcon state color default =
+    case state of
+        Include ->
+            i [ class ("check icon " ++ color) ] []
+
+        Exclude ->
+            i [ class ("minus icon " ++ color) ] []
+
+        Deselect ->
+            default color

modules/webapp/src/main/elm/Comp/UiSettingsForm.elm

@@ -30,6 +30,12 @@ type alias Model =
     , itemSearchNoteLength : Maybe Int
     , searchNoteLengthModel : Comp.IntField.Model
     , itemDetailNotesPosition : Pos
+    , searchMenuFolderCount : Maybe Int
+    , searchMenuFolderCountModel : Comp.IntField.Model
+    , searchMenuTagCount : Maybe Int
+    , searchMenuTagCountModel : Comp.IntField.Model
+    , searchMenuTagCatCount : Maybe Int
+    , searchMenuTagCatCountModel : Comp.IntField.Model
     }
 
 
@@ -56,6 +62,27 @@ init flags settings =
                 False
                 "Max. Note Length"
       , itemDetailNotesPosition = settings.itemDetailNotesPosition
+      , searchMenuFolderCount = Just settings.searchMenuFolderCount
+      , searchMenuFolderCountModel =
+            Comp.IntField.init
+                (Just 0)
+                (Just 2000)
+                False
+                "Number of folders in search menu"
+      , searchMenuTagCount = Just settings.searchMenuTagCount
+      , searchMenuTagCountModel =
+            Comp.IntField.init
+                (Just 0)
+                (Just 2000)
+                False
+                "Number of tags in search menu"
+      , searchMenuTagCatCount = Just settings.searchMenuTagCatCount
+      , searchMenuTagCatCountModel =
+            Comp.IntField.init
+                (Just 0)
+                (Just 2000)
+                False
+                "Number of categories in search menu"
       }
     , Api.getTags flags "" GetTagsResp
     )
@@ -68,6 +95,9 @@ type Msg
     | TogglePdfPreview
     | NoteLengthMsg Comp.IntField.Msg
     | SetNotesPosition Pos
+    | SearchMenuFolderMsg Comp.IntField.Msg
+    | SearchMenuTagMsg Comp.IntField.Msg
+    | SearchMenuTagCatMsg Comp.IntField.Msg
 
 
 
@@ -109,6 +139,54 @@ update sett msg model =
             in
             ( model_, nextSettings )
 
+        SearchMenuFolderMsg lm ->
+            let
+                ( m, n ) =
+                    Comp.IntField.update lm model.searchMenuFolderCountModel
+
+                nextSettings =
+                    Maybe.map (\len -> { sett | searchMenuFolderCount = len }) n
+
+                model_ =
+                    { model
+                        | searchMenuFolderCountModel = m
+                        , searchMenuFolderCount = n
+                    }
+            in
+            ( model_, nextSettings )
+
+        SearchMenuTagMsg lm ->
+            let
+                ( m, n ) =
+                    Comp.IntField.update lm model.searchMenuTagCountModel
+
+                nextSettings =
+                    Maybe.map (\len -> { sett | searchMenuTagCount = len }) n
+
+                model_ =
+                    { model
+                        | searchMenuTagCountModel = m
+                        , searchMenuTagCount = n
+                    }
+            in
+            ( model_, nextSettings )
+
+        SearchMenuTagCatMsg lm ->
+            let
+                ( m, n ) =
+                    Comp.IntField.update lm model.searchMenuTagCatCountModel
+
+                nextSettings =
+                    Maybe.map (\len -> { sett | searchMenuTagCatCount = len }) n
+
+                model_ =
+                    { model
+                        | searchMenuTagCatCountModel = m
+                        , searchMenuTagCatCount = n
+                    }
+            in
+            ( model_, nextSettings )
+
         SetNotesPosition pos ->
             let
                 model_ =
@@ -204,6 +282,29 @@ view flags _ model =
                 "field"
                 model.searchNoteLengthModel
             )
+        , div [ class "ui dividing header" ]
+            [ text "Search Menu" ]
+        , Html.map SearchMenuTagMsg
+            (Comp.IntField.viewWithInfo
+                "How many tags to display in search menu at once. Others can be expanded. Use 0 to always show all."
+                model.searchMenuTagCount
+                "field"
+                model.searchMenuTagCountModel
+            )
+        , Html.map SearchMenuTagCatMsg
+            (Comp.IntField.viewWithInfo
+                "How many categories to display in search menu at once. Others can be expanded. Use 0 to always show all."
+                model.searchMenuTagCatCount
+                "field"
+                model.searchMenuTagCatCountModel
+            )
+        , Html.map SearchMenuFolderMsg
+            (Comp.IntField.viewWithInfo
+                "How many folders to display in search menu at once. Other folders can be expanded. Use 0 to always show all."
+                model.searchMenuFolderCount
+                "field"
+                model.searchMenuFolderCountModel
+            )
         , div [ class "ui dividing header" ]
             [ text "Item Detail"
             ]

modules/webapp/src/main/elm/Data/UiSettings.elm

@@ -2,6 +2,8 @@ module Data.UiSettings exposing
     ( Pos(..)
     , StoredUiSettings
     , UiSettings
+    , catColor
+    , catColorString
     , defaults
     , merge
     , mergeDefaults
@@ -31,6 +33,9 @@ type alias StoredUiSettings =
     , nativePdfPreview : Bool
     , itemSearchNoteLength : Maybe Int
     , itemDetailNotesPosition : Maybe String
+    , searchMenuFolderCount : Maybe Int
+    , searchMenuTagCount : Maybe Int
+    , searchMenuTagCatCount : Maybe Int
     }
 
 
@@ -47,6 +52,9 @@ type alias UiSettings =
     , nativePdfPreview : Bool
     , itemSearchNoteLength : Int
     , itemDetailNotesPosition : Pos
+    , searchMenuFolderCount : Int
+    , searchMenuTagCount : Int
+    , searchMenuTagCatCount : Int
     }
 
 
@@ -85,6 +93,9 @@ defaults =
     , nativePdfPreview = False
     , itemSearchNoteLength = 0
     , itemDetailNotesPosition = Top
+    , searchMenuFolderCount = 3
+    , searchMenuTagCount = 6
+    , searchMenuTagCatCount = 3
     }
 
 
@@ -106,6 +117,13 @@ merge given fallback =
     , itemDetailNotesPosition =
         choose (Maybe.andThen posFromString given.itemDetailNotesPosition)
             fallback.itemDetailNotesPosition
+    , searchMenuFolderCount =
+        choose given.searchMenuFolderCount
+            fallback.searchMenuFolderCount
+    , searchMenuTagCount =
+        choose given.searchMenuTagCount fallback.searchMenuTagCount
+    , searchMenuTagCatCount =
+        choose given.searchMenuTagCatCount fallback.searchMenuTagCatCount
     }
 
 
@@ -123,16 +141,27 @@ toStoredUiSettings settings =
     , nativePdfPreview = settings.nativePdfPreview
     , itemSearchNoteLength = Just settings.itemSearchNoteLength
     , itemDetailNotesPosition = Just (posToString settings.itemDetailNotesPosition)
+    , searchMenuFolderCount = Just settings.searchMenuFolderCount
+    , searchMenuTagCount = Just settings.searchMenuTagCount
+    , searchMenuTagCatCount = Just settings.searchMenuTagCatCount
     }
 
 
+catColor : UiSettings -> String -> Maybe Color
+catColor settings c =
+    Dict.get c settings.tagCategoryColors
+
+
 tagColor : Tag -> UiSettings -> Maybe Color
 tagColor tag settings =
-    let
+    Maybe.andThen (catColor settings) tag.category
-        readColor c =
+
-            Dict.get c settings.tagCategoryColors
+
-    in
+catColorString : UiSettings -> String -> String
-    Maybe.andThen readColor tag.category
+catColorString settings name =
+    catColor settings name
+        |> Maybe.map Data.Color.toString
+        |> Maybe.withDefault ""
 
 
 tagColorString : Tag -> UiSettings -> String

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

@@ -1,6 +1,6 @@
 module Page.CollectiveSettings.View exposing (view)
 
-import Api.Model.NameCount exposing (NameCount)
+import Api.Model.TagCount exposing (TagCount)
 import Comp.CollectiveSettingsForm
 import Comp.SourceManage
 import Comp.UserManage
@@ -145,14 +145,14 @@ viewInsights model =
     ]
 
 
-makeTagStats : NameCount -> Html Msg
+makeTagStats : TagCount -> Html Msg
 makeTagStats nc =
     div [ class "ui statistic" ]
         [ div [ class "value" ]
             [ String.fromInt nc.count |> text
             ]
         , div [ class "label" ]
-            [ text nc.name
+            [ text nc.tag.name
             ]
         ]
 

modules/webapp/src/main/elm/Page/Home/Data.elm

@@ -23,6 +23,7 @@ import Data.UiSettings exposing (UiSettings)
 import Http
 import Throttle exposing (Throttle)
 import Util.Html exposing (KeyCode(..))
+import Util.ItemDragDrop as DD
 
 
 type alias Model =
@@ -39,6 +40,7 @@ type alias Model =
     , searchType : SearchType
     , searchTypeForm : SearchType
     , contentOnlySearch : Maybe String
+    , dragDropData : DD.DragDropData
     }
 
 
@@ -67,6 +69,8 @@ init flags =
     , searchType = BasicSearch
     , searchTypeForm = defaultSearchType flags
     , contentOnlySearch = Nothing
+    , dragDropData =
+        DD.DragDropData DD.init Nothing
     }
 
 

modules/webapp/src/main/elm/Page/Home/Update.elm

@@ -11,6 +11,7 @@ import Page.Home.Data exposing (..)
 import Throttle
 import Time
 import Util.Html exposing (KeyCode(..))
+import Util.ItemDragDrop as DD
 import Util.Maybe
 import Util.String
 import Util.Update
@@ -39,10 +40,21 @@ update key flags settings msg model =
         SearchMenuMsg m ->
             let
                 nextState =
-                    Comp.SearchMenu.update flags settings m model.searchMenuModel
+                    Comp.SearchMenu.updateDrop
+                        model.dragDropData.model
+                        flags
+                        settings
+                        m
+                        model.searchMenuModel
+
+                dropCmd =
+                    DD.makeUpdateCmd flags (\_ -> DoSearch) nextState.dragDrop.dropped
 
                 newModel =
-                    { model | searchMenuModel = Tuple.first nextState.modelCmd }
+                    { model
+                        | searchMenuModel = nextState.model
+                        , dragDropData = nextState.dragDrop
+                    }
 
                 ( m2, c2, s2 ) =
                     if nextState.stateChange && not model.searchInProgress then
@@ -54,18 +66,22 @@ update key flags settings msg model =
             ( m2
             , Cmd.batch
                 [ c2
-                , Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd)
+                , Cmd.map SearchMenuMsg nextState.cmd
+                , dropCmd
                 ]
             , s2
             )
 
         ItemCardListMsg m ->
             let
-                ( m2, c2, mitem ) =
+                result =
-                    Comp.ItemCardList.update flags m model.itemListModel
+                    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 }
+                ( { model
-                , Cmd.batch [ Cmd.map ItemCardListMsg c2, cmd ]
+                    | itemListModel = result.model
+                    , dragDropData = DD.DragDropData result.dragModel Nothing
+                  }
+                , Cmd.batch [ Cmd.map ItemCardListMsg result.cmd, cmd ]
                 )
 
         ItemSearchResp (Ok list) ->

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

@@ -19,14 +19,14 @@ view flags settings model =
     div [ class "home-page ui padded grid" ]
         [ div
             [ classList
-                [ ( "sixteen wide mobile six wide tablet four wide computer column"
+                [ ( "sixteen wide mobile six wide tablet four wide computer search-menu column"
                   , True
                   )
                 , ( "invisible hidden", model.menuCollapsed )
                 ]
             ]
             [ div
-                [ class "ui top attached ablue-comp icon menu"
+                [ class "ui ablue-comp icon menu"
                 ]
                 [ a
                     [ class "borderless item"
@@ -62,8 +62,13 @@ view flags settings model =
                         ]
                     ]
                 ]
-            , div [ class "ui attached fluid segment" ]
+            , div [ class "" ]
-                [ Html.map SearchMenuMsg (Comp.SearchMenu.view flags settings model.searchMenuModel)
+                [ Html.map SearchMenuMsg
+                    (Comp.SearchMenu.viewDrop model.dragDropData
+                        flags
+                        settings
+                        model.searchMenuModel
+                    )
                 ]
             ]
         , div

modules/webapp/src/main/elm/Util/ExpandCollapse.elm

@@ -0,0 +1,50 @@
+module Util.ExpandCollapse exposing
+    ( collapseToggle
+    , expandToggle
+    )
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+
+
+expandToggle : Int -> Int -> msg -> List (Html msg)
+expandToggle max all m =
+    if max >= all then
+        []
+
+    else
+        [ a
+            [ class "item"
+            , onClick m
+            , href "#"
+            ]
+            [ i [ class "angle down icon" ] []
+            , div [ class "content" ]
+                [ div [ class "description" ]
+                    [ em [] [ text "Show More …" ]
+                    ]
+                ]
+            ]
+        ]
+
+
+collapseToggle : Int -> Int -> msg -> List (Html msg)
+collapseToggle max all m =
+    if max >= all then
+        []
+
+    else
+        [ a
+            [ class "item"
+            , onClick m
+            , href "#"
+            ]
+            [ i [ class "angle up icon" ] []
+            , div [ class "content" ]
+                [ div [ class "description" ]
+                    [ em [] [ text "Show Less …" ]
+                    ]
+                ]
+            ]
+        ]

modules/webapp/src/main/elm/Util/Folder.elm

@@ -1,6 +1,7 @@
 module Util.Folder exposing
     ( isFolderMember
     , mkFolderOption
+    , onlyVisible
     )
 
 import Api.Model.FolderItem exposing (FolderItem)
@@ -51,3 +52,13 @@ isFolderMember allFolders selected =
     in
     Maybe.map .isMember folder
         |> Maybe.withDefault True
+
+
+onlyVisible : Flags -> List FolderItem -> List FolderItem
+onlyVisible flags folders =
+    let
+        isVisible folder =
+            folder.isMember
+                || (Maybe.map .user flags.account == Just folder.owner.name)
+    in
+    List.filter isVisible folders

modules/webapp/src/main/elm/Util/ItemDragDrop.elm

@@ -0,0 +1,99 @@
+module Util.ItemDragDrop exposing
+    ( DragDropData
+    , Dropped
+    , ItemDrop(..)
+    , Model
+    , Msg
+    , draggable
+    , droppable
+    , getDropId
+    , init
+    , makeUpdateCmd
+    , update
+    )
+
+import Api
+import Api.Model.BasicResult exposing (BasicResult)
+import Api.Model.OptionalId exposing (OptionalId)
+import Api.Model.StringList exposing (StringList)
+import Data.Flags exposing (Flags)
+import Html exposing (Attribute)
+import Html5.DragDrop as DD
+import Http
+
+
+type ItemDrop
+    = Tag String
+    | Folder String
+    | FolderRemove
+
+
+type alias Model =
+    DD.Model String ItemDrop
+
+
+type alias Msg =
+    DD.Msg String ItemDrop
+
+
+type alias Dropped =
+    { itemId : String
+    , target : ItemDrop
+    }
+
+
+type alias DragDropData =
+    { model : Model
+    , dropped : Maybe Dropped
+    }
+
+
+init : Model
+init =
+    DD.init
+
+
+update : Msg -> Model -> DragDropData
+update msg model =
+    let
+        ( m, res ) =
+            DD.update msg model
+    in
+    DragDropData m (Maybe.map (\( id, t, _ ) -> Dropped id t) res)
+
+
+makeUpdateCmd :
+    Flags
+    -> (Result Http.Error BasicResult -> msg)
+    -> Maybe Dropped
+    -> Cmd msg
+makeUpdateCmd flags receive droppedMaybe =
+    case droppedMaybe of
+        Just dropped ->
+            case dropped.target of
+                Folder fid ->
+                    Api.setFolder flags dropped.itemId (OptionalId (Just fid)) receive
+
+                FolderRemove ->
+                    Api.setFolder flags dropped.itemId (OptionalId Nothing) receive
+
+                Tag tid ->
+                    Api.toggleTags flags dropped.itemId (StringList [ tid ]) receive
+
+        Nothing ->
+            Cmd.none
+
+
+droppable : (Msg -> msg) -> ItemDrop -> List (Attribute msg)
+droppable tagger dropId =
+    DD.droppable tagger dropId
+
+
+draggable : (Msg -> msg) -> String -> List (Attribute msg)
+draggable tagger itemId =
+    DD.draggable tagger itemId
+
+
+getDropId : Model -> Maybe ItemDrop
+getDropId model =
+    DD.getDropId model

modules/webapp/src/main/elm/Util/Maybe.elm

@@ -57,13 +57,12 @@ fromString str =
 
 filter : (a -> Bool) -> Maybe a -> Maybe a
 filter predicate ma =
-    case ma of
+    let
-        Just v ->
+        check v =
             if predicate v then
                 Just v
 
             else
                 Nothing
-
+    in
-        Nothing ->
+    Maybe.andThen check ma
-            Nothing

modules/webapp/src/main/webjar/docspell.css

@@ -41,12 +41,12 @@
 }
 
 .default-layout .main-content {
-    margin-top: 45px;
+    margin-top: 44px;
     padding-bottom: 2em;
 }
 
 .default-layout .top-menu {
-    background: aliceblue;
+    background:  aliceblue;
     box-shadow: 1px 1px 0px 0px black;
 }
 
@@ -166,10 +166,15 @@ textarea.markdown-editor {
     background: rgba(240,248,255,0.4);
 }
 
-.default-layout .ui.menu .item.current-drop-target {
+.default-layout .ui.menu .item.current-drop-target, .header.current-drop-target, .item.current-drop-target {
     background: rgba(0,0,0,0.2);
 }
 
+.default-layout .search-menu {
+    border-bottom: 2px solid #d8dfe5;
+    border-right: 2px solid #d8dfe5;
+    background-color: aliceblue;
+}
 
 .ui.dimmer.keep-small {
     justify-content: start;
@@ -198,14 +203,21 @@ label span.muted {
 }
 
 .ui.ablue-comp.menu, .ui.menu .ablue-comp.item {
-    background-color: #fff7f0;
+    background-color: rgba(255, 247, 240, 1);
 }
 .ui.ablue-comp.header {
-    background-color: #fff7f0;
+    background-color: rgba(255, 247, 240, 1);
 }
 
 .ui.ablue-shade.menu, .ui.menu .ablue-shade.item {
-    background-color: #d8dfe5;
+    background-color: rgba(216, 223, 229, 1);
+}
+
+.ablue-bg {
+    background-color: aliceblue;
+}
+.ablue-shade-bg {
+    background-color: rgba(216, 223, 229, 1);
 }
 
 .ui.selectable.pointer.table tr {