1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
module Util.Ajax
( postJson
, delete
) where
import Data.Aeson (ToJSON)
import Data.Default (def)
import qualified Data.Map.Lazy as LM
import Data.Text (Text)
import Reflex.Dom (Dynamic, Event, IsXhrPayload, MonadWidget,
XhrRequest, XhrRequestConfig (..), XhrResponse,
XhrResponseHeaders (..))
import qualified Reflex.Dom as R
postJson
:: forall t m a. (MonadWidget t m, ToJSON a)
=> Text
-> Event t a
-> m (Event t (Either Text Text))
postJson url input =
fmap getResult <$>
R.performRequestAsync (R.postJson url <$> input)
delete
:: forall t m. MonadWidget t m
=> Dynamic t Text
-> Event t ()
-> m (Event t (Either Text Text))
delete url fire =
fmap getResult <$>
R.performRequestAsync (R.attachPromptlyDynWith (\u _ -> request "DELETE" u ()) url fire)
getResult :: XhrResponse -> Either Text Text
getResult response =
case R._xhrResponse_responseText response of
Just responseText ->
if R._xhrResponse_status response == 200
then Right responseText
else Left responseText
_ -> Left "NoKey"
request :: forall a. (IsXhrPayload a) => Text -> Text -> a -> XhrRequest a
request method url sendData =
let
config = XhrRequestConfig
{ _xhrRequestConfig_headers = def
, _xhrRequestConfig_user = def
, _xhrRequestConfig_password = def
, _xhrRequestConfig_responseType = def
, _xhrRequestConfig_responseHeaders = def
, _xhrRequestConfig_withCredentials = False
, _xhrRequestConfig_sendData = sendData
}
in
R.xhrRequest method url config
|
