Merge branch 'dev' into dev-phylo-dates-with-hh-mm-ss-2

CHANGELOG.md

+## Version 0.0.7.5.2
+
+* [BACK/FRONT][FIX][[query] a prefixed query like ~prefix should transform to 'prefix', not '"prefix'](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/443)
+* [BACK][OPTIM][Separate ngram extraction from document insertion](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/415)
+* [BACK][FIX][Keep only the roots in searchTableNgrams](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/439)
+* [BACK/FRONT][OPTIM][Dev add option to notify users](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/438) and [[notifications] add possibility to notify user from the backend](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/merge_requests/520)
+* [BACK][FIX][Dev worker fixes](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/447)
+* [BACK][FIX][Dev allow for api error in flow](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/440)
+
+## Version 0.0.7.5.1
+
+* [BACK/FRONT][FIX][[search] small refactoring of the search API](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/441) and [[query] a prefixed query like ~prefix should transform to 'prefix', not '"prefix'](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/443)
+* [BACK][FIX][[CLI] db fix command, to fix hyperdata #630](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/505)
+* [BACK][OPTIM][Add the ability to emit logging messages from a `DbTx` transaction](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/436)
+* [BACK][OPTIM][Prevent importing ngrams which will lead to loops](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/435)
+* [FRONT][FIX][[graph] fix updateGraph function so that labels are rendered properly](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/merge_requests/521)
+
+## Version 0.0.7.5
+
+* [BACK][UPGRADE][Allow ngrams to be searched even if they appear deeply nested](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/433)
+* [BACK][FIX][[cli] add support to spawn multiple workers of the same type](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/437)
+* [FRONT][FIX][Resolve "Problem with related terms"](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/merge_requests/518)
+* [BACK/FRONT][OPTIM][[API] version with git hash](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/422) and [Resolve "Inject commit hash in the version popup"](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/merge_requests/517)
+
+## Version 0.0.7.4.9
+
+* [FRONT][FIX][Dev support emitting warnings](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/merge_requests/519)
+* [BACK][FIX][Forest of trees: restore hierarchical grouping of terms](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/424)
+* [BACK][UPGRADE][[BREAKING] refactoring of fc_url](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/405)
+* [BACK][FIX][Resolve "[Node Terms] On multiple Map terms, if the first term is already a map term, the count of the multiple map term is to zero"](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/414)
+* [BACK][UPGRADE][Resolve "Move corenlp to separate repo/flake"](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/434)
+
 ## Version 0.0.7.4.8
 
 * [BACK][UPGRADE][Upgrade GHC to 9.6.x (#436)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/436) and [Try to drop dependency on `accelerate-llvm` and the entire `llvm` stack (#291)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/291)

README.md

@@ -110,3 +110,16 @@ nix-shell --run "npm run css"
 ```
 
 
+
+#### Feature flags
+
+Some functionality is hidden behind feature flags (mostly it's because
+the work is in progress). To enable "expert" mode, issue this in your
+JS console:
+```javascript
+document.cookie = 'expert=true'
+```
+To unset expert mode:
+```javascript
+document.cookie = 'expert=false'
+```

flake.nix

@@ -45,14 +45,6 @@
         fi
       '';
       
-      
-      build-zephyr = pkgs.writeShellScriptBin "build-zephyr" ''
-        set -e
-    
-        npm spago build --purs-args '--codegen corefn,js'
-        zephyr -f Main.main
-        browserify-zephyr
-      '';
     
       minify-bundle = pkgs.writeShellScriptBin "minify-bundle" ''
         set -e
@@ -123,7 +115,9 @@
               # compile
 
               echo "Bundling"
+              echo "{\"commit_hash\": \"$(git rev-parse HEAD)\"}" > .commit-hash.json
               npm run bundle
+              rm .commit-hash.json
               '';
             };
             test-ps = pkgs.writeShellApplication {
@@ -170,7 +164,6 @@
               self.packages.${system}.test-ps
               self.packages.${system}.repl
               setup-gitblame
-              build-zephyr
               minify-bundle
               serve
             ]);

package-lock.json

 {
   "name": "GarganText",
-  "version": "0.0.7.4.8",
+  "version": "0.0.7.5.2",
   "lockfileVersion": 3,
   "requires": true,
   "packages": {
     "": {
       "name": "GarganText",
-      "version": "0.0.7.4.8",
+      "version": "0.0.7.5.2",
       "dependencies": {
         "@fontsource/crete-round": "~5.0.12",
         "@fontsource/montserrat": "~5.0.17",

package.json

 {
   "name": "GarganText",
-  "version": "0.0.7.4.8",
+  "version": "0.0.7.5.2",
   "scripts": {
     "build": "spago build",
     "bundle": "spago bundle --module Main --outfile dist/bundle.min.js --minify --source-maps",

src/Gargantext/Components/App/App.purs

@@ -2,6 +2,7 @@ module Gargantext.Components.App (app) where
 
 import Gargantext.Prelude
 
+import Data.Array as A
 import Data.Sequence as Seq
 import Data.Tuple.Nested ((/\))
 import Gargantext.AsyncTasks as GAT
@@ -14,7 +15,7 @@ import Gargantext.Hooks (useHashRouter)
 import Gargantext.Hooks.FirstEffect (useFirstEffect')
 import Gargantext.Router as Router
 import Gargantext.Sessions as Sessions
-import Gargantext.Types (CacheParams, defaultCacheParams)
+import Gargantext.Types (CacheParams, defaultCacheParams, FrontendError(FStringNotification))
 import Gargantext.Utils (getter, host)
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
@@ -122,6 +123,15 @@ mainAppCpt = here.component "main" cpt
       wsProto <- Notifications.wsProtocol
       h <- host
       Notifications.connect ws (wsProto <> "://" <> h <> "/ws") session
+
+      -- Subscribe to ping requests (e.g. NotifyUser)
+      let
+        callback n = case n of
+          NotificationsT.NNotifyUser _userId notification -> T.modify_ (A.cons $ FStringNotification { notification }) boxes.errors
+          _ -> here.log2 "ping received but not handled" n
+      let action = NotificationsT.InsertCallback NotificationsT.Ping "ping!" callback
+      Notifications.performAction ws action
+
     -- T.write_ ws boxes.wsNotification
     -- NOTE: Dummy subscription
     -- let action = NotificationsT.InsertCallback (NotificationsT.UpdateTree (-1)) "some-uuid" (\_ -> here.log "callback!")

src/Gargantext/Components/ErrorsView.purs

@@ -38,6 +38,7 @@ componentCpt = here.component "main" cpt
 
   showError errors i (FStringError { error }) = errorAlert errors i "danger" error
   showError errors i (FStringWarning { warning }) = errorAlert errors i "warning" warning
+  showError errors i (FStringNotification { notification }) = errorAlert errors i "info" notification
   showError errors i (FRESTError { error }) = errorAlert errors i "danger" (show error)
   showError errors i (FOtherError { error }) = errorAlert errors i "danger" (show error)
 

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

@@ -11,6 +11,7 @@ import Data.Foldable (intercalate)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), maybe)
 import Data.String.Regex as Regex
+import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff)
 import Effect.Class (liftEffect)
@@ -36,6 +37,7 @@ import Gargantext.Context.Progress (asyncContext, asyncProgress)
 import Gargantext.Ends (Frontends, url)
 import Gargantext.Hooks.Loader (useLoader)
 import Gargantext.Hooks.UpdateEffect (useUpdateEffect1')
+import Gargantext.Hooks.UseFeatureFlag as Feature
 import Gargantext.Hooks.Version (Version, useVersion)
 import Gargantext.Routes as Routes
 import Gargantext.Sessions (Session, sessionId)
@@ -738,7 +740,9 @@ listNodeActionsLoadedCpt = here.component "listNodeActionsLoaded" cpt
 
 type VersionComparatorProps =
   ( clientVersion :: Version
+  , clientCommit :: String
   , remoteVersion :: Version
+  , remoteCommit :: String
   )
 
 versionComparator :: R2.Leaf VersionComparatorProps
@@ -747,41 +751,46 @@ versionComparator = R2.leaf versionComparatorCpt
 versionComparatorCpt :: R.Component VersionComparatorProps
 versionComparatorCpt = here.component "versionComparator" cpt
   where
-  cpt { clientVersion, remoteVersion } _
-    | clientVersion == remoteVersion = pure $
-        B.caveat
-          { variant: Success
-          , className: "mainleaf__version-comparator"
-          }
-          [ B.b_ "Versions match"
-          , content clientVersion remoteVersion
-          ]
-    | otherwise = pure $
-        B.caveat
-          { variant: Warning
-          , className: "mainleaf__version-comparator"
-          }
-          [ B.b_ "Versions mismatch"
-          , content clientVersion remoteVersion
+  cpt { clientCommit, clientVersion, remoteVersion, remoteCommit } _ = do
+    let
+      Tuple variant msg =
+        if clientVersion == remoteVersion then Tuple Success "Versions match"
+        else Tuple Warning "Versions mismatch"
+
+      commitEl hash =
+        H.span {}
+          [ H.text " ("
+          , B.code_ hash
+          , H.text ")"
           ]
 
-  content :: Version -> Version -> R.Element
-  content clientVersion remoteVersion =
-    H.ul
-      {}
-      [ H.li
-          {}
-          [ B.span_ "frontend: "
-          , H.text $ nbsp 1
-          , B.code_ clientVersion
-          ]
-      , H.li
-          {}
-          [ B.span_ "backend: "
-          , H.text $ nbsp 1
-          , B.code_ remoteVersion
-          ]
-      ]
+    pure $
+      B.caveat
+        { variant
+        , className: "mainleaf__version-comparator"
+        }
+        [ B.b_ msg
+        , H.ul {}
+            [ H.li {}
+                [ B.span_ "frontend: "
+                , H.text $ nbsp 1
+                , B.code_ clientVersion
+                , Feature.hide
+                    { keys: [ "expert" ]
+                    , render: commitEl clientCommit
+                    }
+                ]
+            , H.li {}
+                [ B.span_ "backend: "
+                , H.text $ nbsp 1
+                , B.code_ remoteVersion
+                , Feature.hide
+                    { keys: [ "expert" ]
+                    , render: commitEl remoteCommit
+                    }
+                ]
+            ]
+        ]
 
 -------------------------------------------------------
 

src/Gargantext/Components/GraphExplorer/Resources.purs

@@ -216,6 +216,9 @@ drawGraphCpt = here.component "drawGraph" cpt
                   , edgeWeight: edgeWeight'
                   , showEdges: showEdges'
                   }
+                -- #512 make sure labels are rendered according to forceAtlasState
+                let renderLabels = SigmaxTypes.forceAtlasLabelState forceAtlasState'
+                Sigma.setSettings sigma { renderLabels }
 
           -- TODO This is a temporary solution that seems to fix
           -- blank page of graph when there are too many edges. It

src/Gargantext/Components/GraphExplorer/Sidebar.purs

@@ -513,11 +513,11 @@ neighborhoodCpt = R.memo' $ here.component "neighborhood" cpt
       flip T.listen expandNeighborhood onExpandNeighborhoodChange
 
     R.useEffect1' selectedNodeIds' do
-      let refreshed = neighbourBadges graph' selectedNodeIds'
-      let count = Seq.length refreshed
-      let ordered = A.sortWith (\n -> -n.size) $ Seq.toUnfoldable refreshed
-      T.write_ (count - 1) termCountBox
-      T.write_ ordered termListBox
+      let neighbours' = SigmaxT.neighborsSortedByEdgeWeight graph' selectedNodeIds'
+      let count = A.length neighbours'
+
+      T.write_ count termCountBox
+      T.write_ neighbours' termListBox
       T.write_ false showMoreBox
 
     -- | Render
@@ -684,11 +684,6 @@ badgeSize minSize maxSize size =
 badges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
 badges graph selectedNodeIds = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
 
-neighbourBadges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
-neighbourBadges graph selectedNodeIds = SigmaxT.neighbors graph selectedNodes'
-  where
-  selectedNodes' = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
-
 ---------------------------------------------------------
 
 type SendPatches =

src/Gargantext/Components/Notifications.purs

@@ -142,7 +142,7 @@ performAction ws (RemoveCallback topic uuid) = do
 -- WSNotification $ ws' { state = removeCallback ws'.state topic uuid }
 performAction (WSNotification ws') (Call notification) = do
   state <- Ref.read ws'.state
-  -- here.log2 "[performAction Call] state" state
+  -- here.log2 "[performAction Call] notification" notification
   callNotification state notification
 
 -- | Correctly choose between "ws" and "wss" protocols based on what

src/Gargantext/Components/Notifications/Types.purs

@@ -18,6 +18,7 @@ import Effect.Timer (setTimeout)
 import Effect.Var (($=))
 import Effect.Var as Var
 import Foreign as F
+import Gargantext.Components.Login.Types (UserId)
 import Gargantext.Sessions.Types (Session(..))
 import Gargantext.Types as GT
 import Gargantext.Utils.Reactix as R2
@@ -37,6 +38,7 @@ type UUID = String
 data Topic
   = UpdateWorkerProgress GT.WorkerTask
   | UpdateTree NodeId
+  | Ping
 
 derive instance Generic Topic _
 instance Eq Topic where
@@ -58,6 +60,8 @@ instance JSON.ReadForeign Topic where
       "update_tree" -> do
         { node_id } <- JSON.readImpl f :: F.F { node_id :: NodeId }
         pure $ UpdateTree node_id
+      "ping" -> do
+        pure Ping
       s -> F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unknown Topic type: " <> s
 
 instance JSON.WriteForeign Topic where
@@ -69,6 +73,9 @@ instance JSON.WriteForeign Topic where
     { "type": "update_tree"
     , node_id
     }
+  writeImpl Ping = JSON.writeImpl
+    { "type": "ping"
+    }
 
 data WSRequest
   = WSSubscribe Topic
@@ -98,6 +105,7 @@ instance JSON.WriteForeign WSRequest where
 data Notification
   = NUpdateWorkerProgress GT.WorkerTask GT.AsyncTaskLog
   | NUpdateTree NodeId
+  | NNotifyUser UserId String
 
 derive instance Generic Notification _
 instance JSON.ReadForeign Notification where
@@ -110,6 +118,9 @@ instance JSON.ReadForeign Notification where
       "update_tree" -> do
         { node_id } <- JSON.readImpl f :: F.F { node_id :: NodeId }
         pure $ NUpdateTree node_id
+      "notify_user" -> do
+        { user_id, message } <- JSON.readImpl f :: F.F { user_id :: UserId, message :: String }
+        pure $ NNotifyUser user_id message
       s -> F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unkown type: " <> s
 
 notificationTopics :: Notification -> Array Topic
@@ -123,6 +134,7 @@ notificationTopics (NUpdateWorkerProgress workerTask@(GT.WorkerTask { node_id })
     Nothing -> []
     Just nId -> [ UpdateTree nId ]
 notificationTopics (NUpdateTree nodeId) = [ UpdateTree nodeId ]
+notificationTopics (NNotifyUser _ _) = [ Ping ]
 
 type Callback = Notification -> Effect Unit
 

src/Gargantext/Hooks/Sigmax/Types.purs

@@ -18,7 +18,7 @@ import Gargantext.Data.Louvain as Louvain
 import Gargantext.Types as GT
 import Gargantext.Utils.Range as Range
 import Partial.Unsafe (unsafePartial)
-import Prelude (class Eq, class Show, ($), (&&), (==), (||), (<$>), mod, not, (<=))
+import Prelude (class Eq, class Show, ($), (&&), (==), (||), (<$>), mod, not, (<=), negate)
 import Record.Unsafe (unsafeGet, unsafeSet)
 
 newtype Graph n e = Graph { edges :: Seq.Seq { | e }, nodes :: Seq.Seq { | n } }
@@ -214,11 +214,13 @@ sub graph (Graph { nodes, edges }) = newGraph
   filteredEdges = edgesFilter edgeFilterFunc graph
   newGraph = nodesFilter (\n -> not (Set.member n.id nodeIds)) filteredEdges
 
-neighbors :: SGraph -> Seq.Seq (Record Node) -> Seq.Seq (Record Node)
-neighbors g nodes = Seq.fromFoldable $ Set.unions [ if Set.size sources <= 1 then targets else sources ]
+-- | NOTE: The logic of this function is a bit iffy. See
+-- https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/749
+neighbors :: SGraph -> NodeIds -> Set.Set (Record Node)
+neighbors g nodeIds = Set.unions [ if Set.size sources <= 1 then targets else sources ]
   where
-  nodeIds = Set.fromFoldable $ Seq.map _.id nodes
-  selectedEdges = neighboringEdges g nodeIds
+  nodeIds' = Set.fromFoldable nodeIds
+  selectedEdges = neighboringEdges g nodeIds'
   sources = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.source selectedEdges
   targets = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.target selectedEdges
 
@@ -227,6 +229,12 @@ neighboringEdges g nodeIds = Seq.filter condition $ graphEdges g
   where
   condition { source, target } = (Set.member source nodeIds) || (Set.member target nodeIds)
 
+neighborsSortedByEdgeWeight :: SGraph -> NodeIds -> Array (Record Node)
+neighborsSortedByEdgeWeight g nodeIds = A.nubByEq (\n1 n2 -> n1.id == n2.id) neighbourNodes
+  where
+  neighbourNodes = (\e -> if Set.member e.source nodeIds then e.targetNode else e.sourceNode) <$> edgesSorted
+  edgesSorted = A.sortWith (\e -> -e.weight) $ A.fromFoldable (neighboringEdges g nodeIds)
+
 eqGraph :: SGraph -> SGraph -> Boolean
 eqGraph (Graph { nodes: n1, edges: e1 }) (Graph { nodes: n2, edges: e2 }) = (n1 == n2) && (e1 == e2)
 

src/Gargantext/Hooks/Version.js

 'use strict';
 
 import pkg from '../../package.json';
+import ch from '../../.commit-hash.json';
 
-let version = pkg.version
+let version = pkg.version;
+let commitHash = ch.commit_hash;
 
-export { version };
+export { version, commitHash };

src/Gargantext/Hooks/Version.purs

@@ -22,6 +22,7 @@ import Toestand as T
 
 -- | (ie. Frontend Version)
 foreign import version :: Version
+foreign import commitHash :: String
 
 type Version = String
 
@@ -33,7 +34,9 @@ type R_Input =
 type Output = Maybe R_Output
 type R_Output =
   { clientVersion :: String
+  , clientCommit :: String
   , remoteVersion :: String
+  , remoteCommit :: String
   }
 
 -- | Conditional Hooks checking release version match between client and remove
@@ -49,7 +52,9 @@ useVersion mInput = do
         Left err -> liftEffect $ log2 "[version] error" err
         Right v -> liftEffect $ flip T.write_ mOutputBox $ Just
           { clientVersion: version
-          , remoteVersion: v
+          , clientCommit: commitHash
+          , remoteVersion: v.version
+          , remoteCommit: v.commitHash
           }
   -- Hooks
   useFirstEffect' $ case mInput of
@@ -58,5 +63,5 @@ useVersion mInput = do
   -- Output
   pure mOutput
 
-getBackendVersion :: Session -> REST.AffRESTError Version
+getBackendVersion :: Session -> REST.AffRESTError { version :: Version, commitHash :: String }
 getBackendVersion (Session { backend }) = REST.get Nothing (toUrl backend "version")

src/Gargantext/Types.purs

@@ -922,6 +922,7 @@ toggleSidePanelState Opened = Closed
 data FrontendError
   = FStringError { error :: String }
   | FStringWarning { warning :: String }
+  | FStringNotification { notification :: String }
   | FRESTError { error :: RESTError }
   | FOtherError { error :: String }