From 5e77ff0fc5f535bbbe904cc90487db548c2f1857 Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Mon, 22 Jun 2020 00:35:11 +0200 Subject: [PATCH] Start search by pressing enter and not on each stroke This reduces (unecessary) requests and eases the restless list rendering. Throttling is still in place to avoid too many requests when e.g. holding the enter-key. --- .../webapp/src/main/elm/Comp/SearchMenu.elm | 79 +++++++++++++++---- .../webapp/src/main/elm/Page/Home/Data.elm | 2 + .../webapp/src/main/elm/Page/Home/Update.elm | 9 ++- .../webapp/src/main/elm/Page/Home/View.elm | 40 ++++++---- modules/webapp/src/main/elm/Util/Html.elm | 6 ++ 5 files changed, 103 insertions(+), 33 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index 1bfd1edc..e7a029f3 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -25,8 +25,9 @@ import Data.UiSettings exposing (UiSettings) import DatePicker exposing (DatePicker) import Html exposing (..) import Html.Attributes exposing (..) -import Html.Events exposing (onCheck, onInput) +import Html.Events exposing (onCheck, onClick, onInput) import Http +import Util.Html exposing (KeyCode(..)) import Util.Maybe import Util.Tag import Util.Update @@ -57,6 +58,7 @@ type alias Model = , allNameModel : Maybe String , fulltextModel : Maybe String , datePickerInitialized : Bool + , showNameHelp : Bool } @@ -114,6 +116,7 @@ init = , allNameModel = Nothing , fulltextModel = Nothing , datePickerInitialized = False + , showNameHelp = False } @@ -139,6 +142,8 @@ type Msg | SetAllName String | SetFulltext String | ResetForm + | KeyUpMsg (Maybe KeyCode) + | ToggleNameHelp getDirection : Model -> Maybe Direction @@ -475,7 +480,7 @@ update flags settings msg model = ( { model | nameModel = next } , Cmd.none ) - (model.nameModel /= next) + (model.nameModel /= Nothing && str == "") SetAllName str -> let @@ -486,7 +491,7 @@ update flags settings msg model = ( { model | allNameModel = next } , Cmd.none ) - (model.allNameModel /= next) + (model.allNameModel /= Nothing && str == "") SetFulltext str -> let @@ -497,7 +502,16 @@ update flags settings msg model = ( { model | fulltextModel = next } , Cmd.none ) - (model.fulltextModel /= next) + (model.fulltextModel /= Nothing && str == "") + + KeyUpMsg (Just Enter) -> + NextState ( model, Cmd.none ) True + + KeyUpMsg _ -> + NextState ( model, Cmd.none ) False + + ToggleNameHelp -> + NextState ( { model | showNameHelp = not model.showNameHelp }, Cmd.none ) False @@ -515,6 +529,21 @@ view flags settings model = ] ] + formHeaderHelp icon headline tagger = + div [ class "ui small dividing header" ] + [ a + [ class "right-float" + , href "#" + , onClick tagger + ] + [ i [ class "small grey help link icon" ] [] + ] + , icon + , div [ class "content" ] + [ text headline + ] + ] + nameIcon = i [ class "left align icon" ] [] in @@ -542,6 +571,7 @@ view flags settings model = , input [ type_ "text" , onInput SetFulltext + , Util.Html.onKeyUpCode KeyUpMsg , model.fulltextModel |> Maybe.withDefault "" |> value ] [] @@ -549,17 +579,36 @@ view flags settings model = [ text "Fulltext search in document contents." ] ] - , formHeader nameIcon "Names" + , formHeaderHelp nameIcon "Names" ToggleNameHelp + , span + [ classList + [ ( "small-info", True ) + , ( "invisible hidden", not model.showNameHelp ) + ] + ] + [ text "Use wildcards " + , code [] [ text "*" ] + , text " at beginning or end. Added automatically if not " + , text "present and not quoted. Press " + , em [] [ text "Enter" ] + , text " to start searching." + ] , div [ class "field" ] [ label [] [ text "All Names" ] , input [ type_ "text" , onInput SetAllName + , Util.Html.onKeyUpCode KeyUpMsg , model.allNameModel |> Maybe.withDefault "" |> value ] [] - , span [ class "small-info" ] - [ text "Looks in correspondents, concerned, item name and notes." + , span + [ classList + [ ( "small-info", True ) + , ( "invisible hidden", not model.showNameHelp ) + ] + ] + [ text "Looks in correspondents, concerned entities, item name and notes." ] ] , div [ class "field" ] @@ -567,18 +616,18 @@ view flags settings model = , input [ type_ "text" , onInput SetName + , Util.Html.onKeyUpCode KeyUpMsg , model.nameModel |> Maybe.withDefault "" |> value ] [] - , span [ class "small-info" ] - [ text "Looks in item name." + , span + [ classList + [ ( "small-info", True ) + , ( "invisible hidden", not model.showNameHelp ) + ] + ] + [ text "Looks in item name only." ] - ] - , span [ class "small-info" ] - [ text "Use wildcards " - , code [] [ text "*" ] - , text " at beginning or end. Added automatically if not " - , text "present and not quoted." ] , formHeader (Icons.tagsIcon "") "Tags" , div [ class "field" ] diff --git a/modules/webapp/src/main/elm/Page/Home/Data.elm b/modules/webapp/src/main/elm/Page/Home/Data.elm index 071f8e3c..ba928fe6 100644 --- a/modules/webapp/src/main/elm/Page/Home/Data.elm +++ b/modules/webapp/src/main/elm/Page/Home/Data.elm @@ -20,6 +20,7 @@ import Data.Items import Data.UiSettings exposing (UiSettings) import Http import Throttle exposing (Throttle) +import Util.Html exposing (KeyCode(..)) type alias Model = @@ -83,6 +84,7 @@ type Msg | UpdateThrottle | SetBasicSearch String | SearchTypeMsg (Comp.FixedDropdown.Msg SearchType) + | KeyUpMsg (Maybe KeyCode) type SearchType diff --git a/modules/webapp/src/main/elm/Page/Home/Update.elm b/modules/webapp/src/main/elm/Page/Home/Update.elm index 33fe7fc4..e4ca1976 100644 --- a/modules/webapp/src/main/elm/Page/Home/Update.elm +++ b/modules/webapp/src/main/elm/Page/Home/Update.elm @@ -10,6 +10,7 @@ import Page exposing (Page(..)) import Page.Home.Data exposing (..) import Throttle import Time +import Util.Html exposing (KeyCode(..)) import Util.Update @@ -177,6 +178,12 @@ update key flags settings msg model = , Cmd.none ) + KeyUpMsg (Just Enter) -> + update key flags settings DoSearch model + + KeyUpMsg _ -> + withSub ( model, Cmd.none ) + --- Helpers @@ -218,6 +225,6 @@ withSub ( m, c ) = ( m , c , Throttle.ifNeeded - (Time.every 150 (\_ -> UpdateThrottle)) + (Time.every 500 (\_ -> UpdateThrottle)) m.throttle ) diff --git a/modules/webapp/src/main/elm/Page/Home/View.elm b/modules/webapp/src/main/elm/Page/Home/View.elm index a6bfbaf7..c50d0bf3 100644 --- a/modules/webapp/src/main/elm/Page/Home/View.elm +++ b/modules/webapp/src/main/elm/Page/Home/View.elm @@ -11,6 +11,7 @@ import Html.Attributes exposing (..) import Html.Events exposing (onClick, onInput) import Page exposing (Page(..)) import Page.Home.Data exposing (..) +import Util.Html view : Flags -> UiSettings -> Model -> Html Msg @@ -165,12 +166,22 @@ viewSearchBar flags model = span [ class "hidden invisible" ] [] ] ] - , div [ class "ui category search item" ] - [ div [ class "ui action input" ] - [ input + , div [ class "item" ] + [ div [ class "ui left icon right action input" ] + [ i + [ classList + [ ( "search link icon", not model.searchInProgress ) + , ( "loading spinner icon", model.searchInProgress ) + ] + , href "#" + , onClick DoSearch + ] + [] + , input [ type_ "text" , placeholder "Search …" , onInput SetBasicSearch + , Util.Html.onKeyUpCode KeyUpMsg , Maybe.map value searchInput |> Maybe.withDefault (value "") ] @@ -180,19 +191,6 @@ viewSearchBar flags model = (Just searchTypeItem) model.searchTypeDropdown ) - , a - [ class "ui basic icon button" - , href "#" - , onClick DoSearch - ] - [ i - [ classList - [ ( "search link icon", not model.searchInProgress ) - , ( "loading spinner icon", model.searchInProgress ) - ] - ] - [] - ] ] ] ] @@ -205,6 +203,14 @@ hasMoreSearch model = Comp.SearchMenu.getItemSearch model.searchMenuModel is_ = - { is | allNames = Nothing, fullText = Nothing } + case model.searchType of + BasicSearch -> + { is | allNames = Nothing } + + ContentSearch -> + { is | fullText = Nothing } + + ContentOnlySearch -> + Debug.todo "implement" in is_ /= Api.Model.ItemSearch.empty diff --git a/modules/webapp/src/main/elm/Util/Html.elm b/modules/webapp/src/main/elm/Util/Html.elm index a25e7ad0..7649fa46 100644 --- a/modules/webapp/src/main/elm/Util/Html.elm +++ b/modules/webapp/src/main/elm/Util/Html.elm @@ -9,6 +9,7 @@ module Util.Html exposing , onDragOver , onDropFiles , onKeyUp + , onKeyUpCode ) import File exposing (File) @@ -76,6 +77,11 @@ onKeyUp tagger = on "keyup" (D.map tagger keyCode) +onKeyUpCode : (Maybe KeyCode -> msg) -> Attribute msg +onKeyUpCode tagger = + onKeyUp (intToKeyCode >> tagger) + + onClickk : msg -> Attribute msg onClickk msg = Html.Events.preventDefaultOn "click" (D.map alwaysPreventDefault (D.succeed msg))