Commit 48f62a98 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

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

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