2 files changed, 32 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 =
diff --git a/client/src/Util/Either.hs b/client/src/Util/Either.hs
new file mode 100644
index 0000000..2910d95
--- /dev/null
+++ b/client/src/Util/Either.hs
@@ -0,0 +1,7 @@
+module Util.Either
+  ( eitherToMaybe
+  ) where
+
+eitherToMaybe :: Either a b -> Maybe b
+eitherToMaybe (Right b) = Just b
+eitherToMaybe _         = Nothing