Merge pull request #146 from eikek/search-improvements

Search improvements

elm.json

@@ -22,7 +22,8 @@
             "justinmimbs/date": "3.1.2",
             "norpan/elm-html5-drag-drop": "3.1.4",
             "ryannhg/date-format": "2.3.0",
-            "truqu/elm-base64": "2.0.4"
+            "truqu/elm-base64": "2.0.4",
+            "ursi/elm-throttle": "1.0.1"
         },
         "indirect": {
             "elm/bytes": "1.0.8",

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

@@ -3354,6 +3354,13 @@ components:
             - outgoing
         name:
           type: string
+          description: |
+            Search in item names.
+        allNames:
+          type: string
+          description: |
+            Search in item names, correspondents, concerned entities
+            and notes.
         corrOrg:
           type: string
           format: ident

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

@@ -121,6 +121,7 @@ trait Conversions {
       m.dateUntil,
       m.dueDateFrom,
       m.dueDateUntil,
+      m.allNames,
       None
     )
 

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

@@ -164,6 +164,7 @@ object QItem {
       dateTo: Option[Timestamp],
       dueDateFrom: Option[Timestamp],
       dueDateTo: Option[Timestamp],
+      allNames: Option[String],
       orderAsc: Option[RItem.Columns.type => Column]
   )
 
@@ -184,6 +185,7 @@ object QItem {
         None,
         None,
         None,
+        None,
         None
       )
   }
@@ -282,13 +284,26 @@ object QItem {
           RTagItem.Columns.tagId.isOneOf(q.tagsExclude)
         )
 
-    val name = q.name.map(queryWildcard)
+    val name     = q.name.map(_.toLowerCase).map(queryWildcard)
+    val allNames = q.allNames.map(_.toLowerCase).map(queryWildcard)
     val cond = and(
       IC.cid.prefix("i").is(q.collective),
       IC.state.prefix("i").isOneOf(q.states),
       IC.incoming.prefix("i").isOrDiscard(q.direction),
       name
-        .map(n => or(IC.name.prefix("i").lowerLike(n), IC.notes.prefix("i").lowerLike(n)))
+        .map(n => IC.name.prefix("i").lowerLike(n))
+        .getOrElse(Fragment.empty),
+      allNames
+        .map(n =>
+          or(
+            OC.name.prefix("o0").lowerLike(n),
+            PC.name.prefix("p0").lowerLike(n),
+            PC.name.prefix("p1").lowerLike(n),
+            EC.name.prefix("e1").lowerLike(n),
+            IC.name.prefix("i").lowerLike(n),
+            IC.notes.prefix("i").lowerLike(n)
+          )
+        )
         .getOrElse(Fragment.empty),
       RPerson.Columns.pid.prefix("p0").isOrDiscard(q.corrPerson),
       ROrganization.Columns.oid.prefix("o0").isOrDiscard(q.corrOrg),

modules/webapp/src/main/elm/App/Update.elm

@@ -40,44 +40,44 @@ update msg model =
         ( m, c, s ) =
             updateWithSub msg model
     in
-    ( { m | subs = Sub.batch [ m.subs, s ] }, c )
+    ( { m | subs = s }, c )
 
 
 updateWithSub : Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
 updateWithSub msg model =
     case msg of
         HomeMsg lm ->
-            updateHome lm model |> noSub
+            updateHome lm model
 
         LoginMsg lm ->
-            updateLogin lm model |> noSub
+            updateLogin lm model
 
         ManageDataMsg lm ->
-            updateManageData lm model |> noSub
+            updateManageData lm model
 
         CollSettingsMsg m ->
-            updateCollSettings m model |> noSub
+            updateCollSettings m model
 
         UserSettingsMsg m ->
-            updateUserSettings m model |> noSub
+            updateUserSettings m model
 
         QueueMsg m ->
-            updateQueue m model |> noSub
+            updateQueue m model
 
         RegisterMsg m ->
-            updateRegister m model |> noSub
+            updateRegister m model
 
         UploadMsg m ->
             updateUpload m model
 
         NewInviteMsg m ->
-            updateNewInvite m model |> noSub
+            updateNewInvite m model
 
         ItemDetailMsg m ->
             updateItemDetail m model
 
         VersionResp (Ok info) ->
-            ( { model | version = info }, Cmd.none ) |> noSub
+            ( { model | version = info }, Cmd.none, Sub.none )
 
         VersionResp (Err _) ->
             ( model, Cmd.none, Sub.none )
@@ -162,25 +162,27 @@ updateWithSub msg model =
                 check =
                     checkPage model.flags page
 
-                ( m, c ) =
+                ( m, c, s ) =
                     initPage model page
             in
             if check == page then
-                ( { m | page = page }, c, Sub.none )
+                ( { m | page = page }, c, s )
 
             else
                 ( model, Page.goto check, Sub.none )
 
         ToggleNavMenu ->
-            ( { model | navMenuOpen = not model.navMenuOpen }, Cmd.none, Sub.none )
+            ( { model | navMenuOpen = not model.navMenuOpen }
+            , Cmd.none
+            , Sub.none
+            )
 
         GetUiSettings settings ->
-            Util.Update.andThen1
+            Util.Update.andThen2
                 [ updateUserSettings Page.UserSettings.Data.UpdateSettings
                 , updateHome Page.Home.Data.DoSearch
                 ]
                 { model | uiSettings = settings }
-                |> noSub
 
 
 updateItemDetail : Page.ItemDetail.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
@@ -200,7 +202,7 @@ updateItemDetail lmsg model =
     )
 
 
