Skip to content

Commit c2388a8

Browse files
garybgaryb
committed
Remove Requestable class
1 parent f3bdc05 commit c2388a8

File tree

3 files changed

+87
-126
lines changed

3 files changed

+87
-126
lines changed

‎src/Network/HTTP/Affjax.purs‎

Lines changed: 55 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -14,9 +14,10 @@ module Network.HTTP.Affjax
1414
, RetryPolicy(..)
1515
, defaultRetryPolicy
1616
, retry
17+
, module Exports
1718
) where
1819

19-
import Prelude hiding (max)
20+
import Prelude
2021

2122
import Control.Monad.Aff (Aff, try, delay)
2223
import Control.Monad.Aff.Compat as AC
@@ -26,12 +27,13 @@ import Control.Monad.Eff.Exception (Error, error)
2627
import Control.Monad.Eff.Ref (REF, newRef, readRef, writeRef)
2728
import Control.Monad.Except (runExcept, throwError)
2829
import Control.Parallel (parOneOf)
29-
30+
import Data.Argonaut.Core as J
3031
import Data.Argonaut.Parser (jsonParser)
3132
import Data.Array as Arr
3233
import Data.Either (Either(..), either)
3334
import Data.Foldable (any)
3435
import Data.Foreign (F, Foreign, ForeignError(JSONError), fail, readString, toForeign)
36+
import Data.FormURLEncoded as FormURLEncoded
3537
import Data.Function (on)
3638
import Data.Function.Uncurried (Fn2, runFn2)
3739
import Data.HTTP.Method (Method(..), CustomMethod)
@@ -41,11 +43,10 @@ import Data.Maybe (Maybe(..))
4143
import Data.MediaType (MediaType)
4244
import Data.Nullable (Nullable, toNullable)
4345
import Data.Time.Duration (Milliseconds(..))
44-
import Data.Tuple (Tuple(..), fst, snd)
45-
46-
import Math (max, pow)
47-
48-
import Network.HTTP.Affjax.Request (class Requestable, RequestContent, toRequest)
46+
import Data.Tuple (Tuple, fst, snd)
47+
import Math as Math
48+
import Network.HTTP.Affjax.Request (RequestContent(..)) as Exports
49+
import Network.HTTP.Affjax.Request (RequestContent(..), defaultMediaType)
4950
import Network.HTTP.Affjax.Response (class Respondable, ResponseContent, ResponseType(..), fromResponse, responseType, responseTypeToString)
5051
import Network.HTTP.RequestHeader (RequestHeader(..), requestHeaderName, requestHeaderValue)
5152
import Network.HTTP.ResponseHeader (ResponseHeader, responseHeader)
@@ -54,20 +55,20 @@ import Network.HTTP.StatusCode (StatusCode(..))
5455
-- | The effect type for AJAX requests made with Affjax.
5556
foreign import data AJAX :: Effect
5657

57-
-- | The type for Affjax requests.
58-
type Affjax e a = Aff (ajax :: AJAX | e) (AffjaxResponse a)
58+
-- | The result type for Affjax requests.
59+
type Affjax eff a = Aff (ajax :: AJAX | eff) (AffjaxResponse a)
5960

60-
type AffjaxRequest a =
61+
type AffjaxRequest =
6162
{ method :: Either Method CustomMethod
6263
, url :: URL
6364
, headers :: Array RequestHeader
64-
, content :: Maybe a
65+
, content :: Maybe RequestContent
6566
, username :: Maybe String
6667
, password :: Maybe String
6768
, withCredentials :: Boolean
6869
}
6970

