Skip to content

Instantly share code, notes, and snippets.

@norpan
Last active December 1, 2018 12:56
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save norpan/63d74d96a880fb3b1ad3f475365c3746 to your computer and use it in GitHub Desktop.
Save norpan/63d74d96a880fb3b1ad3f475365c3746 to your computer and use it in GitHub Desktop.
Http 1.0.0 shim
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment