[GraphExplorer] search pairing of authors with annuaire

src/Gargantext/Components/GraphExplorer.purs

@@ -2,7 +2,6 @@ module Gargantext.Components.GraphExplorer where
 
 import Gargantext.Prelude hiding (max,min)
 
-import DOM.Simple.Types (Element)
 import Data.Array as A
 import Data.FoldableWithIndex (foldMapWithIndex)
 import Data.Int (toNumber)
@@ -13,6 +12,7 @@ import Data.Sequence as Seq
 import Data.Set as Set
 import Data.Tuple (fst, snd, Tuple(..))
 import Data.Tuple.Nested ((/\))
+import DOM.Simple.Types (Element)
 import Effect.Aff (Aff)
 import Gargantext.Components.Forest (forest)
 import Gargantext.Components.Graph as Graph
@@ -70,7 +70,7 @@ explorerLayoutView graphVersion p = R.createElement el p []
   where
     el = R.hooksComponent "G.C.GE.explorerLayoutView" cpt
     cpt {frontends, graphId, mCurrentRoute, session, sessions, showLogin } _ = do
-      useLoader graphId (getNodes session graphVersion) handler
+      useLoader {graphId, graphVersion: fst graphVersion, session} getNodes handler
       where
         handler loaded =
           explorer { frontends
@@ -280,8 +280,9 @@ modeGraphType Types.Sources = "star"
 modeGraphType Types.Terms = "def"
 
 
-getNodes :: Session -> R.State Int -> GraphId -> Aff GET.GraphData
-getNodes session (graphVersion /\ _) graphId = get session $ NodeAPI Types.Graph (Just graphId) ("?version=" <> show graphVersion)
+getNodes :: {graphId :: GraphId, graphVersion :: Int, session :: Session} -> Aff GET.GraphData
+getNodes {graphId, graphVersion, session} =
+  get session $ NodeAPI Types.Graph (Just graphId) ("?version=" <> show graphVersion)
 
 
 transformGraph :: Record Controls.Controls -> SigmaxT.SGraph -> SigmaxT.SGraph

src/Gargantext/Components/GraphExplorer/Sidebar.purs

@@ -5,8 +5,9 @@ module Gargantext.Components.GraphExplorer.Sidebar
 import Prelude
 
 import Control.Parallel (parTraverse)
-import Data.Array (head, last)
+import Data.Array (last, uncons)
 import Data.Int (fromString)
+import Data.List as List
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromJust)
 import Data.Sequence as Seq
@@ -26,8 +27,9 @@ import Gargantext.Components.RandomText (words)
 import Gargantext.Data.Array (mapMaybe)
 import Gargantext.Ends (Frontends)
 import Gargantext.Hooks.Sigmax.Types as SigmaxT
-import Gargantext.Sessions (Session)
-import Gargantext.Types (CTabNgramType, TabSubType(..), TabType(..), TermList(..), modeTabType)
+import Gargantext.Routes (SessionRoute(..))
+import Gargantext.Sessions (Session, post)
+import Gargantext.Types as GT
 import Gargantext.Utils.Reactix as R2
 
 type Props =
@@ -45,7 +47,7 @@ sidebar :: Record Props -> R.Element
 sidebar props = R.createElement sidebarCpt props []
 
 sidebarCpt :: R.Component Props
-sidebarCpt = R.hooksComponent "Sidebar" cpt
+sidebarCpt = R.hooksComponent "G.C.GE.S.sidebar" cpt
   where
     cpt {showSidePanel: GET.Closed} _children = do
       pure $ RH.div {} []
@@ -66,8 +68,8 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
                   ]
                 , RH.div { className: "tab-content" }
                   [
-                    removeButton "Remove candidate" CandidateTerm props nodesMap
-                  , removeButton "Remove stop" StopTerm props nodesMap
+                    removeButton "Remove candidate" GT.CandidateTerm props nodesMap
+                  , removeButton "Remove stop" GT.StopTerm props nodesMap
                   ]
                 , RH.li { className: "nav-item" }
                   [ RH.a { id: "home-tab"
@@ -96,7 +98,13 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
               -}
             , RH.div { className: "col-md-12", id: "query" }
               [
-                query props.frontends props.metaData props.session nodesMap props.selectedNodeIds
+                query {
+                  frontends: props.frontends
+                , metaData: props.metaData
+                , nodesMap
+                , selectedNodeIds: props.selectedNodeIds
+                , session: props.session
+                }
               ]
             ]
           ]
@@ -141,7 +149,7 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selected
   where
     selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
 
-deleteNodes :: TermList -> Session -> GET.MetaData -> R.State Int -> Array (Record SigmaxT.Node) -> Effect Unit
+deleteNodes :: GT.TermList -> Session -> GET.MetaData -> R.State Int -> Array (Record SigmaxT.Node) -> Effect Unit
 deleteNodes termList session metaData (_ /\ setGraphVersion) nodes = do
   launchAff_ do
     patches <- (parTraverse (deleteNode termList session metaData) nodes) :: Aff (Array NTC.VersionedNgramsPatches)
@@ -151,7 +159,7 @@ deleteNodes termList session metaData (_ /\ setGraphVersion) nodes = do
       Just (NTC.Versioned patch) -> pure unit --liftEffect do
         --setGraphVersion $ const $ patch.version
 
