Skip to content

Commit 7275387

Browse files
natefaubionnatefaubion
authored
Merge pull request #1 from purescript-web/impl
Initial implementation
2 parents 66363b6 + 76bcf9d commit 7275387

File tree

7 files changed

+366
-0
lines changed

7 files changed

+366
-0
lines changed

‎LICENSE‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
The MIT License (MIT)
2+
3+
Copyright (c) 2017 Nathan Faubion
4+
5+
Permission is hereby granted, free of charge, to any person obtaining a copy of
6+
this software and associated documentation files (the "Software"), to deal in
7+
the Software without restriction, including without limitation the rights to
8+
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
9+
the Software, and to permit persons to whom the Software is furnished to do so,
10+
subject to the following conditions:
11+
12+
The above copyright notice and this permission notice shall be included in all
13+
copies or substantial portions of the Software.
14+
15+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16+
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
17+
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
18+
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
19+
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20+
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

‎bower.json‎

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
{
2+
"name": "purescript-web-xhr",
3+
"homepage": "https://github.com/purescript-web/purescript-web-xhr",
4+
"authors": [
5+
"Nathan Faubion <[email protected]>"
6+
],
7+
"license": "MIT",
8+
"repository": {
9+
"type": "git",
10+
"url": "git://github.com/purescript-web/purescript-web-xhr.git"
11+
},
12+
"ignore": [
13+
"**/.*",
14+
"node_modules",
15+
"bower_components",
16+
"output"
17+
],
18+
"dependencies": {
19+
"purescript-prelude": "^3.0.0",
20+
"purescript-console": "^3.0.0",
21+
"purescript-dom": "^4.0.0",
22+
"purescript-datetime": "^3.0.0",
23+
"purescript-foreign": "^4.0.0",
24+
"purescript-nullable": "^3.0.0",
25+
"purescript-eff": "^3.1.0",
26+
"purescript-proxy": "^2.0.0",
27+
"purescript-unsafe-coerce": "^3.0.0",
28+
"purescript-maybe": "^3.0.0",
29+
"purescript-arraybuffer-types": "^1.0.0"
30+
},
31+
"devDependencies": {
32+
"purescript-psci-support": "^3.0.0"
33+
}
34+
}

‎package.json‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
{
2+
"private": true,
3+
"scripts": {
4+
"build": "pulp build -- --strict --censor-lib"
5+
},
6+
"devDependencies": {
7+
"pulp": "^12.0.0",
8+
"purescript": "^0.11.6",
9+
"purescript-psa": "^0.5.0"
10+
}
11+
}

