[Document] refactor the annotated field menu

src/Gargantext/Components/Annotation/AnnotatedField.purs

@@ -13,9 +13,9 @@ module Gargantext.Components.Annotation.AnnotatedField where
 
 import Prelude
 import Data.Maybe ( Maybe(..), maybe )
-import Data.Tuple ( Tuple(..) )
+import Data.Tuple ( Tuple )
 import Data.Tuple.Nested ( (/\) )
-import DOM.Simple.Console (log2)
+--import DOM.Simple.Console (log2)
 import DOM.Simple.Event as DE
 import Effect ( Effect )
 import Reactix as R
@@ -25,7 +25,7 @@ import Reactix.SyntheticEvent as E
 import Gargantext.Types (CTabNgramType(..), TermList)
 import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
 import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
-import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
+import Gargantext.Components.Annotation.Menu ( annotationMenu, MenuType(..) )
 import Gargantext.Utils.Selection as Sel
 
 thisModule :: String
@@ -48,110 +48,65 @@ annotatedField p = R.createElement annotatedFieldComponent p []
 annotatedFieldComponent :: R.Component Props
 annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField" cpt
   where
-    cpt {ngrams,setTermList,text} _ = do
-      mMenu@(_ /\ setMenu) <- R.useState' Nothing
+    cpt {ngrams,setTermList,text: fieldText} _ = do
+      (_ /\ setRedrawMenu) <- R.useState' false
 
       menuRef <- R.useRef Nothing
 
       let wrapperProps = { className: "annotated-field-wrapper" }
 
-          onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
-          onSelect text' Nothing event = do
-            --log2 "[onSelect] text'" text'
-            maybeShowMenu setMenu menuRef setTermList ngrams event
-          onSelect text' (Just list) event = do
-            --log2 "[onSelect] text'" text'
-            --log2 "[onSelect] list" (show list)
+          redrawMenu = setRedrawMenu not
+
+          hideMenu = do
+            R.setRef menuRef Nothing
+            redrawMenu
+
+          showMenu { event, text, getList, menuType } = do
             let x = E.clientX event
                 y = E.clientY event
+                n = normNgram CTabTerms text
+                list = getList n
                 setList t = do
