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
56
57
58
59
60
61
62
63
64
65
|
module Util.Ajax
( postJson
, delete
) where
import Control.Arrow (left)
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as Aeson
import Data.Default (def)
import qualified Data.Map.Lazy as LM
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Reflex.Dom (Dynamic, Event, IsXhrPayload, MonadWidget,
XhrRequest, XhrRequestConfig (..),
XhrResponse, XhrResponseHeaders (..))
import qualified Reflex.Dom as R
postJson
:: forall t m a b. (MonadWidget t m, ToJSON a, FromJSON b)
=> Text
-> Event t a
-> m (Event t (Either Text b))
postJson url input =
fmap getJsonResult <$>
R.performRequestAsync (R.postJson url <$> input)
delete
:: forall t m a. (MonadWidget t m)
=> Dynamic t Text
-> Event t ()
-> m (Event t (Either Text Text))
delete url fire = do
response <- R.performRequestAsync (R.attachWith (\u _ -> request "DELETE" u ()) (R.current url) fire)
return $ fmap getResult response
getJsonResult :: forall a. (FromJSON a) => XhrResponse -> Either Text a
getJsonResult response =
case getResult response of
Left l -> Left l
Right r -> left T.pack . Aeson.eitherDecodeStrict $ (T.encodeUtf8 r)
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
|
