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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
-- | The ContextMenu component renders a generic context menu
module Gargantext.Components.ContextMenu.ContextMenu where
-- (MenuProps, Action(..), separator) where
import Data.Maybe ( Maybe(..) )
import Data.Nullable ( Nullable, null, toMaybe )
import Data.Traversable ( traverse_ )
import DOM.Simple as DOM
import DOM.Simple.Event as DE
import DOM.Simple.EventListener ( Callback, callback )
import DOM.Simple.Element as Element
import DOM.Simple.Window ( window )
import DOM.Simple.Document ( document )
import DOM.Simple.Types ( DOMRect )
import Effect (Effect)
import FFI.Simple ((..))
import Reactix as R
import Reactix.DOM.HTML as HTML
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.ContextMenu.ContextMenu"
type Props t = (
onClose :: Effect Unit
, x :: Number
, y :: Number
)
contextMenu :: forall t. R2.Component (Props t)
contextMenu = R.createElement contextMenuCpt
contextMenuCpt :: forall t. R.Component (Props t)
contextMenuCpt = here.component "contextMenu" cpt
where
cpt menu@{ onClose, x, y } children = do
host <- R2.getPortalHost
root <- R.useRef null
-- NOTE: Just some dummy width/height here, it should be set properly in the effect function later
rect <- T.useBox $ Just $ R2.domRectFromRect { x, y, width: 100.0, height: 100.0 }
rect' <- T.useLive T.unequal rect
R.useLayoutEffect1 (R.readRef root) $ do
traverse_
(\r -> T.write_ (Just (Element.boundingRect r)) rect)
(toMaybe $ R.readRef root)
pure $ pure unit
R.useLayoutEffect2 (R.readRef root) rect' (contextMenuEffect onClose root)
let cs = [
HTML.div { className: "popover-content" }
[ HTML.div { className: "card" }
[ HTML.ul { className: "list-group" }
children
]
]
]
pure $ R.createPortal [ elems root menu rect' $ cs ] host
elems ref menu (Just rect) = HTML.div
{ ref
, key: "context-menu"
, className: "context-menu"
, style: position menu rect
, data: { placement: "right", toggle: "popover" }
}
elems ref _menu Nothing = HTML.div
{ ref
, key: "context-menu"
, className: "context-menu"
, data: { placement: "right", toggle: "popover" }
}
contextMenuEffect
:: forall t.
Effect Unit
-> R.Ref (Nullable DOM.Element)
-> Effect (Effect Unit)
contextMenuEffect onClose rootRef =
case R.readNullableRef rootRef of
Just root -> do
let onClick = documentClickHandler onClose root
let onScroll = documentScrollHandler onClose
DOM.addEventListener document "click" onClick
DOM.addEventListener document "scroll" onScroll
pure $ do
DOM.removeEventListener document "click" onClick
DOM.removeEventListener document "scroll" onScroll
Nothing -> pure R.nothing
documentClickHandler :: Effect Unit -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler onClose menu =
R2.named "hideMenuOnClickOutside" $ callback $ \e -> do
when (R2.mouseClickInElement e menu) $ do
here.log "mouse in element"
onClose
documentScrollHandler :: Effect Unit -> Callback DE.MouseEvent
documentScrollHandler onClose =
R2.named "hideMenuOnScroll" $ callback $ \_ -> onClose
position :: forall t. Record (Props t) -> DOMRect -> { left :: Number, top :: Number }
position mouse {width: menuWidth, height: menuHeight} = {left, top}
where left = if isRight then mouse.x else mouse.x - menuWidth
top = if isAbove then mouse.y else mouse.y - menuHeight
isRight = screenWidth - mouse.x > menuWidth -- is there enough space to show above
isAbove = screenHeight - mouse.y > menuHeight -- is there enough space to show to the right?
screenWidth = window .. "innerWidth"
screenHeight = window .. "innerHeight"
contextMenuItem :: R2.Component ()
contextMenuItem = R.createElement contextMenuItemCpt
contextMenuItemCpt :: R.Component ()
contextMenuItemCpt = here.component "contextMenuItem" cpt
where
cpt _props children = pure $ HTML.li { className: "context-menu-item" } children
-- -- CSS Classes
-- menuClass :: String
-- menuClass = "context-menu"
-- menuShownClass :: String
-- menuShownClass = "context-menu-shown"
-- menuHiddenClass :: String
-- menuHiddenClass = "context-menu-hidden"
-- itemClass :: String
-- itemClass = "context-menu-item"
-- separatorClass :: String
-- separatorClass = "context-menu-item"