Skip to content

P
purescript-gargantext
Commit 48f62a98 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

Merge branch 'dev' into dev-ngrams-table-cache-in-local-storage

parents 6abd6697 4ed494c7
Hide whitespace changes
Inline Side-by-side
Showing with 92 additions and 143 deletions
src/Gargantext/Components/Annotation/AnnotatedField.purs
View file @ 48f62a98
......@@ -13,9 +13,9 @@ module Gargantext.Components.Annotation.AnnotatedField where
import Prelude
import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple ( Tuple(..) )
import Data.Tuple ( Tuple )
import Data.Tuple.Nested ( (/\) )
import DOM.Simple.Console (log2)
--import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Effect ( Effect )
import Reactix as R
......@@ -25,7 +25,7 @@ import Reactix.SyntheticEvent as E
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
import Gargantext.Components.Annotation.Menu ( annotationMenu, MenuType(..) )
import Gargantext.Utils.Selection as Sel
thisModule :: String
......@@ -48,110 +48,65 @@ annotatedField p = R.createElement annotatedFieldComponent p []
annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField" cpt
where
cpt {ngrams,setTermList,text} _ = do
mMenu@(_ /\ setMenu) <- R.useState' Nothing
cpt {ngrams,setTermList,text: fieldText} _ = do
(_ /\ setRedrawMenu) <- R.useState' false
menuRef <- R.useRef Nothing
let wrapperProps = { className: "annotated-field-wrapper" }
onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
onSelect text' Nothing event = do
--log2 "[onSelect] text'" text'
maybeShowMenu setMenu menuRef setTermList ngrams event
onSelect text' (Just list) event = do
--log2 "[onSelect] text'" text'
--log2 "[onSelect] list" (show list)
redrawMenu = setRedrawMenu not
hideMenu = do
R.setRef menuRef Nothing
redrawMenu
showMenu { event, text, getList, menuType } = do
let x = E.clientX event
y = E.clientY event
n = normNgram CTabTerms text
list = getList n
setList t = do
R.setRef menuRef Nothing
setTermList (normNgram CTabTerms text') (Just list) t
--setMenu (const Nothing)
menu = Just {
x
setTermList n list t
hideMenu
E.preventDefault event
--range <- Sel.getRange sel 0
--log2 "[showMenu] selection range" $ Sel.rangeToTuple range
let menu = Just
{ x
, y
, list: Just list
, menuType: SetTermListItem
, onClose: \_ -> R.setRef menuRef Nothing
, list
, menuType
, onClose: hideMenu
, setList
}
R.setRef menuRef menu
setMenu $ const menu
mapCompile (Tuple t l) = {text: t, list: l, onSelect}
compiled = map mapCompile $ compile ngrams text
runs =
HTML.div { className: "annotated-field-runs" } $ map annotateRun compiled
--pure $ HTML.div wrapperProps [maybeAddMenu mMenu runs]
pure $ HTML.div wrapperProps [ addMenu { menuRef }, runs ]
type AddMenuProps = (
menuRef :: R.Ref (Maybe AnnotationMenu)
)
redrawMenu
addMenu :: Record AddMenuProps -> R.Element
addMenu p = R.createElement addMenuCpt p []
addMenuCpt :: R.Component AddMenuProps
addMenuCpt = R.hooksComponentWithModule thisModule "addMenu" cpt
where
cpt { menuRef } _ = do
(mMenu /\ setmMenu) <- R.useState' (Nothing :: Maybe AnnotationMenu)
R.useEffect' $ do
let m = R.readRef menuRef
--log2 "[addMenu] menuRef" m
--log2 "[addMenu] mMenu" mMenu
setmMenu $ const m
pure $ case mMenu of
Nothing -> HTML.div {} []
Just menu -> annotationMenu setmMenu menu
-- forall e. IsMouseEvent e => R.Setter (Maybe AnnotationMenu) -> R.Setter ? -> ? -> e -> Effect Unit
maybeShowMenu setMenu menuRef setTermList ngrams event = do
s <- Sel.getSelection
--log2 "[maybeShowMenu] s" s
case s of
Just sel -> do
case Sel.selectionToString sel of
"" -> pure unit
sel' -> do
let x = E.clientX event
y = E.clientY event
n = normNgram CTabTerms sel'
list = findNgramTermList ngrams n
setList t = do
setTermList n list t
R.setRef menuRef Nothing
--setMenu (const Nothing)
E.preventDefault event
range <- Sel.getRange sel 0
--log2 "[maybeShowMenu] selection range" $ Sel.rangeToTuple range
let menu = Just {
x
, y
, list
, menuType: NewNgram
, onClose: \_ -> R.setRef menuRef Nothing
, setList
}
R.setRef menuRef menu
setMenu $ const $ menu
Nothing -> pure unit
-- Nothing -> do
-- R.setRef menuRef Nothing
maybeAddMenu
:: R.State (Maybe AnnotationMenu)
-> R.Element
-> R.Element
maybeAddMenu (Just props /\ setMenu) e = annotationMenu setMenu props <> e
maybeAddMenu _ e = e
onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
onSelect text mList event =
case mList of
Just list ->
showMenu { event, text, getList: const (Just list), menuType: SetTermListItem }
Nothing -> do
s <- Sel.getSelection
case s of
Just sel -> do
case Sel.selectionToString sel of
"" -> hideMenu
sel' -> do
showMenu { event, text: sel', getList: findNgramTermList ngrams, menuType: NewNgram }
Nothing -> hideMenu
wrap (text /\ list) = {text, list, onSelect}
pure $ HTML.div wrapperProps
[ maybe (HTML.div {} []) annotationMenu $ R.readRef menuRef
, HTML.div { className: "annotated-field-runs" }
$ annotateRun
<$> wrap
<$> compile ngrams fieldText
]
compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
......@@ -170,13 +125,11 @@ annotateRun p = R.createElement annotatedRunComponent p []
annotatedRunComponent :: R.Component Run
annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
where
cpt { list: Nothing, onSelect, text } _ =
HTML.span { on: { mouseUp: \e -> onSelect text Nothing e } } [ HTML.text text ]
cpt { list: (Just list), onSelect, text } _ =
HTML.span { className: className list
, on: { click: \e -> onSelect text (Just list) e } } [ HTML.text text ]
cpt { list, onSelect, text } _ = elt [ HTML.text text ]
where
className list' = "annotation-run bg-" <> termBootstrapClass list'
cb = onSelect text list
elt =
case list of
Nothing -> HTML.span { on: { mouseUp: cb } }
Just l -> HTML.span { className: "annotation-run bg-" <> termBootstrapClass l
, on: { click: cb } }
\ No newline at end of file
src/Gargantext/Components/Annotation/Menu.purs
View file @ 48f62a98
......@@ -30,16 +30,16 @@ type Props =
type AnnotationMenu = {
x :: Number
, y :: Number
, onClose :: Unit -> Effect Unit
, onClose :: Effect Unit
| Props
}
-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to
annotationMenu :: R.Setter (Maybe AnnotationMenu) -> AnnotationMenu -> R.Element
annotationMenu setMenu { x,y,list,menuType, onClose,setList } =
CM.contextMenu { x,y, onClose, setMenu } [
R.createElement annotationMenuCpt {list,menuType,setList} []
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
......
src/Gargantext/Components/App.purs
View file @ 48f62a98
......@@ -132,9 +132,9 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
--, treeReload
}
RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session }
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameCalc }
RouteFrameCode sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameCode }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameWrite}
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameCalc }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameWrite }
RouteFrameCode sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameNotebook }
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { frontends, nodeId, session, sessionUpdate }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout {
......
src/Gargantext/Components/ContextMenu/ContextMenu.purs
View file @ 48f62a98
......@@ -26,8 +26,7 @@ thisModule = "Gargantext.Components.ContextMenu.ContextMenu"
type Props t = (
x :: Number
, y :: Number
, onClose :: Unit -> Effect Unit
, setMenu :: R.Setter (Maybe t)
, onClose :: Effect Unit
)
contextMenu :: forall t. Record (Props t) -> Array R.Element -> R.Element
......@@ -36,7 +35,7 @@ contextMenu = R.createElement contextMenuCpt
contextMenuCpt :: forall t. R.Component (Props t)
contextMenuCpt = R.hooksComponentWithModule thisModule "contextMenu" cpt
where
cpt menu@{ x, y, onClose, setMenu } children = do
cpt menu@{ x, y, onClose } children = do
host <- R2.getPortalHost
root <- R.useRef null
rect /\ setRect <- R.useState $ \_ -> Nothing
......@@ -45,7 +44,7 @@ contextMenuCpt = R.hooksComponentWithModule thisModule "contextMenu" cpt
(\r -> setRect (\_ -> Just (Element.boundingRect r)))
(toMaybe $ R.readRef root)
pure $ pure unit
R.useLayoutEffect2 root rect (contextMenuEffect onClose setMenu root)
R.useLayoutEffect2 root rect (contextMenuEffect onClose root)
let cs = [
HTML.div { className: "popover-content" }
[ HTML.div { className: "panel panel-default" }
......@@ -57,27 +56,28 @@ contextMenuCpt = R.hooksComponentWithModule thisModule "contextMenu" cpt
pure $ R.createPortal [ elems root menu rect $ cs ] host
elems ref menu (Just rect) = HTML.div
{ ref
, key: "context-menu"
, className: "context-menu"
, style: position menu rect
, data: {toggle: "popover", placement: "right"}
}
elems ref _ _ = HTML.div
{ ref
, key: "context-menu"
, className: "context-menu"
, data: {toggle: "popover", placement: "right"}
}
contextMenuEffect
:: forall t.
(Unit -> Effect Unit)
-> R.Setter (Maybe t)
Effect Unit
-> R.Ref (Nullable DOM.Element)
-> Effect (Effect Unit)
contextMenuEffect onClose setMenu rootRef =
contextMenuEffect onClose rootRef =
case R.readNullableRef rootRef of
Just root -> do
let onClick = documentClickHandler onClose setMenu root
let onScroll = documentScrollHandler setMenu
let onClick = documentClickHandler onClose root
let onScroll = documentScrollHandler onClose
DOM.addEventListener document "click" onClick
DOM.addEventListener document "scroll" onScroll
pure $ do
......@@ -85,18 +85,14 @@ contextMenuEffect onClose setMenu rootRef =
DOM.removeEventListener document "scroll" onScroll
Nothing -> pure R.nothing
documentClickHandler :: forall t. (Unit -> Effect Unit) -> R.Setter (Maybe t) -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler onClose hide menu =
documentClickHandler :: Effect Unit -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler onClose menu =
R2.named "hideMenuOnClickOutside" $ callback $ \e ->
if Element.contains menu (DE.target e)
then pure unit
else do
hide (const Nothing)
onClose unit
documentScrollHandler :: forall t. R.Setter (Maybe t) -> Callback DE.MouseEvent
documentScrollHandler hide =
R2.named "hideMenuOnScroll" $ callback $ \e -> hide (const Nothing)
when (Element.contains menu (DE.target e)) onClose
documentScrollHandler :: Effect Unit -> Callback DE.MouseEvent
documentScrollHandler onClose =
R2.named "hideMenuOnScroll" $ callback $ \e -> onClose
position :: forall t. Record (Props t) -> DOMRect -> { left :: Number, top :: Number }
position mouse {width: menuWidth, height: menuHeight} = {left, top}
......
src/Gargantext/Components/Forest/Tree/Node/Settings.purs
View file @ 48f62a98
......@@ -126,7 +126,7 @@ settingsBox Team =
, Annuaire
, NodeFrameWrite
, NodeFrameCalc
, NodeFrameCode
, NodeFrameNotebook
]
, Share
, Delete
......@@ -317,13 +317,13 @@ settingsBox NodeFrameCalc =
]
}
settingsBox NodeFrameCode =
settingsBox NodeFrameNotebook =
SettingsBox { show : true
, edit : true
, doc : Documentation NodeFrameCode
, doc : Documentation NodeFrameNotebook
, buttons : [ Add [ NodeFrameCalc
, NodeFrameWrite
, NodeFrameCode
, NodeFrameNotebook
]
, Move moveFrameParameters
, Delete
......
src/Gargantext/Components/NgramsTable/Core.purs
View file @ 48f62a98
......@@ -448,7 +448,7 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
where
spR x = " " <> R.replace wordBoundaryReg "$1$1" x <> " "
reR = R.replace wordBoundaryReg " "
db = S.replace (S.Pattern " ") (S.Replacement " ")
db = S.replaceAll (S.Pattern " ") (S.Replacement " ")
sp x = " " <> db x <> " "
undb = R.replace wordBoundaryReg2 "$1"
init x = S.take (S.length x - 1) x
......
src/Gargantext/Components/Nodes/Frame.purs
View file @ 48f62a98
......@@ -95,7 +95,7 @@ type Base = String
type FrameId = String
hframeUrl :: NodeType -> Base -> FrameId -> String
hframeUrl NodeFrameCode _ frame_id = frame_id -- Temp fix : frame_id is currently the whole url created
hframeUrl NodeFrameNotebook _ frame_id = frame_id -- Temp fix : frame_id is currently the whole url created
hframeUrl _ base frame_id = base <> "/" <> frame_id <> "?both"
frameLayoutView :: Record ViewProps -> R.Element
......
src/Gargantext/Types.purs
View file @ 48f62a98
......@@ -156,7 +156,7 @@ data NodeType = NodeUser
-- TODO Optional Nodes
| NodeFrameWrite
| NodeFrameCalc
| NodeFrameCode
| NodeFrameNotebook
| NodePublic NodeType
| NodeFile
......@@ -188,7 +188,7 @@ instance showNodeType :: Show NodeType where
show Texts = "NodeDocs"
show NodeFrameWrite = "NodeFrameWrite"
show NodeFrameCalc = "NodeFrameCalc"
show NodeFrameCode = "NodeFrameCode"
show NodeFrameNotebook = "NodeFrameNotebook"
show (NodePublic nt) = "NodePublic" <> show nt
show NodeFile = "NodeFile"
......@@ -216,7 +216,7 @@ instance readNodeType :: Read NodeType where
read "Annuaire" = Just Annuaire
read "NodeFrameWrite" = Just NodeFrameWrite
read "NodeFrameCalc" = Just NodeFrameCalc
read "NodeFrameCode" = Just NodeFrameCode
read "NodeFrameNotebook" = Just NodeFrameNotebook
read "NodeFile" = Just NodeFile
-- TODO NodePublic read ?
read _ = Nothing
......@@ -264,8 +264,8 @@ fldr NodeFrameWrite false = "fa fa-file-text"
fldr NodeFrameCalc true = "fa fa-calculator"
fldr NodeFrameCalc false = "fa fa-calculator"
fldr NodeFrameCode true = "fa fa-terminal"
fldr NodeFrameCode false = "fa fa-terminal"
fldr NodeFrameNotebook true = "fa fa-file-code-o"
fldr NodeFrameNotebook false = "fa fa-code"
fldr (NodePublic nt) b = fldr nt b
......@@ -323,7 +323,7 @@ nodeTypePath Texts = "texts"
nodeTypePath Team = "team"
nodeTypePath NodeFrameWrite = "write"
nodeTypePath NodeFrameCalc = "calc"
nodeTypePath NodeFrameCode = "code"
nodeTypePath NodeFrameNotebook = "code"
nodeTypePath (NodePublic nt) = nodeTypePath nt
nodeTypePath NodeFile = "file"
......
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