Commit c1b03f41 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[Graph] multi-select works in search

parent 07ad2aa1
......@@ -149,6 +149,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
, RH.li {} [ multiSelectEnabledButton props.multiSelectEnabled ] -- toggle multi node selection
-- save button
, RH.li {} [ nodeSearchControl { graph: props.graph
, multiSelectEnabled: props.multiSelectEnabled
, selectedNodeIds: props.selectedNodeIds } ]
, RH.li {} [ mouseSelectorSizeButton props.sigmaRef localControls.mouseSelectorSize ]
]
......
......@@ -18,6 +18,7 @@ import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
type Props = (
graph :: SigmaxTypes.SGraph
, multiSelectEnabled :: R.State Boolean
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
)
......@@ -37,36 +38,38 @@ nodeSearchControl props = R.createElement sizeButtonCpt props []
sizeButtonCpt :: R.Component Props
sizeButtonCpt = R.hooksComponent "NodeSearchControl" cpt
where
cpt {graph, selectedNodeIds} _ = do
cpt {graph, multiSelectEnabled, selectedNodeIds} _ = do
search@(search' /\ setSearch) <- R.useState' ""
pure $
H.div { className: "form-group" }
[ H.div { className: "input-group" }
[ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph
, onAutocompleteClick: \s -> triggerSearch graph s selectedNodeIds
, onEnterPress: \s -> triggerSearch graph s selectedNodeIds
, onAutocompleteClick: \s -> triggerSearch graph s multiSelectEnabled selectedNodeIds
, onEnterPress: \s -> triggerSearch graph s multiSelectEnabled selectedNodeIds
, state: search }
, H.div { className: "btn input-group-addon"
, on: { click: \_ -> triggerSearch graph search' selectedNodeIds }
, on: { click: \_ -> triggerSearch graph search' multiSelectEnabled selectedNodeIds }
}
[ H.span { className: "fa fa-search" } [] ]
]
]
autocompleteSearch :: SigmaxTypes.SGraph -> String -> Array String
autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s nodes
where
nodes = SigmaxTypes.graphNodes graph
autocompleteSearch :: SigmaxTypes.SGraph -> String -> Array String
autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s nodes
where
nodes = SigmaxTypes.graphNodes graph
triggerSearch :: SigmaxTypes.SGraph
-> String
-> R.State SigmaxTypes.SelectedNodeIds
-> Effect Unit
triggerSearch graph search (_ /\ setSelectedNodeIds) = do
let nodes = SigmaxTypes.graphNodes graph
let matching = (_.id) <$> searchNodes search nodes
triggerSearch :: SigmaxTypes.SGraph
-> String
-> R.State Boolean
-> R.State SigmaxTypes.SelectedNodeIds
-> Effect Unit
triggerSearch graph search (multiSelectEnabled /\ _) (_ /\ setSelectedNodeIds) = do
let graphNodes = SigmaxTypes.graphNodes graph
let matching = Set.fromFoldable $ (_.id) <$> searchNodes search graphNodes
log2 "[triggerSearch] search" search
log2 "[triggerSearch] search" search
setSelectedNodeIds $ const $ Set.fromFoldable matching
setSelectedNodeIds $ \nodes ->
Set.union matching $ if multiSelectEnabled then nodes else Set.empty
......@@ -3,6 +3,8 @@ module Gargantext.Components.GraphExplorer.Sidebar
where
import Prelude
import DOM.Simple.Console (log2)
import Data.Array (head)
import Data.Int (fromString)
import Data.Map as Map
......@@ -10,23 +12,21 @@ import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.Set as Set
import Data.Traversable (traverse_)
import Data.Tuple.Nested((/\))
import DOM.Simple.Console (log2)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.RandomText (words)
import Gargantext.Components.Nodes.Corpus.Graph.Tabs as GT
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Nodes.Corpus.Graph.Tabs as GT
import Gargantext.Components.RandomText (words)
import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, delete)
import Gargantext.Types (NodeType(..))
import Gargantext.Types (NodeType(..), TermList(..))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as RH
type Props =
( frontends :: Frontends
......@@ -63,8 +63,11 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, RH.div { className: "tab-content" }
[
RH.button { className: "btn btn-danger"
, on: { click: onClickRemove props.session props.selectedNodeIds }}
[ RH.text "Remove" ]
, on: { click: onClickRemove CandidateTerm props.session props.selectedNodeIds }}
[ RH.text "Remove candidate" ]
, RH.button { className: "btn btn-danger"
, on: { click: onClickRemove StopTerm props.session props.selectedNodeIds }}
[ RH.text "Remove stop" ]
]
, RH.li { className: "nav-item" }
[ RH.a { id: "home-tab"
......@@ -98,13 +101,6 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
]
]
]
badge (_ /\ setSelectedNodeIds) {id, label} =
RH.a { className: "badge badge-light"
, on: { click: onClick }
} [ RH.text label ]
where
onClick e = do
setSelectedNodeIds $ const $ Set.singleton id
checkbox text =
RH.li {}
[ RH.span {} [ RH.text text ]
......@@ -112,39 +108,52 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, className: "checkbox"
, checked: true
, title: "Mark as completed" } ]
badges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
badges graph (selectedNodeIds /\ _) = SigmaxTypes.nodesById graph selectedNodeIds
neighbourBadges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
neighbourBadges graph (selectedNodeIds /\ _) = SigmaxTypes.neighbours graph selectedNodes
where
selectedNodes = SigmaxTypes.nodesById graph selectedNodeIds
onClickRemove session (selectedNodeIds /\ _) e = do
onClickRemove rType session (selectedNodeIds /\ _) e = do
log2 "[onClickRemove] selectedNodeIds" selectedNodeIds
let nodeIds = mapMaybe fromString $ Set.toUnfoldable selectedNodeIds
deleteNodes session nodeIds
deleteNodes :: Session -> Array Int -> Effect Unit
deleteNodes session nodeIds = do
traverse_ (launchAff_ <<< deleteNode session) nodeIds
deleteNode :: Session -> Int -> Aff Int
deleteNode session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
query' (head metaData.corpusId)
where
query' Nothing = RH.div {} []
query' (Just corpusId) =
GT.tabs {frontends, session, query: q <$> Set.toUnfoldable selectedNodeIds, sides: [side corpusId]}
q id = case Map.lookup id nodesMap of
Nothing -> []
Just n -> words n.label
side corpusId = GET.GraphSideCorpus {
corpusId
, listId: metaData.listId
, corpusLabel: metaData.title
}
deleteNodes rType session nodeIds
badge :: R.State SigmaxTypes.SelectedNodeIds -> Record SigmaxTypes.Node -> R.Element
badge (_ /\ setSelectedNodeIds) {id, label} =
RH.a { className: "badge badge-light"
, on: { click: onClick }
} [ RH.text label ]
where
onClick e = do
setSelectedNodeIds $ const $ Set.singleton id
badges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
badges graph (selectedNodeIds /\ _) = SigmaxTypes.nodesById graph selectedNodeIds
neighbourBadges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
neighbourBadges graph (selectedNodeIds /\ _) = SigmaxTypes.neighbours graph selectedNodes
where
selectedNodes = SigmaxTypes.nodesById graph selectedNodeIds
deleteNodes :: TermList -> Session -> Array Int -> Effect Unit
deleteNodes termList session nodeIds = do
traverse_ (launchAff_ <<< deleteNode termList session) nodeIds
deleteNode :: TermList -> Session -> Int -> Aff Int
deleteNode termList session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
query :: Frontends -> GET.MetaData -> Session -> SigmaxTypes.NodesMap -> R.State SigmaxTypes.SelectedNodeIds -> R.Element
query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
query' (head metaData.corpusId)
where
query' Nothing = RH.div {} []
query' (Just corpusId) =
GT.tabs {frontends, session, query: q <$> Set.toUnfoldable selectedNodeIds, sides: [side corpusId]}
q id = case Map.lookup id nodesMap of
Nothing -> []
Just n -> words n.label
side corpusId = GET.GraphSideCorpus {
corpusId
, listId: metaData.listId
, corpusLabel: metaData.title
}
module Gargantext.Data.Louvain where
import Prelude (Unit, unit, ($), (<$>))
import Prelude (Unit, (<$>))
import Data.Function.Uncurried (Fn1, runFn1, Fn3, runFn3)
import Data.Map as Map
import Data.Tuple (Tuple(..))
......
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