git.iko.soy/rowtype-yoga/purescript-fetch
on main help sign in
Initial commit
commit9ae131a1ac62d80dadcad7f5466233fed5a85ed1 authorsigma-andex <77549848+sigma-andex@users.noreply.github.com> dateThu 18 Aug 2022, 21:08 (4 years ago) parentf2a1389
9 files changed+165−115
README.md+8 packages.dhall+1−99 spago.dhall+16−2 src/Fetch/Fetch.purs+44 src/Fetch/Internal/Response.purs+60 src/Main.purs−10 test.dhall+15 test/Fetch/FetchSpec.purs+14 test/Main.purs+7−4
README.md+8
@@ -1 +1,9 @@
11# purescript-fetch
2+
3+High-level library for the [WHATWG Fetch Living Standard](https://fetch.spec.whatwg.org/).
4+
5+## Usage
6+
7+```bash
8+spago install fetch
9+```
packages.dhall+1−99
@@ -1,105 +1,7 @@
1−{-
2−Welcome to your new Dhall package-set!
31
4−Below are instructions for how to edit this file for most use
5−cases, so that you don't need to know Dhall to use it.
6−
7−## Use Cases
8−
9−Most will want to do one or both of these options:
10−1. Override/Patch a package's dependency
11−2. Add a package not already in the default package set
12−
13−This file will continue to work whether you use one or both options.
14−Instructions for each option are explained below.
15−
16−### Overriding/Patching a package
17−
18−Purpose:
19−- Change a package's dependency to a newer/older release than the
20− default package set's release
21−- Use your own modified version of some dependency that may
22− include new API, changed API, removed API by
23− using your custom git repo of the library rather than
24− the package set's repo
25−
26−Syntax:
27−where `entityName` is one of the following:
28−- dependencies
29−- repo
30−- version
31−-------------------------------
32−let upstream = --
33−in upstream
34− with packageName.entityName = "new value"
35−-------------------------------
36−
37−Example:
38−-------------------------------
39−let upstream = --
40−in upstream
41− with halogen.version = "master"
42− with halogen.repo = "https://example.com/path/to/git/repo.git"
43−
44− with halogen-vdom.version = "v4.0.0"
45− with halogen-vdom.dependencies = [ "extra-dependency" ] # halogen-vdom.dependencies
46−-------------------------------
47−
48−### Additions
49−
50−Purpose:
51−- Add packages that aren't already included in the default package set
52−
53−Syntax:
54−where `<version>` is:
55−- a tag (i.e. "v4.0.0")
56−- a branch (i.e. "master")
57−- commit hash (i.e. "701f3e44aafb1a6459281714858fadf2c4c2a977")
58−-------------------------------
59−let upstream = --
60−in upstream
61− with new-package-name =
62− { dependencies =
63− [ "dependency1"
64− , "dependency2"
65− ]
66− , repo =
67− "https://example.com/path/to/git/repo.git"
68− , version =
69− "<version>"
70− }
71−-------------------------------
72−
73−Example:
74−-------------------------------
75−let upstream = --
76−in upstream
77− with benchotron =
78− { dependencies =
79− [ "arrays"
80− , "exists"
81− , "profunctor"
82− , "strings"
83− , "quickcheck"
84− , "lcg"
85− , "transformers"
86− , "foldable-traversable"
87− , "exceptions"
88− , "node-fs"
89− , "node-buffer"
90− , "node-readline"
91− , "datetime"
92− , "now"
93− ]
94− , repo =
95− "https://github.com/hdgarrood/purescript-benchotron.git"
96− , version =
97− "v7.0.0"
98− }
99−-------------------------------
100−-}
1012let upstream =
1023 https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220816/packages.dhall
1034 sha256:8b4467b4b5041914f9b765779c8936d6d4c230b1f60eb64f6269c71812fd7e98
1045
1056in upstream
7+ with fetch-core = ../purescript-fetch-core/spago.dhall as Location
spago.dhall+16−2
@@ -1,7 +1,21 @@
11{ name = "fetch"
2−, dependencies = [ "console", "effect", "prelude" ]
2+, dependencies =
3+ [ "aff"
4+ , "aff-promise"
5+ , "arraybuffer-types"
6+ , "console"
7+ , "effect"
8+ , "fetch-core"
9+ , "foreign"
10+ , "newtype"
11+ , "prelude"
12+ , "record"
13+ , "unsafe-coerce"
14+ , "web-file"
15+ , "web-streams"
16+ ]
317, packages = ./packages.dhall
4−, sources = [ "src/**/*.purs", "test/**/*.purs" ]
18+, sources = [ "src/**/*.purs" ]
519, license = "MIT"
620, repository = "https://github.com/rowtype-yoga/purescript-fetch.git"
721}
src/Fetch/Fetch.pursnew file+44
@@ -0,0 +1,44 @@
1+module Fetch.Fetch
2+ ( Request
3+ , fetch
4+ , fetchJson
5+ , fetchRaw
6+ ) where
7+
8+import Prelude
9+
10+import Control.Promise as Promise
11+import Effect.Aff (Aff)
12+import Fetch.Core as Core
13+import Fetch.Core.Request as CoreRequest
14+import Fetch.Core.Response as CoreResponse
15+import Fetch.Internal.Response (BaseResponseR, JsonDriver, JsonResponse, RawResponse(..), Response)
16+import Fetch.Internal.Response as Response
17+import Record (merge)
18+import Unsafe.Coerce (unsafeCoerce)
19+
20+type Request = CoreRequest.Request
21+
22+convert :: CoreResponse.Response -> { | BaseResponseR () }
23+convert = unsafeCoerce
24+
25+fetch :: Request -> Aff Response
26+fetch request = do
27+ 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
34+
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/Response.pursnew file+60
@@ -0,0 +1,60 @@
1+module Fetch.Internal.Response where
2+
3+import Prelude
4+
5+import Control.Promise as Promise
6+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
7+import Data.Newtype (class Newtype, un)
8+import Effect (Effect)
9+import Effect.Aff (Aff)
10+import Effect.Aff.Class (liftAff)
11+import Effect.Class (liftEffect)
12+import Fetch.Core.Headers (Headers)
13+import Fetch.Core.Response as CoreResponse
14+import Foreign (Foreign)
15+import Unsafe.Coerce (unsafeCoerce)
16+import Web.File.Blob (Blob)
17+import Web.Streams.ReadableStream (ReadableStream)
18+
19+newtype RawResponse = RawResponse CoreResponse.Response
20+
21+instance Newtype RawResponse CoreResponse.Response
22+type BaseResponseR r =
23+ ( headers :: Headers
24+ , ok :: Boolean
25+ , redirected :: Boolean
26+ , status :: Int
27+ , statusText :: String
28+ , url :: String
29+ | r
30+ )
31+
32+type Response =
33+ { text :: String
34+ | BaseResponseR ()
35+ }
36+
37+type JsonResponse json =
38+ { json :: json
39+ | BaseResponseR ()
40+ }
41+
42+data BlobDriver :: forall k. k -> Type
43+data BlobDriver blob = BlobDriver
44+
45+data StreamDriver :: forall k. k -> Type
46+data StreamDriver stream = StreamDriver
47+
48+newtype JsonDriver :: Type -> Type
49+newtype JsonDriver json = JsonDriver (Foreign -> Aff json)
50+
51+derive instance Newtype (JsonDriver json) _
52+
53+body :: RawResponse -> Effect (ReadableStream Uint8Array)
54+body = un RawResponse >>> CoreResponse.body >>> liftEffect
55+
56+blob :: RawResponse -> Aff Blob
57+blob = un RawResponse >>> CoreResponse.blob >>> unsafeCoerce >>> Promise.toAffE >>> liftAff
58+
59+json :: forall json. JsonDriver json -> RawResponse -> Aff json
60+json (JsonDriver fromJson) = un RawResponse >>> CoreResponse.json >>> unsafeCoerce >>> Promise.toAffE >=> fromJson
src/Main.pursdeleted−10
@@ -1,10 +0,0 @@
1−module Main where
2−
3−import Prelude
4−
5−import Effect (Effect)
6−import Effect.Console (log)
7−
8−main :: Effect Unit
9−main = do
10− log "🍝"
test.dhallnew file+15
@@ -0,0 +1,15 @@
1+let conf = ./spago.dhall
2+
3+in conf
4+ // { sources = conf.sources # [ "test/**/*.purs" ]
5+ , dependencies =
6+ conf.dependencies
7+ # [ "aff"
8+ , "aff-promise"
9+ , "effect"
10+ , "spec"
11+ , "spec-discovery"
12+ , "strings"
13+ , "debug"
14+ ]
15+ }
test/Fetch/FetchSpec.pursnew file+14
@@ -0,0 +1,14 @@
1+module Test.Fetch.FetchSpec where
2+
3+import Prelude
4+
5+import Test.Spec (Spec, describe, it)
6+import Test.Spec.Assertions (shouldEqual)
7+
8+spec :: Spec Unit
9+spec =
10+ describe "Fetch.Fetch" do
11+ describe "fetch" do
12+ it "should send a Post request" do
13+
14+ true `shouldEqual` (true)
test/Main.purs+7−4
@@ -3,9 +3,12 @@ module Test.Main where
33import Prelude
44
55import Effect (Effect)
6−import Effect.Class.Console (log)
6+import Effect.Aff (launchAff_)
7+import Test.Spec.Discovery (discover)
8+import Test.Spec.Reporter.Console (consoleReporter)
9+import Test.Spec.Runner (runSpec)
710
811main :: Effect Unit
9−main = do
10− log "🍝"
11− log "You should add some tests."
12+main = launchAff_ do
13+ specs <- discover "\\..*Spec"
14+ runSpec [ consoleReporter ] specs