aboutsummaryrefslogtreecommitdiff
path: root/client/src/Util/Reflex.hs
blob: aa5cebbd0e19a7becdc0cc52ab2add1379800ddf (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
module Util.Reflex
  ( visibleIfDyn
  , visibleIfEvent
  , divVisibleIf
  , divClassVisibleIf
  , flatten
  , flattenTuple
  , 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

flattenTuple
  :: forall t m a b. MonadWidget t m
  => Event t (Event t a, Event t b)
  -> m (Event t a, Event t b)
flattenTuple e = (,) <$> (flatten $ fmap fst e) <*> (flatten $ fmap snd e)

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