-updateNewInvite : Page.NewInvite.Data.Msg -> Model -> ( Model, Cmd Msg )
+updateNewInvite : Page.NewInvite.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
 updateNewInvite lmsg model =
     let
         ( lm, lc ) =
@@ -208,6 +210,7 @@ updateNewInvite lmsg model =
     in
     ( { model | newInviteModel = lm }
     , Cmd.map NewInviteMsg lc
+    , Sub.none
     )
 
 
@@ -227,7 +230,7 @@ updateUpload lmsg model =
     )
 
 
-updateRegister : Page.Register.Data.Msg -> Model -> ( Model, Cmd Msg )
+updateRegister : Page.Register.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
 updateRegister lmsg model =
     let
         ( lm, lc ) =
@@ -235,10 +238,11 @@ updateRegister lmsg model =
     in
     ( { model | registerModel = lm }
     , Cmd.map RegisterMsg lc
+    , Sub.none
     )
 
 
-updateQueue : Page.Queue.Data.Msg -> Model -> ( Model, Cmd Msg )
+updateQueue : Page.Queue.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
 updateQueue lmsg model =
     let
         ( lm, lc ) =
@@ -246,10 +250,11 @@ updateQueue lmsg model =
     in
     ( { model | queueModel = lm }
     , Cmd.map QueueMsg lc
+    , Sub.none
     )
 
 
-updateUserSettings : Page.UserSettings.Data.Msg -> Model -> ( Model, Cmd Msg )
+updateUserSettings : Page.UserSettings.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
 updateUserSettings lmsg model =
     let
         ( lm, lc, ls ) =
@@ -257,17 +262,13 @@ updateUserSettings lmsg model =
     in
     ( { model
         | userSettingsModel = lm
-        , subs =
-            Sub.batch
-                [ model.subs
-                , Sub.map UserSettingsMsg ls
-                ]
       }
     , Cmd.map UserSettingsMsg lc
+    , Sub.map UserSettingsMsg ls
     )
 
 
-updateCollSettings : Page.CollectiveSettings.Data.Msg -> Model -> ( Model, Cmd Msg )
+updateCollSettings : Page.CollectiveSettings.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
 updateCollSettings lmsg model =
     let
         ( lm, lc ) =
