Show search sources with filtering

This commit is contained in:
iko 2023-08-03 22:29:38 +03:00
parent 3de0c04bce
commit 4841a52fad
Signed by untrusted user: iko
GPG Key ID: 82C257048D1026F2
5 changed files with 192 additions and 25 deletions

View File

@ -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 "$@"

View File

@ -6,6 +6,22 @@
<style>
body {
font-family: system-ui, -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, Helvetica, Arial, sans-serif, "Apple Color Emoji", "Segoe UI Emoji", "Segoe UI Symbol";
margin: 0;
}
@keyframes bobbing {
from {
transform: translateY(-30px);
}
to {
transform: traslateY(0);
}
}
.bobbing {
animation-duration: 2s;
animation-name: bobbing;
animation-iteration-count: infinite;
animation-direction: alternate;
animation-timing-function: ease-in-out;
}
</style>
</head>

View File

@ -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

View File

@ -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)

View File

@ -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
|%