ContextMenu.purs 4.49 KB
Newer Older
1
-- | The ContextMenu component renders a generic context menu
James Laver's avatar
James Laver committed
2
module Gargantext.Components.ContextMenu.ContextMenu where
3
  -- (MenuProps, Action(..), separator) where
4

5 6 7 8 9 10 11 12 13 14
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 )
15
import Effect (Effect)
16
import FFI.Simple ((..))
James Laver's avatar
James Laver committed
17
import Reactix as R
18
import Reactix.DOM.HTML as HTML
19 20 21
import Toestand as T

import Gargantext.Prelude
James Laver's avatar
James Laver committed
22

23
import Gargantext.Utils.Reactix as R2
James Laver's avatar
James Laver committed
24

25 26
here :: R2.Here
here = R2.here "Gargantext.Components.ContextMenu.ContextMenu"
27

28
type Props t = (
29 30
    onClose :: Effect Unit
  , x :: Number
31 32
  , y :: Number
  )
James Laver's avatar
James Laver committed
33

34
contextMenu :: forall t. R2.Component (Props t)
35 36
contextMenu = R.createElement contextMenuCpt
contextMenuCpt :: forall t. R.Component (Props t)
37
contextMenuCpt = here.component "contextMenu" cpt
James Laver's avatar
James Laver committed
38
  where
39
    cpt menu@{ onClose, x, y } children = do
James Laver's avatar
James Laver committed
40
      host <- R2.getPortalHost
41
      root <- R.useRef null
42 43
      -- 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 }
44 45
      rect' <- T.useLive T.unequal rect

James Laver's avatar
James Laver committed
46
      R.useLayoutEffect1 (R.readRef root) $ do
47
        traverse_
48
          (\r -> T.write_ (Just (Element.boundingRect r)) rect)
49
          (toMaybe $ R.readRef root)
James Laver's avatar
James Laver committed
50
        pure $ pure unit
51
      R.useLayoutEffect2 (R.readRef root) rect' (contextMenuEffect onClose root)
52 53
      let cs = [
            HTML.div { className: "popover-content" }
54
            [ HTML.div { className: "card" }
55 56 57 58 59
              [ HTML.ul { className: "list-group" }
                children
              ]
            ]
      ]
60
      pure $ R.createPortal [ elems root menu rect' $ cs ] host
61 62
    elems ref menu (Just rect) = HTML.div
        { ref
63
        , key: "context-menu"
64 65
        , className: "context-menu"
        , style: position menu rect
66
        , data: { placement: "right", toggle: "popover" }
67
        }
68
    elems ref menu Nothing = HTML.div
69
        { ref
70
        , key: "context-menu"
71
        , className: "context-menu"
72
        , data: { placement: "right", toggle: "popover" }
73
        }
74 75

contextMenuEffect
76
  :: forall t.
77
     Effect Unit
78
  -> R.Ref (Nullable DOM.Element)
James Laver's avatar
James Laver committed
79
  -> Effect (Effect Unit)
80
contextMenuEffect onClose rootRef =
81 82
  case R.readNullableRef rootRef of
    Just root -> do
83 84
      let onClick = documentClickHandler onClose root
      let onScroll = documentScrollHandler onClose
85 86
      DOM.addEventListener document "click" onClick
      DOM.addEventListener document "scroll" onScroll
James Laver's avatar
James Laver committed
87
      pure $ do
88 89
        DOM.removeEventListener document "click" onClick
        DOM.removeEventListener document "scroll" onScroll
James Laver's avatar
James Laver committed
90
    Nothing -> pure R.nothing
91

92 93
documentClickHandler :: Effect Unit -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler onClose menu =
94 95 96 97
  R2.named "hideMenuOnClickOutside" $ callback $ \e -> do
    when (R2.mouseClickInElement e menu) $ do
      here.log "mouse in element"
      onClose
98

99 100 101
documentScrollHandler :: Effect Unit -> Callback DE.MouseEvent
documentScrollHandler onClose =
  R2.named "hideMenuOnScroll" $ callback $ \e -> onClose
102 103 104 105 106 107 108 109 110

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"
James Laver's avatar
James Laver committed
111

112 113
contextMenuItem :: R2.Component ()
contextMenuItem = R.createElement contextMenuItemCpt
114
contextMenuItemCpt :: R.Component ()
115
contextMenuItemCpt = here.component "contextMenuItem" cpt
James Laver's avatar
James Laver committed
116
  where
117
    cpt _props children = pure $ HTML.li { className: "context-menu-item" } children
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134

-- -- 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"
135