@@ -277,10 +278,11 @@ updateCollSettings lmsg model =
     in
     ( { model | collSettingsModel = lm }
     , Cmd.map CollSettingsMsg lc
+    , Sub.none
     )
 
 
-updateLogin : Page.Login.Data.Msg -> Model -> ( Model, Cmd Msg )
+updateLogin : Page.Login.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
 updateLogin lmsg model =
     let
         ( lm, lc, ar ) =
@@ -295,21 +297,25 @@ updateLogin lmsg model =
     in
     ( { model | loginModel = lm, flags = newFlags }
     , Cmd.map LoginMsg lc
+    , Sub.none
     )
 
 
-updateHome : Page.Home.Data.Msg -> Model -> ( Model, Cmd Msg )
+updateHome : Page.Home.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
 updateHome lmsg model =
     let
-        ( lm, lc ) =
+        ( lm, lc, ls ) =
             Page.Home.Update.update model.key model.flags model.uiSettings lmsg model.homeModel
     in
-    ( { model | homeModel = lm }
+    ( { model
+        | homeModel = lm
+      }
     , Cmd.map HomeMsg lc
+    , Sub.map HomeMsg ls
     )
 
 
-updateManageData : Page.ManageData.Data.Msg -> Model -> ( Model, Cmd Msg )
+updateManageData : Page.ManageData.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
 updateManageData lmsg model =
     let
         ( lm, lc ) =
@@ -317,14 +323,15 @@ updateManageData lmsg model =
     in
     ( { model | manageDataModel = lm }
     , Cmd.map ManageDataMsg lc
+    , Sub.none
     )
 
 
-initPage : Model -> Page -> ( Model, Cmd Msg )
+initPage : Model -> Page -> ( Model, Cmd Msg, Sub Msg )
 initPage model page =
     case page of
         HomePage ->
-            Util.Update.andThen1
+            Util.Update.andThen2
                 [ updateHome Page.Home.Data.Init
                 , updateQueue Page.Queue.Data.StopRefresh
                 ]
@@ -337,14 +344,14 @@ initPage model page =
             updateQueue Page.Queue.Data.StopRefresh model
 
         CollectiveSettingPage ->
-            Util.Update.andThen1
+            Util.Update.andThen2
                 [ updateQueue Page.Queue.Data.StopRefresh
                 , updateCollSettings Page.CollectiveSettings.Data.Init
                 ]
                 model
 
         UserSettingPage ->
-            Util.Update.andThen1
+            Util.Update.andThen2
                 [ updateQueue Page.Queue.Data.StopRefresh
                 ]
                 model
@@ -362,21 +369,8 @@ initPage model page =
             updateQueue Page.Queue.Data.StopRefresh model
 
         ItemDetailPage id ->
-            let
+            Util.Update.andThen2
-                updateDetail m__ =
+                [ updateItemDetail (Page.ItemDetail.Data.Init id)
-                    let
-                        ( m, c, s ) =
-                            updateItemDetail (Page.ItemDetail.Data.Init id) m__
-                    in
-                    ( { m | subs = Sub.batch [ m.subs, s ] }, c )
-            in
-            Util.Update.andThen1
-                [ updateDetail
                 , updateQueue Page.Queue.Data.StopRefresh
                 ]
                 model
-
-
-noSub : ( Model, Cmd Msg ) -> ( Model, Cmd Msg, Sub Msg )
-noSub ( m, c ) =
-    ( m, c, Sub.none )

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

@@ -209,7 +209,7 @@ viewItem settings item =
                     [ class "item"
                     , title "Correspondent"
                     ]
-                    [ Icons.correspondentIcon
+                    [ Icons.correspondentIcon ""
                     , text " "
                     , Util.String.withDefault "-" corr |> text
                     ]

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

@@ -1787,7 +1787,7 @@ renderItemInfo settings model =
                 [ class "item"
                 , title "Correspondent"
                 ]
-                [ Icons.correspondentIcon
+                [ Icons.correspondentIcon ""
                 , List.filterMap identity [ model.item.corrOrg, model.item.corrPerson ]
                     |> List.map .name
                     |> String.join ", "
@@ -1994,7 +1994,7 @@ renderEditForm settings model =
                 , renderDueDateSuggestions model
                 ]
             , h4 [ class "ui dividing header" ]
-                [ Icons.correspondentIcon
+                [ Icons.correspondentIcon ""
                 , text "Correspondent"
                 ]
             , div [ class "field" ]

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

@@ -20,12 +20,14 @@ import Comp.DatePicker
 import Comp.Dropdown exposing (isDropdownChangeMsg)
 import Data.Direction exposing (Direction)
 import Data.Flags exposing (Flags)
+import Data.Icons as Icons
 import Data.UiSettings exposing (UiSettings)
 import DatePicker exposing (DatePicker)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (onCheck, onInput)
 import Http
+import Util.Maybe
 import Util.Tag
 import Util.Update
 
@@ -52,6 +54,7 @@ type alias Model =
     , untilDueDateModel : DatePicker
     , untilDueDate : Maybe Int
     , nameModel : Maybe String
+    , allNameModel : Maybe String
     , datePickerInitialized : Bool
     }
 
@@ -107,6 +110,7 @@ init =
     , untilDueDateModel = Comp.DatePicker.emptyModel
     , untilDueDate = Nothing
     , nameModel = Nothing
+    , allNameModel = Nothing
     , datePickerInitialized = False
     }
 
@@ -130,6 +134,7 @@ type Msg
     | GetEquipResp (Result Http.Error EquipmentList)
     | GetPersonResp (Result Http.Error ReferenceList)
     | SetName String
+    | SetAllName String
     | ResetForm
 
 
@@ -152,6 +157,17 @@ getItemSearch model =
     let
         e =
             Api.Model.ItemSearch.empty
+
+        amendWildcards s =
+            if String.startsWith "\"" s && String.endsWith "\"" s then
+                String.dropLeft 1 s
+                    |> String.dropRight 1
+
+            else if String.contains "*" s then
+                s
+
+            else
+                "*" ++ s ++ "*"
     in
     { e
         | tagsInclude = Comp.Dropdown.getSelected model.tagInclModel |> List.map .id
@@ -166,7 +182,12 @@ getItemSearch model =
         , dateUntil = model.untilDate
         , dueDateFrom = model.fromDueDate
         , dueDateUntil = model.untilDueDate
-        , name = model.nameModel
+        , name =
+            model.nameModel
+                |> Maybe.map amendWildcards
+        , allNames =
+            model.allNameModel
+                |> Maybe.map amendWildcards
     }
 
 
@@ -444,11 +465,7 @@ update flags settings msg model =
         SetName str ->
             let
                 next =
-                    if str == "" then
+                    Util.Maybe.fromString str
-                        Nothing
-
-                    else
-                        Just str
             in
             NextState
                 ( { model | nameModel = next }
@@ -456,6 +473,17 @@ update flags settings msg model =
                 )
                 (model.nameModel /= next)
 
+        SetAllName str ->
+            let
+                next =
+                    Util.Maybe.fromString str
+            in
+            NextState
+                ( { model | allNameModel = next }
+                , Cmd.none
+                )
+                (model.allNameModel /= next)
+
 
 
 -- View
@@ -463,6 +491,18 @@ update flags settings msg model =
 
 view : UiSettings -> Model -> Html Msg
 view settings model =
+    let
+        formHeader icon headline =
+            div [ class "ui small dividing header" ]
+                [ icon
+                , div [ class "content" ]
+                    [ text headline
+                    ]
+                ]
+
+        nameIcon =
+            i [ class "left align icon" ] []
+    in
     div [ class "ui form" ]
         [ div [ class "inline field" ]
             [ div [ class "ui checkbox" ]
@@ -477,8 +517,21 @@ view settings model =
                     ]
                 ]
             ]
+        , formHeader nameIcon "Names"
         , div [ class "field" ]
-            [ label [] [ text "Name or Notes" ]
+            [ label [] [ text "All Names" ]
+            , input
+                [ type_ "text"
+                , onInput SetAllName
+                , model.allNameModel |> Maybe.withDefault "" |> value
+                ]
+                []
+            , span [ class "small-info" ]
+                [ text "Looks in correspondents, concerned, item name and notes."
+                ]
+            ]
+        , div [ class "field" ]
+            [ label [] [ text "Name" ]
             , input
                 [ type_ "text"
                 , onInput SetName
@@ -486,18 +539,16 @@ view settings model =
                 ]
                 []
             , span [ class "small-info" ]
-                [ text "May contain wildcard "
+                [ text "Looks in item name."
+                ]
+            ]
+        , span [ class "small-info" ]
+            [ text "Use wildcards "
             , code [] [ text "*" ]
-                , text " at beginning or end"
+            , text " at beginning or end. Added automatically if not "
-                ]
+            , text "present and not quoted."
-            ]
-        , div [ class "field" ]
-            [ label [] [ text "Direction" ]
-            , Html.map DirectionMsg (Comp.Dropdown.view settings model.directionModel)
-            ]
-        , h3 [ class "ui header" ]
-            [ text "Tags"
             ]
+        , formHeader (Icons.tagsIcon "") "Tags"
         , div [ class "field" ]
             [ label [] [ text "Include (and)" ]
             , Html.map TagIncMsg (Comp.Dropdown.view settings model.tagInclModel)
@@ -506,17 +557,17 @@ view settings model =
             [ label [] [ text "Exclude (or)" ]
             , Html.map TagExcMsg (Comp.Dropdown.view settings model.tagExclModel)
             ]
-        , h3 [ class "ui header" ]
+        , formHeader (Icons.correspondentIcon "")
-            [ case getDirection model of
+            (case getDirection model of
                 Just Data.Direction.Incoming ->
-                    text "Sender"
+                    "Sender"
 
                 Just Data.Direction.Outgoing ->
-                    text "Recipient"
+                    "Recipient"
 
                 Nothing ->
-                    text "Correspondent"
+                    "Correspondent"
-            ]
+            )
         , div [ class "field" ]
             [ label [] [ text "Organization" ]
             , Html.map OrgMsg (Comp.Dropdown.view settings model.orgModel)
@@ -525,9 +576,7 @@ view settings model =
             [ label [] [ text "Person" ]
             , Html.map CorrPersonMsg (Comp.Dropdown.view settings model.corrPersonModel)
             ]
-        , h3 [ class "ui header" ]
+        , formHeader Icons.concernedIcon "Concerned"
-            [ text "Concerned"
-            ]
         , div [ class "field" ]
             [ label [] [ text "Person" ]
             , Html.map ConcPersonMsg (Comp.Dropdown.view settings model.concPersonModel)
@@ -536,9 +585,7 @@ view settings model =
             [ label [] [ text "Equipment" ]
             , Html.map ConcEquipmentMsg (Comp.Dropdown.view settings model.concEquipmentModel)
             ]
-        , h3 [ class "ui header" ]
+        , formHeader (Icons.dateIcon "") "Date"
-            [ text "Date"
-            ]
         , div [ class "fields" ]
             [ div [ class "field" ]
                 [ label []
@@ -561,9 +608,7 @@ view settings model =
                     )
                 ]
             ]
-        , h3 [ class "ui header" ]
+        , formHeader (Icons.dueDateIcon "") "Due Date"
-            [ text "Due Date"
-            ]
         , div [ class "fields" ]
             [ div [ class "field" ]
                 [ label []
@@ -586,4 +631,8 @@ view settings model =
                     )
                 ]
             ]
+        , formHeader (Icons.directionIcon "") "Direction"
+        , div [ class "field" ]
+            [ Html.map DirectionMsg (Comp.Dropdown.view settings model.directionModel)
+            ]
         ]

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

@@ -44,9 +44,9 @@ correspondent =
     "address card outline icon"
 
 
-correspondentIcon : Html msg
+correspondentIcon : String -> Html msg
-correspondentIcon =
+correspondentIcon classes =
-    i [ class correspondent ] []
+    i [ class (correspondent ++ " " ++ classes) ] []
 
 
 date : String

modules/webapp/src/main/elm/Main.elm

@@ -45,12 +45,12 @@ init flags url key =
         page =
             checkPage flags im.page
 
-        ( m, cmd ) =
+        ( m, cmd, s ) =
             if im.page == page then
                 App.Update.initPage im page
 
             else
-                ( im, Page.goto page )
+                ( im, Page.goto page, Sub.none )
 
         sessionCheck =
             case m.flags.account of
@@ -60,7 +60,7 @@ init flags url key =
                 Nothing ->
                     Cmd.none
     in
-    ( m
+    ( { m | subs = s }
     , Cmd.batch
         [ cmd
         , ic

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

@@ -16,6 +16,7 @@ import Data.Flags exposing (Flags)
 import Data.Items
 import Data.UiSettings exposing (UiSettings)
 import Http
+import Throttle exposing (Throttle)
 
 
 type alias Model =
@@ -27,6 +28,7 @@ type alias Model =
     , searchOffset : Int
     , moreAvailable : Bool
     , moreInProgress : Bool
+    , throttle : Throttle Msg
     }
 
 
@@ -36,10 +38,11 @@ init _ =
     , itemListModel = Comp.ItemCardList.init
     , searchInProgress = False
     , viewMode = Listing
-    , menuCollapsed = False
+    , menuCollapsed = True
     , searchOffset = 0
     , moreAvailable = True
     , moreInProgress = False
+    , throttle = Throttle.create 1
     }
 
 
@@ -53,6 +56,8 @@ type Msg
     | DoSearch
     | ToggleSearchMenu
     | LoadMore
+    | UpdateThrottle
+    | SetBasicSearch String
 
 
 type ViewMode

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

@@ -7,17 +7,15 @@ import Data.Flags exposing (Flags)
 import Data.UiSettings exposing (UiSettings)
 import Page exposing (Page(..))
 import Page.Home.Data exposing (..)
-import Util.Update
+import Throttle
+import Time
 
 
-update : Nav.Key -> Flags -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg )
+update : Nav.Key -> Flags -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
 update key flags settings msg model =
     case msg of
         Init ->
-            Util.Update.andThen1
+            update key flags settings (SearchMenuMsg Comp.SearchMenu.Init) model
-                [ update key flags settings (SearchMenuMsg Comp.SearchMenu.Init)
-                ]
-                model
 
         ResetSearch ->
             let
@@ -34,14 +32,20 @@ update key flags settings msg model =
                 newModel =
                     { model | searchMenuModel = Tuple.first nextState.modelCmd }
 
-                ( m2, c2 ) =
+                ( m2, c2, s2 ) =
-                    if nextState.stateChange then
+                    if nextState.stateChange && not model.searchInProgress then
                         doSearch flags settings newModel
 
                     else
-                        ( newModel, Cmd.none )
+                        withSub ( newModel, Cmd.none )
             in
-            ( m2, Cmd.batch [ c2, Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd) ] )
+            ( m2
+            , Cmd.batch
+                [ c2
+                , Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd)
+                ]
+            , s2
+            )
 
         ItemCardListMsg m ->
             let
@@ -56,6 +60,7 @@ update key flags settings msg model =
                         Nothing ->
                             Cmd.none
             in
+            withSub
                 ( { model | itemListModel = m2 }
                 , Cmd.batch [ Cmd.map ItemCardListMsg c2, cmd ]
                 )
@@ -92,6 +97,7 @@ update key flags settings msg model =
             update key flags settings (ItemCardListMsg (Comp.ItemCardList.AddResults list)) m
 
         ItemSearchAddResp (Err _) ->
+            withSub
                 ( { model
                     | moreInProgress = False
                   }
@@ -99,6 +105,7 @@ update key flags settings msg model =
                 )
 
         ItemSearchResp (Err _) ->
+            withSub
                 ( { model
                     | searchInProgress = False
                   }
@@ -110,31 +117,59 @@ update key flags settings msg model =
                 nm =
                     { model | searchOffset = 0 }
             in
+            if model.searchInProgress then
+                withSub ( model, Cmd.none )
+
+            else
                 doSearch flags settings nm
 
         ToggleSearchMenu ->
+            withSub
                 ( { model | menuCollapsed = not model.menuCollapsed }
                 , Cmd.none
                 )
 
         LoadMore ->
             if model.moreAvailable then
-                doSearchMore flags settings model
+                doSearchMore flags settings model |> withSub
 
             else
-                ( model, Cmd.none )
+                withSub ( model, Cmd.none )
+
+        UpdateThrottle ->
+            let
+                ( newThrottle, cmd ) =
+                    Throttle.update model.throttle
+            in
+            withSub ( { model | throttle = newThrottle }, cmd )
+
+        SetBasicSearch str ->
+            let
+                m =
+                    SearchMenuMsg (Comp.SearchMenu.SetAllName str)
+            in
+            update key flags settings m model
 
 
-doSearch : Flags -> UiSettings -> Model -> ( Model, Cmd Msg )
+
+--- Helpers
+
+
+doSearch : Flags -> UiSettings -> Model -> ( Model, Cmd Msg, Sub Msg )
 doSearch flags settings model =
     let
-        cmd =
+        searchCmd =
             doSearchCmd flags settings 0 model
+
+        ( newThrottle, cmd ) =
+            Throttle.try searchCmd model.throttle
     in
+    withSub
         ( { model
-        | searchInProgress = True
+            | searchInProgress = cmd /= Cmd.none
             , viewMode = Listing
             , searchOffset = 0
+            , throttle = newThrottle
           }
         , cmd
         )
@@ -149,3 +184,13 @@ doSearchMore flags settings model =
     ( { model | moreInProgress = True, viewMode = Listing }
     , cmd
     )
+
+
+withSub : ( Model, Cmd Msg ) -> ( Model, Cmd Msg, Sub Msg )
+withSub ( m, c ) =
+    ( m
+    , c
+    , Throttle.ifNeeded
+        (Time.every 150 (\_ -> UpdateThrottle))
+        m.throttle
+    )

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

@@ -1,11 +1,12 @@
 module Page.Home.View exposing (view)
 
+import Api.Model.ItemSearch
 import Comp.ItemCardList
 import Comp.SearchMenu
 import Data.UiSettings exposing (UiSettings)
 import Html exposing (..)
 import Html.Attributes exposing (..)
-import Html.Events exposing (onClick)
+import Html.Events exposing (onClick, onInput)
 import Page exposing (Page(..))
 import Page.Home.Data exposing (..)
 
@@ -47,8 +48,15 @@ view settings model =
                         , onClick DoSearch
                         , title "Run search query"
                         , href ""
+                        , disabled model.searchInProgress
                         ]
-                        [ i [ class "ui search icon" ] []
+                        [ i
+                            [ classList
+                                [ ( "search icon", not model.searchInProgress )
+                                , ( "loading spinner icon", model.searchInProgress )
+                                ]
+                            ]
+                            []
                         ]
                     ]
                 ]
