diff options
author | Joris | 2019-12-08 11:39:37 +0100 |
---|---|---|
committer | Joris | 2019-12-08 11:39:37 +0100 |
commit | 316bda10c6bec8b5ccc9e23f1f677c076205f046 (patch) | |
tree | 98da1d18834108af50f80ca6fa5c0f4facc42472 /client/src/Util | |
parent | e622e8fdd2e40b4306b5cc724d8dfb76bf976242 (diff) |
Add category page
Diffstat (limited to 'client/src/Util')
-rw-r--r-- | client/src/Util/Ajax.hs | 28 |
1 files changed, 26 insertions, 2 deletions
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 |