From 50fb8fa48d1c4881da20b4ecf6d68a772301e713 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 30 Oct 2018 18:04:58 +0100
Subject: Update table when adding or removing a payment

---
 client/src/Util/Ajax.hs | 40 +++++++++++++++++++++++++---------------
 1 file changed, 25 insertions(+), 15 deletions(-)

(limited to 'client/src/Util/Ajax.hs')

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 =
-- 
cgit v1.2.3