aux-search/src/ElasticSearch.elm

module ElasticSearch exposing
    ( Model
    , Msg(..)
    , Options
    , Result
    , ResultItem
    , decodeResult
    , init
    , makeRequest
    , update
    , view
    )

import Base64
import Browser.Navigation
import Html
    exposing
        ( Html
        , a
        , button
        , div
        , em
        , form
        , h1
        , input
        , li
        , p
        , pre
        , text
        , ul
        )
import Html.Attributes
    exposing
        ( class
        , classList
        , href
        , type_
        , value
        )
import Html.Events
    exposing
        ( custom
        , onClick
        , onInput
        , onSubmit
        , preventDefaultOn
        )
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
    , from : Int
    , size : Int
    }


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
    -> Maybe Int
    -> Maybe Int
    -> ( Model a, Cmd msg )
init query showDetailsFor from size =
    ( { query = query
      , result = RemoteData.NotAsked
      , showDetailsFor = showDetailsFor
      , from = Maybe.withDefault 0 from
      , size = Maybe.withDefault 15 size
      }
    , Cmd.none
    )



-- ---------------------------
-- UPDATE
-- ---------------------------


type Msg a
    = NoOp
    | 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
        NoOp ->
            ( model
            , Cmd.none
            )

        QueryInput query ->
            ( { model | query = Just query }
            , Cmd.none
            )

        QuerySubmit ->
            ( model
            , createUrl path
                model.query
                model.showDetailsFor
                0
                model.size
                |> Browser.Navigation.pushUrl navKey
            )

        QueryResponse result ->
            ( { model | result = result }
            , Cmd.none
            )

        ShowDetails selected ->
            ( model
            , createUrl path
                model.query
                (if model.showDetailsFor == Just selected then
                    Nothing

                 else
                    Just selected
                )
                model.from
                model.size
                |> Browser.Navigation.pushUrl navKey
            )


createUrl :
    String
    -> Maybe String
    -> Maybe String
    -> Int
    -> Int
    -> String
createUrl path query showDetailsFor from size =
    [ Url.Builder.int "from" from
    , Url.Builder.int "size" size
    ]
        |> 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 :
    String
    -> String
    -> Model a
    -> (Maybe String -> Result a -> Html b)
    -> (Msg a -> b)
    -> Html b
view path title model viewSuccess outMsg =
    div [ class "search-page" ]
        [ h1 [ class "page-header" ] [ text 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" ]
                        ]
                    ]
                ]
            ]
        , case model.result of
            RemoteData.NotAsked ->
                div [] [ text "NotAsked" ]

            RemoteData.Loading ->
                div [] [ text "Loading" ]

            RemoteData.Success result ->
                div []
                    [ p []
                        [ em []
                            [ text
                                ("Showing results "
                                    ++ String.fromInt model.from
                                    ++ "-"
                                    ++ String.fromInt
                                        (if model.from + model.size > result.hits.total.value then
                                            result.hits.total.value

                                         else
                                            model.from + model.size
                                        )
                                    ++ " of "
                                    ++ String.fromInt result.hits.total.value
                                    ++ "."
                                )
                            ]
                        ]
                    , viewPager outMsg model result path
                    , viewSuccess model.showDetailsFor result
                    , viewPager outMsg model result path
                    ]

            RemoteData.Failure error ->
                div []
                    [ text "Error!"

                    --, pre [] [ text (Debug.toString error) ]
                    ]
        ]


viewPager :
    (Msg a -> b)
    -> Model a
    -> Result a
    -> String
    -> Html b
viewPager outMsg model result path =
    ul [ class "pager" ]
        [ li
            [ classList
                [ ( "disabled", model.from == 0 )
                ]
            ]
            [ a
                [ if model.from == 0 then
                    href "#disabled"

                  else
                    href <|
                        createUrl
                            path
                            model.query
                            model.showDetailsFor
                            0
                            model.size
                ]
                [ text "First" ]
            ]
        , li
            [ classList
                [ ( "disabled", model.from == 0 )
                ]
            ]
            [ a
                [ href <|
                    if model.from - model.size < 0 then
                        "#disabled"

                    else
                        createUrl
                            path
                            model.query
                            model.showDetailsFor
                            (model.from - model.size)
                            model.size
                ]
                [ text "Previous" ]
            ]
        , li
            [ classList
                [ ( "disabled", model.from + model.size >= result.hits.total.value )
                ]
            ]
            [ a
                [ href <|
                    if model.from + model.size >= result.hits.total.value then
                        "#disabled"

                    else
                        createUrl
                            path
                            model.query
                            model.showDetailsFor
                            (model.from + model.size)
                            model.size
                ]
                [ text "Next" ]
            ]
        , li
            [ classList
                [ ( "disabled", model.from + model.size >= result.hits.total.value )
                ]
            ]
            [ a
                [ href <|
                    if model.from + model.size >= result.hits.total.value then
                        "#disabled"

                    else
                        createUrl
                            path
                            model.query
                            model.showDetailsFor
                            ((result.hits.total.value // model.size) * model.size)
                            model.size
                ]
                [ text "Last" ]
            ]
        ]



-- API


type alias Options =
    { url : String
    , username : String
    , password : String
    }


makeRequestBody :
    String
    -> String
    -> Int
    -> Int
    -> Http.Body
makeRequestBody field query from size =
    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"
        |> List.append
            [ ( "from", Json.Encode.int from )
            , ( "size", Json.Encode.int size )
            ]
        |> Json.Encode.object
        |> Http.jsonBody


makeRequest :
    String
    -> String
    -> Json.Decode.Decoder a
    -> Options
    -> String
    -> Int
    -> Int
    -> Cmd (Msg a)
makeRequest field index decodeResultItemSource options query from size =
    Http.riskyRequest
        { method = "POST"
        , headers =
            [ Http.header "Authorization" ("Basic " ++ Base64.encode (options.username ++ ":" ++ options.password))
            ]
        , url = options.url ++ "/" ++ index ++ "/_search"
        , body = makeRequestBody field query from size
        , 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)