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
-- | The ContextMenu component renders a generic context menu
module Gargantext.Components.ContextMenu.ContextMenu where
-- (MenuProps, Action(..), separator) where
import Prelude hiding (div)
import Data.Maybe ( Maybe(..) )
import Data.Nullable ( Nullable, null, toMaybe )
import Data.Tuple ( Tuple(..) )
import Data.Tuple.Nested ( (/\) )
import Data.Traversable ( traverse_ )
import DOM.Simple as DOM
import DOM.Simple.Console
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.Document as Document
import DOM.Simple.Types ( DOMRect )
import Effect (Effect)
import Effect.Uncurried ( mkEffectFn1 )
import FFI.Simple ( (...), (..), delay )
import Reactix as R
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
import Gargantext.Utils.Reactix as R2
type Props t = ( x :: Number, y :: Number, setMenu :: (Maybe t -> Maybe t) -> Effect Unit)
getPortalHost :: R.Hooks DOM.Element
getPortalHost = R.unsafeHooksEffect $ delay unit $ \_ -> pure $ document ... "getElementById" $ ["menu-portal"]
contextMenu :: forall t. Record (Props t) -> Array R.Element -> R.Element
contextMenu = R.createElement contextMenuCpt
contextMenuCpt :: forall t. R.Component (Props t)
contextMenuCpt = R.hooksComponent "ContextMenu" cpt
where
cpt menu children = do
host <- getPortalHost
root <- R.useRef null
rect /\ setRect <- R.useState $ \_ -> Nothing
R.useLayoutEffect1 (R.readRef root) $ do
traverse_
(\r -> setRect (\_ -> Just (Element.boundingRect r)))
(toMaybe $ R.readRef root)
pure $ pure unit
R.useLayoutEffect2 root rect (contextMenuEffect menu.setMenu root)
let cs = [
HTML.div { className: "popover-content" }
[ HTML.div { className: "panel panel-default" }
[ HTML.ul { className: "list-group" }
children
]
]
]
pure $ R.createPortal [ elems root menu rect $ cs ] host
elems ref menu (Just rect) = HTML.div
{ ref
, className: "context-menu"
, style: position menu rect
, data: {toggle: "popover", placement: "right"}
}
elems ref _ _ = HTML.div
{ ref
, className: "context-menu"
, data: {toggle: "popover", placement: "right"}
}
contextMenuEffect
:: forall t
. ((Maybe t -> Maybe t) -> Effect Unit)
-> R.Ref (Nullable DOM.Element)
-> Effect (Effect Unit)
contextMenuEffect setMenu rootRef =
case R.readNullableRef rootRef of
Just root -> do
let onClick = documentClickHandler setMenu root
let onScroll = documentScrollHandler setMenu
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 :: forall t. ((Maybe t -> Maybe t) -> Effect Unit) -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler hide menu =
R2.named "hideMenuOnClickOutside" $ callback $ \e ->
if Element.contains menu (DE.target e)
then pure unit
else hide (const Nothing)
documentScrollHandler :: forall t. ((Maybe t -> Maybe t) -> Effect Unit) -> Callback DE.MouseEvent
documentScrollHandler hide =
R2.named "hideMenuOnScroll" $ callback $ \e -> hide (const Nothing)
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 :: Array R.Element -> R.Element
contextMenuItem = R.createElement contextMenuItemCpt {}
contextMenuItemCpt :: R.Component ()
contextMenuItemCpt = R.hooksComponent "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"