[annotation] refactoring of AnnotatedField.purs

src/Gargantext/Components/Annotation/AnnotatedField.purs

@@ -11,22 +11,23 @@
 -- | 2. We will need a more ambitious search algorithm for skipgrams.
 module Gargantext.Components.Annotation.AnnotatedField where
 
-import Prelude
 import Data.Maybe ( Maybe(..), maybe )
-import Data.Tuple ( Tuple )
-import Data.Tuple.Nested ( (/\) )
 --import DOM.Simple.Console (log2)
 import DOM.Simple.Event as DE
+import Data.Tuple ( Tuple )
+import Data.Tuple.Nested ( (/\) )
 import Effect ( Effect )
 import Reactix as R
 import Reactix.DOM.HTML as HTML
 import Reactix.SyntheticEvent as E
 
-import Gargantext.Types (CTabNgramType(..), TermList)
-import Gargantext.Components.Annotation.Utils ( termBootstrapClass, termClass )
-import Gargantext.Components.NgramsTable.Core
-import Gargantext.Components.Annotation.Menu ( annotationMenu, MenuType(..) )
+import Gargantext.Prelude
+
+import Gargantext.Components.Annotation.Menu ( annotationMenu, AnnotationMenu, MenuType(..) )
+import Gargantext.Components.Annotation.Utils (termClass)
+import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
 import Gargantext.Utils.Selection as Sel
+import Gargantext.Types (CTabNgramType(..), TermList)
 
 thisModule :: String
 thisModule = "Gargantext.Components.Annotation.AnnotatedField"
@@ -48,57 +49,16 @@ annotatedField p = R.createElement annotatedFieldComponent p []
 annotatedFieldComponent :: R.Component Props
 annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField" cpt
   where
-    cpt {ngrams,setTermList,text: fieldText} _ = do
+    cpt {ngrams, setTermList, text: fieldText} _ = do
       (_ /\ setRedrawMenu) <- R.useState' false
 
-      menuRef <- R.useRef Nothing
+      menuRef <- R.useRef (Nothing :: Maybe AnnotationMenu)
 
       let wrapperProps = { className: "annotated-field-wrapper" }
 
-          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
-                  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
-                  , menuType
-                  , onClose: hideMenu
-                  , setList
-                  }
-            R.setRef menuRef menu
-            redrawMenu
-
-          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}
+          wrap (text /\ list) = { list
+                               , onSelect: onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList }
+                               , text }
 
       pure $ HTML.div wrapperProps
         [ maybe (HTML.div {} []) annotationMenu $ R.readRef menuRef
@@ -113,6 +73,60 @@ compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
 
 -- Runs
 
+onAnnotationSelect { menuRef, ngrams, setRedrawMenu, setTermList } text mList event =
+  case mList of
+    Just list ->
+      showMenu { event
+                , getList: const (Just list)
+                , menuRef
+                , menuType: SetTermListItem
+                , setRedrawMenu
+                , setTermList
+                , text }
+    Nothing -> do
+      s <- Sel.getSelection
+      case s of
+        Just sel -> do
+          case Sel.selectionToString sel of
+            "" -> hideMenu { menuRef, setRedrawMenu }
+            sel' -> do
+              showMenu { event
+                        , getList: findNgramTermList ngrams
+                        , menuRef
+                        , menuType: NewNgram
+                        , setRedrawMenu
+                        , setTermList
+                        , text: sel' }
+        Nothing -> hideMenu { menuRef, setRedrawMenu }
+
+showMenu { event, getList, menuRef, menuType, setRedrawMenu, setTermList, text } = do
+  let x = E.clientX event
+      y = E.clientY event
+      n = normNgram CTabTerms text
+      list = getList n
+      redrawMenu = setRedrawMenu not
+      setList t = do
+        setTermList n list t
+        hideMenu { menuRef, setRedrawMenu }
+  E.preventDefault event
+  --range <- Sel.getRange sel 0
+  --log2 "[showMenu] selection range" $ Sel.rangeToTuple range
+  let menu = Just
+        { x
+        , y
+        , list
+        , menuType
+        , onClose: hideMenu { menuRef, setRedrawMenu }
+        , setList
+        }
+  R.setRef menuRef menu
+  redrawMenu
+
+hideMenu { menuRef, setRedrawMenu } = do
+  let redrawMenu = setRedrawMenu not
+  R.setRef menuRef Nothing
+  redrawMenu
+
 type Run =
   ( list :: (Maybe TermList)
   , onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit