From 4841a52fad9ec0535fdb87f67bd661a4ef8ac0b3 Mon Sep 17 00:00:00 2001 From: iko Date: Thu, 3 Aug 2023 22:29:38 +0300 Subject: [PATCH] Show search sources with filtering --- dev/elm-live.sh | 2 +- frontend/index.html | 16 ++++ frontend/src/Main.elm | 173 ++++++++++++++++++++++++++++++++++++----- zod/seax/app/seax.hoon | 18 ++++- zod/seax/lib/rank.hoon | 8 +- 5 files changed, 192 insertions(+), 25 deletions(-) diff --git a/dev/elm-live.sh b/dev/elm-live.sh index 3153dff..e06cfda 100755 --- a/dev/elm-live.sh +++ b/dev/elm-live.sh @@ -4,4 +4,4 @@ set -e cd "$(dirname "$0")/../frontend" -nix run nixpkgs#elmPackages.elm-live -- src/Main.elm --start-page=index.html -- --output=elm.js "$@" +nix run nixpkgs#elmPackages.elm-live -- src/Main.elm --start-page=index.html -- --debug --output=elm.js "$@" diff --git a/frontend/index.html b/frontend/index.html index 7df940a..ddf34f6 100644 --- a/frontend/index.html +++ b/frontend/index.html @@ -6,6 +6,22 @@ diff --git a/frontend/src/Main.elm b/frontend/src/Main.elm index db1f3cb..6f59d3e 100644 --- a/frontend/src/Main.elm +++ b/frontend/src/Main.elm @@ -1,26 +1,27 @@ port module Main exposing (main) import Animator +import Browser.Events exposing (onAnimationFrameDelta) import Dict exposing (Dict) import Element exposing (..) import Element.Background as Background import Element.Border as Border -import Element.Events as Events +import Element.Events as Events exposing (onClick) import Element.Font as Font import Element.Input as Input import Element.Keyed as Keyed -import Heroicons.Outline import Html.Attributes -import Html.Events import Json.Decode as JD import List.Extra -import Svg.Attributes exposing (opacity) +import Set exposing (Set) import Time exposing (Posix) import Ur import Ur.Cmd import Ur.Deconstructor as D +import Ur.Jam exposing (isSig) import Ur.Run import Ur.Sub +import Ur.Types exposing (Noun(..)) url : String @@ -28,18 +29,36 @@ url = "http://localhost:8080" +type SearchEngineState + = Loading + | Failed + | Completed + + +deconstructSearchEngineState : D.Deconstructor SearchEngineState +deconstructSearchEngineState = + D.oneOf + [ D.const D.cord "loading" |> D.map (\_ -> Loading) + , D.const D.cord "failed" |> D.map (\_ -> Failed) + , D.const D.cord "completed" |> D.map (\_ -> Completed) + ] + + type alias Model = { ship : Maybe String , search : String , initiatedSearch : Maybe String , searchResults : List SearchResult , resultTimelines : Dict String ( Animator.Timeline Int, Animator.Timeline Bool ) + , engines : List ( String, SearchEngineState ) + , selectedEngines : Set String } type alias SearchResult = { title : String , link : String + , engines : Set String } @@ -48,9 +67,10 @@ type Msg | GotShipName String | UpdateSearch String | Search String - | UpdateSearchResults (List SearchResult) + | UpdateSearchResults (List SearchResult) (List ( String, SearchEngineState )) | OpenResult String | Tick Posix + | ToggleSearchEngine String main : Ur.Run.Program Model Msg @@ -59,9 +79,11 @@ main = { init = ( { ship = Nothing , search = "" - , initiatedSearch = Nothing + , initiatedSearch = Just "urbit" , searchResults = [] , resultTimelines = Dict.empty + , engines = [] + , selectedEngines = Set.empty } , Cmd.batch [ Ur.logIn url "lidlut-tabwed-pillex-ridrup" @@ -83,13 +105,19 @@ main = , path = [ "search", query ] , ship = ship_ , deconstructor = - D.list (D.cell D.cord D.cord) + D.cell + (D.list (D.cell D.cord deconstructSearchEngineState)) + (D.list (D.cell (D.list D.cord) (D.cell D.cord D.cord))) |> D.map - (List.map - (\( title, link ) -> - { title = title, link = link } - ) - >> UpdateSearchResults + (\( engines, results ) -> + UpdateSearchResults + (List.map + (\( resultEngines, ( title, link ) ) -> + { engines = Set.fromList resultEngines, title = title, link = link } + ) + results + ) + engines ) } @@ -100,6 +128,42 @@ main = } +debug : (String -> String) -> D.Deconstructor a -> D.Deconstructor a +debug log f noun = + case f noun of + Just x -> + Just x + + Nothing -> + let + _ = + log (prettyNoun noun) + in + Nothing + + +prettyNoun : Noun -> String +prettyNoun noun = + let + go isRhs n = + case n of + Atom a -> + if isSig a then + "~" + + else + "@" + + Cell ( lhs, rhs ) -> + if isRhs then + go False lhs ++ " " ++ go True rhs + + else + "[" ++ go False lhs ++ " " ++ go True rhs ++ "]" + in + go False noun + + view : Model -> Element Msg view model = case model.initiatedSearch of @@ -110,10 +174,65 @@ view model = ] Just query -> - column [ width fill, padding 8, spacing 16 ] - [ searchView model - , Keyed.column [ width fill ] + column [ width fill, spacing 16 ] + [ row [ spacing 16, width fill ] + [ searchView model |> el [ padding 8 ] + , model.engines + |> List.filter (\( _, state ) -> state /= Failed) + |> List.map + (\( name, state ) -> + text ("%" ++ name) + |> el + ([ Font.size 43 + , Font.bold + ] + ++ (if Set.isEmpty model.selectedEngines then + [] + + else if Set.member name model.selectedEngines then + [] + + else + [ Font.color (rgb 0.8 0.8 0.8) + ] + ) + ++ (case state of + Loading -> + [ Html.Attributes.class "bobbing" |> htmlAttribute + , Font.color (rgb 0.8 0.8 0.8) + ] + + Completed -> + [ mouseOver + [ Font.color (rgb 0.6 0.6 0.6) + ] + , pointer + , Events.onClick (ToggleSearchEngine name) + ] + + Failed -> + [] + ) + ) + ) + |> row + [ spacing 16 + , clipX + , scrollbarX + , width fill + , height (px 62) + ] + ] + , Keyed.column [ width fill, padding 8 ] (model.searchResults + |> List.filter + (\{ engines } -> + if Set.isEmpty model.selectedEngines then + True + + else + Set.intersect engines model.selectedEngines |> Set.isEmpty |> not + ) |> List.map (\{ title, link } -> ( link @@ -172,7 +291,7 @@ view model = searchView : { a | search : String } -> Element Msg searchView model = row [ spacing 8 ] - [ Input.text [] + [ Input.text [ width (px 250) ] { onChange = UpdateSearch , placeholder = Nothing , text = model.search @@ -214,7 +333,7 @@ update msg model = Search query -> ( { model | initiatedSearch = Just query }, Ur.Cmd.none ) - UpdateSearchResults results -> + UpdateSearchResults results engines -> let foo = List.Extra.zip (List.range 0 (List.length results - 1)) results @@ -231,7 +350,13 @@ update msg model = ) |> Dict.fromList in - ( { model | resultTimelines = foo, searchResults = results }, Ur.Cmd.none ) + ( { model + | resultTimelines = foo + , searchResults = results + , engines = engines + } + , Ur.Cmd.none + ) OpenResult url_ -> ( model, Ur.Cmd.none ) @@ -239,6 +364,13 @@ update msg model = Tick time -> ( Animator.update time (animator model) model, Ur.Cmd.none ) + ToggleSearchEngine name -> + if Set.member name model.selectedEngines then + ( { model | selectedEngines = Set.remove name model.selectedEngines }, Ur.Cmd.none ) + + else + ( { model | selectedEngines = Set.insert name model.selectedEngines }, Ur.Cmd.none ) + animator : Model -> Animator.Animator Model animator model = @@ -273,6 +405,11 @@ result f g res = f a +listsHaveElementsInCommon : List comparable -> List comparable -> Bool +listsHaveElementsInCommon a b = + Set.intersect (Set.fromList a) (Set.fromList b) |> Set.isEmpty |> not + + port createEventSource : String -> Cmd msg diff --git a/zod/seax/app/seax.hoon b/zod/seax/app/seax.hoon index 027a8de..14eaee3 100644 --- a/zod/seax/app/seax.hoon +++ b/zod/seax/app/seax.hoon @@ -42,15 +42,29 @@ $: -- =/ state *state-0 +=* current-engines + |= =query + ^- (list [term ?(%loading %failed %completed)]) + %+ turn ~(tap in ~(key by engines)) + |= engine=term + :- engine + =/ results + (~(get by search-results:(~(got by search-subscriptions.state) query)) engine) + ?~ results %loading + ?~ +.results %failed + %completed =* search-results |= =query %- rank-results =/ search-state=search-state (~(got by search-subscriptions.state) query) search-results.search-state +=* sink-for-query + |= =query + [(current-engines query) (search-results query)] =* sink |= =query - ((sink:^sink ~[~[%search query]]) (search-results query)) + ((sink:^sink ~[~[%search query]]) (sink-for-query query)) ^- agent:gall %- agent:dbug @@ -130,7 +144,7 @@ $: (~(put by search-results.search-subscription) engine-name results) =. search-subscriptions.state (~(put by search-subscriptions.state) query search-subscription) - =^ card sink (sync:sink (search-results query)) + =^ card sink (sync:sink (sink-for-query query)) [~[card] this] == ++ on-fail |=([term tang] `..on-init) diff --git a/zod/seax/lib/rank.hoon b/zod/seax/lib/rank.hoon index dd90618..d2e85e9 100644 --- a/zod/seax/lib/rank.hoon +++ b/zod/seax/lib/rank.hoon @@ -3,7 +3,7 @@ =< |= results=(list [engine=term results=(list search-result)]) -^- (list search-result) +^- (list [engines=(list term) =search-result]) =/ url-to-engine-map ^- (list (map @t [engines=(list term) ords=(list @u) result=search-result])) %- zing @@ -29,7 +29,7 @@ == [(weld engines-lhs engines-rhs) (weld ords-lhs ords-rhs) result] =/ ranking - ^- (list [ord=@rs result=search-result]) + ^- (list [ord=@rs result=[engines=(list term) =search-result]]) %+ turn ~(val by url-to-engines-map) |= [engines=(list term) ords=(list @u) result=search-result] =/ engine-weights @@ -52,13 +52,13 @@ =/ rank ^- @rs (mul:rs engine-weights position-weights) - [ord=rank result=result] + [ord=rank result=[engines result]] =/ sorted-results %+ sort ranking |= [[lhs=@rs *] [rhs=@rs *]] %+ gth lhs rhs %+ turn sorted-results -|= [* result=search-result] +|= [* result=[(list term) search-result]] result |%