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,7 +171,7 @@ viewItem settings item =
             "blue"
     in
     a
-        [ classList
+        ([ classList
             [ ( "ui fluid card", True )
             , ( newColor, not isConfirmed )
             ]
@@ -147,6 +179,8 @@ viewItem settings item =
          , href "#"
          , onClick (SelectItem item)
          ]
+            ++ DD.draggable ItemDDMsg item.id
+        )
         [ div [ class "content" ]
             [ div
                 [ class "header"
@@ -157,22 +191,18 @@ viewItem settings item =
                 , Util.String.underscoreToSpace item.name
                     |> text
                 ]
-            , div [ class "meta" ]
+            , div
-                [ div
                 [ classList
-                        [ ( "ui ribbon label", True )
+                    [ ( "ui right corner label", True )
                     , ( newColor, True )
                     , ( "invisible", isConfirmed )
                     ]
+                , title "New"
                 ]
                 [ i [ class "exclamation icon" ] []
-                    , text " New"
-                    ]
-                , span
-                    [ classList
-                        [ ( "right floated", not isConfirmed )
-                        ]
                 ]
+            , div [ class "meta" ]
+                [ span []
                     [ Util.Time.formatDate item.date |> text
                     ]
                 ]

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

@@ -5,20 +5,24 @@ module Comp.SearchMenu exposing
     , getItemSearch
     , init
     , update
+    , updateDrop
     , view
+    , viewDrop
     )
 
 import Api
 import Api.Model.Equipment exposing (Equipment)
 import Api.Model.EquipmentList exposing (EquipmentList)
+import Api.Model.FolderItem exposing (FolderItem)
 import Api.Model.FolderList exposing (FolderList)
 import Api.Model.IdName exposing (IdName)
 import Api.Model.ItemSearch exposing (ItemSearch)
 import Api.Model.ReferenceList exposing (ReferenceList)
-import Api.Model.Tag exposing (Tag)
+import Api.Model.TagCloud exposing (TagCloud)
-import Api.Model.TagList exposing (TagList)
 import Comp.DatePicker
 import Comp.Dropdown exposing (isDropdownChangeMsg)
+import Comp.FolderSelect
+import Comp.TagSelect
 import Data.Direction exposing (Direction)
 import Data.Flags exposing (Flags)
 import Data.Icons as Icons
@@ -28,10 +32,10 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (onCheck, onClick, onInput)
 import Http
+import Util.Folder
 import Util.Html exposing (KeyCode(..))
+import Util.ItemDragDrop as DD
 import Util.Maybe
-import Util.Tag
-import Util.Update
 
 
 
@@ -39,16 +43,15 @@ import Util.Update
 
 
 type alias Model =
-    { tagInclModel : Comp.Dropdown.Model Tag
+    { tagSelectModel : Comp.TagSelect.Model
-    , tagExclModel : Comp.Dropdown.Model Tag
+    , tagSelection : Comp.TagSelect.Selection
-    , tagCatInclModel : Comp.Dropdown.Model String
-    , tagCatExclModel : Comp.Dropdown.Model String
     , directionModel : Comp.Dropdown.Model Direction
     , orgModel : Comp.Dropdown.Model IdName
     , corrPersonModel : Comp.Dropdown.Model IdName
     , concPersonModel : Comp.Dropdown.Model IdName
     , concEquipmentModel : Comp.Dropdown.Model Equipment
-    , folderModel : Comp.Dropdown.Model IdName
+    , folderList : Comp.FolderSelect.Model
+    , selectedFolder : Maybe FolderItem
     , inboxCheckbox : Bool
     , fromDateModel : DatePicker
     , fromDate : Maybe Int
@@ -68,10 +71,8 @@ type alias Model =
 
 init : Model
 init =
-    { tagInclModel = Util.Tag.makeDropdownModel
+    { tagSelectModel = Comp.TagSelect.init []
-    , tagExclModel = Util.Tag.makeDropdownModel
+    , tagSelection = Comp.TagSelect.emptySelection
-    , tagCatInclModel = Util.Tag.makeCatDropdownModel
-    , tagCatExclModel = Util.Tag.makeCatDropdownModel
     , directionModel =
         Comp.Dropdown.makeSingleList
             { makeOption =
@@ -110,14 +111,8 @@ init =
             , labelColor = \_ -> \_ -> ""
             , placeholder = "Choose an equipment"
             }
-    , folderModel =
+    , folderList = Comp.FolderSelect.init []
-        Comp.Dropdown.makeModel
+    , selectedFolder = Nothing
-            { multiple = False
-            , searchable = \n -> n > 5
-            , makeOption = \e -> { value = e.id, text = e.name, additional = "" }
-            , labelColor = \_ -> \_ -> ""
-            , placeholder = "Only items in folder"
-            }
     , inboxCheckbox = False
     , fromDateModel = Comp.DatePicker.emptyModel
     , fromDate = Nothing
@@ -135,36 +130,6 @@ init =
     }
 
 
-type Msg
-    = Init
-    | TagIncMsg (Comp.Dropdown.Msg Tag)
-    | TagExcMsg (Comp.Dropdown.Msg Tag)
-    | DirectionMsg (Comp.Dropdown.Msg Direction)
-    | OrgMsg (Comp.Dropdown.Msg IdName)
-    | CorrPersonMsg (Comp.Dropdown.Msg IdName)
-    | ConcPersonMsg (Comp.Dropdown.Msg IdName)
-    | ConcEquipmentMsg (Comp.Dropdown.Msg Equipment)
-    | FromDateMsg Comp.DatePicker.Msg
-    | UntilDateMsg Comp.DatePicker.Msg
-    | FromDueDateMsg Comp.DatePicker.Msg
-    | UntilDueDateMsg Comp.DatePicker.Msg
-    | ToggleInbox
-    | GetTagsResp (Result Http.Error TagList)
-    | GetOrgResp (Result Http.Error ReferenceList)
-    | GetEquipResp (Result Http.Error EquipmentList)
-    | GetPersonResp (Result Http.Error ReferenceList)
-    | SetName String
-    | SetAllName String
-    | SetFulltext String
-    | ResetForm
-    | KeyUpMsg (Maybe KeyCode)
-    | ToggleNameHelp
-    | FolderMsg (Comp.Dropdown.Msg IdName)
-    | GetFolderResp (Result Http.Error FolderList)
-    | TagCatIncMsg (Comp.Dropdown.Msg String)
-    | TagCatExcMsg (Comp.Dropdown.Msg String)
-
-
 getDirection : Model -> Maybe Direction
 getDirection model =
     let
@@ -197,14 +162,17 @@ getItemSearch model =
                 "*" ++ s ++ "*"
     in
     { e
-        | tagsInclude = Comp.Dropdown.getSelected model.tagInclModel |> List.map .id
+        | tagsInclude = model.tagSelection.includeTags |> List.map .tag |> List.map .id
-        , tagsExclude = Comp.Dropdown.getSelected model.tagExclModel |> List.map .id
+        , tagsExclude = model.tagSelection.excludeTags |> List.map .tag |> List.map .id
         , corrPerson = Comp.Dropdown.getSelected model.corrPersonModel |> List.map .id |> List.head
         , corrOrg = Comp.Dropdown.getSelected model.orgModel |> List.map .id |> List.head
         , concPerson = Comp.Dropdown.getSelected model.concPersonModel |> List.map .id |> List.head
         , concEquip = Comp.Dropdown.getSelected model.concEquipmentModel |> List.map .id |> List.head
-        , folder = Comp.Dropdown.getSelected model.folderModel |> List.map .id |> List.head
+        , folder = model.selectedFolder |> Maybe.map .id
-        , direction = Comp.Dropdown.getSelected model.directionModel |> List.head |> Maybe.map Data.Direction.toString
+        , direction =
+            Comp.Dropdown.getSelected model.directionModel
+                |> List.head
+                |> Maybe.map Data.Direction.toString
         , inbox = model.inboxCheckbox
         , dateFrom = model.fromDate
         , dateUntil = model.untilDate
@@ -217,8 +185,8 @@ getItemSearch model =
             model.allNameModel
                 |> Maybe.map amendWildcards
         , fullText = model.fulltextModel
-        , tagCategoriesInclude = Comp.Dropdown.getSelected model.tagCatInclModel
+        , tagCategoriesInclude = model.tagSelection.includeCats |> List.map .name
-        , tagCategoriesExclude = Comp.Dropdown.getSelected model.tagCatExclModel
+        , tagCategoriesExclude = model.tagSelection.excludeCats |> List.map .name
     }
 
 
@@ -226,19 +194,48 @@ getItemSearch model =
 -- Update
 
 
+type Msg
+    = Init
+    | TagSelectMsg Comp.TagSelect.Msg
+    | DirectionMsg (Comp.Dropdown.Msg Direction)
+    | OrgMsg (Comp.Dropdown.Msg IdName)
+    | CorrPersonMsg (Comp.Dropdown.Msg IdName)
+    | ConcPersonMsg (Comp.Dropdown.Msg IdName)
+    | ConcEquipmentMsg (Comp.Dropdown.Msg Equipment)
+    | FromDateMsg Comp.DatePicker.Msg
+    | UntilDateMsg Comp.DatePicker.Msg
+    | FromDueDateMsg Comp.DatePicker.Msg
+    | UntilDueDateMsg Comp.DatePicker.Msg
+    | ToggleInbox
+    | GetTagsResp (Result Http.Error TagCloud)
+    | GetOrgResp (Result Http.Error ReferenceList)
+    | GetEquipResp (Result Http.Error EquipmentList)
+    | GetPersonResp (Result Http.Error ReferenceList)
+    | SetName String
+    | SetAllName String
+    | SetFulltext String
+    | ResetForm
+    | KeyUpMsg (Maybe KeyCode)
+    | ToggleNameHelp
+    | FolderSelectMsg Comp.FolderSelect.Msg
+    | GetFolderResp (Result Http.Error FolderList)
+
+
 type alias NextState =
-    { modelCmd : ( Model, Cmd Msg )
+    { model : Model
+    , cmd : Cmd Msg
     , stateChange : Bool
+    , dragDrop : DD.DragDropData
     }
 
 
-noChange : ( Model, Cmd Msg ) -> NextState
-noChange p =
-    NextState p False
-
-
 update : Flags -> UiSettings -> Msg -> Model -> NextState
-update flags settings msg model =
+update =
+    updateDrop DD.init
+
+
+updateDrop : DD.Model -> Flags -> UiSettings -> Msg -> Model -> NextState
+updateDrop ddm flags settings msg model =
     case msg of
         Init ->
             let
@@ -265,17 +262,19 @@ update flags settings msg model =
                             ]
                         )
             in
-            noChange
+            { model = mdp
-                ( mdp
+            , cmd =
-                , Cmd.batch
+                Cmd.batch
-                    [ Api.getTags flags "" GetTagsResp
+                    [ Api.getTagCloud flags GetTagsResp
                     , Api.getOrgLight flags GetOrgResp
                     , Api.getEquipments flags "" GetEquipResp
                     , Api.getPersonsLight flags GetPersonResp
                     , Api.getFolders flags "" False GetFolderResp
                     , cdp
                     ]
-                )
+            , stateChange = False
+            , dragDrop = DD.DragDropData ddm Nothing
+            }
 
         ResetForm ->
             let
@@ -286,24 +285,26 @@ update flags settings msg model =
 
         GetTagsResp (Ok tags) ->
             let
-                tagList =
+                selectModel =
-                    Comp.Dropdown.SetOptions tags.items
+                    List.sortBy .count tags.items
+                        |> List.reverse
+                        |> Comp.TagSelect.init
 
-                catList =
+                model_ =
-                    Util.Tag.getCategories tags.items
+                    { model | tagSelectModel = selectModel }
-                        |> Comp.Dropdown.SetOptions
             in
-            noChange <|
+            { model = model_
-                Util.Update.andThen1
+            , cmd = Cmd.none
-                    [ update flags settings (TagIncMsg tagList) >> .modelCmd
+            , stateChange = False
-                    , update flags settings (TagExcMsg tagList) >> .modelCmd
+            , dragDrop = DD.DragDropData ddm Nothing
-                    , update flags settings (TagCatIncMsg catList) >> .modelCmd
+            }
-                    , update flags settings (TagCatExcMsg catList) >> .modelCmd
-                    ]
-                    model
 
         GetTagsResp (Err _) ->
-            noChange ( model, Cmd.none )
+            { model = model
+            , cmd = Cmd.none
+            , stateChange = False
+            , dragDrop = DD.DragDropData ddm Nothing
+            }
 
         GetEquipResp (Ok equips) ->
             let
@@ -313,7 +314,11 @@ update flags settings msg model =
             update flags settings (ConcEquipmentMsg opts) model
 
         GetEquipResp (Err _) ->
-            noChange ( model, Cmd.none )
+            { model = model
+            , cmd = Cmd.none
+            , stateChange = False
+            , dragDrop = DD.DragDropData ddm Nothing
+            }
 
         GetOrgResp (Ok orgs) ->
             let
@@ -323,106 +328,112 @@ update flags settings msg model =
             update flags settings (OrgMsg opts) model
 
         GetOrgResp (Err _) ->
-            noChange ( model, Cmd.none )
+            { model = model
+            , cmd = Cmd.none
+            , stateChange = False
+            , dragDrop = DD.DragDropData ddm Nothing
+            }
 
         GetPersonResp (Ok ps) ->
             let
                 opts =
                     Comp.Dropdown.SetOptions ps.items
+
+                next1 =
+                    updateDrop ddm flags settings (CorrPersonMsg opts) model
+
+                next2 =
+                    updateDrop next1.dragDrop.model flags settings (ConcPersonMsg opts) next1.model
             in
-            noChange <|
+            next2
-                Util.Update.andThen1
-                    [ update flags settings (CorrPersonMsg opts) >> .modelCmd
-                    , update flags settings (ConcPersonMsg opts) >> .modelCmd
-                    ]
-                    model
 
         GetPersonResp (Err _) ->
-            noChange ( model, Cmd.none )
+            { model = model
+            , cmd = Cmd.none
+            , stateChange = False
+            , dragDrop = DD.DragDropData ddm Nothing
+            }
 
-        TagIncMsg m ->
+        TagSelectMsg m ->
             let
-                ( m2, c2 ) =
+                ( m_, sel, ddd ) =
-                    Comp.Dropdown.update m model.tagInclModel
+                    Comp.TagSelect.updateDrop ddm m model.tagSelectModel
             in
-            NextState
+            { model =
-                ( { model | tagInclModel = m2 }
+                { model
-                , Cmd.map TagIncMsg c2
+                    | tagSelectModel = m_
-                )
+                    , tagSelection = sel
-                (isDropdownChangeMsg m)
+                }
-
+            , cmd = Cmd.none
-        TagExcMsg m ->
+            , stateChange = sel /= model.tagSelection
-            let
+            , dragDrop = ddd
-                ( m2, c2 ) =
+            }
-                    Comp.Dropdown.update m model.tagExclModel
-            in
-            NextState
-                ( { model | tagExclModel = m2 }
-                , Cmd.map TagExcMsg c2
-                )
-                (isDropdownChangeMsg m)
 
         DirectionMsg m ->
             let
                 ( m2, c2 ) =
                     Comp.Dropdown.update m model.directionModel
             in
-            NextState
+            { model = { model | directionModel = m2 }
-                ( { model | directionModel = m2 }
+            , cmd = Cmd.map DirectionMsg c2
-                , Cmd.map DirectionMsg c2
+            , stateChange = isDropdownChangeMsg m
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                (isDropdownChangeMsg m)
+            }
 
         OrgMsg m ->
             let
                 ( m2, c2 ) =
                     Comp.Dropdown.update m model.orgModel
             in
-            NextState
+            { model = { model | orgModel = m2 }
-                ( { model | orgModel = m2 }
+            , cmd = Cmd.map OrgMsg c2
-                , Cmd.map OrgMsg c2
+            , stateChange = isDropdownChangeMsg m
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                (isDropdownChangeMsg m)
+            }
 
         CorrPersonMsg m ->
             let
                 ( m2, c2 ) =
                     Comp.Dropdown.update m model.corrPersonModel
             in
-            NextState
+            { model = { model | corrPersonModel = m2 }
-                ( { model | corrPersonModel = m2 }
+            , cmd = Cmd.map CorrPersonMsg c2
-                , Cmd.map CorrPersonMsg c2
+            , stateChange = isDropdownChangeMsg m
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                (isDropdownChangeMsg m)
+            }
 
         ConcPersonMsg m ->
             let
                 ( m2, c2 ) =
                     Comp.Dropdown.update m model.concPersonModel
             in
-            NextState
+            { model = { model | concPersonModel = m2 }
-                ( { model | concPersonModel = m2 }
+            , cmd = Cmd.map ConcPersonMsg c2
-                , Cmd.map ConcPersonMsg c2
+            , stateChange = isDropdownChangeMsg m
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                (isDropdownChangeMsg m)
+            }
 
         ConcEquipmentMsg m ->
             let
                 ( m2, c2 ) =
                     Comp.Dropdown.update m model.concEquipmentModel
             in
-            NextState
+            { model = { model | concEquipmentModel = m2 }
-                ( { model | concEquipmentModel = m2 }
+            , cmd = Cmd.map ConcEquipmentMsg c2
-                , Cmd.map ConcEquipmentMsg c2
+            , stateChange = isDropdownChangeMsg m
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                (isDropdownChangeMsg m)
+            }
 
         ToggleInbox ->
             let
                 current =
                     model.inboxCheckbox
             in
-            NextState ( { model | inboxCheckbox = not current }, Cmd.none ) True
+            { model = { model | inboxCheckbox = not current }
+            , cmd = Cmd.none
+            , stateChange = True
+            , dragDrop = DD.DragDropData ddm Nothing
+            }
 
         FromDateMsg m ->
             let
@@ -437,11 +448,11 @@ update flags settings msg model =
                         _ ->
                             Nothing
             in
-            NextState
+            { model = { model | fromDateModel = dp, fromDate = nextDate }
-                ( { model | fromDateModel = dp, fromDate = nextDate }
+            , cmd = Cmd.none
-                , Cmd.none
+            , stateChange = model.fromDate /= nextDate
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                (model.fromDate /= nextDate)
+            }
 
         UntilDateMsg m ->
             let
@@ -456,11 +467,11 @@ update flags settings msg model =
                         _ ->
                             Nothing
             in
-            NextState
+            { model = { model | untilDateModel = dp, untilDate = nextDate }
-                ( { model | untilDateModel = dp, untilDate = nextDate }
+            , cmd = Cmd.none
-                , Cmd.none
+            , stateChange = model.untilDate /= nextDate
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                (model.untilDate /= nextDate)
+            }
 
         FromDueDateMsg m ->
             let
@@ -475,11 +486,11 @@ update flags settings msg model =
                         _ ->
                             Nothing
             in
-            NextState
+            { model = { model | fromDueDateModel = dp, fromDueDate = nextDate }
-                ( { model | fromDueDateModel = dp, fromDueDate = nextDate }
+            , cmd = Cmd.none
-                , Cmd.none
+            , stateChange = model.fromDueDate /= nextDate
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                (model.fromDueDate /= nextDate)
+            }
 
         UntilDueDateMsg m ->
             let
@@ -494,98 +505,102 @@ update flags settings msg model =
                         _ ->
                             Nothing
             in
-            NextState
+            { model = { model | untilDueDateModel = dp, untilDueDate = nextDate }
-                ( { model | untilDueDateModel = dp, untilDueDate = nextDate }
+            , cmd = Cmd.none
-                , Cmd.none
+            , stateChange = model.untilDueDate /= nextDate
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                (model.untilDueDate /= nextDate)
+            }
 
         SetName str ->
             let
                 next =
                     Util.Maybe.fromString str
             in
-            NextState
+            { model = { model | nameModel = next }
-                ( { model | nameModel = next }
+            , cmd = Cmd.none
-                , Cmd.none
+            , stateChange = False
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                False
+            }
 
         SetAllName str ->
             let
                 next =
                     Util.Maybe.fromString str
             in
-            NextState
+            { model = { model | allNameModel = next }
-                ( { model | allNameModel = next }
+            , cmd = Cmd.none
-                , Cmd.none
+            , stateChange = False
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                False
+            }
 
         SetFulltext str ->
             let
                 next =
                     Util.Maybe.fromString str
             in
-            NextState
+            { model = { model | fulltextModel = next }
-                ( { model | fulltextModel = next }
+            , cmd = Cmd.none
-                , Cmd.none
+            , stateChange = False
-                )
+            , dragDrop = DD.DragDropData ddm Nothing
-                False
+            }
 
         KeyUpMsg (Just Enter) ->
-            NextState ( model, Cmd.none ) True
+            { model = model
+            , cmd = Cmd.none
+            , stateChange = True
+            , dragDrop = DD.DragDropData ddm Nothing
+            }
 
         KeyUpMsg _ ->
-            NextState ( model, Cmd.none ) False
+            { model = model
+            , cmd = Cmd.none
+            , stateChange = False
+            , dragDrop = DD.DragDropData ddm Nothing
+            }
 
         ToggleNameHelp ->
-            NextState ( { model | showNameHelp = not model.showNameHelp }, Cmd.none ) False
+            { model = { model | showNameHelp = not model.showNameHelp }
+            , cmd = Cmd.none
+            , stateChange = False
+            , dragDrop = DD.DragDropData ddm Nothing
+            }
 
         GetFolderResp (Ok fs) ->
             let
-                opts =
+                model_ =
-                    List.filter .isMember fs.items
+                    { model
-                        |> List.map (\e -> IdName e.id e.name)
+                        | folderList =
-                        |> Comp.Dropdown.SetOptions
+                            Util.Folder.onlyVisible flags fs.items
+                                |> Comp.FolderSelect.init
+                    }
             in
-            update flags settings (FolderMsg opts) model
+            { model = model_
+            , cmd = Cmd.none
+            , stateChange = False
+            , dragDrop = DD.DragDropData ddm Nothing
+            }
 
         GetFolderResp (Err _) ->
-            noChange ( model, Cmd.none )
+            { model = model
+            , cmd = Cmd.none
+            , stateChange = False
+            , dragDrop = DD.DragDropData ddm Nothing
+            }
 
-        FolderMsg lm ->
+        FolderSelectMsg lm ->
             let
-                ( m2, c2 ) =
+                ( fsm, sel, ddd ) =
-                    Comp.Dropdown.update lm model.folderModel
+                    Comp.FolderSelect.updateDrop ddm lm model.folderList
             in
-            NextState
+            { model =
-                ( { model | folderModel = m2 }
+                { model
-                , Cmd.map FolderMsg c2
+                    | folderList = fsm
-                )
+                    , selectedFolder = sel
-                (isDropdownChangeMsg lm)
+                }
-
+            , cmd = Cmd.none
-        TagCatIncMsg m ->
+            , stateChange = model.selectedFolder /= sel
-            let
+            , dragDrop = ddd
-                ( m2, c2 ) =
+            }
-                    Comp.Dropdown.update m model.tagCatInclModel
-            in
-            NextState
-                ( { model | tagCatInclModel = m2 }
-                , Cmd.map TagCatIncMsg c2
-                )
-                (isDropdownChangeMsg m)
-
-        TagCatExcMsg m ->
-            let
-                ( m2, c2 ) =
-                    Comp.Dropdown.update m model.tagCatExclModel
-            in
-            NextState
-                ( { model | tagCatExclModel = m2 }
-                , Cmd.map TagCatExcMsg c2
-                )
-                (isDropdownChangeMsg m)
 
 
 
@@ -593,35 +608,26 @@ update flags settings msg model =
 
 
 view : Flags -> UiSettings -> Model -> Html Msg
-view flags settings model =
+view =
+    viewDrop (DD.DragDropData DD.init Nothing)
+
+
+viewDrop : DD.DragDropData -> Flags -> UiSettings -> Model -> Html Msg
+viewDrop ddd flags settings model =
     let
         formHeader icon headline =
-            div [ class "ui small dividing header" ]
+            div [ class "ui tiny header" ]
                 [ icon
                 , div [ class "content" ]
                     [ text headline
                     ]
                 ]
 
-        formHeaderHelp icon headline tagger =
+        segmentClass =
-            div [ class "ui small dividing header" ]
+            "ui vertical segment"
-                [ a
-                    [ class "right-float"
-                    , href "#"
-                    , onClick tagger
-                    ]
-                    [ i [ class "small grey help link icon" ] []
-                    ]
-                , icon
-                , div [ class "content" ]
-                    [ text headline
-                    ]
-                ]
-
-        nameIcon =
-            i [ class "left align icon" ] []
     in
     div [ class "ui form" ]
+        [ div [ class segmentClass ]
             [ div [ class "inline field" ]
                 [ div [ class "ui checkbox" ]
                     [ input
@@ -635,80 +641,15 @@ view flags settings model =
                         ]
                     ]
                 ]
-        , formHeaderHelp nameIcon "Names" ToggleNameHelp
-        , span
-            [ classList
-                [ ( "small-info", True )
-                , ( "invisible hidden", not model.showNameHelp )
             ]
+        , div [ class segmentClass ]
+            [ Html.map TagSelectMsg (Comp.TagSelect.viewTagsDrop ddd.model settings model.tagSelectModel)
+            , Html.map TagSelectMsg (Comp.TagSelect.viewCats settings model.tagSelectModel)
+            , Html.map FolderSelectMsg
+                (Comp.FolderSelect.viewDrop ddd.model settings.searchMenuFolderCount model.folderList)
             ]
-            [ text "Use wildcards "
+        , div [ class segmentClass ]
-            , code [] [ text "*" ]
+            [ formHeader (Icons.correspondentIcon "")
-            , text " at beginning or end. Added automatically if not "
-            , text "present and not quoted. Press "
-            , em [] [ text "Enter" ]
-            , text " to start searching."
-            ]
-        , div [ class "field" ]
-            [ label [] [ text "Names" ]
-            , input
-                [ type_ "text"
-                , onInput SetAllName
-                , Util.Html.onKeyUpCode KeyUpMsg
-                , model.allNameModel |> Maybe.withDefault "" |> value
-                ]
-                []
-            , span
-                [ classList
-                    [ ( "small-info", True )
-                    , ( "invisible hidden", not model.showNameHelp )
-                    ]
-                ]
-                [ text "Looks in correspondents, concerned entities, item name and notes."
-                ]
-            ]
-        , formHeader (Icons.folderIcon "") "Folder"
-        , div [ class "field" ]
-            [ label [] [ text "Folder" ]
-            , Html.map FolderMsg (Comp.Dropdown.view settings model.folderModel)
-            ]
-        , formHeader (Icons.tagsIcon "") "Tags"
-        , div [ class "field" ]
-            [ label [] [ text "Include (and)" ]
-            , Html.map TagIncMsg (Comp.Dropdown.view settings model.tagInclModel)
-            ]
-        , div [ class "field" ]
-            [ label [] [ text "Exclude (or)" ]
-            , Html.map TagExcMsg (Comp.Dropdown.view settings model.tagExclModel)
-            ]
-        , div [ class "field" ]
-            [ label [] [ text "Category Include (and)" ]
-            , Html.map TagCatIncMsg (Comp.Dropdown.view settings model.tagCatInclModel)
-            ]
-        , div [ class "field" ]
-            [ label [] [ text "Category Exclude (or)" ]
-            , Html.map TagCatExcMsg (Comp.Dropdown.view settings model.tagCatExclModel)
-            ]
-        , formHeader (Icons.searchIcon "") "Content"
-        , div
-            [ classList
-                [ ( "field", True )
-                , ( "invisible hidden", not flags.config.fullTextSearchEnabled )
-                ]
-            ]
-            [ label [] [ text "Content Search" ]
-            , input
-                [ type_ "text"
-                , onInput SetFulltext
-                , Util.Html.onKeyUpCode KeyUpMsg
-                , model.fulltextModel |> Maybe.withDefault "" |> value
-                ]
-                []
-            , span [ class "small-info" ]
-                [ text "Fulltext search in document contents and notes."
-                ]
-            ]
-        , formHeader (Icons.correspondentIcon "")
                 (case getDirection model of
                     Just Data.Direction.Incoming ->
                         "Sender"
@@ -736,7 +677,71 @@ view flags settings model =
                 [ label [] [ text "Equipment" ]
                 , Html.map ConcEquipmentMsg (Comp.Dropdown.view settings model.concEquipmentModel)
                 ]
-        , formHeader (Icons.dateIcon "") "Date"
+            ]
+        , div [ class segmentClass ]
+            [ formHeader (Icons.searchIcon "") "Text Search"
+            , div
+                [ classList
+                    [ ( "field", True )
+                    , ( "invisible hidden", not flags.config.fullTextSearchEnabled )
+                    ]
+                ]
+                [ label [] [ text "Fulltext Search" ]
+                , input
+                    [ type_ "text"
+                    , onInput SetFulltext
+                    , Util.Html.onKeyUpCode KeyUpMsg
+                    , model.fulltextModel |> Maybe.withDefault "" |> value
+                    , placeholder "Fulltext search in results…"
+                    ]
+                    []
+                , span [ class "small-info" ]
+                    [ text "Fulltext search in document contents and notes."
+                    ]
+                ]
+            , div [ class "field" ]
+                [ label []
+                    [ text "Names"
+                    , a
+                        [ class "right-float"
+                        , href "#"
+                        , onClick ToggleNameHelp
+                        ]
+                        [ i [ class "small grey help link icon" ] []
+                        ]
+                    ]
+                , input
+                    [ type_ "text"
+                    , onInput SetAllName
+                    , Util.Html.onKeyUpCode KeyUpMsg
+                    , model.allNameModel |> Maybe.withDefault "" |> value
+                    , placeholder "Search in various names…"
+                    ]
+                    []
+                , span
+                    [ classList
+                        [ ( "small-info", True )
+                        ]
+                    ]
+                    [ text "Looks in correspondents, concerned entities, item name and notes."
+                    ]
+                , p
+                    [ classList
+                        [ ( "small-info", True )
+                        , ( "invisible hidden", not model.showNameHelp )
+                        ]
+                    ]
+                    [ text "Use wildcards "
+                    , code [] [ text "*" ]
+                    , text " at beginning or end. They are added automatically on both sides "
+                    , text "if not present in the search term and the term is not quoted. Press "
+                    , em [] [ text "Enter" ]
+                    , text " to start searching."
+                    ]
+                ]
+            ]
+        , div [ class segmentClass ]
+            [ formHeader (Icons.dateIcon "") "Date"
             , div [ class "fields" ]
                 [ div [ class "field" ]
                     [ label []
@@ -782,8 +787,11 @@ view flags settings model =
                         )
                     ]
                 ]
-        , formHeader (Icons.directionIcon "") "Direction"
+            ]
+        , div [ class segmentClass ]
+            [ formHeader (Icons.directionIcon "") "Direction"
             , div [ class "field" ]
                 [ Html.map DirectionMsg (Comp.Dropdown.view settings model.directionModel)
                 ]
             ]
+        ]

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