aboutsummaryrefslogtreecommitdiff
path: root/client/src/Util
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Util')
-rw-r--r--client/src/Util/Ajax.hs40
-rw-r--r--client/src/Util/Either.hs7
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