ContextMenu.purs 4.3 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

import Prelude hiding (div)
6 7 8 9 10 11 12 13 14 15 16 17 18 19
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 )
20
import Effect (Effect)
21 22
import Effect.Uncurried ( mkEffectFn1 )
import FFI.Simple ( (...), (..), delay )
James Laver's avatar
James Laver committed
23
import Reactix as R
24 25
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
James Laver's avatar
James Laver committed
26 27 28

import Gargantext.Utils.Reactix as R'

29
type Props t = ( x :: Number, y :: Number, setMenu :: Maybe t -> Effect Unit)
James Laver's avatar
James Laver committed
30

31 32 33 34 35 36 37
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)
38
contextMenuCpt = R.hooksComponent "ContextMenu" cpt
James Laver's avatar
James Laver committed
39
  where
40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
    cpt menu children = do
      host <- getPortalHost
      root <- R.useRef null
      rect /\ setRect <- R.useState $ \_ -> pure 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.ul { className: "context-menu-items" } children ]
      pure $ R.createPortal [ elems root menu rect $ cs ] host
    elems ref menu (Just rect) = HTML.nav { ref , className: "context-menu", style: position menu rect}
    elems ref _ _ = HTML.nav { ref, className: "context-menu" }

contextMenuEffect
  :: forall t
  .  (Maybe t -> Effect Unit)
  -> R.Ref (Nullable DOM.Element)
  -> Unit -> Effect (Unit -> Effect Unit)
60 61 62 63
contextMenuEffect setMenu rootRef _ =
  case R.readNullableRef rootRef of
    Just root -> do
      let onClick = documentClickHandler setMenu root
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
      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 $ \_ -> pure unit
          
documentClickHandler :: forall t. (Maybe t -> Effect Unit) -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler hide menu =
  R'.named "hideMenuOnClickOutside" $ callback $ \e ->
    if Element.contains menu (DE.target e)
      then pure unit
      else hide Nothing

documentScrollHandler :: forall t. (Maybe t -> Effect Unit) -> Callback DE.MouseEvent
documentScrollHandler hide =
  R'.named "hideMenuOnScroll" $ callback $ \e -> hide 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"
James Laver's avatar
James Laver committed
91 92

contextMenuItem :: Array R.Element -> R.Element
93
contextMenuItem = R.createElement contextMenuItemCpt {}
James Laver's avatar
James Laver committed
94

95 96
contextMenuItemCpt :: R.Component ()
contextMenuItemCpt = R.hooksComponent "ContextMenuItem" cpt
James Laver's avatar
James Laver committed
97
  where
98
    cpt _props children = pure $ HTML.li { className: "context-menu-item" } children
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115

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