Http 1.0.0 shim

Http.elm

module Shim1.Http exposing
    ( Body
    , Error(..)
    , Expect
    , Header
    , Part
    , Request
    , Response
    , emptyBody
    , expectJson
    , expectString
    , expectStringResponse
    , get
    , getString
    , header
    , jsonBody
    , multipartBody
    , post
    , request
    , send
    , stringBody
    , stringPart
    , toTask
    )

import Dict exposing (Dict)
import Http
import Json.Decode as Decode
import Json.Encode as Encode
import Maybe exposing (Maybe(..))
import Platform.Cmd as Cmd exposing (Cmd)
import Result exposing (Result(..))
import Task exposing (Task)


type alias Request a =
    { body : Http.Body
    , headers : List Http.Header
    , method : String
    , resolver : Http.Resolver Error a
    , timeout : Maybe Float
    , url : String
    }


send : (Result Error a -> msg) -> Request a -> Cmd msg
send resultToMessage request_ =
    Task.attempt resultToMessage (toTask request_)


toTask : Request a -> Task Error a
toTask =
    Http.task


type Error
    = BadUrl String
    | Timeout
    | NetworkError
    | BadStatus (Response String)
    | BadPayload String (Response String)


getString : String -> Request String
getString url =
    request
        { method = "GET"
        , headers = []
        , url = url
        , body = Http.emptyBody
        , expect = expectString
        , timeout = Nothing
        , withCredentials = False
        }


get : String -> Decode.Decoder a -> Request a
get url decoder =
    request
        { method = "GET"
        , headers = []
        , url = url
        , body = Http.emptyBody
        , expect = expectJson decoder
        , timeout = Nothing
        , withCredentials = False
        }


post : String -> Http.Body -> Decode.Decoder a -> Request a
post url body decoder =
    request
        { method = "POST"
        , headers = []
        , url = url
        , body = body
        , expect = expectJson decoder
        , timeout = Nothing
        , withCredentials = False
        }


request :
    { method : String
    , headers : List Http.Header
    , url : String
    , body : Http.Body
    , expect : Expect a
    , timeout : Maybe Float
    , withCredentials : Bool
    }
    -> Request a
request { method, headers, url, body, expect, timeout, withCredentials } =
    { method = method
    , headers = headers
    , url = url
    , body = body
    , timeout = timeout
    , resolver = Http.stringResolver expect
    }


type alias Expect msg =
    Http.Response String -> Result Error msg


expectAny : (Http.Metadata -> String -> Result Error msg) -> Expect msg
expectAny f response =
    case response of
        Http.BadUrl_ string ->
            Err (BadUrl string)

        Http.Timeout_ ->
            Err Timeout

        Http.NetworkError_ ->
            Err NetworkError

        Http.BadStatus_ metadata body ->
            Err (BadStatus (metadataToResponse metadata body))

        Http.GoodStatus_ metadata body ->
            f metadata body


expectString : Expect String
expectString =
    expectAny (\_ body -> Ok body)


expectJson : Decode.Decoder a -> Expect a
expectJson decoder =
    expectAny <|
        \metadata body ->
            case Decode.decodeString decoder body of
                Err decodeError ->
                    Err (BadPayload (Decode.errorToString decodeError) (metadataToResponse metadata body))

                Ok value ->
                    Ok value


metadataToResponse { url, statusCode, statusText, headers } body =
    { url = url
    , status = { code = statusCode, message = statusText }
    , headers = headers
    , body = body
    }


expectStringResponse : (Response String -> Result String a) -> Expect a
expectStringResponse =
    Debug.todo "expectStringResponse"


type alias Response body =
    { url : String
    , status : { code : Int, message : String }
    , headers : Dict String String
    , body : body
    }



-- UNCHANGED


type alias Body =
    Http.Body


type alias Header =
    Http.Header


type alias Part =
    Http.Part


emptyBody =
    Http.emptyBody


header =
    Http.header


jsonBody =
    Http.jsonBody


multipartBody =
    Http.multipartBody


stringBody =
    Http.stringBody


stringPart =
    Http.stringPart