Merge remote-tracking branch 'origin/489-dev-graph-explorer-fixes' into dev-merge

nix/easy-ps.nix

@@ -5,8 +5,8 @@ import
     pkgs.fetchFromGitHub {
       owner = "justinwoo";
       repo = "easy-purescript-nix";
-      rev = "ee51a6d459b8fecfcb10f24ca9728e649c6a9e00";
-      sha256 = "dVC+xvdUksFFN0LZYXtKVZPUcVGMAWURGuZ5r1g1k/A=";
+      rev = "master";
+      sha256 = "tESal32bcqqdZO+aKnBzc1GoL2mtnaDtj2y7ociCRGA=";
     }
   ) {
   inherit pkgs;

nix/pinned.nix

 import (
   builtins.fetchTarball {
-    url = "https://github.com/NixOS/nixpkgs/archive/22.05.tar.gz";
-    sha256 = "0d643wp3l77hv2pmg2fi7vyxn4rwy0iyr8djcw1h5x72315ck9ik";
+    url = "https://github.com/NixOS/nixpkgs/archive/22.11.tar.gz";
   }
 )

package.json

@@ -35,6 +35,7 @@
         "base-x": "^3.0.2",
         "bootstrap": "^4.6.0",
         "bootstrap-dark": "^1.0.3",
+        "buffer": "^6.0.3",
         "create-react-class": "^15.6.3",
         "crypto": "^1.0.1",
         "d3": "^7.6.1",
@@ -54,7 +55,6 @@
         "markdown-it": "^13.0.1",
         "prop-types": "^15.6.2",
         "pullstate": "^1.20.6",
-        "react": "^17.0.2",
         "react-awesome-popover": "^6.1.1",
         "react-bootstrap": "^1.5.2",
         "react-dom": "^17.0.2",
@@ -68,7 +68,7 @@
         "@babel/preset-env": "^7.15.6",
         "@babel/preset-react": "^7.12.7",
         "@getgauge/cli": "^1.4.0",
-        "parcel": "^2.0.0-rc.0",
+        "parcel": "^2.8.2",
         "react-testing-library": "^8.0.1",
         "sass": "^1.35.2",
         "serve": "^12.0.0",

packages.dhall

 let upstream =
-      https://github.com/garganscript/package-sets/releases/download/v0.1.7/release.dhall sha256:52886309e1f0158a85427f80c1e3d47ce747c5f14fcec671a81fe5c2c711a6db
+      https://github.com/garganscript/package-sets/releases/download/v0.1.7/release.dhall
+        sha256:52886309e1f0158a85427f80c1e3d47ce747c5f14fcec671a81fe5c2c711a6db
 
 let overrides =
       { graphql-client =
@@ -192,4 +193,4 @@ let additions =
         }
       }
 
-in  upstream ⫽ overrides ⫽ additions
+in  upstream // overrides // additions

shell.nix

@@ -108,7 +108,7 @@ let
 in
 pkgs.mkShell {
   buildInputs = [
-    easy-ps.purs-0_15_4
+    easy-ps.purs-0_15_7
     easy-ps.psc-package
     easy-ps.dhall-json-simple
     easy-ps.zephyr

src/Gargantext/Components/App/App.purs

@@ -23,7 +23,6 @@ here = R2.here "Gargantext.Components.App"
 
 app :: R2.Leaf ()
 app = R2.leaf appCpt
-
 appCpt :: R.Component ()
 appCpt = here.component "container" cpt where
   cpt _ _ = do
@@ -55,7 +54,6 @@ type HydrateStoreProps =
 
 hydrateStore :: R2.Leaf HydrateStoreProps
 hydrateStore = R2.leaf hydrateStoreCpt
-
 hydrateStoreCpt :: R.Component HydrateStoreProps
 hydrateStoreCpt = here.component "hydrateStore" cpt where
   cpt { cacheParams

src/Gargantext/Components/FacetsTable.purs

@@ -21,6 +21,8 @@ import Effect.Aff (launchAff_)
 import Gargantext.Components.Category (CategoryQuery(..), putCategories)
 import Gargantext.Components.Category.Types (Category(..), decodeCategory, favCategory)
 import Gargantext.Components.DocsTable.Types (showSource)
+import Gargantext.Components.GraphQL.Context as GQLCTX
+import Gargantext.Components.GraphQL.Endpoints as GQLE
 import Gargantext.Components.Search (Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..), SearchQuery, SearchResult(..), SearchResultTypes(..))
 import Gargantext.Components.Table as T
 import Gargantext.Components.Table.Types as T
@@ -91,6 +93,21 @@ derive instance Generic DocumentsView _
 instance Eq DocumentsView where eq = genericEq
 instance Show DocumentsView where show = genericShow
 
+gqlContextToDocumentsView :: GQLCTX.Context -> DocumentsView
+gqlContextToDocumentsView ctx@{ c_hyperdata: h } =
+  DocumentsView { id: ctx.c_id
+                , date: ctx.c_date
+                , title: ctx.c_name
+                , source: showSource (_.hrd_source <$> h)
+                , score: fromMaybe 0 ctx.c_score
+                , authors: fromMaybe "Authors" (_.hrd_authors <$> h)
+                , category: decodeCategory $ fromMaybe 0 ctx.c_category
+                , pairs: []
+                , delete: false
+                , publication_year: _.hrd_publication_year <$> h
+                , publication_month: _.hrd_publication_month <$> h
+                , publication_day: _.hrd_publication_day <$> h }
+
 ----------------------------------------------------------------------
 newtype ContactsView =
   ContactsView
@@ -218,7 +235,6 @@ loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy } } =
     convOrderBy (T.ASC  (T.ColumnName "Source")) = SourceAsc
     convOrderBy (T.DESC (T.ColumnName "Source")) = SourceDesc
     convOrderBy _ = DateAsc -- TODO