-                  R.setRef menuRef Nothing
-                  setTermList (normNgram CTabTerms text') (Just list) t
-                  --setMenu (const Nothing)
-                menu = Just {
-                    x
+                  setTermList n list t
+                  hideMenu
+            E.preventDefault event
+            --range <- Sel.getRange sel 0
+            --log2 "[showMenu] selection range" $ Sel.rangeToTuple range
+            let menu = Just
+                  { x
                   , y
-                  , list: Just list
-                  , menuType: SetTermListItem
-                  , onClose: \_ -> R.setRef menuRef Nothing
+                  , list
+                  , menuType
+                  , onClose: hideMenu
                   , setList
                   }
             R.setRef menuRef menu
-            setMenu $ const menu
-
-          mapCompile (Tuple t l) = {text: t, list: l, onSelect}
-          compiled = map mapCompile $ compile ngrams text
-
-          runs =
-            HTML.div { className: "annotated-field-runs" } $ map annotateRun compiled
-      --pure $ HTML.div wrapperProps [maybeAddMenu mMenu runs]
-      pure $ HTML.div wrapperProps [ addMenu { menuRef }, runs ]
-
-
-type AddMenuProps = (
-  menuRef :: R.Ref (Maybe AnnotationMenu)
-  )
+            redrawMenu
 
-
-addMenu :: Record AddMenuProps -> R.Element
-addMenu p = R.createElement addMenuCpt p []
-
-addMenuCpt :: R.Component AddMenuProps
-addMenuCpt = R.hooksComponentWithModule thisModule "addMenu" cpt
-  where
-    cpt { menuRef } _ = do
-      (mMenu /\ setmMenu) <- R.useState' (Nothing :: Maybe AnnotationMenu)
-
-      R.useEffect' $ do
-        let m = R.readRef menuRef
-        --log2 "[addMenu] menuRef" m
-        --log2 "[addMenu] mMenu" mMenu
-        setmMenu $ const m
-
-      pure $ case mMenu of
-        Nothing -> HTML.div {} []
-        Just menu -> annotationMenu setmMenu menu
-
--- forall e. IsMouseEvent e => R.Setter (Maybe AnnotationMenu) -> R.Setter ? -> ? -> e -> Effect Unit
-maybeShowMenu setMenu menuRef setTermList ngrams event = do
-  s <- Sel.getSelection
-  --log2 "[maybeShowMenu] s" s
-  case s of
-    Just sel -> do
-      case Sel.selectionToString sel of
-        "" -> pure unit
-        sel' -> do
-          let x = E.clientX event
-              y = E.clientY event
-              n = normNgram CTabTerms sel'
-              list = findNgramTermList ngrams n
-              setList t = do
-                setTermList n list t
-                R.setRef menuRef Nothing
-                --setMenu (const Nothing)
-          E.preventDefault event
-          range <- Sel.getRange sel 0
-          --log2 "[maybeShowMenu] selection range" $ Sel.rangeToTuple range
-          let menu = Just {
-                x
-              , y
-              , list
-              , menuType: NewNgram
-              , onClose: \_ -> R.setRef menuRef Nothing
-              , setList
-            }
-          R.setRef menuRef menu
-          setMenu $ const $ menu
-    Nothing -> pure unit
-    -- Nothing -> do
-    --   R.setRef menuRef Nothing
-
-maybeAddMenu
-  :: R.State (Maybe AnnotationMenu)
-  -> R.Element
-  -> R.Element
-maybeAddMenu (Just props /\ setMenu) e = annotationMenu setMenu props <> e
-maybeAddMenu _ e = e
+          onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
+          onSelect text mList event =
+            case mList of
+              Just list ->
+                showMenu { event, text, getList: const (Just list), menuType: SetTermListItem }
+              Nothing -> do
+                s <- Sel.getSelection
+                case s of
+                  Just sel -> do
+                    case Sel.selectionToString sel of
+                      "" -> hideMenu
+                      sel' -> do
+                        showMenu { event, text: sel', getList: findNgramTermList ngrams, menuType: NewNgram }
+                  Nothing -> hideMenu
+
+          wrap (text /\ list) = {text, list, onSelect}
+
+      pure $ HTML.div wrapperProps
+        [ maybe (HTML.div {} []) annotationMenu $ R.readRef menuRef
+        , HTML.div { className: "annotated-field-runs" }
+             $ annotateRun
+            <$> wrap
+            <$> compile ngrams fieldText
+        ]
 
 compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList))
 compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
@@ -170,13 +125,11 @@ annotateRun p = R.createElement annotatedRunComponent p []
 annotatedRunComponent :: R.Component Run
 annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
   where
-    cpt    { list: Nothing, onSelect, text }     _ =
-      HTML.span { on: { mouseUp: \e -> onSelect text Nothing e } } [ HTML.text text ]
-
-    cpt    { list: (Just list), onSelect, text } _ =
-      HTML.span { className: className list
-                , on: { click: \e -> onSelect text (Just list) e } } [ HTML.text text ]
+    cpt { list, onSelect, text } _ = elt [ HTML.text text ]
       where
-        className list' = "annotation-run bg-" <> termBootstrapClass list'
-
-
+        cb = onSelect text list
+        elt =
+          case list of
+             Nothing -> HTML.span { on: { mouseUp: cb } }
+             Just l  -> HTML.span { className: "annotation-run bg-" <> termBootstrapClass l
+                                  , on: { click: cb } }
\ No newline at end of file

src/Gargantext/Components/Annotation/Menu.purs

@@ -30,16 +30,16 @@ type Props =
 type AnnotationMenu = {
     x :: Number
   , y :: Number
-  , onClose :: Unit -> Effect Unit
+  , onClose :: Effect Unit
   | Props
   }
 
 -- | An Annotation Menu is parameterised by a Maybe Termlist of the
 -- | TermList the currently selected text belongs to
-annotationMenu :: R.Setter (Maybe AnnotationMenu) -> AnnotationMenu -> R.Element
-annotationMenu setMenu { x,y,list,menuType, onClose,setList } =
-  CM.contextMenu { x,y, onClose, setMenu } [
-    R.createElement annotationMenuCpt {list,menuType,setList} []
+annotationMenu :: AnnotationMenu -> R.Element
+annotationMenu {x, y, list, menuType, onClose, setList} =
+  CM.contextMenu {x, y, onClose} [
+    R.createElement annotationMenuCpt {list, menuType, setList} []
   ]
 
 annotationMenuCpt :: R.Component Props

src/Gargantext/Components/ContextMenu/ContextMenu.purs

@@ -26,8 +26,7 @@ thisModule = "Gargantext.Components.ContextMenu.ContextMenu"
 type Props t = (
     x :: Number
   , y :: Number
-  , onClose :: Unit -> Effect Unit
-  , setMenu :: R.Setter (Maybe t)
+  , onClose :: Effect Unit
   )
 
 contextMenu :: forall t. Record (Props t) -> Array R.Element -> R.Element
@@ -36,7 +35,7 @@ contextMenu = R.createElement contextMenuCpt
 contextMenuCpt :: forall t. R.Component (Props t)
 contextMenuCpt = R.hooksComponentWithModule thisModule "contextMenu" cpt
   where
-    cpt menu@{ x, y, onClose, setMenu } children = do
+    cpt menu@{ x, y, onClose } children = do
       host <- R2.getPortalHost
       root <- R.useRef null
       rect /\ setRect <- R.useState $ \_ -> Nothing
@@ -45,7 +44,7 @@ contextMenuCpt = R.hooksComponentWithModule thisModule "contextMenu" cpt
           (\r -> setRect (\_ -> Just (Element.boundingRect r)))
           (toMaybe $ R.readRef root)
         pure $ pure unit
-      R.useLayoutEffect2 root rect (contextMenuEffect onClose setMenu root)
+      R.useLayoutEffect2 root rect (contextMenuEffect onClose root)
       let cs = [
             HTML.div { className: "popover-content" }
             [ HTML.div { className: "panel panel-default" }
@@ -57,27 +56,28 @@ contextMenuCpt = R.hooksComponentWithModule thisModule "contextMenu" cpt
       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: {toggle: "popover", placement: "right"}
         }
     elems ref _ _ = HTML.div
         { ref
+        , key: "context-menu"
         , className: "context-menu"
         , data: {toggle: "popover", placement: "right"}
         }
 
 contextMenuEffect
   :: forall t.
-    (Unit -> Effect Unit)
-  -> R.Setter (Maybe t)
+     Effect Unit
   -> R.Ref (Nullable DOM.Element)
   -> Effect (Effect Unit)
-contextMenuEffect onClose setMenu rootRef =
+contextMenuEffect onClose rootRef =
   case R.readNullableRef rootRef of
     Just root -> do
-      let onClick = documentClickHandler onClose setMenu root
-      let onScroll = documentScrollHandler setMenu
+      let onClick = documentClickHandler onClose root
+      let onScroll = documentScrollHandler onClose
       DOM.addEventListener document "click" onClick
       DOM.addEventListener document "scroll" onScroll
       pure $ do
@@ -85,18 +85,14 @@ contextMenuEffect onClose setMenu rootRef =
         DOM.removeEventListener document "scroll" onScroll
     Nothing -> pure R.nothing
 
-documentClickHandler :: forall t. (Unit -> Effect Unit) -> R.Setter (Maybe t) -> DOM.Element -> Callback DE.MouseEvent
-documentClickHandler onClose hide menu =
+documentClickHandler :: Effect Unit -> DOM.Element -> Callback DE.MouseEvent
+documentClickHandler onClose menu =
   R2.named "hideMenuOnClickOutside" $ callback $ \e ->
-    if Element.contains menu (DE.target e)
-      then pure unit
-      else do
-        hide (const Nothing)
-        onClose unit
-
-documentScrollHandler :: forall t. R.Setter (Maybe t) -> Callback DE.MouseEvent
-documentScrollHandler hide =
-  R2.named "hideMenuOnScroll" $ callback $ \e -> hide (const Nothing)
+    when (Element.contains menu (DE.target e)) onClose
+
+documentScrollHandler :: Effect Unit -> Callback DE.MouseEvent
+documentScrollHandler onClose =
+  R2.named "hideMenuOnScroll" $ callback $ \e -> onClose
 
 position :: forall t. Record (Props t) -> DOMRect -> { left :: Number, top :: Number }
 position mouse {width: menuWidth, height: menuHeight} = {left, top}