@@ -68,24 +76,48 @@ view settings model =
             [ div
                 [ classList
                     [ ( "invisible hidden", not model.menuCollapsed )
-                    , ( "ui segment container", True )
+                    , ( "ui menu container", True )
                     ]
                 ]
                 [ a
-                    [ class "ui basic large circular label"
+                    [ class "item"
                     , onClick ToggleSearchMenu
                     , href "#"
+                    , title "Open search menu"
+                    ]
+                    [ i [ class "angle left icon" ] []
+                    , i [ class "icons" ]
+                        [ i [ class "grey bars icon" ] []
+                        , i [ class "bottom left corner search icon" ] []
+                        , if hasMoreSearch model then
+                            i [ class "top right blue corner circle icon" ] []
+
+                          else
+                            span [ class "hidden invisible" ] []
+                        ]
+                    ]
+                , div [ class "ui category search item" ]
+                    [ div [ class "ui transparent icon input" ]
+                        [ input
+                            [ type_ "text"
+                            , placeholder "Basic search…"
+                            , onInput SetBasicSearch
+                            , Maybe.map value model.searchMenuModel.allNameModel
+                                |> Maybe.withDefault (value "")
+                            ]
+                            []
+                        , i
+                            [ classList
+                                [ ( "search link icon", not model.searchInProgress )
+                                , ( "loading spinner icon", model.searchInProgress )
+                                ]
+                            ]
+                            []
                         ]
-                    [ i [ class "search icon" ] []
-                    , text "Search Menu…"
                     ]
                 ]
             , case model.viewMode of
                 Listing ->
-                    if model.searchInProgress then
-                        resultPlaceholder
-
-                    else
                     Html.map ItemCardListMsg
                         (Comp.ItemCardList.view settings model.itemListModel)
 
@@ -125,32 +157,13 @@ view settings model =
         ]
 
 
-resultPlaceholder : Html Msg
+hasMoreSearch : Model -> Bool
-resultPlaceholder =
+hasMoreSearch model =
-    div [ class "ui basic segment" ]
+    let
-        [ div [ class "ui active inverted dimmer" ]
+        is =
-            [ div [ class "ui medium text loader" ]
+            Comp.SearchMenu.getItemSearch model.searchMenuModel
-                [ text "Searching …"
+
-                ]
+        is_ =
-            ]
+            { is | allNames = Nothing }
-        , div [ class "ui middle aligned very relaxed divided basic list segment" ]
+    in
-            [ div [ class "item" ]
+    is_ /= Api.Model.ItemSearch.empty
-                [ div [ class "ui fluid placeholder" ]
-                    [ div [ class "full line" ] []
-                    , div [ class "full line" ] []
-                    ]
-                ]
-            , div [ class "item" ]
-                [ div [ class "ui fluid placeholder" ]
-                    [ div [ class "full line" ] []
-                    , div [ class "full line" ] []
-                    ]
-                ]
-            , div [ class "item" ]
-                [ div [ class "ui fluid placeholder" ]
-                    [ div [ class "full line" ] []
-                    , div [ class "full line" ] []
-                    ]
-                ]
-            ]
-        ]

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

@@ -1,4 +1,4 @@
-module Util.Update exposing (andThen1)
+module Util.Update exposing (andThen1, andThen2)
 
 
 andThen1 : List (a -> ( a, Cmd b )) -> a -> ( a, Cmd b )
@@ -16,3 +16,23 @@ andThen1 fs a =
     in
     List.foldl update init fs
         |> Tuple.mapSecond Cmd.batch
+
+
+andThen2 : List (model -> ( model, Cmd msg, Sub msg )) -> model -> ( model, Cmd msg, Sub msg )
+andThen2 fs m =
+    let
+        init =
+            ( m, [], [] )
+
+        update el ( m1, c1, s1 ) =
+            let
+                ( m2, c2, s2 ) =
+                    el m1
+            in
+            ( m2, c2 :: c1, s2 :: s1 )
+
+        combine ( m1, cl, sl ) =
+            ( m1, Cmd.batch cl, Sub.batch sl )
+    in
+    List.foldl update init fs
+        |> combine