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
|
module Component.Modal
( ModalIn(..)
, ModalOut(..)
, modal
) where
import Control.Monad (void)
import qualified Data.Map as M
import qualified Data.Map.Lazy as LM
import Data.Text (Text)
import qualified GHCJS.DOM.Node as Node
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import qualified Reflex.Dom.Class as R
import qualified Util.Dom as Dom
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
]
(elem, (curtainClick, content)) <- R.buildElement "div" (getAttributes <$> showModal) $ 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)
body <- Dom.getBody
let moveBackdrop = (const $ (Node.appendChild body elem)) `fmap` (_modalIn_show modalIn)
R.performEvent_ $ void `fmap` moveBackdrop
return $ ModalOut
{ _modalOut_content = content
}
getAttributes :: Bool -> LM.Map Text Text
getAttributes show =
M.fromList $
[ ("style", if show then "display:block" else "display:none")
, ("class", "modal")
]
|
