diff --git a/src/Gargantext/Components/Annotation/AnnotatedField.purs b/src/Gargantext/Components/Annotation/AnnotatedField.purs index 868b929bd9dacbd33710e1236faeb4a5ec23dc44..1b02faaaf07e79200a23dceb1f3450109765839c 100644 --- a/src/Gargantext/Components/Annotation/AnnotatedField.purs +++ b/src/Gargantext/Components/Annotation/AnnotatedField.purs @@ -13,25 +13,18 @@ module Gargantext.Components.Annotation.AnnotatedField where import Prelude import Data.Map as Map -import Data.Maybe (Maybe(..), maybe, maybe', fromMaybe) -import Data.Lens (Lens', lens) -import Data.Nullable (Nullable, null, toMaybe) -import Data.Ord (max) -import Data.Traversable (traverse, traverse_) -import Data.Tuple (Tuple(..)) -import Data.Tuple.Nested ((/\)) -import DOM.Simple as DOM +import Data.Maybe ( Maybe(..), maybe, maybe' ) +import Data.Lens ( Lens', lens ) +import Data.Traversable ( traverse_ ) +import Data.Tuple ( Tuple(..) ) +import Data.Tuple.Nested ( (/\) ) import DOM.Simple.Console -import DOM.Simple.Document ( document ) -import DOM.Simple.Document as Document -import DOM.Simple.Node as Node -import DOM.Simple.Types (Element) -import DOM.Simple.Element as Element import DOM.Simple.Event as DE -import Effect (Effect) -import Effect.Uncurried (EffectFn1, mkEffectFn1) +import Effect ( Effect ) +import Effect.Uncurried (mkEffectFn1) import Reactix as R import Reactix.DOM.HTML as HTML +import Reactix.SyntheticEvent as E import Gargantext.Types ( TermList(..) ) import Gargantext.Components.Annotation.Utils ( termClass ) @@ -56,66 +49,43 @@ annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt runs props = HTML.div { className: "annotated-field-runs" } (map annotateRun $ compile props) cpt props _ = do - menu <- R.useState $ \_ -> pure Nothing - root <- R.useRef null - useAnnotationEffect root menu props.ngrams - pure $ HTML.div { className } [ maybeAddMenu menu (runs props) ] - className = "annotated-field-wrapper" - -useAnnotationEffect - :: R.Ref (Nullable Element) - -> R.State (Maybe AnnotationMenu) - -> NgramsTable - -> R.Hooks Unit -useAnnotationEffect rootRef menu ngrams = - R.useLayoutEffect1 (R.readNullableRef rootRef) h - where - h _ = - case R.readNullableRef rootRef of - Just root -> do - let handler = onSelectionChange root menu ngrams - DOM.addEventListener document "selectionchange" handler - pure $ \_ -> DOM.removeEventListener document "selectionchange" handler - Nothing -> pure $ \_ -> pure unit - --- | TODO: handle multiple ranges -onSelectionChange - :: Element - -> R.State (Maybe AnnotationMenu) - -> NgramsTable - -> Element.Callback DE.SelectionEvent -onSelectionChange root (_ /\ setMenu) ngrams = - Element.callback $ \event -> - Sel.getSelection >>= traverse (getMenu event) >>= traverse_ setMenu - where - getMenu event sel = getMenu' event sel (Sel.selectionToString sel) - getMenu' event sel sel' - | not (selEmpty sel sel') = do - range <- Sel.getRange sel 0 - if not (liesWithin $ Sel.commonAncestorContainer range) - then pure Nothing - else do - let rect = Sel.boundingRect range - DE.preventDefault event - -- top and right are the most pessimistic values because the menu is biased - -- towards being positioned above and to the right of the cursor - pure $ Just { x: rect.top, y: rect.right, list: findNgram ngrams sel' } - | true = pure Nothing - liesWithin = Element.contains root - selEmpty _ "" = true - selEmpty sel _ = Sel.rangeCount sel > 0 && not (Sel.isSelectionCollapsed sel) + menu /\ setMenu <- R.useState $ \_ -> pure Nothing + let wrapperProps = + { className: "annotated-field-wrapper" + , onContextMenu: mkEffectFn1 (maybeShowMenu setMenu props.ngrams) } + pure $ HTML.div wrapperProps [ maybeAddMenu setMenu (runs props) menu] maybeAddMenu - :: R.State (Maybe AnnotationMenu) + :: (Maybe AnnotationMenu -> Effect Unit) -> R.Element + -> Maybe AnnotationMenu -> R.Element -maybeAddMenu ((Just props) /\ setMenu) e = annotationMenu setMenu props <> e -maybeAddMenu _ e = e +maybeAddMenu setMenu e (Just props) = annotationMenu setMenu props <> e +maybeAddMenu _ e _ = e compile :: Record Props -> Array Run compile props = runs props.text where runs = maybe [] (highlightNgrams props.ngrams) +maybeShowMenu + :: forall t + . (Maybe AnnotationMenu -> Effect Unit) + -> NgramsTable + -> E.SyntheticEvent DE.MouseEvent + -> Effect Unit +maybeShowMenu setMenu ngrams event = do + s <- Sel.getSelection + case s of + Just sel -> do + case Sel.toString sel of + "" -> pure unit + sel' -> do + let x = E.clientX event + let y = E.clientY event + E.preventDefault event + setMenu $ Just { x, y, list: findNgram ngrams sel' } + Nothing -> pure unit + findNgram :: NgramsTable -> String -> Maybe TermList findNgram _ _ = Nothing