-
     p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
 
   --SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
@@ -233,6 +249,28 @@ loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy } } =
               SearchResultContact {contacts} -> Contacts {contacts: contact2view <$> Seq.fromFoldable contacts}
               errMessage                     -> Docs     {docs: Seq.fromFoldable [err2view errMessage]} -- TODO better error view
 
+type PageGQLParams =
+   ( corpusId    :: Int
+   , params      :: T.Params
+   , ngramsTerms :: Array String
+   , session     :: Session )
+
+initialPageGQL :: { corpusId :: Int, ngramsTerms :: Array String, session :: Session }
+               -> Record PageGQLParams
+initialPageGQL { corpusId, ngramsTerms, session } =
+  { corpusId, ngramsTerms, params: T.initialParams, session }
+
+
+loadPageGQL :: Record PageGQLParams -> AffRESTError Rows
+loadPageGQL { corpusId
+            , params: { limit, offset, orderBy }
+            , ngramsTerms
+            , session } = do
+
+  eResult <- GQLE.getContextsForNgrams session corpusId ngramsTerms
+
+  pure $ (\res -> Docs { docs: gqlContextToDocumentsView <$> Seq.fromFoldable res }) <$> eResult
+
 doc2view :: Document -> DocumentsView
 doc2view ( Document { id
                     , created: date

src/Gargantext/Components/FolderView.purs

@@ -113,16 +113,16 @@ folderViewMainCpt = here.component "folderViewMainCpt" cpt where
   makeParentFolder root (Just parent) props =
     [
       folder
-      { nodeId: root.id
+      { disabled: disabled parent
       , linkId: parent.id
       , linkNodeType: parent.node_type
+      , nodeId: root.id
       , nodeType: root.node_type
       , parentId: parent.id
       , reload: props.reload
       , session: props.session
       , style: FolderUp
       , text: "..."
-      , disabled: disabled parent
       }
     ]
     where
@@ -133,32 +133,32 @@ folderViewMainCpt = here.component "folderViewMainCpt" cpt where
   sortFolders a b = compare a.id b.id
 
 type FolderProps =
-  ( style         :: FolderStyle
-  , text          :: String
-  , nodeType      :: GT.NodeType
-  , nodeId        :: Int
+  ( disabled      :: Boolean
   , linkNodeType  :: GT.NodeType
   , linkId        :: Int
-  , session       :: Session
+  , nodeType      :: GT.NodeType
+  , nodeId        :: Int
   , parentId      :: Int
   , reload        :: T.Box T2.Reload
-  , disabled      :: Boolean
+  , session       :: Session
+  , style         :: FolderStyle
+  , text          :: String
   )
 
 folder :: R2.Leaf FolderProps
 folder = R2.leaf folderCpt
 folderCpt :: R.Component FolderProps
 folderCpt = here.component "folderCpt" cpt where
-  cpt props@{ nodeId
-            , nodeType
+  cpt props@{ disabled
             , linkId
             , linkNodeType
+            , nodeId
+            , nodeType
             , parentId
             , reload
             , session
             , style
             , text
-            , disabled
             } _ = do
     -- | States
     -- |
@@ -225,12 +225,12 @@ folderCpt = here.component "folderCpt" cpt where
         [
           nodePopupView
           { boxes
+          , closeCallback: \_ -> T.write_ false isBoxVisible
           , dispatch: dispatch
           , id: props.nodeId
           , nodeType: props.nodeType
           , name: props.text
-          , session: props.session
-          , closeCallback: \_ -> T.write_ false isBoxVisible
+          , session
           }
         ]
       ]

src/Gargantext/Components/Forest/Tree/Node.purs

@@ -342,11 +342,11 @@ nodeSpanCpt = here.component "nodeSpan" cpt
             [
               nodePopupView
               { boxes
+              , closeCallback: \_ -> T.write_ false isBoxVisible
               , dispatch
               , id
               , name
               , nodeType
-              , closeCallback: \_ -> T.write_ false isBoxVisible
               , session
               }
             ]

src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchField.purs

@@ -143,7 +143,7 @@ componentWithIMTOrgsCpt :: R.Component ComponentWithIMTOrgsProps
 componentWithIMTOrgsCpt = here.component "componentWithIMTOrgs" cpt where
   cpt { schools, search } _ = do
     search' <- T.useLive T.unequal search
-  
+
     let allIMTOrgs = [All_IMT] <> (IMT_org <$> schools)
         liCpt org =
           H.li {}
@@ -156,7 +156,7 @@ componentWithIMTOrgsCpt = here.component "componentWithIMTOrgs" cpt where
                All_IMT -> H.i {} [H.text  $ " " <> show org]
                (IMT_org { school_shortName }) -> H.text $ " " <> school_shortName
           ]
-    
+
     pure $ R.fragment
       [ H.ul {} $ map liCpt $ allIMTOrgs
         --, filterInput fi
@@ -427,29 +427,29 @@ filterInput (term /\ setTerm) =
 
 type DatafieldInputProps =
   ( databases :: Array Database
-  , langs :: Array Lang
-  , search :: T.Box Search
-  , session :: Session )
+  , langs     :: Array Lang
+  , search    :: T.Box Search
+  , session   :: Session )
 
 datafieldInput :: R2.Component DatafieldInputProps
 datafieldInput = R.createElement datafieldInputCpt
 datafieldInputCpt :: R.Component DatafieldInputProps
 datafieldInputCpt = here.component "datafieldInput" cpt where
-  cpt { databases, langs, search, session} _ = do
+  cpt { databases, langs, search, session } _ = do
     search' <- T.useLive T.unequal search
     iframeRef <- R.useRef null
-    
+
     pure $ H.div {}
       [ dataFieldNav { search } []
-        
+
       , if isExternal search'.datafield
         then databaseInput { databases, search } []
         else H.div {} []
-             
+
       , if isHAL search'.datafield
         then orgInput { orgs: allOrgs, search } []
         else H.div {} []
-             
+
       , if isIMT search'.datafield
         then componentIMT { search, session } []
         else H.div {} []
@@ -457,15 +457,15 @@ datafieldInputCpt = here.component "datafieldInput" cpt where
       , if isHAL search'.datafield
         then componentYears { search } []
         else H.div {} []
-             
+
       , if isCNRS search'.datafield
         then componentCNRS { search } []
         else H.div {} []
-             
+
       , if needsLang search'.datafield
         then langNav { langs, search } []
         else H.div {} []
-             
+
       , H.div {} [ searchIframes { iframeRef, search } [] ]
       ]
 

src/Gargantext/Components/Forest/Tree/Node/Box/Types.purs

@@ -18,10 +18,10 @@ type CommonProps =
 
 type NodePopupProps =
   ( boxes           :: Boxes
+  , closeCallback   :: Unit -> Effect Unit
   , id              :: ID
   , name            :: Name
   , nodeType        :: GT.NodeType
-  , closeCallback   :: Unit -> Effect Unit
   | CommonProps
   )
 

src/Gargantext/Components/GraphExplorer/GraphTypes.purs

@@ -39,7 +39,7 @@ newtype Node = Node {
   , children   :: Array String
   , id_        :: String
   , label      :: String
-  , size       :: Number
+  , size       :: Int
   , type_      :: String
   , x          :: Number
   , y          :: Number
@@ -80,10 +80,11 @@ instance JSON.WriteForeign Node where
 
 newtype Edge = Edge {
     confluence :: Number
-  , id_ :: String
-  , source :: String
-  , target :: String
-  , weight :: Number
+  , hidden     :: Maybe Boolean
+  , id_        :: String
+  , source     :: String
+  , target     :: String
+  , weight     :: Number
   }
 
 

src/Gargantext/Components/GraphExplorer/Layout.purs

@@ -5,13 +5,12 @@ import Gargantext.Prelude hiding (max, min)
 import DOM.Simple.Types (Element)
 import Data.Array as A
 import Data.FoldableWithIndex (foldMapWithIndex)
-import Data.Int (toNumber)
+import Data.Int (floor, toNumber)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromJust)
 import Data.Nullable (null, Nullable)
 import Data.Sequence as Seq
 import Data.Set as Set
-import Data.Traversable (traverse_)
 import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Gargantext.Components.App.Store as AppStore
@@ -30,7 +29,6 @@ import Gargantext.Config (defaultFrontends)
 import Gargantext.Data.Louvain as DLouvain
 import Gargantext.Hooks.Session (useSession)
 import Gargantext.Hooks.Sigmax.ForceAtlas2 as ForceAtlas
-import Gargantext.Hooks.Sigmax.Graphology as Graphology
 import Gargantext.Hooks.Sigmax.Louvain as Louvain
 import Gargantext.Hooks.Sigmax.Noverlap as Noverlap
 import Gargantext.Hooks.Sigmax as Sigmax
@@ -200,6 +198,7 @@ layoutCpt = here.component "layout" cpt where
           { fa2Ref
           , noverlapRef
           , reloadForest: reloadForest
+          , session
           , sigmaRef
           }
         ]
@@ -270,6 +269,8 @@ graphViewCpt = R.memo' $ here.component "graphView" cpt where
 
     -- todo Cache this?
     R.useEffect' $ do
+      --here.log2 "[graphView] transformedGraph" $ transformGraph graph' transformParams
+
       --let louvain = Louvain.louvain unit in
       --let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph') (SigmaxT.louvainEdges graph') in
       --SigmaxT.louvainGraph graph' cluster
@@ -313,7 +314,8 @@ convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) SigmaxT.SGraph
 convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
   where
     normalizedNodes :: Array GEGT.Node
