aux-search/src/ElasticSearch.elm

349 lines
8.3 KiB
Elm
Raw Normal View History

module ElasticSearch exposing
( Model
, Msg(..)
, Options
, Result
, ResultItem
, decodeResult
, init
, makeRequest
, showLoadingOnQuery
, update
, view
)
import Base64
import Browser.Navigation
import Html
exposing
( Html
, button
, div
, form
, h1
, input
, text
)
import Html.Attributes
exposing
( class
, type_
, value
)
import Html.Events
exposing
( onInput
, onSubmit
)
import Http
import Json.Decode
import Json.Encode
import RemoteData
import Url.Builder
type alias Model a =
{ query : Maybe String
, result : RemoteData.WebData (Result a)
, showDetailsFor : Maybe String
}
type alias Result a =
{ hits : ResultHits a
}
type alias ResultHits a =
{ total : ResultHitsTotal
, max_score : Maybe Float
, hits : List (ResultItem a)
}
type alias ResultHitsTotal =
{ value : Int
, relation : String -- TODO: this should probably be Enum
}
type alias ResultItem a =
{ index : String
, id : String
, score : Float
, source : a
}
init :
Maybe String
-> Maybe String
-> ( Model a, Cmd msg )
init query showDetailsFor =
( { query = query
, result = RemoteData.NotAsked
, showDetailsFor = showDetailsFor
}
, Cmd.none
)
-- ---------------------------
-- UPDATE
-- ---------------------------
type Msg a
= QueryInput String
| QuerySubmit
| QueryResponse (RemoteData.WebData (Result a))
| ShowDetails String
update :
String
-> Browser.Navigation.Key
-> Msg a
-> Model a
-> ( Model a, Cmd (Msg a) )
update path navKey msg model =
case msg of
QueryInput query ->
( { model | query = Just query }
, Cmd.none
)
QuerySubmit ->
( model
, createUrl path model.query model.showDetailsFor
|> Browser.Navigation.pushUrl navKey
)
QueryResponse result ->
( { model | result = result }
, Cmd.none
)
ShowDetails selected ->
( { model
| showDetailsFor =
if model.showDetailsFor == Just selected then
Nothing
else
Just selected
}
, Cmd.none
)
showLoadingOnQuery : Model a -> Model a
showLoadingOnQuery model =
-- TODO: use this
{ model
| result =
case model.query of
Just query ->
RemoteData.Loading
Nothing ->
RemoteData.NotAsked
}
createUrl : String -> Maybe String -> Maybe String -> String
createUrl path query showDetailsFor =
[]
|> List.append
(query
|> Maybe.map
(\x ->
[ Url.Builder.string "query" x ]
)
|> Maybe.withDefault []
)
|> List.append
(showDetailsFor
|> Maybe.map
(\x ->
[ Url.Builder.string "showDetailsFor" x
]
)
|> Maybe.withDefault []
)
|> Url.Builder.absolute [ path ]
-- VIEW
view :
{ title : String }
-> Model a
-> (Maybe String -> Result a -> Html b)
-> (Msg a -> b)
-> Html b
view options model viewSuccess outMsg =
div [ class "search-page" ]
[ h1 [ class "page-header" ] [ text options.title ]
, div [ class "search-input" ]
[ form [ onSubmit (outMsg QuerySubmit) ]
[ div [ class "input-append" ]
[ input
[ type_ "text"
, onInput (\x -> outMsg (QueryInput x))
, value <| Maybe.withDefault "" model.query
]
[]
, div [ class "btn-group" ]
[ button [ class "btn" ] [ text "Search" ]
--TODO: and option to select the right channel+version+evaluation
--, button [ class "btn" ] [ text "Loading ..." ]
--, div [ class "popover bottom" ]
-- [ div [ class "arrow" ] []
-- , div [ class "popover-title" ] [ text "Select options" ]
-- , div [ class "popover-content" ]
-- [ p [] [ text "Sed posuere consectetur est at lobortis. Aenean eu leo quam. Pellentesque ornare sem lacinia quam venenatis vestibulum." ] ]
-- ]
]
]
]
]
, case model.result of
RemoteData.NotAsked ->
div [] [ text "NotAsked" ]
RemoteData.Loading ->
div [] [ text "Loading" ]
RemoteData.Success result ->
viewSuccess model.showDetailsFor result
RemoteData.Failure error ->
div []
[ text "Error!"
--, pre [] [ text (Debug.toString error) ]
]
]
-- API
type alias Options =
{ url : String
, username : String
, password : String
}
makeRequestBody : String -> String -> Http.Body
makeRequestBody field query =
let
stringIn name value =
[ ( name, Json.Encode.string value ) ]
objectIn name object =
[ ( name, Json.Encode.object object ) ]
in
-- Prefix Query
-- {
-- "query": {
-- "prefix": {
-- "user": {
-- "value": ""
-- }
-- }
-- }
-- }
--query
-- |> stringIn "value"
-- |> objectIn field
-- |> objectIn "prefix"
-- |> objectIn "query"
-- |> Json.Encode.object
-- |> Http.jsonBody
--
-- Wildcard Query
-- {
-- "query": {
-- "wildcard": {
-- "<field>": {
-- "value": "*<value>*",
-- }
-- }
-- }
-- }
("*" ++ query ++ "*")
|> stringIn "value"
|> objectIn field
|> objectIn "wildcard"
|> objectIn "query"
|> Json.Encode.object
|> Http.jsonBody
makeRequest :
String
-> String
-> Json.Decode.Decoder a
-> Options
-> String
-> Cmd (Msg a)
makeRequest field index decodeResultItemSource options query =
Http.riskyRequest
{ method = "POST"
, headers =
[ Http.header "Authorization" ("Basic " ++ Base64.encode (options.username ++ ":" ++ options.password))
]
, url = options.url ++ "/" ++ index ++ "/_search"
, body = makeRequestBody field query
, expect =
Http.expectJson
(RemoteData.fromResult >> QueryResponse)
(decodeResult decodeResultItemSource)
, timeout = Nothing
, tracker = Nothing
}
-- JSON
decodeResult :
Json.Decode.Decoder a
-> Json.Decode.Decoder (Result a)
decodeResult decodeResultItemSource =
Json.Decode.map Result
(Json.Decode.field "hits" (decodeResultHits decodeResultItemSource))
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.map4 ResultItem
(Json.Decode.field "_index" Json.Decode.string)
(Json.Decode.field "_id" Json.Decode.string)
(Json.Decode.field "_score" Json.Decode.float)
(Json.Decode.field "_source" decodeResultItemSource)