git.iko.soy/rowtype-yoga/purescript-fetch
on main help sign in
Cleanup
commit7dbace4631b381273884b67b37878a2431b88578 authorsigma-andex <77549848+sigma-andex@users.noreply.github.com> dateFri 19 Aug 2022, 15:01 (4 years ago) parent9ae131a
7 files changed+242−53
compare with main
unifiedsplit
spago.dhall+2−1 src/Fetch/Fetch.purs+23−30 src/Fetch/Internal/Request.purs+122 src/Fetch/Internal/RequestBody.purs+26 src/Fetch/Internal/Response.purs+40−21 test.dhall+6 test/Fetch/FetchSpec.purs+23−1
spago.dhall+2−1
@@ -3,13 +3,14 @@
33 [ "aff"
44 , "aff-promise"
55 , "arraybuffer-types"
6− , "console"
76 , "effect"
87 , "fetch-core"
98 , "foreign"
9+ , "http-methods"
1010 , "newtype"
1111 , "prelude"
1212 , "record"
13+ , "typelevel-prelude"
1314 , "unsafe-coerce"
1415 , "web-file"
1516 , "web-streams"
src/Fetch/Fetch.purs+23−30
@@ -1,44 +1,37 @@
11module Fetch.Fetch
2− ( Request
3− , fetch
4− , fetchJson
5− , fetchRaw
2+ ( fetch
63 ) where
74
85import Prelude
96
107import Control.Promise as Promise
118import Effect.Aff (Aff)
9+import Effect.Class (liftEffect)
1210import Fetch.Core as Core
1311import Fetch.Core.Request as CoreRequest
14−import Fetch.Core.Response as CoreResponse
15−import Fetch.Internal.Response (BaseResponseR, JsonDriver, JsonResponse, RawResponse(..), Response)
12+import Fetch.Internal.Request (class ToCoreRequestOptions, HighlevelRequestOptions, new)
13+import Fetch.Internal.Request as Request
14+import Fetch.Internal.RequestBody (class ToRequestBody)
15+import Fetch.Internal.Response (Response)
1616import Fetch.Internal.Response as Response
17−import Record (merge)
17+import Prim.Row (class Union)
18+import Type.Row.Homogeneous (class Homogeneous)
1819import Unsafe.Coerce (unsafeCoerce)
1920
20−type Request = CoreRequest.Request
21−
22−convert :: CoreResponse.Response -> { | BaseResponseR () }
23−convert = unsafeCoerce
24−
25−fetch :: Request -> Aff Response
26−fetch request = do
21+-- | Fetch
22+-- |
23+fetch
24+ :: forall input output thruIn thruOut headers body
25+ . Homogeneous headers String
26+ => ToRequestBody body
27+ => Union input thruIn (HighlevelRequestOptions headers body)
28+ => Union output thruOut CoreRequest.UnsafeRequestOptions
29+ => ToCoreRequestOptions input output
30+ => String
31+ -> { | input }
32+ -> Aff Response
33+fetch url r = do
34+ request <- liftEffect $ new url $ Request.convert r
2735 cResponse <- Promise.toAffE $ unsafeCoerce $ Core.fetch request
28− text <- Promise.toAffE $ unsafeCoerce $ CoreResponse.text cResponse
29− let response = convert cResponse
30− pure $ merge response { text }
31−
32−fetchRaw :: Request -> Aff RawResponse
33−fetchRaw = Core.fetch >>> unsafeCoerce >>> Promise.toAffE >>> map RawResponse
36+ pure $ Response.convert cResponse
3437
35−fetchJson
36− :: forall json
37− . JsonDriver json
38− -> Request
39− -> Aff (JsonResponse json)
40−fetchJson driver request = do
41− rawResponse@(RawResponse cResponse) <- fetchRaw request
42− json <- Response.json driver rawResponse
43− let response = convert cResponse
44− pure $ merge response { json }
src/Fetch/Internal/Request.pursnew file+122
@@ -0,0 +1,122 @@
1+module Fetch.Internal.Request where
2+
3+import Prelude
4+
5+import Data.HTTP.Method (Method)
6+import Data.Newtype (un)
7+import Data.Symbol (class IsSymbol)
8+import Effect (Effect)
9+import Effect.Uncurried (runEffectFn2)
10+import Fetch.Core.Headers (Headers)
11+import Fetch.Core.Headers as CoreHeaders
12+import Fetch.Core.Integrity (Integrity(..))
13+import Fetch.Core.Integrity as CoreIntegrity
14+import Fetch.Core.Referrer (Referrer)
15+import Fetch.Core.Referrer as CoreReferrer
16+import Fetch.Core.Referrer as Referrer
17+import Fetch.Core.ReferrerPolicy (ReferrerPolicy)
18+import Fetch.Core.ReferrerPolicy as CoreReferrerPolicy
19+import Fetch.Core.ReferrerPolicy as ReferrerPolicy
20+import Fetch.Core.Request (_unsafeNew)
21+import Fetch.Core.Request as CoreRequest
22+import Fetch.Core.RequestBody (RequestBody)
23+import Fetch.Core.RequestCache (RequestCache)
24+import Fetch.Core.RequestCache as CoreRequestCache
25+import Fetch.Core.RequestCache as RequestCache
26+import Fetch.Core.RequestCredentials (RequestCredentials)
27+import Fetch.Core.RequestCredentials as CoreRequestCredentials
28+import Fetch.Core.RequestCredentials as RequestCredentials
29+import Fetch.Core.RequestMode (RequestMode)
30+import Fetch.Core.RequestMode as CoreRequestMode
31+import Fetch.Core.RequestMode as RequestMode
32+import Fetch.Internal.RequestBody (class ToRequestBody, toRequestBody)
33+import Prim.Row (class Lacks, class Union)
34+import Prim.Row as R
35+import Prim.RowList as RL
36+import Record (delete, get, insert)
37+import Type.Proxy (Proxy(..))
38+import Type.Row.Homogeneous (class Homogeneous)
39+
40+type HighlevelRequestOptions headers body =
41+ ( method :: Method
42+ , headers :: { | headers }
43+ , body :: body
44+ , credentials :: CoreRequestCredentials.RequestCredentials
45+ , cache :: CoreRequestCache.RequestCache
46+ , mode :: CoreRequestMode.RequestMode
47+ , referrer :: CoreReferrer.Referrer
48+ , referrerPolicy :: CoreReferrerPolicy.ReferrerPolicy
49+ , integrity :: CoreIntegrity.Integrity
50+ )
51+
52+
53+new
54+ :: forall input thru
55+ . Union input thru CoreRequest.UnsafeRequestOptions
56+ => String
57+ -> { | input }
58+ -> Effect CoreRequest.Request
59+new url options = runEffectFn2 _unsafeNew url options
60+
61+class ToCoreRequestOptions input output | input -> output where
62+ convert :: Record input -> Record output
63+
64+instance (Union rIn thru (HighlevelRequestOptions headers body), RL.RowToList rIn rInRL, ToCoreRequestOptionsHelper rIn rInRL rOut) => ToCoreRequestOptions (| rIn) (| rOut) where
65+ convert = convertHelper (Proxy :: Proxy rInRL)
66+
67+class ToCoreRequestOptionsHelper :: forall k. Row Type -> k -> Row Type -> Constraint
68+class ToCoreRequestOptionsHelper input inputRL output | inputRL -> output where
69+ convertHelper :: Proxy inputRL -> Record input -> Record output
70+
71+instance ToCoreRequestOptionsHelper r RL.Nil () where
72+ convertHelper _ _ = {}
73+else instance
74+ ( ToCoreRequestOptionsConverter sym tpeIn tpeOut
75+ , R.Cons sym tpeIn tailIn r
76+ , RL.RowToList tailIn tailInRL
77+ , Lacks sym tailIn
78+ , IsSymbol sym
79+ , ToCoreRequestOptionsHelper tailIn tailInRL tailOutput
80+ , R.Cons sym tpeOut tailOutput output
81+ , Lacks sym tailOutput
82+ ) =>
83+ ToCoreRequestOptionsHelper r (RL.Cons sym tpeIn tailInRL) output where
84+ convertHelper _ r = insert (Proxy :: Proxy sym) head tail
85+ where
86+ tail :: Record tailOutput
87+ tail = delete (Proxy :: Proxy sym) r # convertHelper (Proxy :: Proxy tailInRL)
88+
89+ head :: tpeOut
90+ head = get (Proxy :: Proxy sym) r # convertImpl (Proxy :: Proxy sym)
91+
92+class ToCoreRequestOptionsConverter :: forall k. k -> Type -> Type -> Constraint
93+class ToCoreRequestOptionsConverter sym input output | sym input -> output where
94+ convertImpl :: Proxy sym -> input -> output
95+
96+instance ToCoreRequestOptionsConverter "method" Method String where
97+ convertImpl _ = show
98+
99+instance (Homogeneous r String) => ToCoreRequestOptionsConverter "headers" { | r } Headers where
100+ convertImpl _ = CoreHeaders.fromRecord
101+
102+instance (ToRequestBody body) => ToCoreRequestOptionsConverter "body" body RequestBody where
103+ convertImpl _ = toRequestBody
104+
105+instance ToCoreRequestOptionsConverter "credentials" RequestCredentials String where
106+ convertImpl _ = RequestCredentials.toString
107+
108+instance ToCoreRequestOptionsConverter "cache" RequestCache String where
109+ convertImpl _ = RequestCache.toString
110+
111+instance ToCoreRequestOptionsConverter "mode" RequestMode String where
112+ convertImpl _ = RequestMode.toString
113+
114+instance ToCoreRequestOptionsConverter "referrer" Referrer String where
115+ convertImpl _ = Referrer.toString
116+
117+instance ToCoreRequestOptionsConverter "referrerPolicy" ReferrerPolicy String where
118+ convertImpl _ = ReferrerPolicy.toString
119+
120+instance ToCoreRequestOptionsConverter "integrity" Integrity String where
121+ convertImpl _ = un Integrity
122+
src/Fetch/Internal/RequestBody.pursnew file+26
@@ -0,0 +1,26 @@
1+module Fetch.Internal.RequestBody
2+ (
3+ )
4+ where
5+
6+import Prelude
7+
8+import Data.ArrayBuffer.Types (ArrayBuffer, ArrayView, Uint8Array)
9+import Fetch.Core.RequestBody as CoreRequestBody
10+import Web.Streams.ReadableStream (ReadableStream)
11+
12+class ToRequestBody body where
13+ toRequestBody :: body -> CoreRequestBody.RequestBody
14+
15+instance ToRequestBody ArrayBuffer where
16+ toRequestBody = CoreRequestBody.fromArrayBuffer
17+
18+instance ToRequestBody (ArrayView a) where
19+ toRequestBody = CoreRequestBody.fromArrayView
20+
21+instance ToRequestBody String where
22+ toRequestBody = CoreRequestBody.fromString
23+
24+instance ToRequestBody (ReadableStream Uint8Array) where
25+ toRequestBody = CoreRequestBody.fromReadableStream
26+
src/Fetch/Internal/Response.purs+40−21
@@ -2,41 +2,36 @@ module Fetch.Internal.Response where
22
33import Prelude
44
5+import Control.Promise as Control
56import Control.Promise as Promise
67import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
7−import Data.Newtype (class Newtype, un)
8+import Data.Newtype (class Newtype)
89import Effect (Effect)
910import Effect.Aff (Aff)
10−import Effect.Aff.Class (liftAff)
11−import Effect.Class (liftEffect)
1211import Fetch.Core.Headers (Headers)
1312import Fetch.Core.Response as CoreResponse
1413import Foreign (Foreign)
1514import Unsafe.Coerce (unsafeCoerce)
1615import Web.File.Blob (Blob)
16+import Web.Promise as Web
1717import Web.Streams.ReadableStream (ReadableStream)
1818
19−newtype RawResponse = RawResponse CoreResponse.Response
20−
21−instance Newtype RawResponse CoreResponse.Response
22−type BaseResponseR r =
19+type ResponseR =
2320 ( headers :: Headers
2421 , ok :: Boolean
2522 , redirected :: Boolean
2623 , status :: Int
2724 , statusText :: String
2825 , url :: String
29− | r
26+ , text :: Aff String
27+ , json :: Aff Foreign
28+ , body :: Effect (ReadableStream Uint8Array)
29+ , arrayBuffer :: Aff ArrayBuffer
30+ , blob :: Aff Blob
3031 )
3132
3233type Response =
33− { text :: String
34− | BaseResponseR ()
35− }
36−
37−type JsonResponse json =
38− { json :: json
39− | BaseResponseR ()
34+ { | ResponseR
4035 }
4136
4237data BlobDriver :: forall k. k -> Type
@@ -50,11 +45,35 @@ newtype JsonDriver json = JsonDriver (Foreign -> Aff json)
5045
5146derive instance Newtype (JsonDriver json) _
5247
53−body :: RawResponse -> Effect (ReadableStream Uint8Array)
54−body = un RawResponse >>> CoreResponse.body >>> liftEffect
48+text :: CoreResponse.Response -> Aff String
49+text response = CoreResponse.text response <#> promiseToPromise # Promise.toAffE
50+
51+body :: CoreResponse.Response -> Effect (ReadableStream Uint8Array)
52+body = CoreResponse.body
5553
56−blob :: RawResponse -> Aff Blob
57−blob = un RawResponse >>> CoreResponse.blob >>> unsafeCoerce >>> Promise.toAffE >>> liftAff
54+json :: CoreResponse.Response -> Aff Foreign
55+json response = CoreResponse.json response <#> promiseToPromise # Promise.toAffE
5856
59−json :: forall json. JsonDriver json -> RawResponse -> Aff json
60−json (JsonDriver fromJson) = un RawResponse >>> CoreResponse.json >>> unsafeCoerce >>> Promise.toAffE >=> fromJson
57+arrayBuffer :: CoreResponse.Response -> Aff ArrayBuffer
58+arrayBuffer response = CoreResponse.arrayBuffer response <#> promiseToPromise # Promise.toAffE
59+
60+blob :: CoreResponse.Response -> Aff Blob
61+blob response = CoreResponse.blob response <#> promiseToPromise # Promise.toAffE
62+
63+promiseToPromise :: Web.Promise ~> Control.Promise
64+promiseToPromise = unsafeCoerce
65+
66+convert :: CoreResponse.Response -> Response
67+convert response =
68+ { headers: CoreResponse.headers response
69+ , ok: CoreResponse.ok response
70+ , redirected: CoreResponse.redirected response
71+ , status: CoreResponse.status response
72+ , statusText: CoreResponse.statusText response
73+ , url: CoreResponse.url response
74+ , text: text response
75+ , json: json response
76+ , body: CoreResponse.body response
77+ , arrayBuffer: arrayBuffer response
78+ , blob: blob response
79+ }
test.dhall+6
@@ -6,10 +6,16 @@ in conf
66 conf.dependencies
77 # [ "aff"
88 , "aff-promise"
9+ , "console"
910 , "effect"
11+ , "either"
12+ , "exceptions"
13+ , "lists"
1014 , "spec"
1115 , "spec-discovery"
1216 , "strings"
17+ , "transformers"
1318 , "debug"
19+ , "yoga-json"
1420 ]
1521 }
test/Fetch/FetchSpec.purs+23−1
@@ -2,6 +2,10 @@ module Test.Fetch.FetchSpec where
22
33import Prelude
44
5+import Data.HTTP.Method (Method(..))
6+import Fetch.Core.Referrer (Referrer(..))
7+import Fetch.Core.RequestMode as RequestMode
8+import Fetch.Fetch (fetch)
59import Test.Spec (Spec, describe, it)
610import Test.Spec.Assertions (shouldEqual)
711
@@ -9,6 +13,24 @@ spec :: Spec Unit
913spec =
1014 describe "Fetch.Fetch" do
1115 describe "fetch" do
16+ it "should send a Get request" do
17+
18+ response@{ status, json, text } <- fetch "https://httpbin.org/get"
19+ { method: GET
20+ , headers:
21+ { "Content-Type": "application/json"
22+ }
23+ }
24+ status `shouldEqual` 200
1225 it "should send a Post request" do
1326
14− true `shouldEqual` (true)
27+ response@{ status, json, text } <- fetch "https://httpbin.org/post"
28+ { method: POST
29+ , mode: RequestMode.Cors
30+ , body: """{"hello":"world"}"""
31+ , headers:
32+ { "Content-Type": "application/json"
33+ }
34+ , referrer: (ReferrerUrl "https://httpbin.org")
35+ }
36+ status `shouldEqual` 200