Commit 8a7fe290 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski Committed by Alexandre Delanoë

[ngrams] annotated field refactoring

Instead of modifying state (which causes rerendering and removal of
current selection), we use refs.

This has the drawback of delayed popup showing, unfortunately (this
happens when backend send the periodic PUT message).
parent 57762d28
...@@ -18,7 +18,6 @@ import Data.Tuple.Nested ( (/\) ) ...@@ -18,7 +18,6 @@ import Data.Tuple.Nested ( (/\) )
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log, log2)
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Effect ( Effect ) import Effect ( Effect )
import Effect.Uncurried ( mkEffectFn1 )
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as HTML import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E import Reactix.SyntheticEvent as E
...@@ -55,9 +54,9 @@ annotatedFieldComponent = R2.hooksComponent thisModule "annotatedField" cpt ...@@ -55,9 +54,9 @@ annotatedFieldComponent = R2.hooksComponent thisModule "annotatedField" cpt
menuRef <- R.useRef Nothing menuRef <- R.useRef Nothing
let wrapperProps = let wrapperProps = { className: "annotated-field-wrapper" }
{ className: "annotated-field-wrapper" }
onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
onSelect text' Nothing event = do onSelect text' Nothing event = do
log2 "[onSelect] text'" text' log2 "[onSelect] text'" text'
maybeShowMenu setMenu menuRef setTermList ngrams event maybeShowMenu setMenu menuRef setTermList ngrams event
...@@ -67,10 +66,17 @@ annotatedFieldComponent = R2.hooksComponent thisModule "annotatedField" cpt ...@@ -67,10 +66,17 @@ annotatedFieldComponent = R2.hooksComponent thisModule "annotatedField" cpt
let x = E.clientX event let x = E.clientX event
y = E.clientY event y = E.clientY event
setList t = do setList t = do
R.setRef menuRef Nothing
setTermList (normNgram CTabTerms text') (Just list) t setTermList (normNgram CTabTerms text') (Just list) t
--setMenu (const Nothing) --setMenu (const Nothing)
R.setRef menuRef Nothing menu = Just {
menu = Just {x, y, list: Just list, menuType: SetTermListItem, setList} x
, y
, list: Just list
, menuType: SetTermListItem
, onClose: \_ -> R.setRef menuRef Nothing
, setList
}
--setMenu (const $ menu) --setMenu (const $ menu)
R.setRef menuRef menu R.setRef menuRef menu
...@@ -110,6 +116,7 @@ addMenuCpt = R2.hooksComponent thisModule "addMenu" cpt ...@@ -110,6 +116,7 @@ addMenuCpt = R2.hooksComponent thisModule "addMenu" cpt
-- forall e. IsMouseEvent e => R2.Setter (Maybe AnnotationMenu) -> R2.Setter ? -> ? -> e -> Effect Unit -- forall e. IsMouseEvent e => R2.Setter (Maybe AnnotationMenu) -> R2.Setter ? -> ? -> e -> Effect Unit
maybeShowMenu setMenu menuRef setTermList ngrams event = do maybeShowMenu setMenu menuRef setTermList ngrams event = do
s <- Sel.getSelection s <- Sel.getSelection
log2 "[maybeShowMenu] s" s
case s of case s of
Just sel -> do Just sel -> do
case Sel.selectionToString sel of case Sel.selectionToString sel of
...@@ -126,10 +133,19 @@ maybeShowMenu setMenu menuRef setTermList ngrams event = do ...@@ -126,10 +133,19 @@ maybeShowMenu setMenu menuRef setTermList ngrams event = do
E.preventDefault event E.preventDefault event
range <- Sel.getRange sel 0 range <- Sel.getRange sel 0
log2 "[maybeShowMenu] selection range" $ Sel.rangeToTuple range log2 "[maybeShowMenu] selection range" $ Sel.rangeToTuple range
let menu = Just { x, y, list, menuType: NewNgram, setList } let menu = Just {
x
, y
, list
, menuType: NewNgram
, onClose: \_ -> R.setRef menuRef Nothing
, setList
}
--setMenu (const $ menu) --setMenu (const $ menu)
R.setRef menuRef menu R.setRef menuRef menu
Nothing -> pure unit Nothing -> pure unit
-- Nothing -> do
-- R.setRef menuRef Nothing
maybeAddMenu maybeAddMenu
:: R.State (Maybe AnnotationMenu) :: R.State (Maybe AnnotationMenu)
...@@ -155,12 +171,12 @@ annotateRun p = R.createElement annotatedRunComponent p [] ...@@ -155,12 +171,12 @@ annotateRun p = R.createElement annotatedRunComponent p []
annotatedRunComponent :: R.Component Run annotatedRunComponent :: R.Component Run
annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
where where
cpt { text, list: Nothing, onSelect } _ = cpt { list: Nothing, onSelect, text } _ =
HTML.span { onMouseUp: mkEffectFn1 $ \e -> onSelect text Nothing e } [ HTML.text text ] HTML.span { on: { mouseUp: \e -> onSelect text Nothing e } } [ HTML.text text ]
cpt { text, list: (Just list), onSelect } _ = cpt { list: (Just list), onSelect, text } _ =
HTML.span { className: className list HTML.span { className: className list
, onClick: mkEffectFn1 $ \e -> onSelect text (Just list) e} [ HTML.text text ] , on: { click: \e -> onSelect text (Just list) e } } [ HTML.text text ]
where where
className list' = "annotation-run bg-" <> termBootstrapClass list' className list' = "annotation-run bg-" <> termBootstrapClass list'
......
...@@ -27,13 +27,18 @@ type Props = ...@@ -27,13 +27,18 @@ type Props =
, setList :: TermList -> Effect Unit -- not a state hook setter , setList :: TermList -> Effect Unit -- not a state hook setter
) )
type AnnotationMenu = { x :: Number, y :: Number | Props } type AnnotationMenu = {
x :: Number
, y :: Number
, onClose :: Unit -> Effect Unit
| Props
}
-- | An Annotation Menu is parameterised by a Maybe Termlist of the -- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to -- | TermList the currently selected text belongs to
annotationMenu :: R2.Setter (Maybe AnnotationMenu) -> AnnotationMenu -> R.Element annotationMenu :: R2.Setter (Maybe AnnotationMenu) -> AnnotationMenu -> R.Element
annotationMenu setMenu { x,y,list,menuType,setList } = annotationMenu setMenu { x,y,list,menuType, onClose,setList } =
CM.contextMenu { x,y,setMenu } [ CM.contextMenu { x,y, onClose, setMenu } [
R.createElement annotationMenuCpt {list,menuType,setList} [] R.createElement annotationMenuCpt {list,menuType,setList} []
] ]
......
...@@ -23,7 +23,12 @@ import Gargantext.Utils.Reactix as R2 ...@@ -23,7 +23,12 @@ import Gargantext.Utils.Reactix as R2
thisModule = "Gargantext.Components.ContextMenu.ContextMenu" thisModule = "Gargantext.Components.ContextMenu.ContextMenu"
type Props t = ( x :: Number, y :: Number, setMenu :: R2.Setter (Maybe t) ) type Props t = (
x :: Number
, y :: Number
, onClose :: Unit -> Effect Unit
, setMenu :: R2.Setter (Maybe t)
)
contextMenu :: forall t. Record (Props t) -> Array R.Element -> R.Element contextMenu :: forall t. Record (Props t) -> Array R.Element -> R.Element
contextMenu = R.createElement contextMenuCpt contextMenu = R.createElement contextMenuCpt
...@@ -31,7 +36,7 @@ contextMenu = R.createElement contextMenuCpt ...@@ -31,7 +36,7 @@ contextMenu = R.createElement contextMenuCpt
contextMenuCpt :: forall t. R.Component (Props t) contextMenuCpt :: forall t. R.Component (Props t)
contextMenuCpt = R2.hooksComponent thisModule "contextMenu" cpt contextMenuCpt = R2.hooksComponent thisModule "contextMenu" cpt
where where
cpt menu children = do cpt menu@{ x, y, onClose, setMenu } children = do
host <- R2.getPortalHost host <- R2.getPortalHost
root <- R.useRef null root <- R.useRef null
rect /\ setRect <- R.useState $ \_ -> Nothing rect /\ setRect <- R.useState $ \_ -> Nothing
...@@ -40,7 +45,7 @@ contextMenuCpt = R2.hooksComponent thisModule "contextMenu" cpt ...@@ -40,7 +45,7 @@ contextMenuCpt = R2.hooksComponent thisModule "contextMenu" cpt
(\r -> setRect (\_ -> Just (Element.boundingRect r))) (\r -> setRect (\_ -> Just (Element.boundingRect r)))
(toMaybe $ R.readRef root) (toMaybe $ R.readRef root)
pure $ pure unit pure $ pure unit
R.useLayoutEffect2 root rect (contextMenuEffect menu.setMenu root) R.useLayoutEffect2 root rect (contextMenuEffect onClose setMenu root)
let cs = [ let cs = [
HTML.div { className: "popover-content" } HTML.div { className: "popover-content" }
[ HTML.div { className: "panel panel-default" } [ HTML.div { className: "panel panel-default" }
...@@ -63,14 +68,15 @@ contextMenuCpt = R2.hooksComponent thisModule "contextMenu" cpt ...@@ -63,14 +68,15 @@ contextMenuCpt = R2.hooksComponent thisModule "contextMenu" cpt
} }
contextMenuEffect contextMenuEffect
:: forall t :: forall t.
. R2.Setter (Maybe t) (Unit -> Effect Unit)
-> R2.Setter (Maybe t)
-> R.Ref (Nullable DOM.Element) -> R.Ref (Nullable DOM.Element)
-> Effect (Effect Unit) -> Effect (Effect Unit)
contextMenuEffect setMenu rootRef = contextMenuEffect onClose setMenu rootRef =
case R.readNullableRef rootRef of case R.readNullableRef rootRef of
Just root -> do Just root -> do
let onClick = documentClickHandler setMenu root let onClick = documentClickHandler onClose setMenu root
let onScroll = documentScrollHandler setMenu let onScroll = documentScrollHandler setMenu
DOM.addEventListener document "click" onClick DOM.addEventListener document "click" onClick
DOM.addEventListener document "scroll" onScroll DOM.addEventListener document "scroll" onScroll
...@@ -79,12 +85,14 @@ contextMenuEffect setMenu rootRef = ...@@ -79,12 +85,14 @@ contextMenuEffect setMenu rootRef =
DOM.removeEventListener document "scroll" onScroll DOM.removeEventListener document "scroll" onScroll
Nothing -> pure R.nothing Nothing -> pure R.nothing
documentClickHandler :: forall t. R2.Setter (Maybe t) -> DOM.Element -> Callback DE.MouseEvent documentClickHandler :: forall t. (Unit -> Effect Unit) -> R2.Setter (Maybe t) -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler hide menu = documentClickHandler onClose hide menu =
R2.named "hideMenuOnClickOutside" $ callback $ \e -> R2.named "hideMenuOnClickOutside" $ callback $ \e ->
if Element.contains menu (DE.target e) if Element.contains menu (DE.target e)
then pure unit then pure unit
else hide (const Nothing) else do
hide (const Nothing)
onClose unit
documentScrollHandler :: forall t. R2.Setter (Maybe t) -> Callback DE.MouseEvent documentScrollHandler :: forall t. R2.Setter (Maybe t) -> Callback DE.MouseEvent
documentScrollHandler hide = documentScrollHandler hide =
......
...@@ -55,28 +55,29 @@ textInputBox p@{ boxName, boxAction, dispatch, isOpen: (true /\ setIsOpen), para ...@@ -55,28 +55,29 @@ textInputBox p@{ boxName, boxAction, dispatch, isOpen: (true /\ setIsOpen), para
where where
textInput (_ /\ set) default = textInput (_ /\ set) default =
H.div {className: "col-md-8"} H.div {className: "col-md-8"}
[ H.input { type: "text" [ H.input { className: "form-control"
, placeholder: (boxName <> " Node")
, defaultValue: default , defaultValue: default
, className: "form-control" , on: { input: set
, onInput: mkEffectFn1 $ set <<< const
<<< const <<< R2.unsafeEventValue }
<<< R2.unsafeEventValue , placeholder: (boxName <> " Node")
, type: "text"
} }
] ]
submitBtn (val1 /\ _) (val2 /\ _) = submitBtn (val1 /\ _) (val2 /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left" H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button" , type: "button"
, onClick: mkEffectFn1 $ \_ -> do , on: { click: \_ -> do
setIsOpen $ const false setIsOpen $ const false
launchAff $ dispatch ( boxAction (AddContactParams {firstname:val1, lastname:val2} )) launchAff $ dispatch ( boxAction (AddContactParams {firstname:val1, lastname:val2} ))
}
, title: "Submit" , title: "Submit"
} [] } []
cancelBtn = cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left" H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button" , on: { click: \_ -> setIsOpen $ const false }
, onClick: mkEffectFn1 $ \_ -> setIsOpen $ const false
, title: "Cancel" , title: "Cancel"
, type: "button"
} [] } []
textInputBox p@{ boxName, isOpen: (false /\ _) } = R.createElement el p [] textInputBox p@{ boxName, isOpen: (false /\ _) } = R.createElement el p []
where where
......
...@@ -167,7 +167,7 @@ renderScaleSel ref props (Range.Closed {min, max}) = ...@@ -167,7 +167,7 @@ renderScaleSel ref props (Range.Closed {min, max}) =
renderKnob :: Knob -> R.Ref (Nullable DOM.Element) -> Range.NumberRange -> Bounds -> R2.Setter (Maybe Knob) -> Int -> R.Element renderKnob :: Knob -> R.Ref (Nullable DOM.Element) -> Range.NumberRange -> Bounds -> R2.Setter (Maybe Knob) -> Int -> R.Element
renderKnob knob ref (Range.Closed value) bounds set precision = renderKnob knob ref (Range.Closed value) bounds set precision =
H.div { ref, tabIndex, className, aria, onMouseDown, style } [ H.div { ref, tabIndex, className, aria, on: { mouseDown: onMouseDown }, style } [
H.div { className: "button" } H.div { className: "button" }
[ [
H.text $ text $ toFixed precision val H.text $ text $ toFixed precision val
...@@ -181,7 +181,7 @@ renderKnob knob ref (Range.Closed value) bounds set precision = ...@@ -181,7 +181,7 @@ renderKnob knob ref (Range.Closed value) bounds set precision =
aria = { label: labelPrefix knob <> "value: " <> show val } aria = { label: labelPrefix knob <> "value: " <> show val }
labelPrefix MinKnob = "Minimum " labelPrefix MinKnob = "Minimum "
labelPrefix MaxKnob = "Maximum " labelPrefix MaxKnob = "Maximum "
onMouseDown = mkEffectFn1 $ \_ -> set $ const $ Just knob onMouseDown _ = set $ const $ Just knob
percOffset = Range.normalise bounds val percOffset = Range.normalise bounds val
style = { left: (show $ 100.0 * percOffset) <> "%" } style = { left: (show $ 100.0 * percOffset) <> "%" }
val = case knob of val = case knob of
......
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