Commit f78ca603 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch '287-dev-doc-annotation-menu' of...

Merge branch '287-dev-doc-annotation-menu' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents c9fdc900 aedbeb27
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
...@@ -8,6 +8,8 @@ ...@@ -8,6 +8,8 @@
<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>
......
...@@ -9,7 +9,14 @@ ...@@ -9,7 +9,14 @@
"install-ps": "psc-package install", "install-ps": "psc-package install",
"compile": "pulp build", "compile": "pulp build",
"build": "pulp browserify -t dist/bundle.js", "build": "pulp browserify -t dist/bundle.js",
"css": "sass src/sass/sass.sass:dist/styles/sass.css && sass src/sass/bootstrap/default.sass:dist/styles/bootstrap-default.css && cp node_modules/bootstrap-dark/src/bootstrap-dark.css dist/styles/bootstrap-dark.css && sass src/sass/bootstrap/greyson.scss:dist/styles/bootstrap-greyson.css && sass src/sass/bootstrap/monotony.scss:dist/styles/bootstrap-monotony.css && sass src/sass/bootstrap/darkster.scss:dist/styles/bootstrap-darkster.css && sass src/sass/bootstrap/herbie.scss:dist/styles/bootstrap-herbie.css", "css": "sass src/sass/sass.sass:dist/styles/sass.css && yarn css-themes",
"css-themes": "yarn css-default-theme && yarn css-dark-theme && yarn css-darkster-theme && yarn css-greyson-theme && yarn css-herbie-theme && yarn css-monotony-theme",
"css-default-theme": "sass src/sass/bootstrap/default.sass:dist/styles/bootstrap-default.css",
"css-dark-theme": "cp node_modules/bootstrap-dark/src/bootstrap-dark.css dist/styles/bootstrap-dark.css",
"css-darkster-theme": "sass src/sass/bootstrap/darkster.scss:dist/styles/bootstrap-darkster.css",
"css-greyson-theme": "sass src/sass/bootstrap/greyson.scss:dist/styles/bootstrap-greyson.css",
"css-herbie-theme": "sass src/sass/bootstrap/herbie.scss:dist/styles/bootstrap-herbie.css",
"css-monotony-theme": "sass src/sass/bootstrap/monotony.scss:dist/styles/bootstrap-monotony.css",
"docs": "pulp docs -- --format html", "docs": "pulp docs -- --format html",
"repl": "pulp repl", "repl": "pulp repl",
"clean": "rm -Rf output node_modules", "clean": "rm -Rf output node_modules",
...@@ -24,9 +31,10 @@ ...@@ -24,9 +31,10 @@
"prod:pack": "parcel build index.html -d prod --public-url . --no-source-maps" "prod:pack": "parcel build index.html -d prod --public-url . --no-source-maps"
}, },
"dependencies": { "dependencies": {
"@popperjs/core": "^2.9.2",
"aes-js": "^3.1.1", "aes-js": "^3.1.1",
"base-x": "^3.0.2", "base-x": "^3.0.2",
"bootstrap": "4.4.1", "bootstrap": "^4.6.0",
"bootstrap-dark": "^1.0.3", "bootstrap-dark": "^1.0.3",
"create-react-class": "^15.6.3", "create-react-class": "^15.6.3",
"echarts": "^4.1.0", "echarts": "^4.1.0",
...@@ -37,6 +45,7 @@ ...@@ -37,6 +45,7 @@
"pullstate": "^1.20.6", "pullstate": "^1.20.6",
"react": "^16.10", "react": "^16.10",
"react-awesome-popover": "^6.1.1", "react-awesome-popover": "^6.1.1",
"react-bootstrap": "^1.5.2",
"react-dom": "^16.10", "react-dom": "^16.10",
"react-tooltip": "^4.2.8", "react-tooltip": "^4.2.8",
"secp256k1": "^3.3.0", "secp256k1": "^3.3.0",
......
...@@ -12,27 +12,27 @@ ...@@ -12,27 +12,27 @@
module Gargantext.Components.Annotation.AnnotatedField where module Gargantext.Components.Annotation.AnnotatedField where
import Data.Array as A import Data.Array as A
import Data.List ( List(..), (:), length ) import Data.List (List(..), (:))
import Data.Maybe ( Maybe(..), maybe ) import Data.Maybe ( Maybe(..), maybe )
import Data.String.Common ( joinWith ) import Data.String.Common ( joinWith )
import Data.Tuple (Tuple(..), snd) import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ( (/\) ) import Data.Tuple.Nested ( (/\) )
-- import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Effect (Effect) 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 ( termBootstrapClass, 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"
...@@ -49,37 +49,51 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent ...@@ -49,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 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 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
...@@ -107,12 +121,12 @@ onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } (Just (Tuple ngr ...@@ -107,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 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
...@@ -124,13 +138,16 @@ showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = ...@@ -124,13 +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 "y" y
E.preventDefault event E.preventDefault event
--range <- Sel.getRange sel 0 --range <- Sel.getRange sel 0
--log2 "[showMenu] 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 }
...@@ -142,32 +159,25 @@ hideMenu { menuRef, redrawMenu } = do ...@@ -142,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,39 +24,75 @@ here :: R2.Here ...@@ -20,39 +24,75 @@ 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
, menuType :: MenuType , menuType :: MenuType
, setList :: TermList -> Effect Unit -- not a state hook setter , setList :: TermList -> Effect Unit -- not a state hook setter
) )
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 :: AnnotationMenu -> R.Element annotationMenu :: R2.Leaf AnnotationMenu
annotationMenu {x, y, list, menuType, onClose, setList} = annotationMenu p = R.createElement annotationMenuCpt p []
CM.contextMenu {x, y, onClose} [ annotationMenuCpt :: R.Component AnnotationMenu
R.createElement annotationMenuCpt {list, menuType, setList} [] annotationMenuCpt = here.component "annotationMenu" cpt where
] cpt { x, y, list, menuType, onClose, redrawMenu, setList } _ = do
redrawMenu' <- T.useLive T.unequal redrawMenu
annotationMenuCpt :: R.Component Props
annotationMenuCpt = here.component "annotationMenu" cpt pure $ CM.contextMenu {x, y, onClose} [
where annotationMenuInner { list, menuType, setList }
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 -- | 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 :: Record Props -> TermList -> Maybe R.Element
addToList {list: Just t'} t addToList {list: Just t'} t
| t == t' = Nothing | t == t' = Nothing
addToList {menuType, setList} t = Just $ CM.contextMenuItem [ link ] addToList {menuType, setList} t = Just $ CM.contextMenuItem {} [ link ]
where where
link = HTML.a { on: { click }, className: className } [ HTML.text (label menuType) ] link = HTML.a { on: { click }, className: className } [ HTML.text (label menuType) ]
label NewNgram = "Add to " <> termListName t label NewNgram = "Add to " <> termListName t
......
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"
......
...@@ -4,7 +4,6 @@ module Gargantext.Components.ContextMenu.ContextMenu where ...@@ -4,7 +4,6 @@ module Gargantext.Components.ContextMenu.ContextMenu where
import Data.Maybe ( Maybe(..) ) import Data.Maybe ( Maybe(..) )
import Data.Nullable ( Nullable, null, toMaybe ) import Data.Nullable ( Nullable, null, toMaybe )
import Data.Tuple.Nested ( (/\) )
import Data.Traversable ( traverse_ ) import Data.Traversable ( traverse_ )
import DOM.Simple as DOM import DOM.Simple as DOM
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
...@@ -34,14 +33,15 @@ type Props t = ( ...@@ -34,14 +33,15 @@ type Props t = (
contextMenu :: forall t. R2.Component (Props t) contextMenu :: forall t. R2.Component (Props t)
contextMenu = R.createElement contextMenuCpt contextMenu = R.createElement contextMenuCpt
contextMenuCpt :: forall t. R.Component (Props t) contextMenuCpt :: forall t. R.Component (Props t)
contextMenuCpt = here.component "contextMenu" cpt contextMenuCpt = here.component "contextMenu" cpt
where where
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
...@@ -49,7 +49,7 @@ contextMenuCpt = here.component "contextMenu" cpt ...@@ -49,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,13 +64,13 @@ contextMenuCpt = here.component "contextMenu" cpt ...@@ -64,13 +64,13 @@ contextMenuCpt = here.component "contextMenu" cpt
, key: "context-menu" , key: "context-menu"
, className: "context-menu" , className: "context-menu"
, style: position menu rect , style: position menu rect
, data: {toggle: "popover", placement: "right"} , 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"
, data: {toggle: "popover", placement: "right"} , data: { placement: "right", toggle: "popover" }
} }
contextMenuEffect contextMenuEffect
...@@ -108,9 +108,8 @@ position mouse {width: menuWidth, height: menuHeight} = {left, top} ...@@ -108,9 +108,8 @@ position mouse {width: menuWidth, height: menuHeight} = {left, top}
screenWidth = window .. "innerWidth" screenWidth = window .. "innerWidth"
screenHeight = window .. "innerHeight" screenHeight = window .. "innerHeight"
contextMenuItem :: Array R.Element -> R.Element contextMenuItem :: R2.Component ()
contextMenuItem = R.createElement contextMenuItemCpt {} contextMenuItem = R.createElement contextMenuItemCpt
contextMenuItemCpt :: R.Component () contextMenuItemCpt :: R.Component ()
contextMenuItemCpt = here.component "contextMenuItem" cpt contextMenuItemCpt = here.component "contextMenuItem" cpt
where where
......
...@@ -136,7 +136,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -136,7 +136,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
) currentTasks' ) currentTasks'
) )
, if nodeType == GT.NodeUser , if nodeType == GT.NodeUser
then GV.versionView {session} then GV.versionView { session } []
else H.div {} [] else H.div {} []
, if showBox then , if showBox then
......
...@@ -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 }
...@@ -31,8 +31,8 @@ type VersionProps = ...@@ -31,8 +31,8 @@ type VersionProps =
session :: Sessions.Session session :: Sessions.Session
) )
versionView :: Record VersionProps -> R.Element versionView :: R2.Component VersionProps
versionView props = R.createElement versionCpt props [] versionView = R.createElement versionCpt
versionCpt :: R.Component VersionProps versionCpt :: R.Component VersionProps
versionCpt = here.component "version" cpt versionCpt = here.component "version" cpt
......
This diff is collapsed.
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