70-
defaultRequest :: AffjaxRequest Unit
71+
defaultRequest :: AffjaxRequest
7172
defaultRequest =
7273
{ method: Left GET
7374
, url: "/"
@@ -93,39 +94,39 @@ get :: forall e a. Respondable a => URL -> Affjax e a
9394
get u = affjax $ defaultRequest { url = u }
9495

9596
-- | Makes a `POST` request to the specified URL, sending data.
96-
post :: forall e a b. Requestable a => Respondable b => URL -> a -> Affjax e b
97+
post :: forall e a b. Respondable b => URL -> RequestContent -> Affjax e b
9798
post u c = affjax $ defaultRequest { method = Left POST, url = u, content = Just c }
9899

99100
-- | Makes a `POST` request to the specified URL with the option to send data.
100-
post' :: forall e a b. Requestable a => Respondable b => URL -> Maybe a -> Affjax e b
101+
post' :: forall e a b. Respondable b => URL -> Maybe RequestContent -> Affjax e b
101102
post' u c = affjax $ defaultRequest { method = Left POST, url = u, content = c }
102103

103104
-- | Makes a `POST` request to the specified URL, sending data and ignoring the
104105
-- | response.
105-
post_ :: forall e a. Requestable a => URL -> a -> Affjax e Unit
106+
post_ :: forall e a. URL -> RequestContent -> Affjax e Unit
106107
post_ = post
107108

108109
-- | Makes a `POST` request to the specified URL with the option to send data,
109110
-- | and ignores the response.
110-
post_' :: forall e a. Requestable a => URL -> Maybe a -> Affjax e Unit
111+
post_' :: forall e a. URL -> Maybe RequestContent -> Affjax e Unit
111112
post_' = post'
112113

113114
-- | Makes a `PUT` request to the specified URL, sending data.
114-
put :: forall e a b. Requestable a => Respondable b => URL -> a -> Affjax e b
115+
put :: forall e a b. Respondable b => URL -> RequestContent -> Affjax e b
115116
put u c = affjax $ defaultRequest { method = Left PUT, url = u, content = Just c }
116117

117118
-- | Makes a `PUT` request to the specified URL with the option to send data.
118-
put' :: forall e a b. Requestable a => Respondable b => URL -> Maybe a -> Affjax e b
119+
put' :: forall e a b. Respondable b => URL -> Maybe RequestContent -> Affjax e b
119120
put' u c = affjax $ defaultRequest { method = Left PUT, url = u, content = c }
120121

121122
-- | Makes a `PUT` request to the specified URL, sending data and ignoring the
122123
-- | response.
123-
put_ :: forall e a. Requestable a => URL -> a -> Affjax e Unit
124+
put_ :: forall e a. URL -> RequestContent -> Affjax e Unit
124125
put_ = put
125126

126127
-- | Makes a `PUT` request to the specified URL with the option to send data,
127128
-- | and ignores the response.
128-
put_' :: forall e a. Requestable a => URL -> Maybe a -> Affjax e Unit
129+
put_' :: forall e a. URL -> Maybe RequestContent -> Affjax e Unit
129130
put_' = put'
130131

131132
-- | Makes a `DELETE` request to the specified URL.
@@ -137,21 +138,21 @@ delete_ :: forall e. URL -> Affjax e Unit
137138
delete_ = delete
138139

139140
-- | Makes a `PATCH` request to the specified URL, sending data.
140-
patch :: forall e a b. Requestable a => Respondable b => URL -> a -> Affjax e b
141+
patch :: forall e a b. Respondable b => URL -> RequestContent -> Affjax e b
141142
patch u c = affjax $ defaultRequest { method = Left PATCH, url = u, content = Just c }
142143

143144
-- | Makes a `PATCH` request to the specified URL with the option to send data.
144-
patch' :: forall e a b. Requestable a => Respondable b => URL -> Maybe a -> Affjax e b
145+
patch' :: forall e a b. Respondable b => URL -> Maybe RequestContent -> Affjax e b
145146
patch' u c = affjax $ defaultRequest { method = Left PATCH, url = u, content = c }
146147

147148
-- | Makes a `PATCH` request to the specified URL, sending data and ignoring the
148149
-- | response.
149-
patch_ :: forall e a. Requestable a => URL -> a -> Affjax e Unit
150+
patch_ :: forall e a. URL -> RequestContent -> Affjax e Unit
150151
patch_ = patch
151152

152153
-- | Makes a `PATCH` request to the specified URL with the option to send data,
153154
-- | and ignores the response.
154-
patch_' :: forall e a. Requestable a => URL -> Maybe a -> Affjax e Unit
155+
patch_' :: forall e a. URL -> Maybe RequestContent -> Affjax e Unit
155156
patch_' = patch'
156157

157158
-- | A sequence of retry delays, in milliseconds.
@@ -168,7 +169,7 @@ type RetryPolicy =
168169
defaultRetryPolicy :: RetryPolicy
169170
defaultRetryPolicy =
170171
{ timeout : Nothing
171-
, delayCurve : \n -> Milliseconds $ max (30.0 * 1000.0) $ 100.0 * (pow 2.0 $ toNumber (n - 1))
172+
, delayCurve : \n -> Milliseconds $ max (30.0 * 1000.0) $ 100.0 * (Math.pow 2.0 $ toNumber (n - 1))
172173
, shouldRetryWithStatusCode : const false
173174
}
174175

@@ -178,10 +179,10 @@ type RetryState e a = Either (Either e a) a
178179
-- | Retry a request using a `RetryPolicy`. After the timeout, the last received response is returned; if it was not possible to communicate with the server due to an error, then this is bubbled up.
179180
retry
180181
:: forall e a b
181-
. Requestable a
182-
=> RetryPolicy
183-
-> (AffjaxRequest a -> Affjax (ref :: REF | e) b)
184-
-> (AffjaxRequest a -> Affjax (ref :: REF | e) b)
182+
. RetryPolicy
183+
-> (AffjaxRequest -> Affjax (ref :: REF | e) b)
184+
-> AffjaxRequest
185+
-> Affjax (ref :: REF | e) b
185186
retry policy run req = do
186187
-- failureRef is either an exception or a failed request
187188
failureRef <- liftEff $ newRef Nothing
@@ -223,9 +224,8 @@ retry policy run req = do
223224
-- | Makes an `Affjax` request.
224225
affjax
225226
:: forall e a b
226-
. Requestable a
227-
=> Respondable b
228-
=> AffjaxRequest a
227+
. Respondable b
228+
=> AffjaxRequest
229229
-> Affjax e b
230230
affjax req = do
231231
res <- AC.fromEffFnAff $ runFn2 _ajax responseHeader req'
@@ -238,25 +238,38 @@ affjax req = do
238238
req' =
239239
{ method: Method.print req.method
240240
, url: req.url
241-
, headers: (\h -> { field: requestHeaderName h, value: requestHeaderValue h }) <$> headers
242-
, content: toNullable (snd requestSettings)
241+
, headers: (\h -> { field: requestHeaderName h, value: requestHeaderValue h }) <$> headers req.content
242+
, content: toNullable (extractContent <$> req.content)
243243
, responseType: responseTypeToString (snd responseSettings)
244244
, username: toNullable req.username
245245
, password: toNullable req.password
246246
, withCredentials: req.withCredentials
247247
}
248248

249-
requestSettings :: Tuple (Maybe MediaType) (Maybe RequestContent)
250-
requestSettings = case toRequest <$> req.content of
251-
Nothing -> Tuple Nothing Nothing
252-
Just (Tuple mime rt) -> Tuple mime (Just rt)
249+
extractContent :: RequestContent -> Foreign
250+
extractContent = case _ of
251+
ArrayViewInt8Request x → toForeign x
252+
ArrayViewInt16Request x → toForeign x
253+
ArrayViewInt32Request x → toForeign x
254+
ArrayViewUint8Request x → toForeign x
255+
ArrayViewUint16Request x → toForeign x
256+
ArrayViewUint32Request x → toForeign x
257+
ArrayViewUint8ClampedRequest x → toForeign x
258+
ArrayViewFloat32Request x → toForeign x
259+
ArrayViewFloat64Request x → toForeign x
260+
BlobRequest x → toForeign x
261+
DocumentRequest x → toForeign x
262+
StringRequest x → toForeign x
263+
FormDataRequest x → toForeign x
264+
FormURLEncodedRequest x → toForeign (FormURLEncoded.encode x)
265+
JsonRequest x → toForeign (J.stringify x)
253266

254267
responseSettings :: Tuple (Maybe MediaType) (ResponseType b)
255268
responseSettings = responseType
256269

257-
headers :: Array RequestHeader
258-
headers =
259-
addHeader (ContentType <$> fst requestSettings) $
270+
headers :: Maybe RequestContent -> Array RequestHeader
271+
headers reqContent =
272+
addHeader (ContentType <$> (defaultMediaType =<< reqContent)) $
260273
addHeader (Accept <$> fst responseSettings)
261274
req.headers
262275

@@ -277,7 +290,7 @@ type AjaxRequest =
277290
{ method :: String
278291
, url :: URL
279292
, headers :: Array { field :: String, value :: String }
280-
, content :: Nullable RequestContent
293+
, content :: Nullable Foreign
281294
, responseType :: String
282295
, username :: Nullable String
283296
, password :: Nullable String

‎src/Network/HTTP/Affjax/Request.purs‎

Lines changed: 29 additions & 81 deletions
Original file line numberDiff line numberDiff line change
@@ -1,86 +1,34 @@
1-
module Network.HTTP.Affjax.Request
2-
( RequestContent()
3-
, class Requestable, toRequest
4-
) where
1+
module Network.HTTP.Affjax.Request where
52

6-
import Prelude
7-
8-
import Data.Argonaut.Core (Json())
3+
import DOM.File.Types (Blob)
4+
import DOM.Node.Types (Document)
5+
import DOM.XHR.Types (FormData)
6+
import Data.Argonaut.Core (Json)
97
import Data.ArrayBuffer.Types as A
10-
import Data.FormURLEncoded (FormURLEncoded())
11-
import Data.FormURLEncoded as URLEncoded
8+
import Data.FormURLEncoded (FormURLEncoded)
129
import Data.Maybe (Maybe(..))
13-
import Data.MediaType (MediaType())
10+
import Data.MediaType (MediaType)
1411
import Data.MediaType.Common (applicationJSON, applicationFormURLEncoded)
15-
import Data.Tuple (Tuple(..))
16-
17-
import DOM.File.Types (Blob())
18-
import DOM.Node.Types (Document())
19-
import DOM.XHR.Types (FormData())
20-
21-
import Unsafe.Coerce as U
22-
23-
-- | Type representing all content types that be sent via XHR (ArrayBufferView,
24-
-- | Blob, Document, String, FormData).
25-
foreign import data RequestContent :: Type
26-
27-
-- | A class for types that can be converted to values that can be sent with
28-
-- | XHR requests. An optional mime-type can be specified for a default
29-
-- | `Content-Type` header.
30-
class Requestable a where
31-
toRequest :: a -> Tuple (Maybe MediaType) RequestContent
32-
33-
defaultToRequest :: forall a. a -> Tuple (Maybe MediaType) RequestContent
34-
defaultToRequest = Tuple Nothing <<< U.unsafeCoerce
35-
36-
instance requestableRequestContent :: Requestable RequestContent where
37-
toRequest = defaultToRequest
38-
39-
instance requestableInt8Array :: Requestable (A.ArrayView A.Int8) where
40-
toRequest = defaultToRequest
41-
42-
instance requestableInt16Array :: Requestable (A.ArrayView A.Int16) where
43-
toRequest = defaultToRequest
44-
45-
instance requestableInt32Array :: Requestable (A.ArrayView A.Int32) where
46-
toRequest = defaultToRequest
47-
48-
instance requestableUint8Array :: Requestable (A.ArrayView A.Uint8) where
49-
toRequest = defaultToRequest
50-
51-
instance requestableUint16Array :: Requestable (A.ArrayView A.Uint16) where
52-
toRequest = defaultToRequest
53-
54-
instance requestableUint32Array :: Requestable (A.ArrayView A.Uint32) where
55-
toRequest = defaultToRequest
56-
57-
instance requestableUint8ClampedArray :: Requestable (A.ArrayView A.Uint8Clamped) where
58-
toRequest = defaultToRequest
59-
60-
instance requestableFloat32Array :: Requestable (A.ArrayView A.Float32) where
61-
toRequest = defaultToRequest
62-
63-
instance requestableFloat64Array :: Requestable (A.ArrayView A.Float64) where
64-
toRequest = defaultToRequest
65-
66-
instance requestableBlob :: Requestable Blob where
67-
toRequest = defaultToRequest
68-
69-
instance requestableDocument :: Requestable Document where
70-
toRequest = defaultToRequest
71-
72-
instance requestableString :: Requestable String where
73-
toRequest = defaultToRequest
74-
75-
instance requestableJson :: Requestable Json where
76-
toRequest json = Tuple (Just applicationJSON) (U.unsafeCoerce (show json))
77-
78-
instance requestableFormData :: Requestable FormData where
79-
toRequest = defaultToRequest
80-
81-
instance requestableFormURLEncoded :: Requestable FormURLEncoded where
82-
toRequest form = Tuple (Just applicationFormURLEncoded)
83-
(U.unsafeCoerce (URLEncoded.encode form))
8412

85-
instance requestableUnit :: Requestable Unit where
86-
toRequest = defaultToRequest
13+
data RequestContent
14+
= ArrayViewInt8Request (A.ArrayView A.Int8)
15+
| ArrayViewInt16Request (A.ArrayView A.Int16)
16+
| ArrayViewInt32Request (A.ArrayView A.Int32)
17+
| ArrayViewUint8Request (A.ArrayView A.Uint8)
18+
| ArrayViewUint16Request (A.ArrayView A.Uint16)
19+
| ArrayViewUint32Request (A.ArrayView A.Uint32)
20+
| ArrayViewUint8ClampedRequest (A.ArrayView A.Uint8Clamped)
21+
| ArrayViewFloat32Request (A.ArrayView A.Float32)
22+
| ArrayViewFloat64Request (A.ArrayView A.Float64)
23+
| BlobRequest Blob
24+
| DocumentRequest Document
25+
| StringRequest String
26+
| FormDataRequest FormData
27+
| FormURLEncodedRequest FormURLEncoded
28+
| JsonRequest Json
29+
30+
defaultMediaType :: RequestContent -> Maybe MediaType
31+
defaultMediaType = case _ of
32+
FormURLEncodedRequest _ -> Just applicationFormURLEncoded
33+
JsonRequest _ -> Just applicationJSON
34+
_ -> Nothing

‎test/Main.purs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -93,13 +93,13 @@ main = void $ runAff (either (\e -> logShow e *> throwException e) (const $ log
9393
assertEq ok200 res.status
9494

9595
A.log "POST /mirror: should use the POST method"
96-
(attempt $ AX.post mirror "test") >>= assertRight >>= \res -> do
96+
(attempt $ AX.post mirror (AX.StringRequest "test")) >>= assertRight >>= \res -> do
9797
assertEq ok200 res.status
9898
assertEq "POST" (_.method $ unsafeFromForeign res.response)
9999

100100
A.log "PUT with a request body"
101101
let content = "the quick brown fox jumps over the lazy dog"
102-
(attempt $ AX.put mirror content) >>= assertRight >>= \res -> do
102+
(attempt $ AX.put mirror (AX.StringRequest content)) >>= assertRight >>= \res -> do
103103
typeIs (res :: AX.AffjaxResponse Foreign)
104104
assertEq ok200 res.status
105105
let mirroredReq = unsafeFromForeign res.response
@@ -113,5 +113,5 @@ main = void $ runAff (either (\e -> logShow e *> throwException e) (const $ log
113113
-- assertEq (Just "test=test") (lookupHeader "Set-Cookie" res.headers)
114114

115115
A.log "Testing cancellation"
116-
forkAff (AX.post_ mirror "do it now") >>= killFiber (error "Pull the cord!")
116+
forkAff (AX.post_ mirror (AX.StringRequest "do it now")) >>= killFiber (error "Pull the cord!")
117117
assertMsg "Should have been canceled" true

0 commit comments

Comments
 (0)