Commit aedbeb27 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[annotation] some fixes to context menu and annotated fields

parent 5001f21c
...@@ -8,8 +8,6 @@ ...@@ -8,8 +8,6 @@
<link id="bootstrap-css" href="styles/bootstrap-default.css" rel="stylesheet" /> <link id="bootstrap-css" href="styles/bootstrap-default.css" rel="stylesheet" />
<link rel="stylesheet" type="text/css" href="styles/highlightjs-solarized-light.css" /> <link rel="stylesheet" type="text/css" href="styles/highlightjs-solarized-light.css" />
<link href="styles/sass.css" rel="stylesheet" type="text/css" /> <link href="styles/sass.css" rel="stylesheet" type="text/css" />
<!-- <script type="text/javascript" src="/js/react-bootstrap.min.js"></script> -->
<script type="text/javascript" src="/js/react-bootstrap.js"></script>
<style> * {margin: 0; padding: 0; list-style: none;} </style> <style> * {margin: 0; padding: 0; list-style: none;} </style>
</head> </head>
<body> <body>
......
...@@ -22,16 +22,17 @@ import Effect (Effect) ...@@ -22,16 +22,17 @@ import Effect (Effect)
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
import Record as Record
import Toestand as T import Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Annotation.Menu ( annotationMenu, AnnotationMenu, MenuType(..) ) import Gargantext.Components.Annotation.Menu ( annotationMenuWrapper, AnnotationMenu, MenuType(..) )
import Gargantext.Components.Annotation.Utils (termClass) import Gargantext.Components.Annotation.Utils (termClass)
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram) import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel import Gargantext.Utils.Selection as Sel
import Gargantext.Types (CTabNgramType(..), TermList)
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.AnnotatedField" here = R2.here "Gargantext.Components.Annotation.AnnotatedField"
...@@ -48,37 +49,51 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent ...@@ -48,37 +49,51 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent
-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit } -- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
annotatedField :: R2.Component Props annotatedField :: R2.Component Props
annotatedField = R.createElement annotatedFieldComponent annotatedField = R.createElement annotatedFieldCpt
annotatedFieldCpt :: R.Component Props
annotatedFieldComponent :: R.Component Props annotatedFieldCpt = here.component "annotatedField" cpt where
annotatedFieldComponent = here.component "annotatedField" cpt cpt props _ = do
where menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu))
cpt { ngrams, setTermList, text: fieldText } _ = do redrawMenu <- T.useBox false
redrawMenu <- T.useBox false
redrawMenu' <- T.useLive T.unequal redrawMenu pure $ annotatedFieldInner (Record.merge { menuRef, redrawMenu } props)
type InnerProps =
(
menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, redrawMenu :: T.Box Boolean
| Props
)
menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu)) annotatedFieldInner :: R2.Leaf InnerProps
annotatedFieldInner p = R.createElement annotatedFieldInnerCpt p []
annotatedFieldInnerCpt :: R.Component InnerProps
annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
cpt { menuRef, ngrams, redrawMenu, setTermList, text: fieldText } _ = do
-- redrawMenu <- T.useBox false
redrawMenu' <- T.useLive T.unequal redrawMenu
let wrapperProps = { className: "annotated-field-wrapper" } -- menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu))
-- menu <- T.useBox (Nothing :: Maybe (Record AnnotationMenu))
wrap (text /\ list) = { list let wrap (text /\ list) = { list
, onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } , onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
, text } , text }
pure $ HTML.div wrapperProps pure $ HTML.div { className: "annotated-field-wrapper" }
[ maybe (HTML.div {} []) annotationMenu $ R.readRef menuRef [ annotationMenuWrapper { menuRef }
, HTML.div { className: "annotated-field-runs" } , HTML.div { className: "annotated-field-runs" }
((\p -> annotateRun p []) <$> wrap <$> compile ngrams fieldText) ((\p -> annotateRun p []) <$> wrap <$> compile ngrams fieldText)
] ]
compile :: NgramsTable -> Maybe String -> Array (Tuple String (List (Tuple NgramsTerm TermList))) compile :: NgramsTable -> Maybe String -> Array (Tuple String (List (Tuple NgramsTerm TermList)))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams) compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs -- Runs
onAnnotationSelect :: forall e. DE.IsMouseEvent e => { menuRef :: R.Ref (Maybe (Record AnnotationMenu)) onAnnotationSelect :: forall e. DE.IsMouseEvent e => { menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, ngrams :: NgramsTable , ngrams :: NgramsTable
, redrawMenu :: T.Box Boolean , redrawMenu :: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit } , setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
-> Maybe (Tuple NgramsTerm TermList) -> E.SyntheticEvent e -> Effect Unit -> Maybe (Tuple NgramsTerm TermList) -> E.SyntheticEvent e -> Effect Unit
onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } Nothing event = do onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } Nothing event = do
...@@ -106,12 +121,12 @@ onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } (Just (Tuple ngr ...@@ -106,12 +121,12 @@ onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } (Just (Tuple ngr
, setTermList } , setTermList }
-- showMenu :: forall p e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e | p } -> Effect Unit -- showMenu :: forall p e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e | p } -> Effect Unit
showMenu :: forall e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e showMenu :: forall e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e
, getList :: NgramsTerm -> Maybe TermList , getList :: NgramsTerm -> Maybe TermList
, menuRef :: R.Ref (Maybe (Record AnnotationMenu)) , menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, menuType :: MenuType , menuType :: MenuType
, ngram :: NgramsTerm , ngram :: NgramsTerm
, redrawMenu :: T.Box Boolean , redrawMenu :: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit } , setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
-> Effect Unit -> Effect Unit
showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = do showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = do
...@@ -123,15 +138,16 @@ showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = ...@@ -123,15 +138,16 @@ showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } =
setList t = do setList t = do
setTermList ngram list t setTermList ngram list t
hideMenu { menuRef, redrawMenu } hideMenu { menuRef, redrawMenu }
here.log2 "x" x -- here.log2 "x" x
here.log2 "y" y -- here.log2 "y" y
E.preventDefault event E.preventDefault event
--range <- Sel.getRange sel 0 --range <- Sel.getRange sel 0
--here.log2 "selection range" $ Sel.rangeToTuple range --here.log2 "selection range" $ Sel.rangeToTuple range
let menu = Just let menu = Just
{ list { list
, onClose: hideMenu { menuRef, redrawMenu }
, menuType , menuType
, onClose: hideMenu { menuRef, redrawMenu }
, redrawMenu
, setList , setList
, x , x
, y } , y }
...@@ -143,32 +159,25 @@ hideMenu { menuRef, redrawMenu } = do ...@@ -143,32 +159,25 @@ hideMenu { menuRef, redrawMenu } = do
T.modify_ not redrawMenu T.modify_ not redrawMenu
type Run = type Run =
( list :: List (Tuple NgramsTerm TermList) ( list :: List (Tuple NgramsTerm TermList)
, onSelect :: Maybe (Tuple NgramsTerm TermList) -> MouseEvent -> Effect Unit , onSelect :: Maybe (Tuple NgramsTerm TermList) -> MouseEvent -> Effect Unit
, text :: String , text :: String
) )
annotateRun :: R2.Component Run annotateRun :: R2.Component Run
annotateRun = R.createElement annotatedRunComponent annotateRun = R.createElement annotatedRunCpt
annotatedRunCpt :: R.Component Run
annotatedRunComponent :: R.Component Run annotatedRunCpt = here.component "annotatedRun" cpt
annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
where where
cpt { list: Nil, onSelect, text } _ = cpt { list, onSelect, text } _ = do
HTML.span { on: { mouseUp: onSelect Nothing } } [ HTML.text text ]
let el = case list of
cpt { list: lst@((ngram /\ list) : otherLists), onSelect, text } _ = Nil -> HTML.span { on: { mouseUp: onSelect Nothing } } [ HTML.text text ]
HTML.span { className lst@(( ngram /\ list' ) : otherLists) ->
, on: { click: onSelect (Just (ngram /\ list)) } } [ HTML.text text ] let bgClasses = joinWith " " $ A.fromFoldable $ termClass <<< snd <$> lst
where className = "annotation-run " <> bgClasses
bgClasses = joinWith " " $ A.fromFoldable $ termClass <<< snd <$> lst in
-- className = "annotation-run bg-" <> termBootstrapClass list HTML.span { className
className = "annotation-run " <> bgClasses , on: { click: onSelect (Just (ngram /\ list')) } } [ HTML.text text ]
-- cb = onSelect text list
-- elt = pure $ el
-- case list of
-- Nothing -> HTML.span { on: { mouseUp: cb } }
-- Just l -> HTML.span { -- className: "annotation-run bg-" <> termBootstrapClass l
-- className: "annotation-run " <> termClass l
-- , on: { click: cb }
-- }
...@@ -2,13 +2,17 @@ ...@@ -2,13 +2,17 @@
module Gargantext.Components.Annotation.Menu where module Gargantext.Components.Annotation.Menu where
import Prelude (Unit, pure, ($), (<>), (==))
import Data.Array as A import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect (Effect) import Effect (Effect)
import Effect.Uncurried (mkEffectFn1) 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 Toestand as T
import Gargantext.Prelude
import Gargantext.Types (TermList(..), termListName) import Gargantext.Types (TermList(..), termListName)
import Gargantext.Components.Annotation.Utils (termBootstrapClass) import Gargantext.Components.Annotation.Utils (termBootstrapClass)
...@@ -20,6 +24,9 @@ here :: R2.Here ...@@ -20,6 +24,9 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.Menu" here = R2.here "Gargantext.Components.Annotation.Menu"
data MenuType = NewNgram | SetTermListItem data MenuType = NewNgram | SetTermListItem
derive instance genericMenuType :: Generic MenuType _
instance eqMenuType :: Eq MenuType where
eq = genericEq
type Props = type Props =
( list :: Maybe TermList ( list :: Maybe TermList
...@@ -28,19 +35,49 @@ type Props = ...@@ -28,19 +35,49 @@ type Props =
) )
type AnnotationMenu = ( type AnnotationMenu = (
x :: Number onClose :: Effect Unit
, y :: Number , redrawMenu :: T.Box Boolean
, onClose :: Effect Unit , x :: Number
, y :: Number
| Props | Props
) )
type AnnotationMenuWrapper =
(
menuRef :: R.Ref (Maybe (Record AnnotationMenu))
)
eqAnnotationMenu :: Record AnnotationMenu -> Record AnnotationMenu -> Boolean
eqAnnotationMenu new old = new.list == old.list &&
new.menuType == old.menuType &&
new.x == old.x &&
new.y == old.y
eqAnnotationMenuWrapper :: { new :: Maybe (Record AnnotationMenu)
, old :: Maybe (Record AnnotationMenu) } -> Effect Boolean
eqAnnotationMenuWrapper { new: Nothing, old: Nothing } = pure $ true
eqAnnotationMenuWrapper { new: Nothing, old: Just _ } = pure $ false
eqAnnotationMenuWrapper { new: Just _, old: Nothing } = pure $ false
eqAnnotationMenuWrapper { new: Just n, old: Just o } = pure $ eqAnnotationMenu n o
annotationMenuWrapper :: R2.Leaf AnnotationMenuWrapper
annotationMenuWrapper p = R.createElement annotationMenuWrapperCpt p []
annotationMenuWrapperCpt :: R.Component AnnotationMenuWrapper
annotationMenuWrapperCpt = here.component "annotationMenuWrapper" cpt where
cpt { menuRef } _ = do
case R.readRef menuRef of
Nothing -> pure $ HTML.div {} []
Just menu -> pure $ annotationMenu menu
-- | 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.Leaf AnnotationMenu annotationMenu :: R2.Leaf AnnotationMenu
annotationMenu p = R.createElement annotationMenuCpt p [] annotationMenu p = R.createElement annotationMenuCpt p []
annotationMenuCpt :: R.Component AnnotationMenu annotationMenuCpt :: R.Component AnnotationMenu
annotationMenuCpt = here.component "annotationMenu" cpt where annotationMenuCpt = here.component "annotationMenu" cpt where
cpt { x, y, list, menuType, onClose, setList } _ = do cpt { x, y, list, menuType, onClose, redrawMenu, setList } _ = do
redrawMenu' <- T.useLive T.unequal redrawMenu
pure $ CM.contextMenu {x, y, onClose} [ pure $ CM.contextMenu {x, y, onClose} [
annotationMenuInner { list, menuType, setList } annotationMenuInner { list, menuType, setList }
] ]
......
module Gargantext.Components.App (app) where module Gargantext.Components.App (app) where
import Reactix as R
import Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
...@@ -9,8 +11,6 @@ import Gargantext.Hooks (useHashRouter) ...@@ -9,8 +11,6 @@ import Gargantext.Hooks (useHashRouter)
import Gargantext.Router as Router import Gargantext.Router as Router
import Gargantext.Sessions as Sessions import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.App" here = R2.here "Gargantext.Components.App"
......
...@@ -39,7 +39,9 @@ contextMenuCpt = here.component "contextMenu" cpt ...@@ -39,7 +39,9 @@ contextMenuCpt = here.component "contextMenu" cpt
cpt menu@{ x, y, onClose } children = do cpt menu@{ x, y, onClose } children = do
host <- R2.getPortalHost host <- R2.getPortalHost
root <- R.useRef null root <- R.useRef null
rect <- T.useBox Nothing -- rect <- T.useBox $ Just $ R2.domRectFromRect { x, y, width: 224.6, height: 102.0 }
let childRect = R2.boundingRect children
rect <- T.useBox $ Just $ R2.domRectFromRect { x, y, width: childRect.width, height: childRect.height }
rect' <- T.useLive T.unequal rect rect' <- T.useLive T.unequal rect
R.useLayoutEffect1 (R.readRef root) $ do R.useLayoutEffect1 (R.readRef root) $ do
...@@ -47,7 +49,7 @@ contextMenuCpt = here.component "contextMenu" cpt ...@@ -47,7 +49,7 @@ contextMenuCpt = here.component "contextMenu" cpt
(\r -> T.write_ (Just (Element.boundingRect r)) rect) (\r -> T.write_ (Just (Element.boundingRect r)) rect)
(toMaybe $ R.readRef root) (toMaybe $ R.readRef root)
pure $ pure unit pure $ pure unit
R.useLayoutEffect2 root rect (contextMenuEffect onClose root) R.useLayoutEffect2 (R.readRef root) rect' (contextMenuEffect onClose root)
let cs = [ let cs = [
HTML.div { className: "popover-content" } HTML.div { className: "popover-content" }
[ HTML.div { className: "card" } [ HTML.div { className: "card" }
...@@ -64,7 +66,7 @@ contextMenuCpt = here.component "contextMenu" cpt ...@@ -64,7 +66,7 @@ contextMenuCpt = here.component "contextMenu" cpt
, style: position menu rect , style: position menu rect
, data: { placement: "right", toggle: "popover" } , data: { placement: "right", toggle: "popover" }
} }
elems ref _ _ = HTML.div elems ref menu Nothing = HTML.div
{ ref { ref
, key: "context-menu" , key: "context-menu"
, className: "context-menu" , className: "context-menu"
......
...@@ -41,6 +41,7 @@ import Gargantext.Sessions as Sessions ...@@ -41,6 +41,7 @@ import Gargantext.Sessions as Sessions
import Gargantext.Types (CorpusId, Handed(..), ListId, NodeID, NodeType(..), SessionId, SidePanelState(..), reverseHanded) import Gargantext.Types (CorpusId, Handed(..), ListId, NodeID, NodeType(..), SessionId, SidePanelState(..), reverseHanded)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Router" here = R2.here "Gargantext.Components.Router"
......
...@@ -23,11 +23,16 @@ function setCookie(c) { ...@@ -23,11 +23,16 @@ function setCookie(c) {
document.cookie = c; document.cookie = c;
} }
function domRectFromRect(obj) {
return DOMRectReadOnly.fromRect(obj)
}
exports._addRootElement = addRootElement; exports._addRootElement = addRootElement;
exports._getSelection = getSelection; exports._getSelection = getSelection;
exports._stringify = stringify; exports._stringify = stringify;
exports._postMessage = postMessage; exports._postMessage = postMessage;
exports._setCookie = setCookie; exports._setCookie = setCookie;
exports._domRectFromRect = domRectFromRect;
exports._keyCode = function(e) { exports._keyCode = function(e) {
// https://www.w3schools.com/jsref/event_key_keycode.asp // https://www.w3schools.com/jsref/event_key_keycode.asp
......
...@@ -2,22 +2,22 @@ module Gargantext.Utils.Reactix where ...@@ -2,22 +2,22 @@ module Gargantext.Utils.Reactix where
import Prelude import Prelude
import DOM.Simple as DOM
import DOM.Simple.Console (log2)
import DOM.Simple.Document (document)
import DOM.Simple.Element as Element
import DOM.Simple.Event as DE
import DOM.Simple.Types (class IsNode)
import Data.Argonaut as Argonaut import Data.Argonaut as Argonaut
import Data.Argonaut as Json import Data.Argonaut as Json
import Data.Argonaut.Core (Json) import Data.Argonaut.Core (Json)
import Data.Array as A
import Data.Either (hush) import Data.Either (hush)
import Data.Function.Uncurried (Fn2, runFn2) import Data.Function.Uncurried (Fn1, runFn1, Fn2, runFn2)
import Data.Maybe (Maybe(..), fromJust, fromMaybe, isJust) import Data.Maybe (Maybe(..), fromJust, fromMaybe, isJust)
import Data.Nullable (Nullable, null, toMaybe) import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import DOM.Simple.Document (document)
import DOM.Simple.Element as Element
import DOM.Simple.Event as DE
import DOM.Simple.Types (class IsNode, class IsElement, DOMRect)
import Effect (Effect) import Effect (Effect)
import Effect.Console (logShow) import Effect.Console (logShow)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber) import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
...@@ -398,3 +398,35 @@ setTrigger tRef fun = R.setRef tRef $ Just fun ...@@ -398,3 +398,35 @@ setTrigger tRef fun = R.setRef tRef $ Just fun
clearTrigger :: forall a. Trigger a -> Effect Unit clearTrigger :: forall a. Trigger a -> Effect Unit
clearTrigger tRef = R.setRef tRef Nothing clearTrigger tRef = R.setRef tRef Nothing
type Rect =
( x :: Number
, y :: Number
, width :: Number
, height :: Number )
foreign import _domRectFromRect :: Fn1 (Record Rect) DOMRect
domRectFromRect :: Record Rect -> DOMRect
domRectFromRect = runFn1 _domRectFromRect
boundingRect :: forall e. IsElement e => Array e -> DOMRect
boundingRect els =
case A.uncons els of
Nothing -> domRectFromRect { x: 0.0, y: 0.0, width: 0.0, height: 0.0 }
Just { head, tail } ->
let br = Element.boundingRect head
in
case tail of
[] -> br
_ ->
let brs = boundingRect tail
minx = min br.left brs.left
maxx = max br.right brs.right
miny = min br.top brs.top
maxy = max br.bottom brs.bottom
in
domRectFromRect { x: minx
, y: miny
, width: maxx - minx
, height: maxy - miny }
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