-    normalizedNodes = GEGT.Node <$> (GEU.normalizeNodeSizeDefault $ (\(GEGT.Node n) -> n) <$> r.nodes)
+    normalizedNodes = (\n -> GEGT.Node (n { size = floor n.size })) <$>
+                      (GEU.normalizeNodeSizeDefault $ (\(GEGT.Node n) -> n { size = toNumber n.size }) <$> r.nodes)
     nodes :: Seq.Seq (Record SigmaxT.Node)
     nodes = foldMapWithIndex nodeFn normalizedNodes
     nodeFn :: Int -> GEGT.Node -> Seq.Seq (Record SigmaxT.Node)
@@ -330,7 +332,7 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
         , highlighted: false
         , id    : n.id_
         , label : n.label
-        , size  : n.size
+        , size  : toNumber n.size
         --, size: toNumber n.size
         , type  : modeGraphType gargType
         , x     : n.x -- cos (toNumber i)

src/Gargantext/Components/GraphExplorer/Resources.purs

@@ -154,19 +154,20 @@ drawGraphCpt = here.component "drawGraph" cpt where
                                                    , showEdges: showEdges' }
 
                 -- here.log2 "[graph] startForceAtlas" startForceAtlas
-                if startForceAtlas' then
-                  case R.readRef fa2Ref of
-                    Nothing -> do
-                      fa2 <- ForceAtlas2.init (Sigma.graph sig) fa2Settings
+                case R.readRef fa2Ref of
+                  Nothing -> do
+                    fa2 <- ForceAtlas2.init (Sigma.graph sig) fa2Settings
+                    R.setRef fa2Ref (Just fa2)
+                    if startForceAtlas' then do
                       ForceAtlas2.start fa2
