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 @@
<link id="bootstrap-css" href="styles/bootstrap-default.css" rel="stylesheet" />
<link rel="stylesheet" type="text/css" href="styles/highlightjs-solarized-light.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>
</head>
<body>
......
......@@ -9,7 +9,14 @@
"install-ps": "psc-package install",
"compile": "pulp build",
"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",
"repl": "pulp repl",
"clean": "rm -Rf output node_modules",
......@@ -24,9 +31,10 @@
"prod:pack": "parcel build index.html -d prod --public-url . --no-source-maps"
},
"dependencies": {
"@popperjs/core": "^2.9.2",
"aes-js": "^3.1.1",
"base-x": "^3.0.2",
"bootstrap": "4.4.1",
"bootstrap": "^4.6.0",
"bootstrap-dark": "^1.0.3",
"create-react-class": "^15.6.3",
"echarts": "^4.1.0",
......@@ -37,6 +45,7 @@
"pullstate": "^1.20.6",
"react": "^16.10",
"react-awesome-popover": "^6.1.1",
"react-bootstrap": "^1.5.2",
"react-dom": "^16.10",
"react-tooltip": "^4.2.8",
"secp256k1": "^3.3.0",
......
......@@ -12,27 +12,27 @@
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
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
import Record as Record
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.Menu ( annotationMenuWrapper, AnnotationMenu, MenuType(..) )
import Gargantext.Components.Annotation.Utils (termClass)
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel
import Gargantext.Types (CTabNgramType(..), TermList)
here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.AnnotatedField"
......@@ -49,37 +49,51 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent
-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
annotatedField :: R2.Component Props
annotatedField = R.createElement annotatedFieldComponent
annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = here.component "annotatedField" cpt
where
cpt { ngrams, setTermList, text: fieldText } _ = do
redrawMenu <- T.useBox false
redrawMenu' <- T.useLive T.unequal redrawMenu
annotatedField = R.createElement annotatedFieldCpt
annotatedFieldCpt :: R.Component Props
annotatedFieldCpt = here.component "annotatedField" cpt where
cpt props _ = do
menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu))
redrawMenu <- T.useBox false
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
, onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
, text }
let wrap (text /\ list) = { list
, onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
, text }
pure $ HTML.div wrapperProps
[ maybe (HTML.div {} []) annotationMenu $ R.readRef menuRef
, HTML.div { className: "annotated-field-runs" }
((\p -> annotateRun p []) <$> wrap <$> compile ngrams fieldText)
]
pure $ HTML.div { className: "annotated-field-wrapper" }
[ annotationMenuWrapper { menuRef }
, HTML.div { className: "annotated-field-runs" }
((\p -> annotateRun p []) <$> wrap <$> compile ngrams fieldText)
]
compile :: NgramsTable -> Maybe String -> Array (Tuple String (List (Tuple NgramsTerm TermList)))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs
onAnnotationSelect :: forall e. DE.IsMouseEvent e => { menuRef :: R.Ref (Maybe AnnotationMenu)
, ngrams :: NgramsTable
, redrawMenu :: T.Box Boolean
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 }
-> Maybe (Tuple NgramsTerm TermList) -> E.SyntheticEvent e -> Effect Unit
onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } Nothing event = do
......@@ -107,12 +121,12 @@ onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } (Just (Tuple ngr
, setTermList }
-- 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)
, menuType :: MenuType
, ngram :: NgramsTerm
, redrawMenu :: T.Box Boolean
showMenu :: forall e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e
, getList :: NgramsTerm -> Maybe TermList
, menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, menuType :: MenuType
, ngram :: NgramsTerm
, redrawMenu :: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
-> Effect Unit
showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = do
......@@ -124,13 +138,16 @@ 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 }
, menuType
, onClose: hideMenu { menuRef, redrawMenu }
, redrawMenu
, setList
, x
, y }
......@@ -142,32 +159,25 @@ hideMenu { menuRef, redrawMenu } = do
T.modify_ not redrawMenu
type Run =
( list :: List (Tuple NgramsTerm TermList)
, onSelect :: Maybe (Tuple NgramsTerm TermList) -> MouseEvent -> Effect Unit
, text :: String
( list :: List (Tuple NgramsTerm TermList)
, onSelect :: Maybe (Tuple NgramsTerm TermList) -> MouseEvent -> Effect Unit
, text :: String
)
annotateRun :: R2.Component Run
annotateRun = R.createElement annotatedRunComponent
annotatedRunComponent :: R.Component Run
annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
annotateRun = R.createElement annotatedRunCpt
annotatedRunCpt :: R.Component Run
annotatedRunCpt = here.component "annotatedRun" cpt
where
cpt { list: Nil, onSelect, text } _ =
HTML.span { on: { mouseUp: onSelect Nothing } } [ HTML.text text ]
cpt { list: lst@((ngram /\ list) : otherLists), onSelect, text } _ =
HTML.span { className
, on: { click: onSelect (Just (ngram /\ list)) } } [ HTML.text text ]
where
bgClasses = joinWith " " $ A.fromFoldable $ termClass <<< snd <$> lst
-- className = "annotation-run bg-" <> termBootstrapClass list
className = "annotation-run " <> bgClasses
-- cb = onSelect text list
-- elt =
-- 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 }
-- }
cpt { list, onSelect, text } _ = do
let el = case list of
Nil -> HTML.span { on: { mouseUp: onSelect Nothing } } [ HTML.text text ]
lst@(( ngram /\ list' ) : otherLists) ->
let bgClasses = joinWith " " $ A.fromFoldable $ termClass <<< snd <$> lst
className = "annotation-run " <> bgClasses
in
HTML.span { className
, on: { click: onSelect (Just (ngram /\ list')) } } [ HTML.text text ]
pure $ el
......@@ -2,13 +2,17 @@
module Gargantext.Components.Annotation.Menu where
import Prelude (Unit, pure, ($), (<>), (==))
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
import Reactix as R
import Reactix.DOM.HTML as HTML
import Toestand as T
import Gargantext.Prelude
import Gargantext.Types (TermList(..), termListName)
import Gargantext.Components.Annotation.Utils (termBootstrapClass)
......@@ -20,39 +24,75 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.Menu"
data MenuType = NewNgram | SetTermListItem
derive instance genericMenuType :: Generic MenuType _
instance eqMenuType :: Eq MenuType where
eq = genericEq
type Props =
( list :: Maybe TermList
( list :: Maybe TermList
, menuType :: MenuType
, setList :: TermList -> Effect Unit -- not a state hook setter
, setList :: TermList -> Effect Unit -- not a state hook setter
)
type AnnotationMenu = {
x :: Number
, y :: Number
, onClose :: Effect Unit
type AnnotationMenu = (
onClose :: Effect Unit
, redrawMenu :: T.Box Boolean
, x :: Number
, y :: Number
| 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
-- | 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} []
]
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 ]
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, redrawMenu, setList } _ = do
redrawMenu' <- T.useLive T.unequal redrawMenu
pure $ CM.contextMenu {x, y, onClose} [
annotationMenuInner { list, menuType, setList }
]
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
......
module Gargantext.Components.App (app) where
import Reactix as R
import Toestand as T
import Gargantext.Prelude
......@@ -9,8 +11,6 @@ import Gargantext.Hooks (useHashRouter)
import Gargantext.Router as Router
import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.App"
......
......@@ -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,14 +33,15 @@ 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
cpt menu@{ x, y, onClose } children = do
host <- R2.getPortalHost
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
R.useLayoutEffect1 (R.readRef root) $ do
......@@ -49,7 +49,7 @@ contextMenuCpt = here.component "contextMenu" cpt
(\r -> T.write_ (Just (Element.boundingRect r)) rect)
(toMaybe $ R.readRef root)
pure $ pure unit
R.useLayoutEffect2 root rect (contextMenuEffect onClose root)
R.useLayoutEffect2 (R.readRef root) rect' (contextMenuEffect onClose root)
let cs = [
HTML.div { className: "popover-content" }
[ HTML.div { className: "card" }
......@@ -64,13 +64,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
elems ref menu Nothing = HTML.div
{ ref
, key: "context-menu"
, className: "context-menu"
, data: {toggle: "popover", placement: "right"}
, data: { placement: "right", toggle: "popover" }
}
contextMenuEffect
......@@ -108,9 +108,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
......
......@@ -136,7 +136,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
) currentTasks'
)
, if nodeType == GT.NodeUser
then GV.versionView {session}
then GV.versionView { session } []
else H.div {} []
, if showBox then
......
......@@ -41,6 +41,7 @@ import Gargantext.Sessions as Sessions
import Gargantext.Types (CorpusId, Handed(..), ListId, NodeID, NodeType(..), SessionId, SidePanelState(..), reverseHanded)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Router"
......
......@@ -23,11 +23,16 @@ function setCookie(c) {
document.cookie = c;
}
function domRectFromRect(obj) {
return DOMRectReadOnly.fromRect(obj)
}
exports._addRootElement = addRootElement;
exports._getSelection = getSelection;
exports._stringify = stringify;
exports._postMessage = postMessage;
exports._setCookie = setCookie;
exports._domRectFromRect = domRectFromRect;
exports._keyCode = function(e) {
// https://www.w3schools.com/jsref/event_key_keycode.asp
......
......@@ -2,22 +2,22 @@ module Gargantext.Utils.Reactix where
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 Json
import Data.Argonaut.Core (Json)
import Data.Array as A
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.Nullable (Nullable, null, toMaybe)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
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, class IsElement, DOMRect)
import Effect (Effect)
import Effect.Console (logShow)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
......@@ -398,3 +398,35 @@ setTrigger tRef fun = R.setRef tRef $ Just fun
clearTrigger :: forall a. Trigger a -> Effect Unit
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 =
session :: Sessions.Session
)
versionView :: Record VersionProps -> R.Element
versionView props = R.createElement versionCpt props []
versionView :: R2.Component VersionProps
versionView = R.createElement versionCpt
versionCpt :: R.Component VersionProps
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