aboutsummaryrefslogtreecommitdiff
path: root/client/src/Util/Reflex.hs
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Util/Reflex.hs')
-rw-r--r--client/src/Util/Reflex.hs52
1 files changed, 52 insertions, 0 deletions
diff --git a/client/src/Util/Reflex.hs b/client/src/Util/Reflex.hs
new file mode 100644
index 0000000..c14feeb
--- /dev/null
+++ b/client/src/Util/Reflex.hs
@@ -0,0 +1,52 @@
+module Util.Reflex
+ ( visibleIfDyn
+ , visibleIfEvent
+ , divVisibleIf
+ , divClassVisibleIf
+ , flatten
+ , getBody
+ ) where
+
+import qualified Data.Map as M
+import Data.Text (Text)
+import qualified GHCJS.DOM as Dom
+import qualified GHCJS.DOM.Document as Document
+import qualified GHCJS.DOM.HTMLCollection as HTMLCollection
+import GHCJS.DOM.Types (Element)
+import Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
+
+visibleIfDyn :: forall t m a. MonadWidget t m => Dynamic t Bool -> m a -> m a -> m (Event t a)
+visibleIfDyn cond empty content =
+ R.dyn $ R.ffor cond $ \case
+ True -> content
+ False -> empty
+
+visibleIfEvent :: forall t m a. MonadWidget t m => Event t Bool -> m a -> m a -> m (Dynamic t a)
+visibleIfEvent cond empty content =
+ R.widgetHold empty $
+ R.ffor cond $ \case
+ True -> content
+ False -> empty
+
+divVisibleIf :: forall t m a. MonadWidget t m => Dynamic t Bool -> m a -> m a
+divVisibleIf cond content = divClassVisibleIf cond "" content
+
+divClassVisibleIf :: forall t m a. MonadWidget t m => Dynamic t Bool -> Text -> m a -> m a
+divClassVisibleIf cond className content =
+ R.elDynAttr
+ "div"
+ (fmap (\c -> (M.singleton "class" className) `M.union` if c then M.empty else M.singleton "style" "display:none") cond)
+ content
+
+flatten :: forall t m a. MonadWidget t m => Event t (Event t a) -> m (Event t a)
+flatten e = do
+ dyn <- R.holdDyn R.never e
+ return $ R.switchDyn dyn
+
+getBody :: forall t m. MonadWidget t m => m Element
+getBody = do
+ document <- Dom.currentDocumentUnchecked
+ nodelist <- Document.getElementsByTagName document ("body" :: String)
+ Just body <- nodelist `HTMLCollection.item` 0
+ return body