aux-search/src/Search.elm
2021-01-23 17:25:43 +01:00

1187 lines
31 KiB
Elm

module Search exposing
( Aggregation
, AggregationsBucketItem
, Model
, Msg(..)
, Options
, ResultItem
, SearchResult
, Sort(..)
, channelDetailsFromId
, channels
, decodeAggregation
, decodeResult
, elementId
, fromSortId
, init
, makeRequest
, makeRequestBody
, onClickStop
, shouldLoad
, showMoreButton
, trapClick
, update
, view
)
import Base64
import Browser.Dom
import Browser.Navigation
import Html
exposing
( Html
, a
, button
, div
, form
, h1
, h2
, h4
, input
, li
, p
, span
, strong
, text
, ul
)
import Html.Attributes
exposing
( attribute
, autofocus
, class
, classList
, href
, id
, placeholder
, type_
, value
)
import Html.Events
exposing
( onClick
, onInput
, onSubmit
)
import Http
import Json.Decode
import Json.Encode
import RemoteData
import Route
import Route.SearchQuery
import Set
import Task
type alias Model a b =
{ channel : String
, query : Maybe String
, result : RemoteData.WebData (SearchResult a b)
, show : Maybe String
, from : Int
, size : Int
, buckets : Maybe String
, sort : Sort
, showNixOSDetails : Bool
}
type alias SearchResult a b =
{ hits : ResultHits a
, aggregations : b
}
type alias ResultHits a =
{ total : ResultHitsTotal
, max_score : Maybe Float
, hits : List (ResultItem a)
}
type alias ResultHitsTotal =
{ value : Int
, relation : String
}
type alias ResultItem a =
{ index : String
, id : String
, score : Maybe Float
, source : a
, text : Maybe String
, matched_queries : Maybe (List String)
}
type alias Aggregation =
{ doc_count_error_upper_bound : Int
, sum_other_doc_count : Int
, buckets : List AggregationsBucketItem
}
type alias AggregationsBucketItem =
{ doc_count : Int
, key : String
}
type Sort
= Relevance
| AlphabeticallyAsc
| AlphabeticallyDesc
init :
Route.SearchArgs
-> Maybe (Model a b)
-> ( Model a b, Cmd (Msg a b) )
init args maybeModel =
let
getField getFn default =
maybeModel
|> Maybe.map getFn
|> Maybe.withDefault default
modelChannel =
getField .channel defaultChannel
modelFrom =
getField .from 0
modelSize =
getField .size 50
in
( { channel =
args.channel
|> Maybe.withDefault modelChannel
, query =
args.query
|> Maybe.andThen Route.SearchQuery.searchQueryToString
, result = getField .result RemoteData.NotAsked
, show = args.show
, from =
args.from
|> Maybe.withDefault modelFrom
, size =
args.size
|> Maybe.withDefault modelSize
, buckets = args.buckets
, sort =
args.sort
|> Maybe.withDefault ""
|> fromSortId
|> Maybe.withDefault Relevance
, showNixOSDetails = False
}
|> ensureLoading
, Browser.Dom.focus "search-query-input" |> Task.attempt (\_ -> NoOp)
)
shouldLoad :
Model a b
-> Bool
shouldLoad model =
model.result == RemoteData.Loading
ensureLoading :
Model a b
-> Model a b
ensureLoading model =
if model.query /= Nothing && model.query /= Just "" && List.member model.channel channels then
{ model | result = RemoteData.Loading }
else
model
elementId : String -> Html.Attribute msg
elementId str =
Html.Attributes.id <| "result-" ++ str
-- ---------------------------
-- UPDATE
-- ---------------------------
type Msg a b
= NoOp
| SortChange Sort
| BucketsChange String
| ChannelChange String
| QueryInput String
| QueryInputSubmit
| QueryResponse (RemoteData.WebData (SearchResult a b))
| ShowDetails String
| ChangePage Int
| ShowNixOSDetails Bool
scrollToEntry :
Maybe String
-> Cmd (Msg a b)
scrollToEntry val =
let
doScroll id =
Browser.Dom.getElement ("result-" ++ id)
|> Task.andThen (\{ element } -> Browser.Dom.setViewport element.x element.y)
|> Task.attempt (always NoOp)
in
Maybe.withDefault Cmd.none <| Maybe.map doScroll val
update :
Route.SearchRoute
-> Browser.Navigation.Key
-> Msg a b
-> Model a b
-> ( Model a b, Cmd (Msg a b) )
update toRoute navKey msg model =
case msg of
NoOp ->
( model
, Cmd.none
)
SortChange sort ->
{ model
| sort = sort
, show = Nothing
, from = 0
}
|> ensureLoading
|> pushUrl toRoute navKey
BucketsChange buckets ->
{ model
| buckets =
if buckets == "" then
Nothing
else
Just buckets
, show = Nothing
, from = 0
}
|> ensureLoading
|> pushUrl toRoute navKey
ChannelChange channel ->
{ model
| channel = channel
, show = Nothing
, buckets = Nothing
, from = 0
}
|> ensureLoading
|> pushUrl toRoute navKey
QueryInput query ->
( { model | query = Just query }
, Cmd.none
)
QueryInputSubmit ->
{ model
| from = 0
, show = Nothing
, buckets = Nothing
}
|> ensureLoading
|> pushUrl toRoute navKey
QueryResponse result ->
( { model
| result = result
}
, scrollToEntry model.show
)
ShowDetails selected ->
{ model
| show =
if model.show == Just selected then
Nothing
else
Just selected
}
|> pushUrl toRoute navKey
ChangePage from ->
{ model | from = from }
|> ensureLoading
|> pushUrl toRoute navKey
ShowNixOSDetails show ->
{ model | showNixOSDetails = show }
|> pushUrl toRoute navKey
pushUrl :
Route.SearchRoute
-> Browser.Navigation.Key
-> Model a b
-> ( Model a b, Cmd msg )
pushUrl toRoute navKey model =
Tuple.pair model <|
if model.query == Nothing || model.query == Just "" then
Cmd.none
else
Browser.Navigation.pushUrl navKey <| createUrl toRoute model
createUrl :
Route.SearchRoute
-> Model a b
-> String
createUrl toRoute model =
Route.routeToString <|
toRoute
{ channel = Just model.channel
, query = Maybe.map Route.SearchQuery.toSearchQuery model.query
, show = model.show
, from = Just model.from
, size = Just model.size
, buckets = model.buckets
, sort = Just <| toSortId model.sort
}
-- VIEW
type Channel
= Unstable
| Release_20_03
| Release_20_09
{-| TODO: we should consider using more dynamic approach here
and load channels from apis similar to what status page does
-}
type alias ChannelDetails =
{ id : String
, title : String
, jobset : String
, branch : String
}
defaultChannel : String
defaultChannel =
"20.09"
channelDetails : Channel -> ChannelDetails
channelDetails channel =
case channel of
Unstable ->
ChannelDetails "unstable" "unstable" "nixos/trunk-combined" "nixos-unstable"
Release_20_03 ->
ChannelDetails "20.03" "20.03" "nixos/release-20.03" "nixos-20.03"
Release_20_09 ->
ChannelDetails "20.09" "20.09" "nixos/release-20.09" "nixos-20.09"
channelFromId : String -> Maybe Channel
channelFromId channel_id =
case channel_id of
"unstable" ->
Just Unstable
"20.03" ->
Just Release_20_03
"20.09" ->
Just Release_20_09
_ ->
Nothing
channelDetailsFromId : String -> Maybe ChannelDetails
channelDetailsFromId channel_id =
channelFromId channel_id
|> Maybe.map channelDetails
channels : List String
channels =
[ "20.03"
, "20.09"
, "unstable"
]
sortBy : List Sort
sortBy =
[ Relevance
, AlphabeticallyAsc
, AlphabeticallyDesc
]
toAggregations :
List String
-> ( String, Json.Encode.Value )
toAggregations bucketsFields =
let
fields =
List.map
(\field ->
( field
, Json.Encode.object
[ ( "terms"
, Json.Encode.object
[ ( "field"
, Json.Encode.string field
)
]
)
]
)
)
bucketsFields
allFields =
[ ( "all"
, Json.Encode.object
[ ( "global"
, Json.Encode.object []
)
, ( "aggregations"
, Json.Encode.object fields
)
]
)
]
in
( "aggregations"
, Json.Encode.object <|
List.append fields allFields
)
toSortQuery :
Sort
-> String
-> ( String, Json.Encode.Value )
toSortQuery sort field =
( "sort"
, case sort of
AlphabeticallyAsc ->
Json.Encode.list Json.Encode.object
[ [ ( field, Json.Encode.string "asc" )
]
]
AlphabeticallyDesc ->
Json.Encode.list Json.Encode.object
[ [ ( field, Json.Encode.string "desc" )
]
]
Relevance ->
Json.Encode.list Json.Encode.string
[ "_score"
]
)
toSortTitle : Sort -> String
toSortTitle sort =
case sort of
AlphabeticallyAsc ->
"Alphabetically Ascending"
AlphabeticallyDesc ->
"Alphabetically Descending"
Relevance ->
"Best match"
toSortId : Sort -> String
toSortId sort =
case sort of
AlphabeticallyAsc ->
"alpha_asc"
AlphabeticallyDesc ->
"alpha_desc"
Relevance ->
"relevance"
fromSortId : String -> Maybe Sort
fromSortId id =
case id of
"alpha_asc" ->
Just AlphabeticallyAsc
"alpha_desc" ->
Just AlphabeticallyDesc
"relevance" ->
Just Relevance
_ ->
Nothing
view :
{ toRoute : Route.SearchRoute
, categoryName : String
}
-> List (Html c)
-> Model a b
->
(String
-> Bool
-> Maybe String
-> List (ResultItem a)
-> Html c
)
->
(Maybe String
-> SearchResult a b
-> List (Html c)
)
-> (Msg a b -> c)
-> Html c
view { toRoute, categoryName } title model viewSuccess viewBuckets outMsg =
let
resultStatus =
case model.result of
RemoteData.NotAsked ->
"not-asked"
RemoteData.Loading ->
"loading"
RemoteData.Success _ ->
"success"
RemoteData.Failure _ ->
"failure"
in
div [ class <| "search-page " ++ resultStatus ]
[ h1 [] title
, viewSearchInput outMsg categoryName model.channel model.query
, viewResult outMsg toRoute categoryName model viewSuccess viewBuckets
]
viewResult :
(Msg a b -> c)
-> Route.SearchRoute
-> String
-> Model a b
->
(String
-> Bool
-> Maybe String
-> List (ResultItem a)
-> Html c
)
->
(Maybe String
-> SearchResult a b
-> List (Html c)
)
-> Html c
viewResult outMsg toRoute categoryName model viewSuccess viewBuckets =
case model.result of
RemoteData.NotAsked ->
div [] [ text "" ]
RemoteData.Loading ->
div [ class "loader-wrapper" ]
[ div [ class "loader" ] [ text "Loading..." ]
, h2 [] [ text "Searching..." ]
]
RemoteData.Success result ->
let
buckets =
viewBuckets model.buckets result
in
if result.hits.total.value == 0 && List.length buckets == 0 then
viewNoResults categoryName
else if List.length buckets > 0 then
div [ class "search-results" ]
[ ul [] buckets
, div []
(viewResults model result viewSuccess toRoute outMsg categoryName)
]
else
div [ class "search-results" ]
[ div []
(viewResults model result viewSuccess toRoute outMsg categoryName)
]
RemoteData.Failure error ->
let
( errorTitle, errorMessage ) =
case error of
Http.BadUrl text ->
( "Bad Url!", text )
Http.Timeout ->
( "Timeout!", "Request to the server timeout." )
Http.NetworkError ->
( "Network Error!", "A network request bonsaisearch.net domain failed. This is either due to a content blocker or a networking issue." )
Http.BadStatus code ->
( "Bad Status", "Server returned " ++ String.fromInt code )
Http.BadBody text ->
( "Bad Body", text )
in
div []
[ div [ class "alert alert-error" ]
[ h4 [] [ text errorTitle ]
, text errorMessage
]
]
viewNoResults :
String
-> Html c
viewNoResults categoryName =
div [ class "search-no-results" ]
[ h2 [] [ text <| "No " ++ categoryName ++ " found!" ]
, text "How to "
, Html.a [ href "https://nixos.org/manual/nixpkgs/stable/#chap-quick-start" ] [ text "add" ]
, text " or "
, a [ href "https://github.com/NixOS/nixpkgs/issues/new?assignees=&labels=0.kind%3A+packaging+request&template=packaging_request.md&title=" ] [ text "request" ]
, text " package to nixpkgs?"
]
viewSearchInput :
(Msg a b -> c)
-> String
-> String
-> Maybe String
-> Html c
viewSearchInput outMsg categoryName selectedChannel searchQuery =
form
[ onSubmit (outMsg QueryInputSubmit)
, class "search-input"
]
[ div []
[ div []
[ input
[ type_ "text"
, id "search-query-input"
, autofocus True
, placeholder <| "Search for " ++ categoryName
, onInput (outMsg << QueryInput)
, value <| Maybe.withDefault "" searchQuery
]
[]
]
, button [ class "btn", type_ "submit" ]
[ text "Search" ]
]
, div [] (viewChannels outMsg selectedChannel)
]
viewChannels :
(Msg a b -> c)
-> String
-> List (Html c)
viewChannels outMsg selectedChannel =
List.append
[ div []
[ h4 [] [ text "Channel: " ]
, div
[ class "btn-group"
, attribute "data-toggle" "buttons-radio"
]
(List.filterMap
(\channelId ->
channelDetailsFromId channelId
|> Maybe.map
(\channel ->
button
[ type_ "button"
, classList
[ ( "btn", True )
, ( "active", channel.id == selectedChannel )
]
, onClick <| outMsg (ChannelChange channel.id)
]
[ text channel.title ]
)
)
channels
)
]
]
(if List.member selectedChannel channels then
[]
else
[ p [ class "alert alert-error" ]
[ h4 [] [ text "Wrong channel selected!" ]
, text <| "Please select one of the channels above!"
]
]
)
viewResults :
Model a b
-> SearchResult a b
->
(String
-> Bool
-> Maybe String
-> List (ResultItem a)
-> Html c
)
-> Route.SearchRoute
-> (Msg a b -> c)
-> String
-> List (Html c)
viewResults model result viewSuccess toRoute outMsg categoryName =
let
from =
String.fromInt (model.from + 1)
to =
String.fromInt
(if model.from + model.size > result.hits.total.value then
result.hits.total.value
else
model.from + model.size
)
total =
String.fromInt result.hits.total.value
in
[ div []
[ Html.map outMsg <| viewSortSelection toRoute model
, div []
(List.append
[ text "Showing results "
, text from
, text "-"
, text to
, text " of "
]
(if result.hits.total.value == 10000 then
[ text "more than 10000."
, p [] [ text "Please provide more precise search terms." ]
]
else
[ strong []
[ text total
, text " "
, text categoryName
]
, text "."
]
)
)
]
, viewSuccess model.channel model.showNixOSDetails model.show result.hits.hits
, Html.map outMsg <| viewPager model result.hits.total.value
]
viewSortSelection :
Route.SearchRoute
-> Model a b
-> Html (Msg a b)
viewSortSelection toRoute model =
div [ class "btn-group dropdown pull-right" ]
[ button
[ class "btn"
, attribute "data-toggle" "dropdown"
]
[ span [] [ text <| "Sort: " ]
, span [ class "selected" ] [ text <| toSortTitle model.sort ]
, span [ class "caret" ] []
]
, ul [ class "dropdown-menu pull-right" ]
(List.append
[ li [ class " header" ] [ text "Sort options" ]
, li [ class "divider" ] []
]
(List.map
(\sort ->
li
[ classList
[ ( "selected", model.sort == sort )
]
]
[ a
[ href "#"
, onClick <| SortChange sort
]
[ text <| toSortTitle sort ]
]
)
sortBy
)
)
]
viewPager :
Model a b
-> Int
-> Html (Msg a b)
viewPager model total =
div []
[ ul [ class "pager" ]
[ li [ classList [ ( "disabled", model.from == 0 ) ] ]
[ a
[ onClick <|
if model.from == 0 then
NoOp
else
ChangePage 0
]
[ text "First" ]
]
, li [ classList [ ( "disabled", model.from == 0 ) ] ]
[ a
[ onClick <|
if model.from - model.size < 0 then
NoOp
else
ChangePage <| model.from - model.size
]
[ text "Previous" ]
]
, li [ classList [ ( "disabled", model.from + model.size >= total ) ] ]
[ a
[ onClick <|
if model.from + model.size >= total then
NoOp
else
ChangePage <| model.from + model.size
]
[ text "Next" ]
]
, li [ classList [ ( "disabled", model.from + model.size >= total ) ] ]
[ a
[ onClick <|
if model.from + model.size >= total then
NoOp
else
let
remainder =
if remainderBy model.size total == 0 then
1
else
0
in
ChangePage <| ((total // model.size) - remainder) * model.size
]
[ text "Last" ]
]
]
]
-- API
type alias Options =
{ mappingSchemaVersion : Int
, url : String
, username : String
, password : String
}
filterByType :
String
-> List ( String, Json.Encode.Value )
filterByType type_ =
[ ( "term"
, Json.Encode.object
[ ( "type"
, Json.Encode.object
[ ( "value", Json.Encode.string type_ )
, ( "_name", Json.Encode.string <| "filter_" ++ type_ ++ "s" )
]
)
]
)
]
searchFields :
String
-> List ( String, Float )
-> List (List ( String, Json.Encode.Value ))
searchFields query fields =
let
queryVariations q =
case ( List.head q, List.tail q ) of
( Just h, Just t ) ->
let
tail : List (List String)
tail =
queryVariations t
in
List.append
(List.map (\x -> List.append [ h ] x) tail)
(List.map (\x -> List.append [ String.reverse h ] x) tail)
|> Set.fromList
|> Set.toList
( Just h, Nothing ) ->
[ [ h ], [ String.reverse h ] ]
( _, _ ) ->
[ [], [] ]
reverseFields =
List.map (\( field, score ) -> ( field ++ "_reverse", score * 0.8 )) fields
allFields =
List.append fields reverseFields
|> List.map (\( field, score ) -> [ field ++ "^" ++ String.fromFloat score, field ++ ".edge^" ++ String.fromFloat score ])
|> List.concat
in
List.map
(\queryWords ->
[ ( "multi_match"
, Json.Encode.object
[ ( "type", Json.Encode.string "cross_fields" )
, ( "query", Json.Encode.string <| String.join " " queryWords )
, ( "analyzer", Json.Encode.string "whitespace" )
, ( "auto_generate_synonyms_phrase_query", Json.Encode.bool False )
, ( "operator", Json.Encode.string "and" )
, ( "_name", Json.Encode.string <| "multi_match_" ++ String.join "_" queryWords )
, ( "fields", Json.Encode.list Json.Encode.string allFields )
]
)
]
)
(queryVariations (String.words query))
makeRequestBody :
String
-> Int
-> Int
-> Sort
-> String
-> String
-> List String
-> List ( String, Json.Encode.Value )
-> List ( String, Float )
-> Http.Body
makeRequestBody query from sizeRaw sort type_ sortField bucketsFields filterByBuckets fields =
let
-- you can not request more then 10000 results otherwise it will return 404
size =
if from + sizeRaw > 10000 then
10000 - from
else
sizeRaw
in
Http.jsonBody
(Json.Encode.object
(List.append
[ ( "from"
, Json.Encode.int from
)
, ( "size"
, Json.Encode.int size
)
, toSortQuery sort sortField
, toAggregations bucketsFields
, ( "query"
, Json.Encode.object
[ ( "bool"
, Json.Encode.object
[ ( "filter"
, Json.Encode.list Json.Encode.object
[ filterByType type_ ]
)
, ( "must"
, Json.Encode.list Json.Encode.object
[ [ ( "dis_max"
, Json.Encode.object
[ ( "tie_breaker", Json.Encode.float 0.7 )
, ( "queries"
, Json.Encode.list Json.Encode.object
(searchFields query fields)
)
]
)
]
]
)
]
)
]
)
]
(if List.isEmpty filterByBuckets then
[]
else
[ ( "post_filter", Json.Encode.object filterByBuckets ) ]
)
)
)
makeRequest :
Http.Body
-> String
-> Json.Decode.Decoder a
-> Json.Decode.Decoder b
-> Options
-> (RemoteData.WebData (SearchResult a b) -> Msg a b)
-> Maybe String
-> Cmd (Msg a b)
makeRequest body index decodeResultItemSource decodeResultAggregations options responseMsg tracker =
Http.riskyRequest
{ method = "POST"
, headers =
[ Http.header "Authorization" ("Basic " ++ Base64.encode (options.username ++ ":" ++ options.password))
]
, url = options.url ++ "/" ++ index ++ "/_search"
, body = body
, expect =
Http.expectJson
(RemoteData.fromResult >> responseMsg)
(decodeResult decodeResultItemSource decodeResultAggregations)
, timeout = Nothing
, tracker = tracker
}
-- JSON
decodeResult :
Json.Decode.Decoder a
-> Json.Decode.Decoder b
-> Json.Decode.Decoder (SearchResult a b)
decodeResult decodeResultItemSource decodeResultAggregations =
Json.Decode.map2 SearchResult
(Json.Decode.field "hits" (decodeResultHits decodeResultItemSource))
(Json.Decode.field "aggregations" decodeResultAggregations)
decodeResultHits : Json.Decode.Decoder a -> Json.Decode.Decoder (ResultHits a)
decodeResultHits decodeResultItemSource =
Json.Decode.map3 ResultHits
(Json.Decode.field "total" decodeResultHitsTotal)
(Json.Decode.field "max_score" (Json.Decode.nullable Json.Decode.float))
(Json.Decode.field "hits" (Json.Decode.list (decodeResultItem decodeResultItemSource)))
decodeResultHitsTotal : Json.Decode.Decoder ResultHitsTotal
decodeResultHitsTotal =
Json.Decode.map2 ResultHitsTotal
(Json.Decode.field "value" Json.Decode.int)
(Json.Decode.field "relation" Json.Decode.string)
decodeResultItem : Json.Decode.Decoder a -> Json.Decode.Decoder (ResultItem a)
decodeResultItem decodeResultItemSource =
Json.Decode.map6 ResultItem
(Json.Decode.field "_index" Json.Decode.string)
(Json.Decode.field "_id" Json.Decode.string)
(Json.Decode.field "_score" (Json.Decode.nullable Json.Decode.float))
(Json.Decode.field "_source" decodeResultItemSource)
(Json.Decode.maybe (Json.Decode.field "text" Json.Decode.string))
(Json.Decode.maybe (Json.Decode.field "matched_queries" (Json.Decode.list Json.Decode.string)))
decodeAggregation : Json.Decode.Decoder Aggregation
decodeAggregation =
Json.Decode.map3 Aggregation
(Json.Decode.field "doc_count_error_upper_bound" Json.Decode.int)
(Json.Decode.field "sum_other_doc_count" Json.Decode.int)
(Json.Decode.field "buckets" (Json.Decode.list decodeAggregationBucketItem))
decodeAggregationBucketItem : Json.Decode.Decoder AggregationsBucketItem
decodeAggregationBucketItem =
Json.Decode.map2 AggregationsBucketItem
(Json.Decode.field "doc_count" Json.Decode.int)
(Json.Decode.field "key" Json.Decode.string)
-- Html Helper elemetnts
showMoreButton : msg -> Bool -> Html msg
showMoreButton toggle isOpen =
div [ class "result-item-show-more-wrapper" ]
[ a
[ href "#"
, onClick toggle
, class "result-item-show-more"
]
[ text <|
if isOpen then
" Hide package details "
else
" Show more package details "
]
]
-- Html Event Helpers
onClickStop : msg -> Html.Attribute msg
onClickStop message =
Html.Events.custom "click" <|
Json.Decode.succeed
{ message = message
, stopPropagation = True
, preventDefault = True
}
trapClick : Html.Attribute (Msg a b)
trapClick =
Html.Events.stopPropagationOn "click" <|
Json.Decode.succeed ( NoOp, True )