aboutsummaryrefslogtreecommitdiff
path: root/client/src/Util/Ajax.hs
diff options
context:
space:
mode:
authorJoris2018-10-30 18:04:58 +0100
committerJoris2018-10-30 18:04:58 +0100
commit50fb8fa48d1c4881da20b4ecf6d68a772301e713 (patch)
tree99c30c644d40664a9a7bb4a27e838d7cccda7a5f /client/src/Util/Ajax.hs
parent40b4994797a797b1fa86cafda789a5c488730c6d (diff)
downloadbudget-50fb8fa48d1c4881da20b4ecf6d68a772301e713.tar.gz
budget-50fb8fa48d1c4881da20b4ecf6d68a772301e713.tar.bz2
budget-50fb8fa48d1c4881da20b4ecf6d68a772301e713.zip
Update table when adding or removing a payment
Diffstat (limited to 'client/src/Util/Ajax.hs')
-rw-r--r--client/src/Util/Ajax.hs40
1 files changed, 25 insertions, 15 deletions
diff --git a/client/src/Util/Ajax.hs b/client/src/Util/Ajax.hs
index 14675df..0d76638 100644
--- a/client/src/Util/Ajax.hs
+++ b/client/src/Util/Ajax.hs
@@ -3,32 +3,42 @@ module Util.Ajax
, 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
+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. (MonadWidget t m, ToJSON a)
+ :: forall t m a b. (MonadWidget t m, ToJSON a, FromJSON b)
=> Text
-> Event t a
- -> m (Event t (Either Text Text))
+ -> m (Event t (Either Text b))
postJson url input =
- fmap getResult <$>
+ fmap getJsonResult <$>
R.performRequestAsync (R.postJson url <$> input)
delete
- :: forall t m. MonadWidget t m
+ :: forall t m a. (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)
+delete url fire = do
+ response <- R.performRequestAsync (R.attachPromptlyDynWith (\u _ -> request "DELETE" u ()) 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 =