Skip to content

Commit 8e0e848

Browse files
garybgaryb
committed
Rework Requestable and Responsable
1 parent 25abc38 commit 8e0e848

File tree

5 files changed

+141
-126
lines changed

5 files changed

+141
-126
lines changed

‎bower.json

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,8 +22,8 @@
2222
"purescript-aff": "~0.7.0",
2323
"purescript-arraybuffer-types": "~0.1.1",
2424
"purescript-dom": "~0.1.2",
25-
"purescript-foreign": "~0.4.1",
25+
"purescript-foreign": "~0.4.2",
2626
"purescript-integers": "~0.0.1",
27-
"purescript-options": "~0.2.1"
27+
"purescript-options": "~0.3.0"
2828
}
2929
}

‎src/Network/HTTP/Affjax.purs

Lines changed: 68 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -1,32 +1,40 @@
11
module Network.HTTP.Affjax
22
( Ajax()
3+
, Affjax()
34
, AffjaxOptions()
45
, AffjaxResponse()
56
, url, method, content, headers, username, password
67
, affjax
78
, affjax'
9+
, get
10+
, post, post_
11+
, put, put_
12+
, delete, delete_
813
) where
914

1015
import Control.Monad.Aff (Aff(), makeAff)
1116
import Control.Monad.Eff (Eff())
12-
import Control.Monad.Eff.Exception (Error())
13-
import Data.Foreign (Foreign(..))
17+
import Control.Monad.Eff.Exception (Error(), error)
18+
import Data.Either (Either(..))
19+
import Data.Foreign (Foreign(..), F())
1420
import Data.Function (Fn4(), runFn4)
1521
import Data.Options (Option(), Options(), IsOption, options, (:=), opt)
16-
import Data.Proxy (Proxy(..))
1722
import Network.HTTP.Affjax.Request
1823
import Network.HTTP.Affjax.Response
1924
import Network.HTTP.Affjax.ResponseType
20-
import Network.HTTP.Method (Method())
25+
import Network.HTTP.Method (Method(..))
2126
import Network.HTTP.RequestHeader (RequestHeader())
2227
import Network.HTTP.ResponseHeader (ResponseHeader(), responseHeader)
2328
import Network.HTTP.StatusCode (StatusCode())
2429

2530
-- | The effect type for AJAX requests made with Affjax.
2631
foreign import data Ajax :: !
2732

33+
-- | The type for Affjax requests.
34+
type Affjax e a = Aff (ajax :: Ajax | e) (AffjaxResponse a)
35+
2836
-- | Options type for Affjax requests.
29-
foreign import data AffjaxOptions :: * -> *
37+
foreign import data AffjaxOptions :: *
3038

3139
-- | The type of records that will be received as an Affjax response.
3240
type AffjaxResponse a =
@@ -36,49 +44,80 @@ type AffjaxResponse a =
3644
}
3745

3846
-- | Sets the URL for a request.
39-
url :: forall a. Option (AffjaxOptions a) String
47+
url :: Option AffjaxOptions String
4048
url = opt "url"
4149

4250
-- | Sets the HTTP method for a request.
43-
method :: forall a. Option (AffjaxOptions a) Method
51+
method :: Option AffjaxOptions Method
4452
method = opt "method"
4553

4654
-- | Sets the content to send in a request.
47-
content :: forall a. (Requestable a, IsOption a) => Option (AffjaxOptions a) a
55+
content :: Option AffjaxOptions RequestContent
4856
content = opt "content"
4957

5058
-- | Sets the headers to send with a request.
51-
headers :: forall a. Option (AffjaxOptions a) [RequestHeader]
59+
headers :: Option AffjaxOptions [RequestHeader]
5260
headers = opt "headers"
5361

5462
-- | Sets the HTTP auth username to send with a request.
55-
username :: forall a. Option (AffjaxOptions a) String
63+
username :: Option AffjaxOptions String
5664
username = opt "username"
5765

5866
-- | Sets the HTTP auth password to send with a request.
59-
password :: forall a. Option (AffjaxOptions a) String
67+
password :: Option AffjaxOptions String
6068
password = opt "password"
6169

