Commit 864d6c9d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[annotationMenu] some refactorings

parent 4eb2785d
......@@ -12,12 +12,11 @@
module Gargantext.Components.Annotation.AnnotatedField where
import Data.Array as A
import Data.List ( List(..), (:), length )
import Data.List (List(..), (:))
import Data.Maybe ( Maybe(..), maybe )
import Data.String.Common ( joinWith )
import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ( (/\) )
-- import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Effect (Effect)
import Reactix as R
......@@ -28,7 +27,7 @@ import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Annotation.Menu ( annotationMenu, AnnotationMenu, MenuType(..) )
import Gargantext.Components.Annotation.Utils ( termBootstrapClass, termClass )
import Gargantext.Components.Annotation.Utils (termClass)
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel
......@@ -58,7 +57,7 @@ annotatedFieldComponent = here.component "annotatedField" cpt
redrawMenu <- T.useBox false
redrawMenu' <- T.useLive T.unequal redrawMenu
menuRef <- R.useRef (Nothing :: Maybe AnnotationMenu)
menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu))
let wrapperProps = { className: "annotated-field-wrapper" }
......@@ -77,7 +76,7 @@ compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs
onAnnotationSelect :: forall e. DE.IsMouseEvent e => { menuRef :: R.Ref (Maybe AnnotationMenu)
onAnnotationSelect :: forall e. DE.IsMouseEvent e => { menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, ngrams :: NgramsTable
, redrawMenu :: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
......@@ -109,7 +108,7 @@ onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } (Just (Tuple ngr
-- showMenu :: forall p e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e | p } -> Effect Unit
showMenu :: forall e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e
, getList :: NgramsTerm -> Maybe TermList
, menuRef :: R.Ref (Maybe AnnotationMenu)
, menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, menuType :: MenuType
, ngram :: NgramsTerm
, redrawMenu :: T.Box Boolean
......@@ -124,9 +123,11 @@ showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } =
setList t = do
setTermList ngram list t
hideMenu { menuRef, redrawMenu }
here.log2 "x" x
here.log2 "y" y
E.preventDefault event
--range <- Sel.getRange sel 0
--log2 "[showMenu] selection range" $ Sel.rangeToTuple range
--here.log2 "selection range" $ Sel.rangeToTuple range
let menu = Just
{ list
, onClose: hideMenu { menuRef, redrawMenu }
......
......@@ -27,32 +27,35 @@ type Props =
, setList :: TermList -> Effect Unit -- not a state hook setter
)
type AnnotationMenu = {
type AnnotationMenu = (
x :: Number
, y :: Number
, onClose :: Effect Unit
| Props
}
)
-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to
annotationMenu :: AnnotationMenu -> R.Element
annotationMenu {x, y, list, menuType, onClose, setList} =
CM.contextMenu {x, y, onClose} [
R.createElement annotationMenuCpt {list, menuType, setList} []
annotationMenu :: R2.Leaf AnnotationMenu
annotationMenu p = R.createElement annotationMenuCpt p []
annotationMenuCpt :: R.Component AnnotationMenu
annotationMenuCpt = here.component "annotationMenu" cpt where
cpt { x, y, list, menuType, onClose, setList } _ = do
pure $ CM.contextMenu {x, y, onClose} [
annotationMenuInner { list, menuType, setList }
]
annotationMenuCpt :: R.Component Props
annotationMenuCpt = here.component "annotationMenu" cpt
where
cpt props _ = pure $ R.fragment $ children props
children props = A.mapMaybe (addToList props) [ MapTerm, CandidateTerm, StopTerm ]
annotationMenuInner :: R2.Leaf Props
annotationMenuInner p = R.createElement annotationMenuInnerCpt p []
annotationMenuInnerCpt :: R.Component Props
annotationMenuInnerCpt = here.component "annotationMenuInner" cpt where
cpt props _ = pure $ R.fragment $ A.mapMaybe (addToList props) [ MapTerm, CandidateTerm, StopTerm ]
-- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem
addToList :: Record Props -> TermList -> Maybe R.Element
addToList {list: Just t'} t
| t == t' = Nothing
addToList {menuType, setList} t = Just $ CM.contextMenuItem [ link ]
addToList {menuType, setList} t = Just $ CM.contextMenuItem {} [ link ]
where
link = HTML.a { on: { click }, className: className } [ HTML.text (label menuType) ]
label NewNgram = "Add to " <> termListName t
......
......@@ -4,7 +4,6 @@ module Gargantext.Components.ContextMenu.ContextMenu where
import Data.Maybe ( Maybe(..) )
import Data.Nullable ( Nullable, null, toMaybe )
import Data.Tuple.Nested ( (/\) )
import Data.Traversable ( traverse_ )
import DOM.Simple as DOM
import DOM.Simple.Event as DE
......@@ -34,7 +33,6 @@ type Props t = (
contextMenu :: forall t. R2.Component (Props t)
contextMenu = R.createElement contextMenuCpt
contextMenuCpt :: forall t. R.Component (Props t)
contextMenuCpt = here.component "contextMenu" cpt
where
......@@ -64,13 +62,13 @@ contextMenuCpt = here.component "contextMenu" cpt
, key: "context-menu"
, className: "context-menu"
, style: position menu rect
, data: {toggle: "popover", placement: "right"}
, data: { placement: "right", toggle: "popover" }
}
elems ref _ _ = HTML.div
{ ref
, key: "context-menu"
, className: "context-menu"
, data: {toggle: "popover", placement: "right"}
, data: { placement: "right", toggle: "popover" }
}
contextMenuEffect
......@@ -108,9 +106,8 @@ position mouse {width: menuWidth, height: menuHeight} = {left, top}
screenWidth = window .. "innerWidth"
screenHeight = window .. "innerHeight"
contextMenuItem :: Array R.Element -> R.Element
contextMenuItem = R.createElement contextMenuItemCpt {}
contextMenuItem :: R2.Component ()
contextMenuItem = R.createElement contextMenuItemCpt
contextMenuItemCpt :: R.Component ()
contextMenuItemCpt = here.component "contextMenuItem" cpt
where
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment