Commit 519b4c37 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[REFACT] Sidepanel in GraphExplorer (Legend tab added with fake legend)

parent 5f23a9dc
...@@ -94,7 +94,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt ...@@ -94,7 +94,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
-- Automatic opening of sidebar when a node is selected (but only first time). -- Automatic opening of sidebar when a node is selected (but only first time).
R.useEffect' $ do R.useEffect' $ do
if fst props.showSidePanel == GET.InitialClosed && (not Set.isEmpty $ fst props.selectedNodeIds) then if fst props.showSidePanel == GET.InitialClosed && (not Set.isEmpty $ fst props.selectedNodeIds) then
snd props.showSidePanel $ \_ -> GET.Opened GET.SideTab2 snd props.showSidePanel $ \_ -> GET.Opened GET.SideTabSelection
else else
pure unit pure unit
......
...@@ -15,6 +15,7 @@ import Effect (Effect) ...@@ -15,6 +15,7 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Types (SidePanelState(..), SideTab(..))
import Gargantext.Components.GraphExplorer.Legend as Legend import Gargantext.Components.GraphExplorer.Legend as Legend
import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
...@@ -29,6 +30,7 @@ import Partial.Unsafe (unsafePartial) ...@@ -29,6 +30,7 @@ import Partial.Unsafe (unsafePartial)
import Gargantext.Prelude import Gargantext.Prelude
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
import Reactix.DOM.HTML as H
type Props = type Props =
( frontends :: Frontends ( frontends :: Frontends
...@@ -54,13 +56,35 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -54,13 +56,35 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
cpt {showSidePanel: (GET.InitialClosed /\ _)} _children = do cpt {showSidePanel: (GET.InitialClosed /\ _)} _children = do
pure $ RH.div {} [] pure $ RH.div {} []
cpt props@{metaData, showSidePanel} _children = do cpt props@{metaData, showSidePanel} _children = do
let (sidePanel /\ setSidePanel) = showSidePanel pure $ RH.div { id: "sp-container" }
let nodesMap = SigmaxT.nodesGraphMap props.graph [ sideTabNav showSidePanel [SideTabLegend, SideTabSelection, SideTabPairing]
pure $ , sideTab (fst showSidePanel) props
RH.div { id: "sp-container" } ]
[ RH.div {}
[ R2.row sideTabNav :: R.State SidePanelState -> Array SideTab -> R.Element
[ R2.col 12 sideTabNav (sidePanel /\ setSidePanel) sideTabs =
R.fragment [ H.div { className: "text-primary center"} [H.text "SideTab"]
, H.div {className: "nav nav-tabs"} (liItem <$> sideTabs)
-- , H.div {className: "center"} [ H.text "Doc sideTabs"]
]
where
liItem :: SideTab -> R.Element
liItem tab =
H.div { className : "nav-item nav-link"
<> if (Opened tab) == sidePanel
then " active"
else ""
, on: { click: \_ -> setSidePanel $ const (Opened tab)
}
} [ H.text $ show tab ]
sideTab :: SidePanelState -> Record Props -> R.Element
sideTab (Opened SideTabLegend) props@{metaData} =
let (GET.MetaData {legend}) = metaData
in Legend.legend { items: Seq.fromFoldable legend}
sideTab (Opened SideTabSelection) props =
RH.div {} [ R2.row [ R2.col 12
[ RH.ul { id: "myTab", className: "nav nav-tabs", role: "tablist"} [ RH.ul { id: "myTab", className: "nav nav-tabs", role: "tablist"}
[ RH.div { className: "tab-content" } [ RH.div { className: "tab-content" }
[ RH.div { className: "", role: "tabpanel" } [ RH.div { className: "", role: "tabpanel" }
...@@ -75,27 +99,7 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -75,27 +99,7 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, removeButton "Remove stop" StopTerm props nodesMap , removeButton "Remove stop" StopTerm props nodesMap
] ]
, RH.li { className: "nav-item" }
[ RH.a { id: "home-tab"
, className: "nav-link active"
, data: {toggle: "tab"}
, href: "#legend"
, role: "tab"
, aria: {controls: "legend", selected: "true"}
}
[ RH.text "Legend" ]
, let (GET.MetaData {legend}) = metaData
in Legend.legend { items: Seq.fromFoldable legend}
] ]
, RH.li { className: "nav-item" }
[ RH.a { id: "home-tab"
, className: "nav-link"
, data: {toggle: "tab"}
, href: "#nodes"
, role: "tab"
, aria: {controls: "nodes", selected: "false"}
}
[ RH.text "Nodes" ]
, RH.div { className: "col-md-12", id: "query" } , RH.div { className: "col-md-12", id: "query" }
[ query props.frontends props.metaData props.session nodesMap props.selectedNodeIds] [ query props.frontends props.metaData props.session nodesMap props.selectedNodeIds]
...@@ -106,47 +110,45 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -106,47 +110,45 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
(Seq.toUnfoldable $ (Seq.map (badge props.selectedNodeIds) (neighbourBadges props.graph props.selectedNodeIds))) (Seq.toUnfoldable $ (Seq.map (badge props.selectedNodeIds) (neighbourBadges props.graph props.selectedNodeIds)))
] ]
] ]
{-, RH.div { className: "col-md-12", id: "horizontal-checkbox" } where
[ RH.ul {}
[ checkbox "Pubs" nodesMap = SigmaxT.nodesGraphMap props.graph
, checkbox "Projects"
, checkbox "Patents" checkbox text =
, checkbox "Others" RH.li {}
] [ RH.span {} [ RH.text text ]
] , RH.input { type: "checkbox"
-} , className: "checkbox"
] , checked: true
] , title: "Mark as completed" } ]
]
checkbox text = removeButton text rType props nodesMap =
RH.li {} if Set.isEmpty $ fst props.selectedNodeIds then
[ RH.span {} [ RH.text text ] RH.div {} []
, RH.input { type: "checkbox" else
, className: "checkbox" RH.button { className: "btn btn-danger"
, checked: true , on: { click: onClickRemove rType props nodesMap }}
, title: "Mark as completed" } ] [ RH.text text ]
removeButton text rType props nodesMap =
if Set.isEmpty $ fst props.selectedNodeIds then
RH.div {} []
else
RH.button { className: "btn btn-danger"
, on: { click: onClickRemove rType props nodesMap }}
[ RH.text text ]
onClickRemove rType props nodesMap e = do
let nodes = mapMaybe (\id -> Map.lookup id nodesMap)
$ Set.toUnfoldable $ fst props.selectedNodeIds
deleteNodes { graphId: props.graphId
, metaData: props.metaData
, nodes
, session: props.session
, termList: rType
, treeReload: props.treeReload }
snd props.removedNodeIds $ const $ fst props.selectedNodeIds
snd props.selectedNodeIds $ const SigmaxT.emptyNodeIds
onClickRemove rType props nodesMap e = do
let nodes = mapMaybe (\id -> Map.lookup id nodesMap)
$ Set.toUnfoldable $ fst props.selectedNodeIds
deleteNodes { graphId: props.graphId
, metaData: props.metaData
, nodes
, session: props.session
, termList: rType
, treeReload: props.treeReload }
snd props.removedNodeIds $ const $ fst props.selectedNodeIds
snd props.selectedNodeIds $ const SigmaxT.emptyNodeIds
sideTab _ _ = H.div {} []
-------------------------------------------
badge :: R.State SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element badge :: R.State SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
badge (_ /\ setNodeIds) {id, label} = badge (_ /\ setNodeIds) {id, label} =
RH.a { className: "badge badge-light" RH.a { className: "badge badge-light"
...@@ -164,6 +166,7 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selected ...@@ -164,6 +166,7 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selected
where where
selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
type DeleteNodes = type DeleteNodes =
( graphId :: Int ( graphId :: Int
, metaData :: GET.MetaData , metaData :: GET.MetaData
...@@ -188,24 +191,31 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches ...@@ -188,24 +191,31 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches
where where
nodeId :: Int nodeId :: Int
nodeId = unsafePartial $ fromJust $ fromString node.id nodeId = unsafePartial $ fromJust $ fromString node.id
versioned :: NTC.VersionedNgramsPatches versioned :: NTC.VersionedNgramsPatches
versioned = NTC.Versioned {version: metaData.list.version, data: np} versioned = NTC.Versioned {version: metaData.list.version, data: np}
coreParams :: NTC.CoreParams () coreParams :: NTC.CoreParams ()
coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType} coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType}
tabNgramType :: CTabNgramType tabNgramType :: CTabNgramType
tabNgramType = modeTabType node.gargType tabNgramType = modeTabType node.gargType
tabType :: TabType tabType :: TabType
tabType = TabCorpus (TabNgramType tabNgramType) tabType = TabCorpus (TabNgramType tabNgramType)
term :: NTC.NgramsTerm term :: NTC.NgramsTerm
term = NTC.normNgram tabNgramType node.label term = NTC.normNgram tabNgramType node.label
pt :: NTC.NgramsTablePatch pt :: NTC.NgramsTablePatch
pt = NTC.fromNgramsPatches np pt = NTC.fromNgramsPatches np
np :: NTC.NgramsPatches np :: NTC.NgramsPatches
np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list } np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
patch_list :: NTC.Replace TermList patch_list :: NTC.Replace TermList
patch_list = NTC.Replace { new: termList, old: MapTerm } patch_list = NTC.Replace { new: termList, old: MapTerm }
query :: Frontends -> GET.MetaData -> Session -> SigmaxT.NodesMap -> R.State SigmaxT.NodeIds -> R.Element query :: Frontends -> GET.MetaData -> Session -> SigmaxT.NodesMap -> R.State SigmaxT.NodeIds -> R.Element
query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} [] query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) = query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
...@@ -222,3 +232,18 @@ query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) ...@@ -222,3 +232,18 @@ query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _)
, listId: metaData.list.listId , listId: metaData.list.listId
, corpusLabel: metaData.title , corpusLabel: metaData.title
} }
------------------------------------------------------------------------
{-, RH.div { className: "col-md-12", id: "horizontal-checkbox" }
[ RH.ul {}
[ checkbox "Pubs"
, checkbox "Projects"
, checkbox "Patents"
, checkbox "Others"
]
]
-}
...@@ -150,6 +150,6 @@ sidebarToggleButton (state /\ setState) = R.createElement el {} [] ...@@ -150,6 +150,6 @@ sidebarToggleButton (state /\ setState) = R.createElement el {} []
onClick = \_ -> do onClick = \_ -> do
setState $ \s -> case s of setState $ \s -> case s of
GET.InitialClosed -> GET.Opened GET.SideTab1 GET.InitialClosed -> GET.Opened GET.SideTabLegend
GET.Closed -> GET.Opened GET.SideTab1 GET.Closed -> GET.Opened GET.SideTabLegend
(GET.Opened _) -> GET.Closed (GET.Opened _) -> GET.Closed
module Gargantext.Components.GraphExplorer.Types where module Gargantext.Components.GraphExplorer.Types where
import Prelude import Gargantext.Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:)) import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Array ((!!), length) import Data.Array ((!!), length)
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
...@@ -190,9 +190,19 @@ intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaul ...@@ -190,9 +190,19 @@ intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaul
data SidePanelState = InitialClosed | Opened SideTab | Closed data SidePanelState = InitialClosed | Opened SideTab | Closed
derive instance eqSidePanelState :: Eq SidePanelState
data SideTab = SideTab1 | SideTab2 | SideTab3 data SideTab = SideTabLegend | SideTabSelection | SideTabPairing
derive instance eqSideTab :: Eq SideTab derive instance eqSideTab :: Eq SideTab
instance showSideTab :: Show SideTab where
show SideTabLegend = "Legend"
show SideTabSelection = "Navigation"
show SideTabPairing = "Pairing"
derive instance eqSidePanelState :: Eq SidePanelState
...@@ -35,7 +35,7 @@ backend_local = backend V10 "/api/" "http://localhost:8008" "local.cnrs ...@@ -35,7 +35,7 @@ backend_local = backend V10 "/api/" "http://localhost:8008" "local.cnrs
-- | public Backend -- | public Backend
-- When user is not logged, use the location of the window -- When user is not logged, use the location of the window
publicBackend :: Backend publicBackend :: Backend
publicBackend = backend_dev publicBackend = backend_local
publicBackend' :: Effect Backend publicBackend' :: Effect Backend
......
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