Commit e9e44dff authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-highlight-currently-selected-node-in-tree

parents c1227c93 4ed494c7
This diff is collapsed.
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.1.91.3", "version": "0.0.1.91.7",
"scripts": { "scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall", "rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall", "rebuild-set": "spago psc-package-insdhall",
......
This diff is collapsed.
let upstream = let upstream =
./packages-0.13.8-20200822.dhall https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20201021/packages.dhall
let overrides = let overrides =
{ thermite = { thermite =
......
...@@ -5,9 +5,11 @@ import Data.Argonaut.Parser (jsonParser) ...@@ -5,9 +5,11 @@ import Data.Argonaut.Parser (jsonParser)
import Data.Array as A import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Tuple (snd)
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Reactix as R
import Web.Storage.Storage as WSS import Web.Storage.Storage as WSS
import Gargantext.Prelude import Gargantext.Prelude
...@@ -19,7 +21,9 @@ import Gargantext.Utils.Reactix as R2 ...@@ -19,7 +21,9 @@ import Gargantext.Utils.Reactix as R2
localStorageKey :: String localStorageKey :: String
localStorageKey = "garg-async-tasks" localStorageKey = "garg-async-tasks"
type Storage = Map.Map Int (Array GT.AsyncTaskWithType)
type NodeId = Int
type Storage = Map.Map NodeId (Array GT.AsyncTaskWithType)
empty :: Storage empty :: Storage
empty = Map.empty empty = Map.empty
...@@ -37,6 +41,39 @@ getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe ...@@ -37,6 +41,39 @@ getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
parse s = GU.mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s) parse s = GU.mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s)
decode j = GU.mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j) decode j = GU.mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j)
getTasks :: Record ReductorProps -> NodeId -> Array GT.AsyncTaskWithType
getTasks { storage } nodeId = fromMaybe [] $ Map.lookup nodeId storage
removeTaskFromList :: Array GT.AsyncTaskWithType -> GT.AsyncTaskWithType -> Array GT.AsyncTaskWithType removeTaskFromList :: Array GT.AsyncTaskWithType -> GT.AsyncTaskWithType -> Array GT.AsyncTaskWithType
removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) = removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
type ReductorProps = (
reload :: R.State Int
, storage :: Storage
)
type Reductor = R2.Reductor (Record ReductorProps) Action
useTasks :: R.State Int -> R.Hooks Reductor
useTasks reload = R2.useReductor act initializer unit
where
act :: R2.Actor (Record ReductorProps) Action
act a s = action s a
initializer _ = do
storage <- getAsyncTasks
pure { reload, storage }
data Action =
Insert NodeId GT.AsyncTaskWithType
| Remove NodeId GT.AsyncTaskWithType
action :: Record ReductorProps -> Action -> Effect (Record ReductorProps)
action { reload, storage } (Insert nodeId t) = do
_ <- snd reload $ (_ + 1)
let newStorage = Map.alter (maybe (Just [t]) (\ts -> Just $ A.cons t ts)) nodeId storage
pure { reload, storage: newStorage }
action { reload, storage } (Remove nodeId t) = do
_ <- snd reload $ (_ + 1)
let newStorage = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts t)) nodeId storage
pure { reload, storage: newStorage }
...@@ -12,10 +12,10 @@ ...@@ -12,10 +12,10 @@
module Gargantext.Components.Annotation.AnnotatedField where module Gargantext.Components.Annotation.AnnotatedField where
import Prelude import Prelude
import Data.Maybe ( Maybe(..), maybe, isJust, isNothing ) 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 (log, 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,9 +25,8 @@ import Reactix.SyntheticEvent as E ...@@ -25,9 +25,8 @@ 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
import Gargantext.Utils.Reactix as R2
thisModule :: String thisModule :: String
thisModule = "Gargantext.Components.Annotation.AnnotatedField" thisModule = "Gargantext.Components.Annotation.AnnotatedField"
...@@ -49,110 +48,65 @@ annotatedField p = R.createElement annotatedFieldComponent p [] ...@@ -49,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" 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
} }
--setMenu (const $ menu)
R.setRef menuRef menu R.setRef menuRef menu
redrawMenu
mapCompile (Tuple t l) = {text: t, list: l, onSelect} onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
compiled = map mapCompile $ compile ngrams text onSelect text mList event =
case mList of
runs = Just list ->
HTML.div { className: "annotated-field-runs" } $ map annotateRun compiled showMenu { event, text, getList: const (Just list), menuType: SetTermListItem }
--pure $ HTML.div wrapperProps [maybeAddMenu mMenu runs] Nothing -> do
pure $ HTML.div wrapperProps [ addMenu { menuRef }, runs ] s <- Sel.getSelection
case s of
Just sel -> do
type AddMenuProps = ( case Sel.selectionToString sel of
menuRef :: R.Ref (Maybe AnnotationMenu) "" -> hideMenu
) sel' -> do
showMenu { event, text: sel', getList: findNgramTermList ngrams, menuType: NewNgram }
Nothing -> hideMenu
addMenu :: Record AddMenuProps -> R.Element
addMenu p = R.createElement addMenuCpt p [] wrap (text /\ list) = {text, list, onSelect}
addMenuCpt :: R.Component AddMenuProps pure $ HTML.div wrapperProps
addMenuCpt = R.hooksComponentWithModule thisModule "addMenu" cpt [ maybe (HTML.div {} []) annotationMenu $ R.readRef menuRef
where , HTML.div { className: "annotated-field-runs" }
cpt { menuRef } _ = do $ annotateRun
(mMenu /\ setmMenu) <- R.useState' (Nothing :: Maybe AnnotationMenu) <$> wrap
<$> compile ngrams fieldText
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
--setMenu (const Nothing)
R.setRef menuRef 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
}
--setMenu (const $ menu)
R.setRef menuRef 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)
...@@ -171,13 +125,11 @@ annotateRun p = R.createElement annotatedRunComponent p [] ...@@ -171,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
......
...@@ -10,7 +10,7 @@ import Reactix.DOM.HTML as H ...@@ -10,7 +10,7 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Config (publicBackend) import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest (forest) import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout) import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Lang (LandingLang(..)) import Gargantext.Components.Lang (LandingLang(..))
...@@ -25,7 +25,7 @@ import Gargantext.Components.Nodes.Frame (frameLayout) ...@@ -25,7 +25,7 @@ import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout) import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout) import Gargantext.Components.Nodes.Lists (listsLayout)
import Gargantext.Components.Nodes.Texts (textsLayout) import Gargantext.Components.Nodes.Texts (textsLayout)
import Gargantext.Config (defaultFrontends, defaultBackends) import Gargantext.Config (defaultFrontends, defaultBackends, publicBackend)
import Gargantext.Ends (Frontends, Backend) import Gargantext.Ends (Frontends, Backend)
import Gargantext.Hooks.Router (useHashRouter) import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.License (license) import Gargantext.License (license)
...@@ -36,6 +36,7 @@ import Gargantext.Sessions as Sessions ...@@ -36,6 +36,7 @@ import Gargantext.Sessions as Sessions
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.App" thisModule = "Gargantext.Components.App"
-- TODO (what does this mean?) -- TODO (what does this mean?)
...@@ -54,15 +55,18 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where ...@@ -54,15 +55,18 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
showLogin <- R.useState' false showLogin <- R.useState' false
backend <- R.useState' Nothing backend <- R.useState' Nothing
showCorpus <- R.useState' false
treeReload <- R.useState' 0 treeReload <- R.useState' 0
asyncTasks <- GAT.useTasks treeReload
showCorpus <- R.useState' false
handed <- R.useState' GT.RightHanded handed <- R.useState' GT.RightHanded
let backends = fromFoldable defaultBackends let backends = fromFoldable defaultBackends
let ff f session = R.fragment [ f session, footer { session } ] let ff f session = R.fragment [ f session, footer { session } ]
let forested child = forestLayout { child let forested child = forestLayout { asyncTasks
, child
, frontends , frontends
, handed , handed
, reload: treeReload , reload: treeReload
...@@ -71,67 +75,69 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where ...@@ -71,67 +75,69 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
, showLogin: snd showLogin , showLogin: snd showLogin
, backend , backend
} }
let defaultView _ = forested $ homeLayout { backend
, lang: LL_EN
, publicBackend
, sessions
, visible: showLogin
}
let mCurrentRoute = fst route let mCurrentRoute = fst route
let withSession sid f = maybe' ( const $ forested let withSession sid f = maybe' defaultView (ff f) (Sessions.lookup sid (fst sessions))
$ homeLayout { lang: LL_EN
, backend let sessionUpdate s = snd sessions $ Sessions.Update s
, publicBackend
, sessions
, visible:showLogin
}
)
(ff f)
(Sessions.lookup sid (fst sessions))
pure $ case fst showLogin of pure $ case fst showLogin of
true -> forested $ login { backend, backends, sessions, visible: showLogin } true -> forested $ login { backend, backends, sessions, visible: showLogin }
false -> false ->
case fst route of case fst route of
Home -> forested $ homeLayout {lang:LL_EN, backend, publicBackend, sessions, visible:showLogin}
Login -> login { backends, sessions, visible: showLogin, backend}
Folder sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderPrivate sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderPublic sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderShared sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
Dashboard sid nodeId -> withSession sid $ \session -> forested $ dashboardLayout { nodeId, session }
Annuaire sid nodeId -> withSession sid $ \session -> forested $ annuaireLayout { frontends, nodeId, session } Annuaire sid nodeId -> withSession sid $ \session -> forested $ annuaireLayout { frontends, nodeId, session }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { frontends, nodeId, session } ContactPage sid aId nodeId -> withSession sid $ \session -> forested $ annuaireUserLayout { annuaireId: aId, asyncTasks, frontends, nodeId, session }
ContactPage sid aId nodeId -> withSession sid $ \session -> forested $ annuaireUserLayout { annuaireId: aId, frontends, nodeId, session } Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
CorpusDocument sid corpusId listId nodeId -> withSession sid $ \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Just corpusId } CorpusDocument sid corpusId listId nodeId -> withSession sid $ \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Just corpusId }
Dashboard sid nodeId -> withSession sid $ \session -> forested $ dashboardLayout { nodeId, session }
Document sid listId nodeId -> Document sid listId nodeId ->
withSession sid $ withSession sid $
\session -> forested $ documentLayout { nodeId, listId, session, corpusId: Nothing } \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Nothing }
Folder sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderPrivate sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderPublic sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderShared sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Home -> forested $ homeLayout { backend, lang:LL_EN, publicBackend, sessions, visible: showLogin }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { asyncTasks, nodeId, session, sessionUpdate }
Login -> login { backend, backends, sessions, visible: showLogin }
PGraphExplorer sid graphId -> PGraphExplorer sid graphId ->
withSession sid $ withSession sid $
\session -> \session ->
simpleLayout handed $ simpleLayout handed $
explorerLayout { frontends explorerLayout { asyncTasks
, backend
, frontends
, graphId , graphId
, handed: fst handed , handed: fst handed
, mCurrentRoute , mCurrentRoute
, session , session
, sessions: (fst sessions) , sessions: (fst sessions)
, showLogin , showLogin
, backend
--, treeReload --, treeReload
} }
RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session }
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 { asyncTasks, frontends, nodeId, session }
type ForestLayoutProps = type ForestLayoutProps =
( child :: R.Element ( asyncTasks :: GAT.Reductor
, backend :: R.State (Maybe Backend)
, child :: R.Element
, frontends :: Frontends , frontends :: Frontends
, handed :: R.State GT.Handed , handed :: R.State GT.Handed
, reload :: R.State Int , reload :: R.State Int
, route :: AppRoute , route :: AppRoute
, sessions :: Sessions , sessions :: Sessions
, showLogin :: R.Setter Boolean , showLogin :: R.Setter Boolean
, backend :: R.State (Maybe Backend)
) )
forestLayout :: Record ForestLayoutProps -> R.Element forestLayout :: Record ForestLayoutProps -> R.Element
...@@ -149,7 +155,7 @@ forestLayoutMain props = R.createElement forestLayoutMainCpt props [] ...@@ -149,7 +155,7 @@ forestLayoutMain props = R.createElement forestLayoutMainCpt props []
forestLayoutMainCpt :: R.Component ForestLayoutProps forestLayoutMainCpt :: R.Component ForestLayoutProps
forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" cpt forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" cpt
where where
cpt { child, frontends, handed, reload, route, sessions, showLogin, backend} _ = do cpt { asyncTasks, child, frontends, handed, reload, route, sessions, showLogin, backend} _ = do
let ordering = let ordering =
case fst handed of case fst handed of
GT.LeftHanded -> reverse GT.LeftHanded -> reverse
...@@ -157,7 +163,7 @@ forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" c ...@@ -157,7 +163,7 @@ forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" c
pure $ R2.row $ ordering [ pure $ R2.row $ ordering [
H.div { className: "col-md-2", style: { paddingTop: "60px" } } H.div { className: "col-md-2", style: { paddingTop: "60px" } }
[ forest { frontends, handed: fst handed, reload, route, sessions, showLogin, backend} ] [ forest { asyncTasks, backend, frontends, handed: fst handed, reload, route, sessions, showLogin } ]
, mainPage child , mainPage child
] ]
......
...@@ -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}
......
This diff is collapsed.
...@@ -6,6 +6,9 @@ import Data.Maybe (Maybe(..)) ...@@ -6,6 +6,9 @@ import Data.Maybe (Maybe(..))
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree (treeView) import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Ends (Frontends, Backend(..)) import Gargantext.Ends (Frontends, Backend(..))
...@@ -14,19 +17,19 @@ import Gargantext.Routes (AppRoute) ...@@ -14,19 +17,19 @@ import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions) import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
import Gargantext.Types (Reload, Handed(..)) import Gargantext.Types (Reload, Handed(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
thisModule :: String
thisModule = "Gargantext.Components.Forest" thisModule = "Gargantext.Components.Forest"
type Props = type Props =
( frontends :: Frontends ( asyncTasks :: GAT.Reductor
, handed :: Handed , backend :: R.State (Maybe Backend)
, reload :: R.State Int , frontends :: Frontends
, route :: AppRoute , handed :: Handed
, sessions :: Sessions , reload :: R.State Int
, showLogin :: R.Setter Boolean , route :: AppRoute
, backend :: R.State (Maybe Backend) , sessions :: Sessions
, showLogin :: R.Setter Boolean
) )
forest :: Record Props -> R.Element forest :: Record Props -> R.Element
...@@ -34,11 +37,10 @@ forest props = R.createElement forestCpt props [] ...@@ -34,11 +37,10 @@ forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props forestCpt :: R.Component Props
forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
cpt { frontends, handed, reload: extReload, route, sessions, showLogin, backend} _ = do cpt { asyncTasks, frontends, handed, reload: extReload, route, sessions, showLogin, backend} _ = do
-- NOTE: this is a hack to reload the tree view on demand -- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload) reload <- R.useState' (0 :: Reload)
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes) openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)
asyncTasks <- R2.useLocalStorageState GAT.localStorageKey GAT.empty
R2.useCache R2.useCache
( frontends ( frontends
/\ route /\ route
...@@ -46,7 +48,7 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where ...@@ -46,7 +48,7 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
/\ fst openNodes /\ fst openNodes
/\ fst extReload /\ fst extReload
/\ fst reload /\ fst reload
/\ fst asyncTasks /\ (fst asyncTasks).storage
/\ handed /\ handed
) )
(cpt' openNodes asyncTasks reload showLogin backend) (cpt' openNodes asyncTasks reload showLogin backend)
...@@ -55,21 +57,18 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where ...@@ -55,21 +57,18 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
where where
trees = tree <$> unSessions sessions trees = tree <$> unSessions sessions
tree s@(Session {treeId}) = tree s@(Session {treeId}) =
treeView { root: treeId treeView { asyncTasks
, asyncTasks
, frontends , frontends
, handed , handed
, mCurrentRoute: Just route , mCurrentRoute: Just route
, openNodes , openNodes
, reload , reload
, root: treeId
, session: s , session: s
} }
plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
plus handed showLogin backend = H.div {className: if handed == RightHanded plus handed showLogin backend = H.div { className: handedClass } [
then "flex-start" -- TODO we should use lefthanded SASS class here
else "flex-end"
} [
H.button { title: "Add or remove connections to the server(s)." H.button { title: "Add or remove connections to the server(s)."
, on: {click} , on: {click}
, className: "btn btn-default" , className: "btn btn-default"
...@@ -81,9 +80,14 @@ plus handed showLogin backend = H.div {className: if handed == RightHanded ...@@ -81,9 +80,14 @@ plus handed showLogin backend = H.div {className: if handed == RightHanded
--, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} [] --, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} []
--, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} [] --, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} []
] ]
] ]
-- TODO same as the one in the Login Modal (same CSS) -- TODO same as the one in the Login Modal (same CSS)
-- [ H.i { className: "material-icons md-36"} [] ] -- [ H.i { className: "material-icons md-36"} [] ]
where where
handedClass = if handed == RightHanded then
"flex-start" -- TODO we should use lefthanded SASS class here
else
"flex-end"
click _ = (snd backend) (const Nothing) click _ = (snd backend) (const Nothing)
*> showLogin (const true) *> showLogin (const true)
This diff is collapsed.
...@@ -126,6 +126,7 @@ settingsBox Team = ...@@ -126,6 +126,7 @@ settingsBox Team =
, Annuaire , Annuaire
, NodeFrameWrite , NodeFrameWrite
, NodeFrameCalc , NodeFrameCalc
, NodeFrameNotebook
] ]
, Share , Share
, Delete , Delete
...@@ -316,6 +317,22 @@ settingsBox NodeFrameCalc = ...@@ -316,6 +317,22 @@ settingsBox NodeFrameCalc =
] ]
} }
settingsBox NodeFrameNotebook =
SettingsBox { show : true
, edit : true
, doc : Documentation NodeFrameNotebook
, buttons : [ Add [ NodeFrameCalc
, NodeFrameWrite
, NodeFrameNotebook
]
, Move moveFrameParameters
, Delete
]
}
settingsBox NodeFile = settingsBox NodeFile =
SettingsBox { show: true SettingsBox { show: true
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
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