-                      R.setRef fa2Ref (Just fa2)
-                    Just _fa2 -> do
-                      -- TODO Kill and restart? Maybe check fa2.graph first? Should be equal to sigma.graph
+                    else do
+                      pure unit
+                  Just fa2 -> do
+                    -- TODO Kill and restart? Maybe check fa2.graph first? Should be equal to sigma.graph
+                    if startForceAtlas' then
                       pure unit
-                else
-                  case R.readRef fa2Ref of
-                    Nothing -> pure unit
-                    Just fa2 -> ForceAtlas2.stop fa2
+                    else
+                      ForceAtlas2.stop fa2
 
                 case R.readRef noverlapRef of
                   Nothing -> do
@@ -228,6 +229,8 @@ drawGraphCpt = here.component "drawGraph" cpt where
       case Tuple forceAtlasState' graphStage' of
 
         --Tuple SigmaxTypes.InitialLoading GET.Ready -> updateGraph
+        -- forceatlas can be stopped initially for eg graph snapshots
+        Tuple SigmaxTypes.InitialStopped GET.Ready -> updateGraph
         Tuple SigmaxTypes.InitialRunning GET.Ready -> updateGraph
         Tuple SigmaxTypes.Paused GET.Ready -> updateGraph
 

src/Gargantext/Components/GraphExplorer/Sidebar/DocList.purs

@@ -4,7 +4,8 @@ module Gargantext.Components.GraphExplorer.Sidebar.DocList
 
 import Gargantext.Prelude
 
-import Data.Array (concat, head)
+import Data.Array (catMaybes, concat, head)
+import Data.Array as A
 import Data.Foldable (intercalate)
 import Data.Map as Map
 import Data.Maybe (Maybe(..))
@@ -14,7 +15,7 @@ import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Bootstrap.Types (Variant(..))
-import Gargantext.Components.FacetsTable (DocumentsView(..), Rows(..), initialPagePath, loadPage, publicationDate)
+import Gargantext.Components.FacetsTable (DocumentsView(..), Rows(..), initialPagePath, initialPageGQL, loadPage, loadPageGQL, publicationDate)
 import Gargantext.Components.GraphExplorer.Store as GraphStore
 import Gargantext.Components.GraphExplorer.Types (CorpusId, DocId, GraphSideDoc(..), ListId)
 import Gargantext.Components.GraphExplorer.Types as GET
@@ -62,26 +63,17 @@ docListWrapperCpt = here.component "wrapper" cpt where
     graph'            <- R2.useLive' graph
     selectedNodeIds'  <- R2.useLive' selectedNodeIds
 
-    query' /\ query <- R2.useBox' Nothing
+    selectedNgramsTerms <- T.useBox []
 
     -- | Helpers
     -- |
     let
       nodesMap = SigmaxT.nodesGraphMap graph'
 
-      toSearchQuery ids = SearchQuery
-        { expected: SearchDoc
-        , query: concat $ toQuery <$> Set.toUnfoldable ids
-        }
-
-      toQuery id = case Map.lookup id nodesMap of
-        Nothing -> []
-        Just n -> words n.label
-
     -- | Hooks
     -- |
     R.useEffect1' selectedNodeIds' $ do
