aboutsummaryrefslogtreecommitdiff
path: root/client/src/Util
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Util')
-rw-r--r--client/src/Util/Ajax.hs20
-rw-r--r--client/src/Util/WaitFor.hs18
2 files changed, 38 insertions, 0 deletions
diff --git a/client/src/Util/Ajax.hs b/client/src/Util/Ajax.hs
new file mode 100644
index 0000000..1e8e4c7
--- /dev/null
+++ b/client/src/Util/Ajax.hs
@@ -0,0 +1,20 @@
+module Util.Ajax
+ ( post
+ ) where
+
+import Data.Aeson (ToJSON)
+import Data.Text (Text)
+import Reflex.Dom (Event, MonadWidget)
+import qualified Reflex.Dom as R
+
+post :: forall t m a. (MonadWidget t m, ToJSON a) => Text -> Event t a -> m (Event t (Either Text Text))
+post url input =
+ fmap getResult <$> R.performRequestAsync xhrRequest
+ where xhrRequest = R.postJson url <$> input
+ getResult response =
+ case R._xhrResponse_responseText response of
+ Just responseText ->
+ if R._xhrResponse_status response == 200
+ then Right responseText
+ else Left responseText
+ _ -> Left "NoKey"
diff --git a/client/src/Util/WaitFor.hs b/client/src/Util/WaitFor.hs
new file mode 100644
index 0000000..0175c95
--- /dev/null
+++ b/client/src/Util/WaitFor.hs
@@ -0,0 +1,18 @@
+module Util.WaitFor
+ ( waitFor
+ ) where
+
+import Data.Time (NominalDiffTime)
+import Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
+
+waitFor
+ :: forall t m a b. MonadWidget t m
+ => (Event t a -> m (Event t b))
+ -> Event t ()
+ -> Dynamic t a
+ -> m (Event t b, Event t Bool)
+waitFor op start input = do
+ result <- op (R.tagPromptlyDyn input start) >>= R.debounce (0.5 :: NominalDiffTime)
+ let waiting = R.leftmost [ const True <$> start , const False <$> result ]
+ return (result, waiting)