‎src/Web/XHR.purs‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
module Web.XHR
2+
( module Web.XHR.Types
3+
, module Web.XHR.XMLHttpRequest
4+
) where
5+
6+
import Web.XHR.Types (ReadyState(..), ResponseType, XHR, XMLHttpRequest, XMLHttpRequestUpload, arrayBuffer, blob, document, string, xmlHttpRequestToEventTarget, xmlHttpRequestUploadToEventTarget)
7+
import Web.XHR.XMLHttpRequest (abort, getAllResponseHeaders, getResponseHeader, open, open', readyState, response, responseURL, send, sendBlob, sendDocument, sendString, setRequestHeader, setTimeout, setWithCredentials, status, statusText, timeout, upload, withCredentials, xmlHttpRequest)

‎src/Web/XHR/Types.purs‎

Lines changed: 94 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,94 @@
1+
module Web.XHR.Types
2+
( XHR
3+
, XMLHttpRequest
4+
, XMLHttpRequestUpload
5+
, ReadyState(..)
6+
, ResponseType
7+
, FormData
8+
, string
9+
, blob
10+
, document
11+
, arrayBuffer
12+
, xmlHttpRequestToEventTarget
13+
, xmlHttpRequestUploadToEventTarget
14+
) where
15+
16+
import Prelude
17+
18+
import Control.Monad.Eff (kind Effect)
19+
import DOM.Event.Types (EventTarget)
20+
import DOM.File.Types (Blob)
21+
import DOM.Node.Types (Document)
22+
import Data.ArrayBuffer.Types (ArrayBuffer)
23+
import Data.Enum (class BoundedEnum, class Enum, Cardinality(..), defaultPred, defaultSucc, fromEnum, toEnum)
24+
import Data.Maybe (Maybe(..))
25+
import Unsafe.Coerce (unsafeCoerce)
26+
27+
foreign import data XHR :: Effect
28+
29+
-- | `XMLHttpRequest`s are indexed by their `ResponseType`
30+
foreign import data XMLHttpRequest :: Type -> Type
31+
32+
foreign import data XMLHttpRequestUpload :: Type
33+
34+
foreign import data FormData :: Type
35+
36+
data ReadyState
37+
= ReadyStateUnsent
38+
| ReadyStateOpened
39+
| ReadyStateHeadersReceived
40+
| ReadyStateLoading
41+
| ReadyStateDone
42+
43+
derive instance eqReadyState :: Eq ReadyState
44+
derive instance ordReadyState :: Ord ReadyState
45+
46+
instance boundedReadyState :: Bounded ReadyState where
47+
bottom = ReadyStateUnsent
48+
top = ReadyStateDone
49+
50+
instance enumReadyState :: Enum ReadyState where
51+
succ = defaultSucc toEnum fromEnum
52+
pred = defaultPred toEnum fromEnum
53+
54+
instance boundedEnumReadyState :: BoundedEnum ReadyState where
55+
cardinality = Cardinality 5
56+
toEnum = toEnumReadyState
57+
fromEnum = fromEnumReadyState
58+
59+
newtype ResponseType res = ResponseType String
60+
61+
string :: ResponseType String
62+
string = ResponseType ""
63+
64+
blob :: ResponseType Blob
65+
blob = ResponseType "blob"
66+
67+
document :: ResponseType Document
68+
document = ResponseType "document"
69+
70+
arrayBuffer :: ResponseType ArrayBuffer
71+
arrayBuffer = ResponseType "arraybuffer"
72+
73+
xmlHttpRequestToEventTarget :: forall res. XMLHttpRequest res -> EventTarget
74+
xmlHttpRequestToEventTarget = unsafeCoerce
75+
76+
xmlHttpRequestUploadToEventTarget :: XMLHttpRequestUpload -> EventTarget
77+
xmlHttpRequestUploadToEventTarget = unsafeCoerce
78+
79+
toEnumReadyState :: Int -> Maybe ReadyState
80+
toEnumReadyState = case _ of
81+
0 -> Just ReadyStateUnsent
82+
1 -> Just ReadyStateOpened
83+
2 -> Just ReadyStateHeadersReceived
84+
3 -> Just ReadyStateLoading
85+
4 -> Just ReadyStateDone
86+
_ -> Nothing
87+
88+
fromEnumReadyState :: ReadyState -> Int
89+
fromEnumReadyState = case _ of
90+
ReadyStateUnsent -> 0
91+
ReadyStateOpened -> 1
92+
ReadyStateHeadersReceived -> 2
93+
ReadyStateLoading -> 3
94+
ReadyStateDone -> 4

‎src/Web/XHR/XMLHttpRequest.js‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
"use strict";
2+
3+
exports._xmlHttpRequest = function(respType) {
4+
var xhr = new XMLHttpRequest();
5+
xhr.responseType = respType;
6+
return xhr;
7+
};
8+
9+
exports._abort = function(xhr) {
10+
xhr.abort();
11+
};
12+
13+
exports._getAllResponseHeaders = function(xhr) {
14+
return xhr.getAllResponseHeaders();
15+
};
16+
17+
exports._getResponseHeader = function(header, xhr) {
18+
return xhr.getResponseHeader(header);
19+
};
20+
21+
exports._open = function(method, url, username, password, xhr) {
22+
xhr.open(method, url, true, username, password);
23+
};
24+
25+
exports._overrideMimeType = function(mimeType, xhr) {
26+
xhr.overrideMimeType(mimeType);
27+
};
28+
29+
exports._send = function(payload, xhr) {
30+
xhr.send(payload);
31+
};
32+
33+
exports._setRequestHeader = function(header, value, xhr) {
34+
xhr.setRequestHeader(header, value);
35+
};
36+
37+
exports._setProperty = function(prop, value, xhr) {
38+
xhr[prop] = value;
39+
};
40+
41+
exports._getProperty = function(prop, xhr) {
42+
return xhr[prop];
43+
};

‎src/Web/XHR/XMLHttpRequest.purs‎

Lines changed: 157 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,157 @@
1+
module Web.XHR.XMLHttpRequest
2+
( xmlHttpRequest
3+
, abort
4+
, getAllResponseHeaders
5+
, getResponseHeader
6+
, open
7+
, open'
8+
, overrideMimeType
9+
, send
10+
, sendString
11+
, sendDocument
12+
, sendBlob
13+
, sendFormData
14+
, setRequestHeader
15+
, readyState
16+
, response
17+
, responseURL
18+
, status
19+
, statusText
20+
, timeout
21+
, setTimeout
22+
, upload
23+
, withCredentials
24+
, setWithCredentials
25+
) where
26+
27+
import Prelude
28+
29+
import Control.Monad.Eff (kind Effect, Eff)
30+
import Control.Monad.Eff.Uncurried as Fn
31+
import DOM.File.Types (Blob)
32+
import DOM.Node.Types (Document)
33+
import Data.Enum (toEnum)
34+
import Data.Foreign (Foreign, toForeign)
35+
import Data.Maybe (Maybe(..), fromMaybe)
36+
import Data.Nullable (Nullable, toMaybe, toNullable)
37+
import Data.Time.Duration (Milliseconds(..))
38+
import Unsafe.Coerce (unsafeCoerce)
39+
import Web.XHR.Types (FormData, ReadyState(..), ResponseType, XHR, XMLHttpRequest, XMLHttpRequestUpload)
40+
41+
xmlHttpRequest :: forall res eff. ResponseType res -> Eff (xhr :: XHR | eff) (XMLHttpRequest res)
42+
xmlHttpRequest = Fn.runEffFn1 _xmlHttpRequest
43+
44+
abort :: forall res eff. XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
45+
abort = Fn.runEffFn1 _abort
46+
47+
getAllResponseHeaders :: forall res eff. XMLHttpRequest res -> Eff (xhr :: XHR | eff) (Maybe String)
48+
getAllResponseHeaders xhr = toMaybe <$> Fn.runEffFn1 _getAllResponseHeaders xhr
49+
50+
getResponseHeader :: forall res eff. String -> XMLHttpRequest res -> Eff (xhr :: XHR | eff) (Maybe String)
51+
getResponseHeader header xhr = toMaybe <$> Fn.runEffFn2 _getResponseHeader header xhr
52+
53+
open :: forall res eff. String -> String -> XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
54+
open method url xhr = Fn.runEffFn5 _open method url (toNullable Nothing) (toNullable Nothing) xhr
55+
56+
open' :: forall res eff. { method :: String, url :: String, username :: Maybe String, password :: Maybe String } -> XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
57+
open' options xhr = Fn.runEffFn5 _open options.method options.url (toNullable options.username) (toNullable options.password) xhr
58+
59+
overrideMimeType :: forall res eff. String -> XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
60+
overrideMimeType = Fn.runEffFn2 _overrideMimeType
61+
62+
send :: forall res eff. XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
63+
send = Fn.runEffFn2 _send (toForeign (toNullable Nothing))
64+
65+
sendString :: forall res eff. String -> XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
66+
sendString payload xhr = Fn.runEffFn2 _send (toForeign payload) xhr
67+
68+
sendBlob :: forall res eff. Blob -> XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
69+
sendBlob payload xhr = Fn.runEffFn2 _send (toForeign payload) xhr
70+
71+
sendFormData :: forall res eff. FormData -> XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
72+
sendFormData payload xhr = Fn.runEffFn2 _send (toForeign payload) xhr
73+
74+
sendDocument :: forall res eff. Document -> XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
75+
sendDocument payload xhr = Fn.runEffFn2 _send (toForeign payload) xhr
76+
77+
setRequestHeader :: forall res eff. String -> String -> XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
78+
setRequestHeader = Fn.runEffFn3 _setRequestHeader
79+
80+
readyState :: forall res eff. XMLHttpRequest res -> Eff (xhr :: XHR | eff) ReadyState
81+
readyState xhr = toReadyState <$> Fn.runEffFn2 _getProperty "readyState" xhr
82+
where
83+
toReadyState :: Foreign -> ReadyState
84+
toReadyState rs = fromMaybe ReadyStateUnsent $ toEnum (unsafeCoerce rs :: Int)
85+
86+
response :: forall res eff. XMLHttpRequest res -> Eff (xhr :: XHR | eff) (Maybe res)
87+
response xhr = toResponse <$> Fn.runEffFn2 _getProperty "response" xhr
88+
where
89+
toResponse :: Foreign -> Maybe res
90+
toResponse r = toMaybe (unsafeCoerce r :: Nullable res)
91+
92+
responseURL :: forall res eff. XMLHttpRequest res -> Eff (xhr :: XHR | eff) String
93+
responseURL xhr = (unsafeCoerce :: Foreign -> String) <$> Fn.runEffFn2 _getProperty "responseURL" xhr
94+
95+
status :: forall res eff. XMLHttpRequest res -> Eff (xhr :: XHR | eff) Int
96+
status xhr = (unsafeCoerce :: Foreign -> Int) <$> Fn.runEffFn2 _getProperty "status" xhr
97+
98+
statusText :: forall res eff. XMLHttpRequest res -> Eff (xhr :: XHR | eff) String
99+
statusText xhr = (unsafeCoerce :: Foreign -> String) <$> Fn.runEffFn2 _getProperty "statusText" xhr
100+
101+
timeout :: forall res eff. XMLHttpRequest res -> Eff (xhr :: XHR | eff) Milliseconds
102+
timeout xhr = toMillis <$> Fn.runEffFn2 _getProperty "statusText" xhr
103+
where
104+
toMillis :: Foreign -> Milliseconds
105+
toMillis m = Milliseconds (unsafeCoerce m)
106+
107+
setTimeout :: forall res eff. Milliseconds -> XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
108+
setTimeout (Milliseconds ms) xhr = Fn.runEffFn3 _setProperty "timeout" (toForeign ms) xhr
109+
110+
upload :: forall res eff. XMLHttpRequest res -> Eff (xhr :: XHR | eff) XMLHttpRequestUpload
111+
upload xhr = (unsafeCoerce :: Foreign -> XMLHttpRequestUpload) <$> Fn.runEffFn2 _getProperty "upload" xhr
112+
113+
withCredentials :: forall res eff. XMLHttpRequest res -> Eff (xhr :: XHR | eff) Boolean
114+
withCredentials xhr = (unsafeCoerce :: Foreign -> Boolean) <$> Fn.runEffFn2 _getProperty "withCredentials" xhr
115+
116+
setWithCredentials :: forall res eff. Boolean -> XMLHttpRequest res -> Eff (xhr :: XHR | eff) Unit
117+
setWithCredentials wc xhr = Fn.runEffFn3 _setProperty "withCredentials" (toForeign wc) xhr
118+
119+
foreign import _xmlHttpRequest
120+
:: forall res eff
121+
. Fn.EffFn1 (xhr :: XHR | eff) (ResponseType res) (XMLHttpRequest res)
122+
123+
foreign import _abort
124+
:: forall res eff
125+
. Fn.EffFn1 (xhr :: XHR | eff) (XMLHttpRequest res) Unit
126+
127+
foreign import _getAllResponseHeaders
128+
:: forall res eff
129+
. Fn.EffFn1 (xhr :: XHR | eff) (XMLHttpRequest res) (Nullable String)
130+
131+
foreign import _getResponseHeader
132+
:: forall res eff
133+
. Fn.EffFn2 (xhr :: XHR | eff) String (XMLHttpRequest res) (Nullable String)
134+
135+
foreign import _open
136+
:: forall res eff
137+
. Fn.EffFn5 (xhr :: XHR | eff) String String (Nullable String) (Nullable String) (XMLHttpRequest res) Unit
138+
139+
foreign import _overrideMimeType
140+
:: forall res eff
141+
. Fn.EffFn2 (xhr :: XHR | eff) String (XMLHttpRequest res) Unit
142+
143+
foreign import _send
144+
:: forall res eff
145+
. Fn.EffFn2 (xhr :: XHR | eff) Foreign (XMLHttpRequest res) Unit
146+
147+
foreign import _setRequestHeader
148+
:: forall res eff
149+
. Fn.EffFn3 (xhr :: XHR | eff) String String (XMLHttpRequest res) Unit
150+
151+
foreign import _setProperty
152+
:: forall res eff
153+
. Fn.EffFn3 (xhr :: XHR | eff) String Foreign (XMLHttpRequest res) Unit
154+
155+
foreign import _getProperty
156+
:: forall res eff
157+
. Fn.EffFn2 (xhr :: XHR | eff) String (XMLHttpRequest res) Foreign

0 commit comments

Comments
 (0)