-      T.write_ (Just $ toSearchQuery selectedNodeIds') query
+      T.write_ (catMaybes $ (\id -> _.label <$> Map.lookup id nodesMap) <$> Set.toUnfoldable selectedNodeIds') selectedNgramsTerms
 
     -- | Render
     -- |
@@ -89,16 +81,16 @@ docListWrapperCpt = here.component "wrapper" cpt where
 
       R.fragment
       [
-        case (head metaData.corpusId) /\ query' of
+        case (head metaData.corpusId) /\ (Set.isEmpty selectedNodeIds') of
 
-          (Just corpusId) /\ (Just q') ->
+          (Just corpusId) /\ false ->
             docList
-            { query: q'
-            , session
-            , corpusId
+            { corpusId
+            , frontends: defaultFrontends
             , listId: metaData.list.listId
+            , selectedNgramsTerms
+            , session
             , showDoc
-            , frontends: defaultFrontends
             }
 
           _ /\ _ ->
@@ -113,12 +105,12 @@ docListWrapperCpt = here.component "wrapper" cpt where
 -------------------------------------------------------------------
 
 type ListProps =
-  ( query           :: SearchQuery
-  , corpusId        :: CorpusId
-  , listId          :: ListId
-  , session         :: Session
-  , showDoc         :: T.Box (Maybe GraphSideDoc)
-  , frontends       :: Frontends
+  ( corpusId            :: CorpusId
+  , frontends           :: Frontends
+  , listId              :: ListId
+  , selectedNgramsTerms :: T.Box (Array SigmaxT.Label)
+  , session             :: Session
+  , showDoc             :: T.Box (Maybe GraphSideDoc)
   )
 
 docList :: R2.Leaf ListProps
@@ -136,18 +128,25 @@ docListCpt = here.component "main" cpt where
       _ -> pure unit
   -- | Component
   -- |
-  cpt { query
-      , session
-      , corpusId: nodeId
+  cpt { corpusId: nodeId
+      , frontends
       , listId
+      , selectedNgramsTerms
+      , session
       , showDoc
-      , frontends
       } _ = do
     -- | States
     -- |
 
+    -- path' /\ path
+    --   <- R2.useBox' $ initialPagePath { nodeId, listId, query, session }
+
+    selectedNgramsTerms' <- T.useLive T.unequal selectedNgramsTerms
+
     path' /\ path
-      <- R2.useBox' $ initialPagePath { nodeId, listId, query, session }
+      <- R2.useBox' $ initialPageGQL { corpusId: nodeId
+                                     , ngramsTerms: A.fromFoldable selectedNgramsTerms'
+                                     , session }
 
     state' /\ state <-
       R2.useBox' Nothing
@@ -163,24 +162,30 @@ docListCpt = here.component "main" cpt where
 
     useLoaderEffect
       { errorHandler
-      , state
-      , loader: loadPage
+      , loader: loadPageGQL
       , path: path'
+      , state
       }
 
     -- | Effects
     -- |
 
     -- (on query change, reload fetched docs)
-    useUpdateEffect1' query $
-      flip T.write_ path $ initialPagePath { nodeId, listId, query, session }
+    --useUpdateEffect1' query $
+      --flip T.write_ path $ initialPagePath { nodeId, listId, query, session }
+    useUpdateEffect1' selectedNgramsTerms' $
+      flip T.write_ path $ initialPageGQL { corpusId: nodeId
+                                          , ngramsTerms: A.fromFoldable selectedNgramsTerms'
+                                          , session }
 
     -- (on fetch success, extract existing docs)
-    useUpdateEffect1' state' case state' of
-      Nothing -> T.write_ (Just Seq.empty) rows
-      Just r -> case r of
-        Docs { docs } -> T.write_ (Just docs) rows
-        _             -> T.write_ (Just Seq.empty) rows
+    useUpdateEffect1' state' do
+      here.log2 "[docList] state'" state'
+      case state' of
+        Nothing -> T.write_ (Just Seq.empty) rows
+        Just r -> case r of
+          Docs { docs } -> T.write_ (Just docs) rows
+          _             -> T.write_ (Just Seq.empty) rows
 
     -- | Computed
     -- |

src/Gargantext/Components/GraphExplorer/Toolbar/Controls.purs

@@ -11,7 +11,7 @@ import Effect.Timer (setTimeout)
 import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.GraphExplorer.Resources as Graph
 import Gargantext.Components.GraphExplorer.Store as GraphStore
-import Gargantext.Components.GraphExplorer.Toolbar.Buttons (centerButton, edgesToggleButton, louvainButton, pauseForceAtlasButton, pauseNoverlapButton, multiSelectEnabledButton)
+import Gargantext.Components.GraphExplorer.Toolbar.Buttons (cameraButton, centerButton, edgesToggleButton, louvainButton, pauseForceAtlasButton, pauseNoverlapButton, multiSelectEnabledButton)
 import Gargantext.Components.GraphExplorer.Toolbar.RangeControl (edgeConfluenceControl, nodeSizeControl)
 import Gargantext.Components.GraphExplorer.Toolbar.SlideButton (labelSizeButton, labelRenderedSizeThresholdButton, mouseSelectorSizeSlider)
 import Gargantext.Components.GraphExplorer.Types as GET
@@ -20,6 +20,7 @@ import Gargantext.Hooks.Sigmax.Noverlap as Noverlap
 import Gargantext.Hooks.Sigmax as Sigmax
 import Gargantext.Hooks.Sigmax.Sigma as Sigma
 import Gargantext.Hooks.Sigmax.Types as SigmaxT
+import Gargantext.Sessions (Session)
 import Gargantext.Types as GT
 import Gargantext.Utils.Reactix as R2
 import Gargantext.Utils.Toestand as T2
@@ -34,6 +35,7 @@ type Controls =
   ( fa2Ref       :: R.Ref (Maybe ForceAtlas.FA2Layout)
   , noverlapRef  :: R.Ref (Maybe Noverlap.NoverlapLayout)
   , reloadForest :: T2.ReloadS
+  , session      :: Session
   , sigmaRef     :: R.Ref Sigmax.Sigma
   )
 
@@ -43,7 +45,8 @@ controlsCpt :: R.Memo Controls
 controlsCpt = R.memo' $ here.component "controls" cpt where
   cpt { fa2Ref
       , noverlapRef
-      -- , reloadForest
+      , reloadForest
+      , session
       , sigmaRef
       } _ = do
     -- | States
@@ -54,7 +57,9 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
     , forceAtlasState
     , noverlapState
     , graph
+    , graphId
     , graphStage
+    , hyperdataGraph
     , labelRenderedSizeThreshold
     , labelSize
     , mouseSelectorSize
@@ -67,6 +72,8 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
     , sideTab
     } <- GraphStore.use
 
+    graphId'              <- R2.useLive' graphId
+    hyperdataGraph'       <- R2.useLive' hyperdataGraph
     forceAtlasState'      <- R2.useLive' forceAtlasState
     noverlapState'        <- R2.useLive' noverlapState
     graphStage'           <- R2.useLive' graphStage
@@ -169,16 +176,15 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
             , pauseNoverlapButton { state: noverlapState }
             ,
               gap
-{-            ,
+            ,
               cameraButton
               { id: graphId'
               , forceAtlasState
               , hyperdataGraph: hyperdataGraph'
               , reloadForest
-              , session: session
+              , session
               , sigmaRef: sigmaRef
               }
--}
             ]
           ,
             -- View Settings

src/Gargantext/Components/GraphExplorer/Utils.purs

@@ -25,7 +25,7 @@ import Gargantext.Utils.Lens as GUL
 import Gargantext.Utils.Seq as GUS
 
 stEdgeToGET :: Record ST.Edge -> GEGT.Edge
-stEdgeToGET { _original } = _original
+stEdgeToGET { _original: GEGT.Edge original, hidden } = GEGT.Edge $ original { hidden = Just hidden }
 
 stNodeToGET :: Record ST.Node -> GEGT.Node
 stNodeToGET { id, label, x, y, _original: GEGT.Node { attributes, size, type_ } } = GEGT.Node {

src/Gargantext/Components/GraphQL.purs

@@ -72,15 +72,16 @@ queryGql session name q = do
 
 -- Schema
 type Schema
-  = { imt_schools :: {} ==> Array GQLIMT.School
+  = { annuaire_contacts :: { contact_id :: Int } ==> Array AnnuaireContact
     , contexts :: { context_id :: Int, node_id :: Int } ==> Array GQLCTX.NodeContext
-    , nodes :: { node_id :: Int } ==> Array Node
+    , contexts_for_ngrams :: { corpus_id :: Int, ngrams_terms :: Array String } ==> Array GQLCTX.Context
+    , imt_schools :: {} ==> Array GQLIMT.School
     , node_parent :: { node_id :: Int, parent_type :: String } ==> Array Node  -- TODO: parent_type :: NodeType
+    , nodes :: { node_id :: Int } ==> Array Node
     , user_infos :: { user_id :: Int } ==> Array UserInfo
     , users :: { user_id :: Int } ==> Array User
-    , tree :: { root_id :: Int } ==> TreeFirstLevel
-    , annuaire_contacts :: { contact_id :: Int } ==> Array AnnuaireContact
     , team :: { team_node_id :: Int } ==> Team
+    , tree :: { root_id :: Int } ==> TreeFirstLevel
     }
 
 type Mutation

src/Gargantext/Components/GraphQL/Context.purs

 module Gargantext.Components.GraphQL.Context
-  ( NodeContext
+  ( Context_
+  , Context
+  , Hyperdata_
+  , Hyperdata
+  , NodeContext
   , NodeContext_
   , nodeContextQuery
   , NodeContextCategoryM
+  , contextsForNgramsQuery
+  , NgramsTerms(..)
   ) where
 
 import Gargantext.Prelude
 
+import Data.Argonaut (class EncodeJson, encodeJson)
 import Data.Lens (Lens', lens)
 import Data.Maybe (Maybe(..), fromMaybe)
-import GraphQL.Client.Args (Args, NotNull, (=>>))
+import GraphQL.Client.Args (Args, NotNull, (=>>), class ArgGql)
 import GraphQL.Client.Variable (Var(..))
+import GraphQL.Client.Variables.TypeName (class VarTypeName, varTypeName)
 import Gargantext.Utils.GraphQL as GGQL
 import Type.Proxy (Proxy(..))
 
 import Data.Array as A
 
+type Context_
+  = ( c_id        :: Int
+    , c_name      :: String
+    , c_typename  :: Int
+    , c_date      :: String
+    , c_hash_id   :: Maybe String
+    , c_user_id   :: Int
+    , c_parent_id :: Maybe Int
+    , c_category  :: Maybe Int
+    , c_score     :: Maybe Int  -- TODO: Maybe Double
+    , c_hyperdata :: Maybe Hyperdata )
+
+type Context = Record Context_
+
+type Hyperdata_
+  = ( hrd_abstract           :: String
+    , hrd_authors            :: String
+    , hrd_bdd                :: String
+    , hrd_doi                :: String
+    , hrd_institutes         :: String
+    , hrd_language_iso2      :: String
+    , hrd_page               :: Int
+    , hrd_publication_date   :: String
+    , hrd_publication_day    :: Int
+    , hrd_publication_hour   :: Int
+    , hrd_publication_minute :: Int
+    , hrd_publication_month  :: Int
+    , hrd_publication_second :: Int
+    , hrd_publication_year   :: Int
+    , hrd_source             :: String
+    , hrd_title              :: String
+    , hrd_url                :: String
+    , hrd_uniqId             :: String
+    , hrd_uniqIdBdd          :: String )
+
+type Hyperdata = Record Hyperdata_
+
 type NodeContext_
   = ( nc_id         :: Maybe Int
     , nc_node_id    :: Int
@@ -44,6 +89,49 @@ nodeContextQuery
       GGQL.getFieldsStandard (Proxy :: _ NodeContext)
     }
 
+type ContextsForNgramsQuery
+  = { contexts_for_ngrams :: Args
+      { corpus_id    :: Var "corpus_id" Int
+      , ngrams_terms :: Var "ngrams_terms" NgramsTerms }
+      { c_id                        :: Unit
+      , c_score                     :: Unit
+      , c_date                      :: Unit
+      , c_name                      :: Unit
+      , c_typename                  :: Unit
+      , c_hash_id                   :: Unit
+      , c_user_id                   :: Unit
+      , c_parent_id                 :: Unit
+      , c_category                  :: Unit
+      , c_hyperdata                 ::
+           { hrd_abstract           :: Unit
+           , hrd_authors            :: Unit
+           , hrd_bdd                :: Unit
+           , hrd_doi                :: Unit
+           , hrd_institutes         :: Unit
+           , hrd_language_iso2      :: Unit
+           , hrd_page               :: Unit
+           , hrd_publication_date   :: Unit
+           , hrd_publication_day    :: Unit
+           , hrd_publication_hour   :: Unit
+           , hrd_publication_minute :: Unit
+           , hrd_publication_month  :: Unit
+           , hrd_publication_second :: Unit
+           , hrd_publication_year   :: Unit
+           , hrd_source             :: Unit
+           , hrd_title              :: Unit
+           , hrd_url                :: Unit
+           , hrd_uniqId             :: Unit
+           , hrd_uniqIdBdd          :: Unit }
+      }
+    }
+contextsForNgramsQuery :: ContextsForNgramsQuery
+contextsForNgramsQuery
+  = { contexts_for_ngrams:
+      { corpus_id:    Var :: _ "corpus_id" Int
+      , ngrams_terms: Var :: _ "ngrams_terms" NgramsTerms } =>>
+      GGQL.getFieldsStandard (Proxy :: _ Context)
+    }
+
 ------------------------------------------------------------------------
 
 type NodeContextCategoryM
@@ -51,3 +139,12 @@ type NodeContextCategoryM
     , node_id    :: NotNull Int
     , category   :: Int
     }
+
+
+newtype NgramsTerms = NgramsTerms (Array String)
+
+instance EncodeJson NgramsTerms where
+  encodeJson (NgramsTerms ngramsTerms) = encodeJson ngramsTerms
+instance ArgGql String NgramsTerms
+instance VarTypeName NgramsTerms where
+  varTypeName _ = "[String!]!"

src/Gargantext/Components/GraphQL/Endpoints.purs

@@ -101,12 +101,23 @@ deleteTeamMembership session sharedFolderId teamNodeId = do
 
 getNodeContext :: Session -> Int -> Int -> AffRESTError GQLCTX.NodeContext
 getNodeContext session context_id node_id = do
-  { contexts } <- queryGql session "get node context" $ GQLCTX.nodeContextQuery `withVars` { context_id, node_id }
+  let query = GQLCTX.nodeContextQuery `withVars` { context_id, node_id }
+  { contexts } <- queryGql session "get node context" query
   --liftEffect $ here.log2 "[getNodeContext] node context" contexts
   case A.head contexts of
     Nothing -> pure $ Left $ CustomError "no node context found"
     Just context -> pure $ Right context -- TODO: error handling
 
+type ContextsForNgramsGQL = { contexts_for_ngrams :: Array GQLCTX.Context }
+getContextsForNgrams :: Session -> Int -> Array String -> AffRESTError (Array GQLCTX.Context)
+getContextsForNgrams session corpus_id ngrams_terms = do
+  let query = GQLCTX.contextsForNgramsQuery `withVars` { corpus_id
+                                                       , ngrams_terms: GQLCTX.NgramsTerms ngrams_terms }
+  { contexts_for_ngrams } <- queryGql session "get contexts for ngrams" query
+
+  pure $ Right contexts_for_ngrams
+  --pure $ Right contexts_for_ngrams
+
 updateNodeContextCategory :: Session -> Int -> Int -> Int -> AffRESTError Int
 updateNodeContextCategory session context_id node_id category = do
   client <- liftEffect $ getClient session

src/Gargantext/Components/NgramsTable.purs

@@ -101,8 +101,8 @@ initialState =
   , ngramsVersion:    0
   }
 
-initialStateWithVersion :: VersionedNgramsTable -> State
-initialStateWithVersion (Versioned { version }) = initialState { ngramsVersion = version }
+-- initialStateWithVersion :: VersionedNgramsTable -> State
+-- initialStateWithVersion (Versioned { version }) = initialState { ngramsVersion = version }
 
 setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action
 setTermListSetA ngramsTable ns new_list =
@@ -813,7 +813,7 @@ mainNgramsTable = R.createElement mainNgramsTableCpt
 mainNgramsTableCpt :: R.Component MainNgramsTableProps
 mainNgramsTableCpt = here.component "mainNgramsTable" cpt
   where
-    cpt props@{ cacheState, path, treeEdit } _ = do
+    cpt props@{ cacheState, path } _ = do
       searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
       params <- T.useFocused (_.params) (\a b -> b { params = a }) path
       cacheState' <- T.useLive T.unequal cacheState

src/Gargantext/Components/Nodes/Graph.purs

@@ -6,10 +6,9 @@ import Gargantext.Prelude
 
 import Data.Array as A
 import Data.Int as I
-import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
+import Data.Maybe (Maybe(..), isJust, maybe)
 import Data.Sequence as Seq
 import Data.Tuple (Tuple(..))
-import Data.Tuple.Nested ((/\))
 import DOM.Simple (document, querySelector)
 import Gargantext.Components.App.Store as AppStore
 import Gargantext.Components.Bootstrap as B
@@ -29,7 +28,6 @@ import Gargantext.Utils (getter)
 import Gargantext.Utils.Range as Range
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
-import Reactix.DOM.HTML as H
 import Record as Record
 import Toestand as T
 
@@ -176,10 +174,10 @@ hydrateStoreCpt = here.component "hydrateStore" cpt where
     --let edgeWeightMin = maybe 0.0 _.weight $ A.head edgesWeightSorted
     --let edgeWeightMax = maybe 100.0 _.weight $ A.last edgesWeightSorted
     --let edgeWeightRange = Range.Closed { min: edgeWeightMin, max: edgeWeightMax }
-    let edgeWeightRange = Range.Closed {
-          min: 0.0
-        , max: I.toNumber $ Seq.length $ SigmaxT.graphEdges graph
-        }
+    -- let edgeWeightRange = Range.Closed {
+    --       min: 0.0
+    --     , max: I.toNumber $ Seq.length $ SigmaxT.graphEdges graph
+    --     }
 
     let nodesSorted = A.sortWith (_.size) $ Seq.toUnfoldable $ SigmaxT.graphNodes graph
     let nodeSizeMin = maybe 0.0 _.size $ A.head nodesSorted

src/Gargantext/Ends.purs

@@ -147,14 +147,8 @@ sessionPath (R.NodeAPI nt i p) = nodeTypePath nt
                               <> (if p == "" then "" else "/" <> p)
 sessionPath (R.TreeFirstLevel nId p) = nodeTypePath Tree
                                     <> (maybe "" (\nId' -> "/" <> show nId') nId) <> "/first-level" <> p
-sessionPath (R.Search {listId, limit, offset, orderBy} Nothing) =
-  sessionPath $ R.NodeAPI Corpus Nothing
-     $ "search?list_id=" <> show listId
-    <> offsetUrl offset
-    <> limitUrl limit
-    <> orderUrl orderBy
-sessionPath (R.Search {listId, limit, offset, orderBy} (Just corpusId)) =
-  sessionPath $ R.NodeAPI Corpus (Just corpusId)
+sessionPath (R.Search {listId, limit, offset, orderBy} mCorpusId) =
+  sessionPath $ R.NodeAPI Corpus mCorpusId
      $ "search?list_id=" <> show listId
     <> offsetUrl offset
     <> limitUrl limit

src/Gargantext/Hooks/Sigmax/Louvain.js

@@ -7,7 +7,7 @@ import louvain from 'graphology-communities-louvain';
 export function _assign(graph, options) {
   louvain.assign(graph, {
     getEdgeWeight: 'weight',
-    resolution: 2
+    resolution: 0.8
   });
   return graph;
 }

src/Gargantext/Hooks/Sigmax/Louvain.purs

@@ -16,6 +16,7 @@ import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4, runEffectFn
 import FFI.Simple ((..), (...), (.=))
 import Gargantext.Data.Louvain as DLouvain
 import Gargantext.Hooks.Sigmax.Graphology as Graphology
+import Gargantext.Hooks.Sigmax.Operators as Operators
 import Gargantext.Hooks.Sigmax.Types as Types
 import Record as Record
 
@@ -34,7 +35,7 @@ assignVisible :: forall settings. Graphology.Graph -> settings -> Effect Graphol
 assignVisible g s = do
   n <- Graphology.copy g
   Graphology.updateGraphOnlyVisible n
-  assign n s
+  assign (Operators.toUndirected n) s
 
 -- \[{ id, community }] -> { id: community }
 cluster :: Graphology.Graph -> DLouvain.LouvainCluster

src/Gargantext/Hooks/Sigmax/Operators.js

+'use strict';
+
+// https://graphology.github.io/standard-library/operators
+
+import { toUndirected } from 'graphology-operators';
+
+export function _toUndirected(graph) {
+  return toUndirected(graph);
+}

src/Gargantext/Hooks/Sigmax/Operators.purs

+module Gargantext.Hooks.Sigmax.Operators where
+
+-- FFI for operators: https://graphology.github.io/standard-library/operators
+
+import Prelude
+
+import Data.Array as A
+import Data.Function.Uncurried (Fn1, runFn1)
+import Data.Map as Map
+import Data.Sequence as Seq
+import Data.Set as Set
+import Data.Traversable (traverse)
+import Data.Tuple (Tuple(..))
+import Effect (Effect)
+import Gargantext.Data.Louvain as DLouvain
+import Gargantext.Hooks.Sigmax.Graphology as Graphology
+import Gargantext.Hooks.Sigmax.Types as Types
+import Record as Record
+
+foreign import _toUndirected :: Fn1 Graphology.Graph Graphology.Graph
+
+toUndirected :: Graphology.Graph -> Graphology.Graph
+toUndirected = runFn1 _toUndirected

src/Gargantext/Hooks/Sigmax/Types.purs

@@ -38,6 +38,8 @@ type Renderer = { "type" :: String, container :: Element }
 type NodeId = String
 type EdgeId = String
 
+type Label = String
+
 type Node = (
     borderColor :: String
   , children    :: Array String
@@ -48,7 +50,7 @@ type Node = (
   , hidden      :: Boolean
   , highlighted :: Boolean
   , id          :: NodeId
-  , label       :: String
+  , label       :: Label
   , size        :: Number
   , type        :: String  -- available types: circle, cross, def, diamond, equilateral, pacman, square, star
   , x           :: Number

src/Gargantext/Utils/Reactix.purs

@@ -297,9 +297,6 @@ useReductor f i j =
 useReductor' :: forall s a. Actor s a -> s -> R.Hooks (Reductor s a)
 useReductor' r = useReductor r pure
 
-render :: R.Element -> DOM.Element -> Effect Unit
-render e d = delay unit $ \_ -> pure $ R.reactDOM ... "render" $ args2 e d
-
 addRootElement :: DOM.Element -> Effect Unit
 addRootElement = runEffectFn1 _addRootElement
 

src/Main.purs

@@ -8,7 +8,8 @@ import Effect (Effect)
 import FFI.Simple ((...))
 import Gargantext.Components.App as App
 import Gargantext.Utils.Reactix as R2
-import Prelude (Unit, ($))
+import Prelude (Unit, ($), bind)
+import Reactix as R
 
 here :: R2.Here
 here = R2.here "Gargantext.Main"
@@ -18,6 +19,7 @@ main = paint $ toMaybe (document ... "getElementById" $ [ "app" ])
 
 paint :: Maybe Element -> Effect Unit
 paint Nothing  = here.error "[main] Container not found"
-paint (Just c) = R2.render app c
+paint (Just c) = do
+  R.render app c
   where
     app = App.app {}