6270
-- | Sets the expected response type for a request. This is not exposed outside
6371
-- | of the module as the `ResponseType` is set based on the `Responsable`
6472
-- | instance for the expected result content type.
65-
responseType = opt "responseType" :: forall a. Option (AffjaxOptions a) ResponseType
73+
responseType = opt "responseType" :: Option AffjaxOptions ResponseType
6674

6775
-- | Runs a request.
68-
affjax :: forall e a b. (Requestable a, Responsable b) =>
69-
Options (AffjaxOptions a) ->
70-
Aff (ajax :: Ajax | e) (AffjaxResponse b)
71-
affjax = makeAff <<< affjax'
76+
affjax :: forall e a. Responsable a ->
77+
Options AffjaxOptions ->
78+
Affjax e a
79+
affjax r = makeAff <<< affjax' r
7280

7381
-- | Runs a request directly in Eff.
74-
affjax' :: forall e a b. (Requestable a, Responsable b) =>
75-
Options (AffjaxOptions a) ->
76-
(Error -> Eff (ajax :: Ajax | e) Unit) ->
77-
(AffjaxResponse b -> Eff (ajax :: Ajax | e) Unit) ->
78-
Eff (ajax :: Ajax | e) Unit
79-
affjax' opts eb cb =
80-
let opts' = opts <> responseType := toResponseType (Proxy :: Proxy b)
81-
in runFn4 unsafeAjax responseHeader (options opts') eb cb
82+
affjax' :: forall e a. Responsable a ->
83+
Options AffjaxOptions ->
84+
(Error -> Eff (ajax :: Ajax | e) Unit) ->
85+
(AffjaxResponse a -> Eff (ajax :: Ajax | e) Unit) ->
86+
Eff (ajax :: Ajax | e) Unit
87+
affjax' (Responsable read ty) opts eb cb =
88+
runFn4 unsafeAjax responseHeader (options $ opts <> responseType := ty) eb cb'
89+
where
90+
cb' :: AffjaxResponse Foreign -> Eff (ajax :: Ajax | e) Unit
91+
cb' res = case res { response = _ } <$> read res.response of
92+
Left err -> eb $ error (show err)
93+
Right res' -> cb res'
94+
95+
get :: forall e a. Responsable a -> String -> Affjax e a
96+
get r addr = affjax r $ method := GET
97+
<> url := addr
98+
99+
post :: forall e a. Responsable a -> String -> RequestContent -> Affjax e a
100+
post r u c = affjax r $ method := POST
101+
<> url := u
102+
<> content := c
103+
104+
post_ :: forall e. String -> RequestContent -> Affjax e Unit
105+
post_ = post rUnit
106+
107+
put :: forall e a. Responsable a -> String -> RequestContent -> Affjax e a
108+
put r u c = affjax r $ method := PUT
109+
<> url := u
110+
<> content := c
111+
112+
put_ :: forall e. String -> RequestContent -> Affjax e Unit
113+
put_ = put rUnit
114+
115+
delete :: forall e a. Responsable a -> String -> Affjax e a
116+
delete r u = affjax r $ method := DELETE
117+
<> url := u
118+
119+
delete_ :: forall e. String -> Affjax e Unit
120+
delete_ = delete rUnit
82121

83122
foreign import unsafeAjax
84123
"""
@@ -112,8 +151,8 @@ foreign import unsafeAjax
112151
xhr.send(options.content);
113152
};
114153
}
115-
""" :: forall e a b. Fn4 (String -> String -> ResponseHeader)
116-
Foreign
117-
(Error -> Eff (ajax :: Ajax | e) Unit)
118-
(AffjaxResponse b -> Eff (ajax :: Ajax | e) Unit)
119-
(Eff (ajax :: Ajax | e) Unit)
154+
""" :: forall e a. Fn4 (String -> String -> ResponseHeader)
155+
Foreign
156+
(Error -> Eff (ajax :: Ajax | e) Unit)
157+
(AffjaxResponse Foreign -> Eff (ajax :: Ajax | e) Unit)
158+
(Eff (ajax :: Ajax | e) Unit)

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ instance isOptionRequestContent :: IsOption RequestContent where
2222
class Requestable a where
2323
toContent :: a -> RequestContent
2424

25-
instance requestableAjaxRequestContent :: Requestable RequestContent where
25+
instance requestableRequestContent :: Requestable RequestContent where
2626
toContent = id
2727

2828
instance requestableInt8Array :: Requestable (A.ArrayView A.Int8) where

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

Lines changed: 59 additions & 76 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,24 @@
11
module Network.HTTP.Affjax.Response
22
( ResponseContent()
3-
, Responsable, toResponseType, fromContent
3+
, Responsable(..)
4+
, rInt8Array
5+
, rInt16Array
6+
, rInt32Array
7+
, rUint8Array
8+
, rUint16Array
9+
, rUint32Array
10+
, rUint8ClampedArray
11+
, rFloat32Array
12+
, rFloat64Array
13+
, rBlob
14+
, rDocument
15+
, rJSON
16+
, rString
17+
, rUnit
418
) where
519

620
import Data.Either (Either(..))
7-
import Data.Foreign (Foreign(), ForeignError())
8-
import Data.Options (IsOption, optionFn, (:=))
9-
import Data.Proxy (Proxy())
21+
import Data.Foreign (Foreign(), F(), readString, unsafeReadTagged)
1022
import DOM (Document())
1123
import DOM.File (Blob())
1224
import DOM.XHR (FormData())
@@ -17,75 +29,46 @@ import qualified Data.ArrayBuffer.Types as A
1729
-- | (ArrayBuffer, Blob, Document, JSON, String).
1830
type ResponseContent = Foreign
1931

20-
-- | Class for types that converted from values returned from an XHR request.
21-
class Responsable a where
22-
toResponseType :: Proxy a -> ResponseType
23-
fromContent :: ResponseContent -> Either ForeignError a
24-
25-
instance responsableUnit :: Responsable Unit where
26-
toResponseType _ = StringResponse
27-
fromContent _ = Right unit
28-
29-
instance responsableInt8Array :: Responsable (A.ArrayView A.Int8) where
30-
toResponseType _ = ArrayBufferResponse
31-
fromContent = arrayBufferConversion
32-
33-
instance responsableInt16Array :: Responsable (A.ArrayView A.Int16) where
34-
toResponseType _ = ArrayBufferResponse
35-
fromContent = arrayBufferConversion
36-
37-
instance responsableInt32Array :: Responsable (A.ArrayView A.Int32) where
38-
toResponseType _ = ArrayBufferResponse
39-
fromContent = arrayBufferConversion
40-
41-
instance responsableUint8Array :: Responsable (A.ArrayView A.Uint8) where
42-
toResponseType _ = ArrayBufferResponse
43-
fromContent = arrayBufferConversion
44-
45-
instance responsableUint16Array :: Responsable (A.ArrayView A.Uint16) where
46-
toResponseType _ = ArrayBufferResponse
47-
fromContent = arrayBufferConversion
48-
49-
instance responsableUint32Array :: Responsable (A.ArrayView A.Uint32) where
50-
toResponseType _ = ArrayBufferResponse
51-
fromContent = arrayBufferConversion
52-
53-
instance responsableUint8ClampedArray :: Responsable (A.ArrayView A.Uint8Clamped) where
54-
toResponseType _ = ArrayBufferResponse
55-
fromContent = arrayBufferConversion
56-
57-
instance responsableFloat32Array :: Responsable (A.ArrayView A.Float32) where
58-
toResponseType _ = ArrayBufferResponse
59-
fromContent = arrayBufferConversion
60-
61-
instance responsableFloat64Array :: Responsable (A.ArrayView A.Float64) where
62-
toResponseType _ = ArrayBufferResponse
63-
fromContent = arrayBufferConversion
64-
65-
instance responsableBlob :: Responsable Blob where
66-
toResponseType _ = BlobResponse
67-
fromContent = unsafeConversion
68-
69-
instance responsableDocument :: Responsable Document where
70-
toResponseType _ = DocumentResponse
71-
fromContent = unsafeConversion
72-
73-
instance responsableString :: Responsable String where
74-
toResponseType _ = StringResponse
75-
fromContent = Right <<< unsafeConversion
76-
77-
-- TODO: this, properly
78-
foreign import arrayBufferConversion
79-
"""
80-
function arrayBufferConversion (x) {
81-
return x;
82-
}
83-
""" :: forall a b. a -> b
84-
85-
-- TODO: not this either, at least use foreign to check the tag of returned values to ensure they are not null, etc.
86-
foreign import unsafeConversion
87-
"""
88-
function unsafeConversion (x) {
89-
return x;
90-
}
91-
""" :: forall a b. a -> b
32+
data Responsable a = Responsable (ResponseContent -> F a) ResponseType
33+
34+
rInt8Array :: Responsable A.Int8Array
35+
rInt8Array = Responsable (unsafeReadTagged "ArrayBuffer") ArrayBufferResponse
36+
37+
rInt16Array :: Responsable A.Int16Array
38+
rInt16Array = Responsable (unsafeReadTagged "ArrayBuffer") ArrayBufferResponse
39+
40+
rInt32Array :: Responsable A.Int32Array
41+
rInt32Array = Responsable (unsafeReadTagged "ArrayBuffer") ArrayBufferResponse
42+
43+
rUint8Array :: Responsable A.Uint8Array
44+
rUint8Array = Responsable (unsafeReadTagged "ArrayBuffer") ArrayBufferResponse
45+
46+
rUint16Array :: Responsable A.Uint16Array
47+
rUint16Array = Responsable (unsafeReadTagged "ArrayBuffer") ArrayBufferResponse
48+
49+
rUint32Array :: Responsable A.Uint32Array
50+
rUint32Array = Responsable (unsafeReadTagged "ArrayBuffer") ArrayBufferResponse
51+
52+
rUint8ClampedArray :: Responsable A.Uint8ClampedArray
53+
rUint8ClampedArray = Responsable (unsafeReadTagged "ArrayBuffer") ArrayBufferResponse
54+
55+
rFloat32Array :: Responsable A.Float32Array
56+
rFloat32Array = Responsable (unsafeReadTagged "ArrayBuffer") ArrayBufferResponse
57+
58+
rFloat64Array :: Responsable A.Float64Array
59+
rFloat64Array = Responsable (unsafeReadTagged "ArrayBuffer") ArrayBufferResponse
60+
61+
rBlob :: Responsable Blob
62+
rBlob = Responsable (unsafeReadTagged "Blob") BlobResponse
63+
64+
rDocument :: Responsable Document
65+
rDocument = Responsable (unsafeReadTagged "Document") DocumentResponse
66+
67+
rJSON :: Responsable Foreign
68+
rJSON = Responsable Right JSONResponse
69+
70+
rString :: Responsable String
71+
rString = Responsable readString StringResponse
72+
73+
rUnit :: Responsable Unit
74+
rUnit = Responsable (const $ Right unit) StringResponse

‎test/Main.purs

Lines changed: 11 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -25,32 +25,25 @@ foreign import traceAny
2525
}
2626
""" :: forall e a. a -> Eff (trace :: Trace | e) Unit
2727

28-
traceAny' :: forall e. AffjaxResponse Unit -> Eff (trace :: Trace | e) Unit
29-
traceAny' = traceAny
30-
3128
foreign import noContent "var noContent = new FormData();" :: RequestContent
3229

33-
-- TODO: make PR for options
34-
instance isOptionUnit :: IsOption Unit where
35-
(:=) k a = (optionFn k) := toContent a
36-
3730
main = do
3831

3932
go $ url := "/api"
4033
<> headers := [ContentType applicationOctetStream]
41-
<> content := noContent
34+
<> content := (toContent "test")
4235

4336
go $ url := "/api"
4437
<> method := POST
45-
<> content := unit
38+
<> content := (toContent unit)
4639

4740
launchAff $ do
48-
res <- attempt $ affjax $ url := "/api"
49-
<> method := POST
50-
<> content := unit
51-
liftEff $ case res of
52-
(Left err) -> traceAny err
53-
(Right res') -> traceAny (res' :: AffjaxResponse String)
54-
55-
go :: forall e a. (Requestable a) => Options (AffjaxOptions a) -> Eff (ajax :: Ajax, trace :: Trace | e) Unit
56-
go opts = affjax' opts traceAny traceAny'
41+
res <- attempt $ affjax rString $ url := "/api" <> method := POST
42+
liftEff $ either traceAny traceAny res
43+
44+
launchAff $ do
45+
res <- attempt $ get rInt8Array "/arrayview"
46+
liftEff $ either traceAny traceAny res
47+
48+
go :: forall e. Options AffjaxOptions -> Eff (ajax :: Ajax, trace :: Trace | e) Unit
49+
go opts = affjax' rUnit opts traceAny traceAny

0 commit comments

Comments
 (0)