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",
"version": "0.0.1.91.3",
"version": "0.0.1.91.7",
"scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall",
......
This diff is collapsed.
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 =
{ thermite =
......
......@@ -5,9 +5,11 @@ import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Either (Either(..))
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 Effect (Effect)
import Reactix as R
import Web.Storage.Storage as WSS
import Gargantext.Prelude
......@@ -19,7 +21,9 @@ import Gargantext.Utils.Reactix as R2
localStorageKey :: String
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 = Map.empty
......@@ -37,6 +41,39 @@ getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
parse s = GU.mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s)
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 ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
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 @@
module Gargantext.Components.Annotation.AnnotatedField where
import Prelude
import Data.Maybe ( Maybe(..), maybe, isJust, isNothing )
import Data.Tuple ( Tuple(..) )
import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple ( Tuple )
import Data.Tuple.Nested ( (/\) )
import DOM.Simple.Console (log, log2)
--import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Effect ( Effect )
import Reactix as R
......@@ -25,9 +25,8 @@ 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
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Annotation.AnnotatedField"
......@@ -49,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" 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
}
--setMenu (const $ menu)
R.setRef menuRef 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
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
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)
......@@ -171,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
......@@ -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
......
......@@ -10,7 +10,7 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Config (publicBackend)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Lang (LandingLang(..))
......@@ -25,7 +25,7 @@ import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout)
import Gargantext.Components.Nodes.Texts (textsLayout)
import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Config (defaultFrontends, defaultBackends, publicBackend)
import Gargantext.Ends (Frontends, Backend)
import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.License (license)
......@@ -36,6 +36,7 @@ import Gargantext.Sessions as Sessions
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.App"
-- TODO (what does this mean?)
......@@ -54,15 +55,18 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
showLogin <- R.useState' false
backend <- R.useState' Nothing
showCorpus <- R.useState' false
treeReload <- R.useState' 0
asyncTasks <- GAT.useTasks treeReload
showCorpus <- R.useState' false
handed <- R.useState' GT.RightHanded
let backends = fromFoldable defaultBackends
let ff f session = R.fragment [ f session, footer { session } ]
let forested child = forestLayout { child
let forested child = forestLayout { asyncTasks
, child
, frontends
, handed
, reload: treeReload
......@@ -71,67 +75,69 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
, showLogin: snd showLogin
, backend
}
let defaultView _ = forested $ homeLayout { backend
, lang: LL_EN
, publicBackend
, sessions
, visible: showLogin
}
let mCurrentRoute = fst route
let withSession sid f = maybe' ( const $ forested
$ homeLayout { lang: LL_EN
, backend
, publicBackend
, sessions
, visible:showLogin
}
)
(ff f)
(Sessions.lookup sid (fst sessions))
let withSession sid f = maybe' defaultView (ff f) (Sessions.lookup sid (fst sessions))
let sessionUpdate s = snd sessions $ Sessions.Update s
pure $ case fst showLogin of
true -> forested $ login { backend, backends, sessions, visible: showLogin }
false ->
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 }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { frontends, nodeId, session }
ContactPage sid aId nodeId -> withSession sid $ \session -> forested $ annuaireUserLayout { annuaireId: aId, frontends, nodeId, session }
ContactPage sid aId nodeId -> withSession sid $ \session -> forested $ annuaireUserLayout { annuaireId: aId, asyncTasks, 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 }
Dashboard sid nodeId -> withSession sid $ \session -> forested $ dashboardLayout { nodeId, session }
Document sid listId nodeId ->
withSession sid $
\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 ->
withSession sid $
\session ->
simpleLayout handed $
explorerLayout { frontends
explorerLayout { asyncTasks
, backend
, frontends
, graphId
, handed: fst handed
, mCurrentRoute
, session
, sessions: (fst sessions)
, showLogin
, backend
--, 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 =
( child :: R.Element
( asyncTasks :: GAT.Reductor
, backend :: R.State (Maybe Backend)
, child :: R.Element
, frontends :: Frontends
, handed :: R.State GT.Handed
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R.Setter Boolean
, backend :: R.State (Maybe Backend)
)
forestLayout :: Record ForestLayoutProps -> R.Element
......@@ -149,7 +155,7 @@ forestLayoutMain props = R.createElement forestLayoutMainCpt props []
forestLayoutMainCpt :: R.Component ForestLayoutProps
forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" cpt
where
cpt { child, frontends, handed, reload, route, sessions, showLogin, backend} _ = do
cpt { asyncTasks, child, frontends, handed, reload, route, sessions, showLogin, backend} _ = do
let ordering =
case fst handed of
GT.LeftHanded -> reverse
......@@ -157,7 +163,7 @@ forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" c
pure $ R2.row $ ordering [
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
]
......
......@@ -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}
......
This diff is collapsed.
......@@ -6,6 +6,9 @@ import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Ends (Frontends, Backend(..))
......@@ -14,19 +17,19 @@ import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
import Gargantext.Types (Reload, Handed(..))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
thisModule :: String
thisModule = "Gargantext.Components.Forest"
type Props =
( frontends :: Frontends
, handed :: Handed
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R.Setter Boolean
, backend :: R.State (Maybe Backend)
( asyncTasks :: GAT.Reductor
, backend :: R.State (Maybe Backend)
, frontends :: Frontends
, handed :: Handed
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R.Setter Boolean
)
forest :: Record Props -> R.Element
......@@ -34,11 +37,10 @@ forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props
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
reload <- R.useState' (0 :: Reload)
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)
asyncTasks <- R2.useLocalStorageState GAT.localStorageKey GAT.empty
R2.useCache
( frontends
/\ route
......@@ -46,7 +48,7 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
/\ fst openNodes
/\ fst extReload
/\ fst reload
/\ fst asyncTasks
/\ (fst asyncTasks).storage
/\ handed
)
(cpt' openNodes asyncTasks reload showLogin backend)
......@@ -55,21 +57,18 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
where
trees = tree <$> unSessions sessions
tree s@(Session {treeId}) =
treeView { root: treeId
, asyncTasks
treeView { asyncTasks
, frontends
, handed
, mCurrentRoute: Just route
, openNodes
, reload
, root: treeId
, session: s
}
plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
plus handed showLogin backend = H.div {className: if handed == RightHanded
then "flex-start" -- TODO we should use lefthanded SASS class here
else "flex-end"
} [
plus handed showLogin backend = H.div { className: handedClass } [
H.button { title: "Add or remove connections to the server(s)."
, on: {click}
, className: "btn btn-default"
......@@ -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-minus-circle fa-lg"} []
]
]
]
-- TODO same as the one in the Login Modal (same CSS)
-- [ H.i { className: "material-icons md-36"} [] ]
where
handedClass = if handed == RightHanded then
"flex-start" -- TODO we should use lefthanded SASS class here
else
"flex-end"
click _ = (snd backend) (const Nothing)
*> showLogin (const true)
This diff is collapsed.
......@@ -126,6 +126,7 @@ settingsBox Team =
, Annuaire
, NodeFrameWrite
, NodeFrameCalc
, NodeFrameNotebook
]
, Share
, Delete
......@@ -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 { 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