-deleteNode :: TermList -> Session -> GET.MetaData -> Record SigmaxT.Node -> Aff NTC.VersionedNgramsPatches
+deleteNode :: GT.TermList -> Session -> GET.MetaData -> Record SigmaxT.Node -> Aff NTC.VersionedNgramsPatches
 deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches coreParams versioned
   where
     nodeId :: Int
@@ -160,33 +168,72 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches
     versioned = NTC.Versioned {version: metaData.list.version, data: np}
     coreParams :: NTC.CoreParams ()
     coreParams = {session, nodeId: nodeId, listIds: [metaData.list.listId], tabType}
-    tabNgramType :: CTabNgramType
-    tabNgramType = modeTabType node.gargType
-    tabType :: TabType
-    tabType = TabCorpus (TabNgramType tabNgramType)
+    tabNgramType :: GT.CTabNgramType
+    tabNgramType = GT.modeTabType node.gargType
+    tabType :: GT.TabType
+    tabType = GT.TabCorpus (GT.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: GraphTerm }
+    patch_list :: NTC.Replace GT.TermList
+    patch_list = NTC.Replace { new: termList, old: GT.GraphTerm }
+
+type QueryProps =
+  (
+    frontends :: Frontends
+  , metaData :: GET.MetaData
+  , nodesMap :: SigmaxT.NodesMap
+  , selectedNodeIds :: R.State SigmaxT.NodeIds
+  , session :: Session
+  )
 
+query :: Record QueryProps -> R.Element
+query props = R.createElement queryCpt props []
 
-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 /\ _) =
-  query' (head metaData.corpusId)
+queryCpt :: R.Component QueryProps
+queryCpt = R.hooksComponent "G.C.GE.S.query" cpt
+  where
+    cpt {selectedNodeIds: (selectedNodeIds /\ _)} _ | Set.isEmpty selectedNodeIds = pure $ RH.div {} []
+    cpt {frontends, metaData: (GET.MetaData metaData@{corpusId}), nodesMap, selectedNodeIds: (selectedNodeIds /\ _), session} _ = case uncons corpusId of
+      Nothing -> pure $ RH.div {} []
+      Just {head: corpusId} ->
+        pure $ RH.div {} [
+            pairing corpusId
+          , query' corpusId
+        ]
       where
-    query' Nothing = RH.div {} []
-    query' (Just corpusId) =
-      GT.tabs {frontends, session, query: q <$> Set.toUnfoldable selectedNodeIds, sides: [side corpusId]}
+        query' cId =
+          GT.tabs { frontends
+                  , query: q <$> Set.toUnfoldable selectedNodeIds
+                  , session
+                  , sides: [side cId]}
         q id = case Map.lookup id nodesMap of
           Nothing -> []
           Just n -> words n.label
-    side corpusId = GET.GraphSideCorpus {
-          corpusId
+        side cId = GET.GraphSideCorpus {
+              corpusId: cId
             , listId: metaData.list.listId
             , corpusLabel: metaData.title
             }
+        pairing cId =
+          RH.div {} [ RH.span { className: "btn btn-default"
+                              , on: { click: onClickPair }
+                              } [ RH.text "Pair with Annuaire" ] ]
+          where
+            onClickPair _ = do
+              let labels = Map.values $ Map.mapMaybe (\n -> if Set.member n.id selectedNodeIds then Just n.label else Nothing) nodesMap
+              launchAff_ $ do
+                pairWithAnnuaire { corpusId: cId
+                                 , listId: metaData.list.listId
+                                 , query: List.toUnfoldable labels
+                                 , session }
+
+pairWithAnnuaire :: { corpusId :: Int
+                    , listId :: Int
+                    , query :: Array String
+                    , session :: Session } -> Aff Unit
+pairWithAnnuaire {corpusId, listId, query, session} =
+  post session (NodeAPI GT.Node (Just corpusId) $ "searchPair/list/" <> (show listId)) {query}

src/Gargantext/Components/GraphExplorer/Types.purs

@@ -48,10 +48,10 @@ newtype GraphSideCorpus = GraphSideCorpus
   }
 
 newtype GraphData = GraphData
-  { nodes :: Array Node
-  , edges :: Array Edge
-  , sides :: Array GraphSideCorpus
+  { edges :: Array Edge
   , metaData :: Maybe MetaData
+  , nodes :: Array Node
+  , sides :: Array GraphSideCorpus
   }
 
 derive instance newtypeGraphData :: Newtype GraphData _
@@ -106,8 +106,8 @@ initialGraphData = GraphData {
 instance decodeJsonGraphData :: DecodeJson GraphData where
   decodeJson json = do
     obj <- decodeJson json
-    nodes <- obj .: "nodes"
     edges <- obj .: "edges"
+    nodes <- obj .: "nodes"
     -- TODO: sides
     metadata <- obj .: "metadata"
     corpusIds <- metadata .: "corpusId"
@@ -116,7 +116,7 @@ instance decodeJsonGraphData :: DecodeJson GraphData where
     metaData <- obj .: "metadata"
     let side x = GraphSideCorpus { corpusId: x, corpusLabel: "Publications", listId : listId'}
     let sides = side <$> corpusIds
-    pure $ GraphData { nodes, edges, sides, metaData }
+    pure $ GraphData { edges, metaData, nodes, sides }
 
 instance decodeJsonNode :: DecodeJson Node where
   decodeJson json = do