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
-- Automatic opening of sidebar when a node is selected (but only first time).
R.useEffect' $ do
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
pure unit
......
......@@ -15,6 +15,7 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Types (SidePanelState(..), SideTab(..))
import Gargantext.Components.GraphExplorer.Legend as Legend
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
......@@ -29,6 +30,7 @@ import Partial.Unsafe (unsafePartial)
import Gargantext.Prelude
import Reactix as R
import Reactix.DOM.HTML as RH
import Reactix.DOM.HTML as H
type Props =
( frontends :: Frontends
......@@ -54,13 +56,35 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
cpt {showSidePanel: (GET.InitialClosed /\ _)} _children = do
pure $ RH.div {} []
cpt props@{metaData, showSidePanel} _children = do
let (sidePanel /\ setSidePanel) = showSidePanel
let nodesMap = SigmaxT.nodesGraphMap props.graph
pure $
RH.div { id: "sp-container" }
[ RH.div {}
[ R2.row
[ R2.col 12
pure $ RH.div { id: "sp-container" }
[ sideTabNav showSidePanel [SideTabLegend, SideTabSelection, SideTabPairing]
, sideTab (fst showSidePanel) props
]
sideTabNav :: R.State SidePanelState -> Array SideTab -> R.Element
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.div { className: "tab-content" }
[ RH.div { className: "", role: "tabpanel" }
......@@ -75,27 +99,7 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, 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" }
[ query props.frontends props.metaData props.session nodesMap props.selectedNodeIds]
......@@ -106,47 +110,45 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
(Seq.toUnfoldable $ (Seq.map (badge props.selectedNodeIds) (neighbourBadges props.graph props.selectedNodeIds)))
]
]
{-, RH.div { className: "col-md-12", id: "horizontal-checkbox" }
[ RH.ul {}
[ checkbox "Pubs"
, checkbox "Projects"
, checkbox "Patents"
, checkbox "Others"
]
]
-}
]
]
]
checkbox text =
RH.li {}
[ RH.span {} [ RH.text text ]
, RH.input { type: "checkbox"
, className: "checkbox"
, checked: true
, title: "Mark as completed" } ]
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
where
nodesMap = SigmaxT.nodesGraphMap props.graph
checkbox text =
RH.li {}
[ RH.span {} [ RH.text text ]
, RH.input { type: "checkbox"
, className: "checkbox"
, checked: true
, title: "Mark as completed" } ]
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
sideTab _ _ = H.div {} []
-------------------------------------------
badge :: R.State SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
badge (_ /\ setNodeIds) {id, label} =
RH.a { className: "badge badge-light"
......@@ -164,6 +166,7 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selected
where
selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
type DeleteNodes =
( graphId :: Int
, metaData :: GET.MetaData
......@@ -188,24 +191,31 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches
where
nodeId :: Int
nodeId = unsafePartial $ fromJust $ fromString node.id
versioned :: NTC.VersionedNgramsPatches
versioned = NTC.Versioned {version: metaData.list.version, data: np}
coreParams :: NTC.CoreParams ()
coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType}
tabNgramType :: CTabNgramType
tabNgramType = modeTabType node.gargType
tabType :: TabType
tabType = TabCorpus (TabNgramType tabNgramType)
term :: NTC.NgramsTerm
term = NTC.normNgram tabNgramType node.label
pt :: NTC.NgramsTablePatch
pt = NTC.fromNgramsPatches np
np :: NTC.NgramsPatches
np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
patch_list :: NTC.Replace TermList
patch_list = NTC.Replace { new: termList, old: MapTerm }
query :: Frontends -> GET.MetaData -> Session -> SigmaxT.NodesMap -> R.State SigmaxT.NodeIds -> R.Element
query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
......@@ -222,3 +232,18 @@ query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _)
, listId: metaData.list.listId
, 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 {} []
onClick = \_ -> do
setState $ \s -> case s of
GET.InitialClosed -> GET.Opened GET.SideTab1
GET.Closed -> GET.Opened GET.SideTab1
GET.InitialClosed -> GET.Opened GET.SideTabLegend
GET.Closed -> GET.Opened GET.SideTabLegend
(GET.Opened _) -> GET.Closed
module Gargantext.Components.GraphExplorer.Types where
import Prelude
import Gargantext.Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Array ((!!), length)
import Data.Maybe (Maybe(..), fromJust)
......@@ -190,9 +190,19 @@ intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaul
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
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
-- | public Backend
-- When user is not logged, use the location of the window
publicBackend :: Backend
publicBackend = backend_dev
publicBackend = backend_local
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