From da9c348cfa760f0de44a6185ec0f7bd96292d4b7 Mon Sep 17 00:00:00 2001 From: Steven Vandevelde Date: Mon, 21 Jan 2019 17:01:15 +0100 Subject: [PATCH] Implement search --- Makefile | 2 +- elm.json | 6 +- src/Applications/Brain.elm | 61 +++++++++++++++--- src/Applications/Brain/Core.elm | 3 + src/Applications/Brain/Tracks.elm | 102 ++++++++++++++++++++++++++++++ src/Applications/UI.elm | 12 ++++ src/Applications/UI/Reply.elm | 3 + src/Applications/UI/Tracks.elm | 55 +++++++++++++--- src/Applications/UI/UserData.elm | 2 + src/Library/Alien.elm | 7 ++ src/Library/Replying.elm | 12 +++- src/Library/Sources.elm | 8 ++- src/Library/String/Ext.elm | 4 +- src/README.md | 2 +- 14 files changed, 255 insertions(+), 24 deletions(-) create mode 100644 src/Applications/Brain/Tracks.elm diff --git a/Makefile b/Makefile index d9d08660..1000b47e 100644 --- a/Makefile +++ b/Makefile @@ -29,7 +29,7 @@ clean: elm: @echo "> Compiling Elm application" @elm make $(SRC_DIR)/Applications/Brain.elm --output $(BUILD_DIR)/brain.js - @elm make $(SRC_DIR)/Applications/UI.elm --output $(BUILD_DIR)/application.js + @elm make $(SRC_DIR)/Applications/UI.elm --output $(BUILD_DIR)/application.js --debug system: diff --git a/elm.json b/elm.json index aaf6b16b..222b5b69 100644 --- a/elm.json +++ b/elm.json @@ -31,6 +31,7 @@ "justgage/tachyons-elm": "4.1.1", "noahzgordon/elm-color-extra": "1.0.1", "pilatch/flip": "1.0.0", + "rluiten/elm-text-search": "5.0.0", "rtfeldman/elm-css": "16.0.0", "rtfeldman/elm-hex": "1.0.0", "ryannhg/date-format": "2.3.0", @@ -43,7 +44,10 @@ "elm/random": "1.0.0", "elm-explorations/test": "1.2.0", "fredcy/elm-parseint": "2.0.1", - "jinjor/elm-xml-parser": "2.0.0" + "jinjor/elm-xml-parser": "2.0.0", + "rluiten/sparsevector": "1.0.3", + "rluiten/stemmer": "1.0.4", + "rluiten/trie": "2.0.3" } }, "test-dependencies": { diff --git a/src/Applications/Brain.elm b/src/Applications/Brain.elm index b193025f..afb282e2 100644 --- a/src/Applications/Brain.elm +++ b/src/Applications/Brain.elm @@ -8,10 +8,11 @@ import Brain.Ports import Brain.Reply as Reply exposing (Reply(..)) import Brain.Sources.Processing as Processing import Brain.Sources.Processing.Common as Processing +import Brain.Tracks as Tracks import Json.Decode as Json import Json.Decode.Pipeline exposing (optional) import Json.Encode -import Replying exposing (return) +import Replying exposing (andThen, return) import Sources.Encoding as Sources import Sources.Processing.Encoding as Processing import Tracks.Encoding as Tracks @@ -42,6 +43,7 @@ init flags = { authentication = Authentication.initialModel , hypaethralUserData = Authentication.emptyHypaethralUserData , processing = Processing.initialModel + , tracks = Tracks.initialModel } ----------------------------------------- -- Initial command @@ -85,9 +87,21 @@ update msg model = ProcessingMsg sub -> updateProcessing model sub + TracksMsg sub -> + updateTracks model sub + ----------------------------------------- -- User data ----------------------------------------- + -- The hypaethral user data is received in pieces, + -- pieces which are "cached" here in the web worker. + -- + -- The reasons for this are: + -- 1. Lesser performance penalty on the UI when saving data + -- (ie. this avoids having to encode/decode everything each time) + -- 2. The data can be used in the web worker (brain) as well. + -- (eg. for track-search index) + -- LoadHypaethralUserData value -> let decodedData = @@ -98,6 +112,7 @@ update msg model = ( { model | hypaethralUserData = decodedData } , Brain.Ports.toUI (Alien.broadcast Alien.LoadHypaethralUserData value) ) + |> andThen updateSearchIndex SaveFavourites value -> value @@ -118,11 +133,22 @@ update msg model = |> Json.decodeValue (Json.list Tracks.trackDecoder) |> Result.withDefault model.hypaethralUserData.tracks |> hypaethralLenses.setTracks model - |> saveHypaethralData + |> updateSearchIndex + |> andThen saveHypaethralData + +updateSearchIndex : Model -> ( Model, Cmd Msg ) +updateSearchIndex model = + update + (model.hypaethralUserData.tracks + |> Tracks.UpdateSearchIndex + |> TracksMsg + ) + model --- 📣 ░░ CHILDREN & REPLIES + +-- 📣 ░░ REPLIES translateReply : Reply -> Msg @@ -148,6 +174,10 @@ updateChild = Replying.updateChild update translateReply + +-- 📣 ░░ CHILDREN + + updateAuthentication : Model -> Authentication.Msg -> ( Model, Cmd Msg ) updateAuthentication model sub = updateChild @@ -172,6 +202,18 @@ updateProcessing model sub = } +updateTracks : Model -> Tracks.Msg -> ( Model, Cmd Msg ) +updateTracks model sub = + updateChild + { mapCmd = TracksMsg + , mapModel = \child -> { model | tracks = child } + , update = Tracks.update + } + { model = model.tracks + , msg = sub + } + + -- 📣 ░░ USER DATA @@ -185,11 +227,7 @@ hypaethralLenses = makeHypaethralLens : (HypaethralUserData -> a -> HypaethralUserData) -> Model -> a -> Model makeHypaethralLens setter model value = - let - h = - model.hypaethralUserData - in - { model | hypaethralUserData = setter h value } + { model | hypaethralUserData = setter model.hypaethralUserData value } saveHypaethralData : Model -> ( Model, Cmd Msg ) @@ -261,6 +299,13 @@ translateAlienEvent event = Just Alien.SaveTracks -> SaveTracks event.data + Just Alien.SearchTracks -> + event.data + |> Json.decodeValue Json.string + |> Result.withDefault "" + |> Tracks.Search + |> TracksMsg + Just Alien.SignIn -> AuthenticationMsg (Authentication.PerformSignIn event.data) diff --git a/src/Applications/Brain/Core.elm b/src/Applications/Brain/Core.elm index f5d861e8..26f0a461 100644 --- a/src/Applications/Brain/Core.elm +++ b/src/Applications/Brain/Core.elm @@ -4,6 +4,7 @@ import Alien import Authentication import Brain.Authentication as Authentication import Brain.Sources.Processing.Common as Processing +import Brain.Tracks as Tracks import Json.Decode as Json @@ -23,6 +24,7 @@ type alias Model = { authentication : Authentication.Model , hypaethralUserData : Authentication.HypaethralUserData , processing : Processing.Model + , tracks : Tracks.Model } @@ -38,6 +40,7 @@ type Msg ----------------------------------------- | AuthenticationMsg Authentication.Msg | ProcessingMsg Processing.Msg + | TracksMsg Tracks.Msg ----------------------------------------- -- User data ----------------------------------------- diff --git a/src/Applications/Brain/Tracks.elm b/src/Applications/Brain/Tracks.elm new file mode 100644 index 00000000..b0bdf43f --- /dev/null +++ b/src/Applications/Brain/Tracks.elm @@ -0,0 +1,102 @@ +module Brain.Tracks exposing (IndexedTrack, Model, Msg(..), createSearchIndex, initialModel, update) + +import Alien +import Brain.Reply exposing (Reply(..)) +import ElmTextSearch +import Json.Encode as Json +import Replying exposing (R3D3) +import Tracks exposing (Track) + + + +-- 🌳 + + +type alias Model = + { searchIndex : ElmTextSearch.Index IndexedTrack + } + + +type alias IndexedTrack = + { ref : String + + -- + , album : String + , artist : String + , title : String + } + + +initialModel : Model +initialModel = + { searchIndex = createSearchIndex [] + } + + + +-- 📣 + + +type Msg + = Search String + | UpdateSearchIndex (List Track) + + +update : Msg -> Model -> R3D3 Model Msg Reply +update msg model = + case msg of + Search term -> + let + ( updatedIndex, results ) = + Result.withDefault + ( model.searchIndex, [] ) + (ElmTextSearch.search + term + model.searchIndex + ) + + json = + results + |> List.map Tuple.first + |> Json.list Json.string + in + ( { model | searchIndex = updatedIndex } + , Cmd.none + , Just [ GiveUI Alien.SearchTracks json ] + ) + + UpdateSearchIndex tracks -> + ( { model | searchIndex = createSearchIndex tracks } + , Cmd.none + , Nothing + ) + + + +-- SEARCH + + +createSearchIndex : List Track -> ElmTextSearch.Index IndexedTrack +createSearchIndex tracks = + { ref = .ref + , fields = + [ ( .album, 5.0 ) + , ( .artist, 5.0 ) + , ( .title, 5.0 ) + ] + , listFields = [] + } + |> ElmTextSearch.new + |> ElmTextSearch.addDocs (List.map makeIndexedTrack tracks) + |> Tuple.first + + +makeIndexedTrack : Track -> IndexedTrack +makeIndexedTrack track = + { ref = track.id + + -- + , artist = track.tags.artist + , album = track.tags.album + , title = track.tags.title + } diff --git a/src/Applications/UI.elm b/src/Applications/UI.elm index 60de7fe1..c566b9ea 100644 --- a/src/Applications/UI.elm +++ b/src/Applications/UI.elm @@ -283,6 +283,15 @@ translateReply reply = Reply.SaveTracks -> Core.SaveTracks + ----------------------------------------- + -- To Brain + ----------------------------------------- + GiveBrain tag data -> + NotifyBrain (Alien.broadcast tag data) + + NudgeBrain tag -> + NotifyBrain (Alien.trigger tag) + updateChild = Replying.updateChild update translateReply @@ -334,6 +343,9 @@ translateAlienEvent event = -- TODO Bypass + Just Alien.SearchTracks -> + TracksMsg (UI.Tracks.SetSearchResults event.data) + Just Alien.UpdateSourceData -> -- TODO Bypass diff --git a/src/Applications/UI/Reply.elm b/src/Applications/UI/Reply.elm index 97020e1c..2f21bfa6 100644 --- a/src/Applications/UI/Reply.elm +++ b/src/Applications/UI/Reply.elm @@ -19,3 +19,6 @@ type Reply | SaveFavourites | SaveSources | SaveTracks + -- Brain + | GiveBrain Alien.Tag Json.Value + | NudgeBrain Alien.Tag diff --git a/src/Applications/UI/Tracks.elm b/src/Applications/UI/Tracks.elm index 0bf60bb0..119295ba 100644 --- a/src/Applications/UI/Tracks.elm +++ b/src/Applications/UI/Tracks.elm @@ -1,20 +1,23 @@ module UI.Tracks exposing (Model, Msg(..), initialModel, makeParcel, resolveParcel, update, view) +import Alien import Chunky exposing (..) import Color import Color.Ext as Color import Css import Html.Styled as Html exposing (Html, text) import Html.Styled.Attributes exposing (css, placeholder, title, value) -import Html.Styled.Events exposing (onClick, onInput) +import Html.Styled.Events exposing (onBlur, onClick, onInput) import Html.Styled.Ext exposing (onEnterKey) import Html.Styled.Lazy exposing (..) -import Json.Decode +import Json.Decode as Json +import Json.Encode import Material.Icons.Action as Icons import Material.Icons.Av as Icons import Material.Icons.Content as Icons import Material.Icons.Editor as Icons import Replying exposing (R3D3) +import Return2 import Return3 import Tachyons.Classes as T import Tracks exposing (..) @@ -65,7 +68,7 @@ type Msg ----------------------------------------- -- Collection ----------------------------------------- - | Add Json.Decode.Value + | Add Json.Value ----------------------------------------- -- Favourites ----------------------------------------- @@ -75,6 +78,7 @@ type Msg ----------------------------------------- | ClearSearch | Search (Maybe String) + | SetSearchResults Json.Value | SetSearchTerm String @@ -94,7 +98,7 @@ update msg model = let tracks = json - |> Json.Decode.decodeValue (Json.Decode.list Encoding.trackDecoder) + |> Json.decodeValue (Json.list Encoding.trackDecoder) |> Result.withDefault [] in model @@ -112,11 +116,35 @@ update msg model = -- Search ----------------------------------------- ClearSearch -> + reviseCollection + harvest + { model | searchResults = Nothing, searchTerm = Nothing } + + Search Nothing -> + reviseCollection + harvest + { model | searchResults = Nothing, searchTerm = Nothing } + + Search (Just "") -> + reviseCollection + harvest + { model | searchResults = Nothing, searchTerm = Nothing } + + Search (Just term) -> + { model | searchTerm = Just term } + |> Return2.withNoCmd + |> Return3.withReply [ GiveBrain Alien.SearchTracks (Json.Encode.string term) ] + + SetSearchResults json -> + json + |> Json.decodeValue (Json.list Json.string) + |> Result.withDefault [] + |> (\results -> { model | searchResults = Just results }) + |> reviseCollection harvest + + SetSearchTerm "" -> Return3.withNothing { model | searchTerm = Nothing } - Search maybeTerm -> - Return3.withNothing { model | searchTerm = maybeTerm } - SetSearchTerm term -> Return3.withNothing { model | searchTerm = Just term } @@ -155,6 +183,14 @@ resolveParcel model ( _, newCollection ) = Return3.withNothing modelWithNewCollection +reviseCollection : (Parcel -> Parcel) -> Model -> R3D3 Model Msg Reply +reviseCollection collector model = + model + |> makeParcel + |> collector + |> resolveParcel model + + -- 🗺 @@ -172,8 +208,8 @@ view model = , chunk [] (List.map - (\t -> text <| t.tags.artist ++ " - " ++ t.tags.title) - model.collection.untouched + (\( _, t ) -> text <| t.tags.artist ++ " - " ++ t.tags.title) + model.collection.harvested ) ] @@ -196,6 +232,7 @@ navigation favouritesOnly searchTerm = slab Html.input [ css searchInputStyles + , onBlur (Search searchTerm) , onEnterKey (Search searchTerm) , onInput SetSearchTerm , placeholder "Search" diff --git a/src/Applications/UI/UserData.elm b/src/Applications/UI/UserData.elm index 2c7887e5..5d05e4eb 100644 --- a/src/Applications/UI/UserData.elm +++ b/src/Applications/UI/UserData.elm @@ -5,6 +5,7 @@ import Json.Decode as Json import Json.Decode.Pipeline exposing (..) import Json.Encode import Replying exposing (R3D3) +import Sources import Sources.Encoding as Sources import Tracks exposing (emptyCollection) import Tracks.Collection as Tracks @@ -81,6 +82,7 @@ importTracks model data = adjustedModel = { model | collection = { emptyCollection | untouched = data.tracks } + , enabledSourceIds = Sources.enabledSourceIds data.sources , favourites = data.favourites } in diff --git a/src/Library/Alien.elm b/src/Library/Alien.elm index 640b029b..9134ac9b 100644 --- a/src/Library/Alien.elm +++ b/src/Library/Alien.elm @@ -22,6 +22,7 @@ type Tag = AuthAnonymous | AuthEnclosedData | AuthMethod + | SearchTracks -- from UI | ProcessSources | SaveEnclosedUserData @@ -82,6 +83,9 @@ tagToString tag = AuthEnclosedData -> "AUTH_ENCLOSED_DATA" + SearchTracks -> + "SEARCH_TRACKS" + ----------------------------------------- -- From UI ----------------------------------------- @@ -149,6 +153,9 @@ tagFromString string = "AUTH_ENCLOSED_DATA" -> Just AuthEnclosedData + "SEARCH_TRACKS" -> + Just SearchTracks + ----------------------------------------- -- From UI ----------------------------------------- diff --git a/src/Library/Replying.elm b/src/Library/Replying.elm index 8e131c89..5d35108b 100644 --- a/src/Library/Replying.elm +++ b/src/Library/Replying.elm @@ -1,5 +1,6 @@ -module Replying exposing (R3D3, Updator, do, reducto, return, updateChild) +module Replying exposing (R3D3, Updator, andThen, do, reducto, return, updateChild) +import Return2 import Return3 import Task @@ -50,6 +51,15 @@ return model msg = ( model, msg ) +{-| Chain `update` calls. +-} +andThen : (model -> ( model, Cmd msg )) -> ( model, Cmd msg ) -> ( model, Cmd msg ) +andThen fn ( model, cmd ) = + model + |> fn + |> Return2.addCmd cmd + + {-| Reduce a `R3D3` to a `R2D2`. -} reducto : Updator msg model -> (reply -> msg) -> R3D3 model msg reply -> ( model, Cmd msg ) diff --git a/src/Library/Sources.elm b/src/Library/Sources.elm index 8eb4f9fb..e671bcde 100644 --- a/src/Library/Sources.elm +++ b/src/Library/Sources.elm @@ -1,5 +1,6 @@ -module Sources exposing (Page(..), Property, Service(..), Source, SourceData, setProperId) +module Sources exposing (Page(..), Property, Service(..), Source, SourceData, enabledSourceIds, setProperId) +import Conditional exposing (..) import Dict exposing (Dict) import Time @@ -54,6 +55,11 @@ type Page --- 🔱 +enabledSourceIds : List Source -> List String +enabledSourceIds = + List.filterMap (\s -> ifThenElse s.enabled (Just s.id) Nothing) + + setProperId : Int -> Time.Posix -> Source -> Source setProperId n time source = { source | id = String.fromInt (Time.toMillis Time.utc time) ++ String.fromInt n } diff --git a/src/Library/String/Ext.elm b/src/Library/String/Ext.elm index fc4aead6..e7b8603a 100644 --- a/src/Library/String/Ext.elm +++ b/src/Library/String/Ext.elm @@ -5,7 +5,7 @@ chopEnd : String -> String -> String chopEnd needle str = if String.endsWith needle str then str - |> String.dropRight (String.length str) + |> String.dropRight 1 |> chopEnd needle else @@ -16,7 +16,7 @@ chopStart : String -> String -> String chopStart needle str = if String.startsWith needle str then str - |> String.dropLeft (String.length str) + |> String.dropLeft 1 |> chopStart needle else diff --git a/src/README.md b/src/README.md index 9d725624..a8271f8d 100644 --- a/src/README.md +++ b/src/README.md @@ -6,7 +6,7 @@ Elm directories: - Applications/UI - Library -`UI` is the Elm application that'll be executed on the main thread (ie. the UI thread) and `Brain` is the Elm application that'll live inside a web worker. `UI` will be the main application and `Brain` does the heavy lifting. The code shared between these two applications lives in `Library`. The library also contains the more "generic", code that's not necessarily tied to one or the other. +`UI` is the Elm application that'll be executed on the main thread (ie. the UI thread) and `Brain` is the Elm application that'll live inside a web worker. `UI` will be the main application and `Brain` does the heavy lifting. The code shared between these two applications lives in `Library`. The library also contains the more "generic" code that's not necessarily tied to one or the other. -- 2.51.2