From 316bda10c6bec8b5ccc9e23f1f677c076205f046 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 8 Dec 2019 11:39:37 +0100
Subject: Add category page

---
 client/src/Util/Ajax.hs | 28 ++++++++++++++++++++++++++--
 1 file changed, 26 insertions(+), 2 deletions(-)

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

diff --git a/client/src/Util/Ajax.hs b/client/src/Util/Ajax.hs
index dc56701..dcfd402 100644
--- a/client/src/Util/Ajax.hs
+++ b/client/src/Util/Ajax.hs
@@ -2,7 +2,9 @@ module Util.Ajax
   ( getNow
   , get
   , post
+  , postAndParseResult
   , put
+  , putAndParseResult
   , delete
   ) where
 
@@ -42,20 +44,38 @@ get url =
     R.performRequestAsync (R.ffor url $ \u -> jsonRequest "GET" u (Aeson.String ""))
 
 post
+  :: forall t m a. (MonadWidget t m, ToJSON a)
+  => Text
+  -> Event t a
+  -> m (Event t (Either Text ()))
+post url input =
+  fmap checkResult <$>
+    R.performRequestAsync (jsonRequest "POST" url <$> input)
+
+postAndParseResult
   :: forall t m a b. (MonadWidget t m, ToJSON a, FromJSON b)
   => Text
   -> Event t a
   -> m (Event t (Either Text b))
-post url input =
+postAndParseResult url input =
   fmap getJsonResult <$>
     R.performRequestAsync (jsonRequest "POST" url <$> input)
 
 put
+  :: forall t m a. (MonadWidget t m, ToJSON a)
+  => Text
+  -> Event t a
+  -> m (Event t (Either Text ()))
+put url input =
+  fmap checkResult <$>
+    R.performRequestAsync (jsonRequest "PUT" url <$> input)
+
+putAndParseResult
   :: forall t m a b. (MonadWidget t m, ToJSON a, FromJSON b)
   => Text
   -> Event t a
   -> m (Event t (Either Text b))
-put url input =
+putAndParseResult url input =
   fmap getJsonResult <$>
     R.performRequestAsync (jsonRequest "PUT" url <$> input)
 
@@ -69,6 +89,10 @@ delete url fire = do
     (R.performRequestAsync $
       R.attachWith (\u _ -> request "DELETE" u ()) (R.current url) fire)
 
+checkResult :: XhrResponse -> Either Text ()
+checkResult response =
+  () <$ getResult response
+
 getJsonResult :: forall a. (FromJSON a) => XhrResponse -> Either Text a
 getJsonResult response =
   case getResult response of
-- 
cgit v1.2.3