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": { -- "": { -- "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)