client/src/Component/Modal.hs


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

{-# LANGUAGE ScopedTypeVariables #-}

module Component.Modal
  ( ModalIn(..)
  , ModalOut(..)
  , modal
  ) where

import qualified Data.Map   as M
import           Reflex.Dom (Event, MonadWidget)
import qualified Reflex.Dom as R

data ModalIn t m a = ModalIn
  { _modalIn_show    :: Event t ()
  , _modalIn_hide    :: Event t ()
  , _modalIn_content :: m a
  }

data ModalOut a = ModalOut
  { _modalOut_content :: a
  }

modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut a)
modal modalIn = do
  rec
    showModal <- R.holdDyn False $ R.leftmost
      [ True <$ _modalIn_show modalIn
      , False <$ _modalIn_hide modalIn
      , False <$ curtainClick
      ]

    let attr = flip fmap showModal (\s -> M.fromList $
          [ ("style", if s then "display:block" else "display:none")
          , ("class", "modal")
          ])

    (curtainClick, content) <- R.elDynAttr "div" attr $ do
      (curtain, _) <- R.elAttr' "div" (M.singleton "class" "modalCurtain") $ R.blank
      cont <- R.divClass "modalContent" $ _modalIn_content modalIn
      return (R.domEvent R.Click curtain, cont)

  return $ ModalOut
    { _modalOut_content = content
    }