Merge branch 'dev' into 396-dev-team-management

CHANGELOG.md

+## Version 0.0.5.9.4
+* [FIX] Arxiv API fix
+* [DESIGN/ERGO] Tree node position highlight
+
+## Version 0.0.5.9.3
+* [FEAT] Graph options with Links Strength
+
+## Version 0.0.5.9.2
+* [FEAT] User description field to User page
+* [FIX] Ngrams Table cache on
+* [FEAT] Ngrams Status change from Phylo Explorer
+* [OPTIM] Graph Order 2 generation
+* [FIX] Forgot password improvement
+
+## Version 0.0.5.9.1
+* [FIX] Graph self referencing nodes
+* [FIX] Ngrams Table Tree CSS
+* [FIX] Ngrams Table Search with enter only
+* [FIX] Graph build: removing mergechildren function for tests
+
+## Version 0.0.5.9
+* [FIX] Annuaire Contact Page
+* [WIP] Graph Debug (mergeNgrams enabled again)
+
+## Version 0.0.5.8.9.9
+* [FIX] Debug Graph Labels
+* [FIX] schema upgraded, use 0.0.5.7.8.sql to upgrade your database
+* [FEAT] Script to create and sending email to user: invitation
+
+## Version 0.0.5.8.9.8
+* [ERGO] NgramsTable, change group and search for ngrams to add
+* [FIX] Board, Source Chart fix
+
+## Version 0.0.5.8.9.7
+* [FEAT] Infomap Clustering
+
+## Version 0.0.5.8.9.6
+* [FIX] IsTex crawler working with basic queries (i.e. without quotes)
+
+## Version 0.0.5.8.9.5
+* [FIX] FrontEnd maybe ParentId
+* [FIX] IsTex crawler
+
+## Version 0.0.5.8.9.4
+* [FE] [FEAT] Phylo Explorer, interactions with documents
+* [FE] [ERGO] Fonts in Ngrams Table
+
 ## Version 0.0.5.8.9.3
 * [BE] [FIX] garg password function
 * [FE] [FIX] Trees closing/opening issue

bin/backup

+#!/bin/bash
+
+# 0 3 * * * pg_dump --dbname=$MYDB | gzip > ~/backup/db/$(date +%Y-%m-%d).psql.gz
+
+if [[ $1 == "" || $2 == "" ]]
+then echo "USAGE : ./psql gargantext.ini backup_directory"
+else 
+
+INIFILE=$1
+
+getter () {
+  grep $1 $INIFILE | sed "s/^.*= //"
+}
+
+USER=$(getter "DB_USER")
+NAME=$(getter "DB_NAME")
+PASS=$(getter "DB_PASS")
+HOST=$(getter "DB_HOST")
+PORT=$(getter "DB_PORT")
+
+
+GARGDB="postgresql://${USER}:${PASS}@${HOST}:${PORT}/${NAME}"
+
+#echo "backuping $GARGDB"
+pg_dump --dbname=$GARGDB | gzip > $2/$(date +%Y-%m-%d).garg_dump.gz
+
+
+fi

bin/gargantext-invitations/Main.hs

+{-|
+Module      : Main.hs
+Description : GarganText Mailing Invitations
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+
+ -}
+
+{-# LANGUAGE Strict            #-}
+
+module Main where
+
+import Data.Either (Either(..))
+import Gargantext.API.Dev (withDevEnv, runCmdDev)
+import Gargantext.API.Node () -- instances only
+import Gargantext.API.Prelude (GargError)
+import Gargantext.Core.Types.Individu (User(..), arbitraryNewUsers, NewUser(..), arbitraryUsername, GargPassword(..))
+import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMk_RootWithCorpus)
+import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
+import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude (CmdR)
+import Gargantext.Database.Query.Table.Node (getOrMkList)
+import Gargantext.Database.Query.Table.User (insertNewUsers, )
+import Gargantext.Prelude
+import Gargantext.Prelude.Config (GargConfig(..), readConfig)
+import Prelude (getLine)
+import System.Environment (getArgs)
+import Gargantext.Database.Action.User.New (newUsers)
+
+main :: IO ()
+main = do
+  params@[iniPath,email] <- getArgs
+
+  _ <- if length params /= 2
+      then panic "USAGE: ./gargantext-init gargantext.ini student@university.edu"
+      else pure ()
+
+  cfg       <- readConfig         iniPath
+
+  let createUsers :: CmdR GargError Int64
+      createUsers = newUsers [cs email]
+
+  withDevEnv iniPath $ \env -> do
+    _ <- runCmdDev env createUsers
+    pure ()

bin/gargantext_stop

 #!/bin/bash
 
 tmux kill-session -t gargantext
+
+docker ps -a | grep garg | awk '{print $1}' | while read p; do
+ docker stop $p && docker rm $p
+done

bin/psql

 #!/bin/bash
 
+
+if [[ $1 == "" ]]
+then echo "USAGE : ./psql gargantext.ini"
+else 
+
 INIFILE=$1
 
 getter () {
   grep $1 $INIFILE | sed "s/^.*= //"
 }
 
-connect () {
 USER=$(getter "DB_USER")
 NAME=$(getter "DB_NAME")
 PASS=$(getter "DB_PASS")
 HOST=$(getter "DB_HOST")
 PORT=$(getter "DB_PORT")
+
+# "postgresql://${USER}:${PASS}@${HOST}:${PORT}/${NAME}"
+
+GARGDB="postgresql://${USER}:${PASS}@${HOST}:${PORT}/${NAME}"
+
+#echo "connecting to $GARGDB"
+
 psql "postgresql://${USER}:${PASS}@${HOST}:${PORT}/${NAME}"
-}
 
-if [[ $1 == "" ]]
-then echo "USAGE : ./psql gargantext.ini"
-else connect $INIFILE
 fi
 
 

devops/docker/install_docker

+#!/bin/bash
+
+
+
+sudo apt-get update
+
+sudo apt-get install \
+    ca-certificates \
+    curl \
+    gnupg \
+    lsb-release
+
+curl -fsSL https://download.docker.com/linux/debian/gpg | sudo gpg --dearmor -o /usr/share/keyrings/docker-archive-keyring.gpg
+
+echo \
+  "deb [arch=$(dpkg --print-architecture) signed-by=/usr/share/keyrings/docker-archive-keyring.gpg] https://download.docker.com/linux/debian \
+  $(lsb_release -cs) stable" | sudo tee /etc/apt/sources.list.d/docker.list > /dev/null
+
+sudo apt-get update
+
+sudo apt-get install docker-ce docker-ce-cli containerd.io
+
+# specific to our LAL config
+sudo adduser debian docker
+
+

devops/docker/install_docker.sh

+#!/bin/bash
+
+
+
+ sudo apt-get update
+
+ sudo apt-get install \
+    ca-certificates \
+    curl \
+    gnupg \
+    lsb-release
+
+
+sudo mkdir -p /etc/apt/keyrings
+curl -fsSL https://download.docker.com/linux/debian/gpg | sudo gpg --dearmor -o /etc/apt/keyrings/docker.gpg
+
+
+ echo \
+  "deb [arch=$(dpkg --print-architecture) signed-by=/etc/apt/keyrings/docker.gpg] https://download.docker.com/linux/debian \
+  $(lsb_release -cs) stable" | sudo tee /etc/apt/sources.list.d/docker.list > /dev/null
+
+
+sudo apt-get update
+sudo apt-get install docker-ce docker-ce-cli containerd.io docker-compose-plugin
+
+sudo adduser debian docker

devops/postgres/schema.sql

@@ -17,6 +17,7 @@ CREATE TABLE public.auth_user (
     is_staff     BOOLEAN NOT NULL,
     is_active    BOOLEAN NOT NULL,
     date_joined  TIMESTAMP with time zone DEFAULT now() NOT NULL,
+    forgot_password_uuid TEXT,
     PRIMARY KEY (id)
 );
 ALTER TABLE public.auth_user OWNER TO gargantua;

devops/postgres/upgrade/0.0.5.8.9.5.sql

+update contexts c set parent_id = id where parent_id is NULL;

gargantext.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           gargantext
-version:        0.0.5.8.9.3
+version: 0.0.5.9.4
 synopsis:       Search, map, share
 description:    Please see README.md
 category:       Data
@@ -221,6 +221,7 @@ library
       Gargantext.Core.Viz.Graph.FGL
       Gargantext.Core.Viz.Graph.GEXF
       Gargantext.Core.Viz.Graph.Legend
+      Gargantext.Core.Viz.Graph.Tools.Infomap
       Gargantext.Core.Viz.Graph.Types
       Gargantext.Core.Viz.Graph.Utils
       Gargantext.Core.Viz.LegacyPhylo
@@ -341,12 +342,12 @@ library
     , Unique
     , accelerate
     , accelerate-arithmetic
+    , accelerate-llvm-native
     , accelerate-utility
     , aeson
     , aeson-lens
     , aeson-pretty
     , array
-    , arxiv
     , async
     , attoparsec
     , auto-update
@@ -393,6 +394,7 @@ library
     , hashable
     , haskell-igraph
     , hlcm
+    , hsinfomap
     , hsparql
     , hstatistics
     , http-api-data
@@ -707,6 +709,33 @@ executable gargantext-init
     , text
   default-language: Haskell2010
 
+executable gargantext-invitations
+  main-is: Main.hs
+  other-modules:
+      Paths_gargantext
+  hs-source-dirs:
+      bin/gargantext-invitations
+  default-extensions:
+      DataKinds
+      DeriveGeneric
+      FlexibleContexts
+      FlexibleInstances
+      GeneralizedNewtypeDeriving
+      MultiParamTypeClasses
+      NamedFieldPuns
+      NoImplicitPrelude
+      OverloadedStrings
+      RankNTypes
+      RecordWildCards
+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -O2 -Wmissing-signatures
+  build-depends:
+      base
+    , extra
+    , gargantext
+    , gargantext-prelude
+    , text
+  default-language: Haskell2010
+
 executable gargantext-phylo
   main-is: Main.hs
   other-modules:

nix/pinned-22.05.nix

+import (builtins.fetchGit {
+  name = "nixos-22.05";
+  url = "https://github.com/nixos/nixpkgs";
+  ref = "refs/heads/nixos-22.05";
+  rev = "ce6aa13369b667ac2542593170993504932eb836";
+})

nix/pkgs.nix

-{ pkgs ? import ./pinned-21.05.nix {} }:
+{ pkgs ? import ./pinned-22.05.nix {} }:
 
 rec {
   inherit pkgs;
-  ghc = pkgs.haskell.compiler.ghc8104;
+  ghc = pkgs.haskell.compiler.ghc8107;
   hsBuildInputs = [
     ghc
     pkgs.cabal-install
+    pkgs.haskellPackages.llvm-hs
   ];
   nonhsBuildInputs = with pkgs; [
     bzip2
@@ -30,6 +31,8 @@ rec {
     expat
     icu
     graphviz
+    libffi
+    llvmPackages_9.llvm
   ];
   libPaths = pkgs.lib.makeLibraryPath nonhsBuildInputs;
   shellHook = ''

package.yaml

@@ -6,7 +6,7 @@ name: gargantext
 #         | | | +-----  Layers * : New versions with API additions
 #         | | | | +---  Layers * : New versions without API breaking changes
 #         | | | | |
-version: '0.0.5.8.9.3'
+version: '0.0.5.9.4'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data
@@ -128,12 +128,12 @@ library:
   - Unique
   - accelerate
   - accelerate-arithmetic
+  - accelerate-llvm-native
   - accelerate-utility
   - aeson
   - aeson-lens
   - aeson-pretty
   - array
-  - arxiv
   - async
   - attoparsec
   - auto-update
@@ -179,6 +179,7 @@ library:
   - hashable
   - haskell-igraph
   - hlcm
+  - hsinfomap
   - hsparql
   - hstatistics
   - http-api-data
@@ -434,6 +435,21 @@ executables:
       - gargantext-prelude
       - base
 
+  gargantext-invitations:
+    main: Main.hs
+    source-dirs: bin/gargantext-invitations
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -O2
+    - -Wmissing-signatures
+    dependencies:
+      - gargantext
+      - gargantext-prelude
+      - base
+
+
   gargantext-upgrade:
     main: Main.hs
     source-dirs: bin/gargantext-upgrade

server

@@ -4,6 +4,10 @@ FOLDER="logs"
 FILE=$(date +%Y%m%d%H%M.log)
 LOGFILE=$FOLDER"/"$FILE
 
+#BIN="/home/anoe/projets/gargantext-hs/.stack-work/docker/_home/.local/bin/gargantext-server"
+#BIN="~/.local/bin/gargantext-server"
+
 mkdir -p $FOLDER
 
-env LANG=en_US.UTF-8 ~/.local/bin/gargantext-server --ini gargantext.ini --run Dev +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE # -p
+#env LANG=en_US.UTF-8 ~/.local/bin/gargantext-server --ini gargantext.ini --run Dev +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE # -p
+env LANG=en_US.UTF-8 stack --docker exec gargantext-server -- --ini gargantext.ini --run Dev +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE # -p

src/Gargantext/API/GraphQL/Annuaire.hs

@@ -19,7 +19,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
   , ContactWho
   , cw_firstName
   , cw_lastName
-  , hc_who)
+  , hc_who, ContactWhere, hc_where, cw_organization, cw_labTeamDepts, cw_role, cw_office, cw_country, cw_city, cw_touch, ct_mail, ct_phone, ct_url, hc_title, hc_source)
 import Gargantext.Database.Admin.Types.Node (NodeId(..))
 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import Gargantext.Database.Query.Table.Context (getContextWith)
@@ -28,9 +28,20 @@ import Gargantext.Prelude
 import GHC.Generics (Generic)
 
 data AnnuaireContact = AnnuaireContact
-  { ac_id        :: Int
-  , ac_firstName :: Maybe Text
-  , ac_lastName  :: Maybe Text
+  { ac_title        :: Maybe Text
+  , ac_source       :: Maybe Text
+  , ac_id           :: Int
+  , ac_firstName    :: Maybe Text
+  , ac_lastName     :: Maybe Text
+  , ac_labTeamDepts :: [Text]
+  , ac_organization :: [Text]
+  , ac_role         :: Maybe Text
+  , ac_office       :: Maybe Text
+  , ac_country      :: Maybe Text
+  , ac_city         :: Maybe Text
+  , ac_touchMail    :: Maybe Text
+  , ac_touchPhone   :: Maybe Text
+  , ac_touchUrl     :: Maybe Text
   }
   deriving (Generic, GQLType, Show)
 
@@ -62,14 +73,48 @@ dbAnnuaireContacts contact_id = do
 
 toAnnuaireContact :: (Int, HyperdataContact) -> AnnuaireContact
 toAnnuaireContact (c_id, c_hyperdata) =
-  AnnuaireContact { ac_id = c_id
+  AnnuaireContact { ac_title = c_hyperdata ^. ac_titleL
+                  , ac_source = c_hyperdata ^. ac_sourceL
+                  , ac_id = c_id
                   , ac_firstName = c_hyperdata ^. ac_firstNameL
-                  , ac_lastName = c_hyperdata ^. ac_lastNameL }
+                  , ac_lastName = c_hyperdata ^. ac_lastNameL
+                  , ac_organization = c_hyperdata ^. ac_organizationL
+                  , ac_labTeamDepts = c_hyperdata ^. ac_labTeamDeptsL
+                  , ac_role = c_hyperdata ^. ac_roleL
+                  , ac_office = c_hyperdata ^. ac_officeL
+                  , ac_country = c_hyperdata ^. ac_countryL
+                  , ac_city = c_hyperdata ^. ac_cityL
+                  , ac_touchMail = c_hyperdata ^. ac_touchMailL
+                  , ac_touchPhone = c_hyperdata ^. ac_touchPhoneL
+                  , ac_touchUrl = c_hyperdata ^. ac_touchUrlL }
 
+ac_titleL :: Traversal' HyperdataContact (Maybe Text)
+ac_titleL = hc_title
+ac_sourceL :: Traversal' HyperdataContact (Maybe Text)
+ac_sourceL = hc_source
 contactWhoL :: Traversal' HyperdataContact ContactWho
 contactWhoL = hc_who . _Just
 ac_firstNameL :: Traversal' HyperdataContact (Maybe Text)
 ac_firstNameL = contactWhoL . cw_firstName
 ac_lastNameL :: Traversal' HyperdataContact (Maybe Text)
 ac_lastNameL = contactWhoL . cw_lastName
-
+contactWhereL :: Traversal' HyperdataContact ContactWhere
+contactWhereL = hc_where . ix 0
+ac_organizationL :: Traversal' HyperdataContact [Text]
+ac_organizationL = contactWhereL . cw_organization
+ac_labTeamDeptsL :: Traversal' HyperdataContact [Text]
+ac_labTeamDeptsL = contactWhereL . cw_labTeamDepts
+ac_roleL :: Traversal' HyperdataContact (Maybe Text)
+ac_roleL = contactWhereL . cw_role
+ac_officeL :: Traversal' HyperdataContact (Maybe Text)
+ac_officeL = contactWhereL . cw_office
+ac_countryL :: Traversal' HyperdataContact (Maybe Text)
+ac_countryL = contactWhereL . cw_country
+ac_cityL :: Traversal' HyperdataContact (Maybe Text)
+ac_cityL = contactWhereL . cw_city
+ac_touchMailL :: Traversal' HyperdataContact (Maybe Text)
+ac_touchMailL = contactWhereL . cw_touch . _Just . ct_mail
+ac_touchPhoneL :: Traversal' HyperdataContact (Maybe Text)
+ac_touchPhoneL = contactWhereL . cw_touch . _Just . ct_phone
+ac_touchUrlL :: Traversal' HyperdataContact (Maybe Text)
+ac_touchUrlL = contactWhereL . cw_touch . _Just . ct_url

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -34,6 +34,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
   , cw_organization
   , cw_role
   , cw_touch
+  , cw_description
   , ct_mail
   , ct_phone
   , hc_who
@@ -64,6 +65,7 @@ data UserInfo = UserInfo
   , ui_cwRole         :: Maybe Text
   , ui_cwTouchPhone   :: Maybe Text
   , ui_cwTouchMail    :: Maybe Text  -- TODO: Remove. userLight_email should be used instead
+  , ui_cwDescription  :: Maybe Text
   }
   deriving (Generic, GQLType, Show)
 
@@ -91,7 +93,8 @@ data UserInfoMArgs
     , ui_cwOffice       :: Maybe Text
     , ui_cwRole         :: Maybe Text
     , ui_cwTouchPhone   :: Maybe Text
-    , ui_cwTouchMail    :: Maybe Text 
+    , ui_cwTouchMail    :: Maybe Text
+    , ui_cwDescription  :: Maybe Text
     } deriving (Generic, GQLType)
 
 type GqlM e env = Resolver QUERY e (GargM env GargError)
@@ -132,6 +135,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
                             uh ui_cwRoleL ui_cwRole $
                             uh ui_cwTouchMailL ui_cwTouchMail $
                             uh ui_cwTouchPhoneL ui_cwTouchPhone $
+                            uh ui_cwDescriptionL ui_cwDescription
                             u_hyperdata
           -- NOTE: We have 1 username and 2 emails: userLight_email and ui_cwTouchMail
           -- The userLight_email is more important: it is used for login and sending mail.
@@ -179,7 +183,8 @@ toUser (UserLight { .. }, u_hyperdata) =
            , ui_cwRole         = u_hyperdata ^. ui_cwRoleL
            --, ui_cwTouchMail    = u_hyperdata ^. ui_cwTouchMailL
            , ui_cwTouchMail    = Just userLight_email
-           , ui_cwTouchPhone   = u_hyperdata ^. ui_cwTouchPhoneL }
+           , ui_cwTouchPhone   = u_hyperdata ^. ui_cwTouchPhoneL
+           , ui_cwDescription  = u_hyperdata ^. ui_cwDescriptionL }
 
 sharedL :: Traversal' HyperdataUser HyperdataContact
 sharedL = hu_shared . _Just
@@ -213,3 +218,5 @@ ui_cwTouchMailL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct
 ui_cwTouchPhoneL :: Traversal' HyperdataUser (Maybe Text)
 ui_cwTouchPhoneL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_phone)
 --ui_cwTouchPhoneL = contactWhereL . cw_touch . _Just . ct_phone
+ui_cwDescriptionL :: Traversal' HyperdataUser (Maybe Text)
+ui_cwDescriptionL = contactWhoL . cw_description

src/Gargantext/API/Node/Update.hs

@@ -28,6 +28,7 @@ import Gargantext.API.Ngrams.List (reIndexWith)
 import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Core.Methods.Distances (GraphMetric(..))
 import Gargantext.Core.Types.Main (ListType(..))
+import Gargantext.Core.Viz.Graph (Strength)
 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
 import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..))
 import Gargantext.Core.Viz.Phylo (PhyloSubConfig(..), subConfig2config)
@@ -59,8 +60,9 @@ type API = Summary " Update node according to NodeType params"
 ------------------------------------------------------------------------
 data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: !Method      }
 
-                      | UpdateNodeParamsGraph { methodGraphMetric     :: !GraphMetric 
-                                              , methodGraphClustering :: !PartitionMethod
+                      | UpdateNodeParamsGraph { methodGraphMetric        :: !GraphMetric
+                                              , methodGraphClustering    :: !PartitionMethod
+                                              , methodGraphEdgesStrength :: !Strength
                                               }
 
                       | UpdateNodeParamsTexts { methodTexts :: !Granularity }
@@ -103,15 +105,16 @@ updateNode :: (HasSettings env, FlowCmdM env err m)
     -> UpdateNodeParams
     -> (JobLog -> m ())
     -> m JobLog
-updateNode uId nId (UpdateNodeParamsGraph metric method) logStatus = do
+updateNode uId nId (UpdateNodeParamsGraph metric method strength) logStatus = do
 
   logStatus JobLog { _scst_succeeded = Just 1
                    , _scst_failed    = Just 0
                    , _scst_remaining = Just 1
                    , _scst_events    = Just []
                    }
-
-  _ <- recomputeGraph uId nId method (Just metric) True
+  printDebug "Computing graph: " method
+  _ <- recomputeGraph uId nId method (Just metric) (Just strength) True
+  printDebug "Graph computed: " method
 
   pure  JobLog { _scst_succeeded = Just 2
                , _scst_failed    = Just 0
@@ -271,7 +274,7 @@ instance ToSchema  UpdateNodeParams
 instance Arbitrary UpdateNodeParams where
   arbitrary = do
     l <- UpdateNodeParamsList  <$> arbitrary
-    g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary
+    g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary
     t <- UpdateNodeParamsTexts <$> arbitrary
     b <- UpdateNodeParamsBoard <$> arbitrary
     elements [l,g,t,b]

src/Gargantext/API/Search.hs

@@ -272,7 +272,7 @@ instance ToHyperdataRow HyperdataDocument where
       , _hr_uniqIdBdd = fromMaybe "" _hd_uniqIdBdd }
 
 instance ToHyperdataRow HyperdataContact where
-  toHyperdataRow (HyperdataContact { _hc_who = Just (ContactWho _ fn ln _ _), _hc_where = ou} ) =
+  toHyperdataRow (HyperdataContact { _hc_who = Just (ContactWho _ fn ln _ _ _), _hc_where = ou} ) =
     HyperdataRowContact (fromMaybe "FirstName" fn) (fromMaybe "LastName" ln) ou'
       where
         ou' = maybe "CNRS" (Text.intercalate " " . _cw_organization) (head ou)

src/Gargantext/Core/Ext/IMTUser.hs

@@ -169,7 +169,8 @@ imtUser2gargContact (IMTUser { id
                      , _cw_firstName = prenom
                      , _cw_lastName = nom
                      , _cw_keywords = catMaybes [service]
-                     , _cw_freetags = [] }
+                     , _cw_freetags = []
+                     , _cw_description = Nothing }
     ou  = ContactWhere { _cw_organization = toList entite
                        , _cw_labTeamDepts = toList service
                        , _cw_role = fonction

src/Gargantext/Core/Methods/Distances.hs

@@ -14,14 +14,13 @@ Portability : POSIX
 module Gargantext.Core.Methods.Distances
   where
 
-import Debug.Trace (trace)
 import Data.Aeson
 import Data.Array.Accelerate (Matrix)
 import Data.Swagger
 import GHC.Generics (Generic)
 import Gargantext.Core.Methods.Distances.Accelerate.Conditional (measureConditional)
 import Gargantext.Core.Methods.Distances.Accelerate.Distributional (logDistributional)
-import Gargantext.Prelude (Ord, Eq, Int, Double, Show, ($), show)
+import Gargantext.Prelude (Ord, Eq, Int, Double, Show)
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
@@ -32,7 +31,7 @@ data Distance = Conditional | Distributional
 
 measure :: Distance -> Matrix Int -> Matrix Double
 measure Conditional    x = measureConditional x
-measure Distributional x = trace (show y) $ y
+measure Distributional x = y
   where
     y = logDistributional x
 

src/Gargantext/Core/Methods/Distances/Accelerate/Distributional.hs

@@ -39,6 +39,7 @@ where $n_{ij}$ is the cooccurrence between term $i$ and term $j$
 {-# LANGUAGE TypeOperators       #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns        #-}
+{-# LANGUAGE GADTs               #-}
 
 module Gargantext.Core.Methods.Distances.Accelerate.Distributional
   where
@@ -46,10 +47,16 @@ module Gargantext.Core.Methods.Distances.Accelerate.Distributional
 -- import qualified Data.Foldable as P (foldl1)
 -- import Debug.Trace (trace)
 import Data.Array.Accelerate as A
-import Data.Array.Accelerate.Interpreter (run)
+-- import Data.Array.Accelerate.Interpreter (run)
+import Data.Array.Accelerate.LLVM.Native (run) -- TODO: try runQ?
 import Gargantext.Core.Methods.Matrix.Accelerate.Utils
 import qualified Gargantext.Prelude as P
 
+import Debug.Trace
+import Prelude (show, mappend{- , String, (<>), fromIntegral, flip -})
+
+import qualified Prelude
+
 -- | `distributional m` returns the distributional distance between terms each
 -- pair of terms as a matrix.  The argument m is the matrix $[n_{ij}]_{i,j}$
 -- where $n_{ij}$ is the coocccurrence between term $i$ and term $j$.
@@ -84,10 +91,10 @@ import qualified Gargantext.Prelude as P
 --     8.333333333333333e-2,             4.6875e-2,                1.0,               0.25,
 --       0.3333333333333333, 5.7692307692307696e-2,                1.0,                1.0]
 --
-distributional :: Matrix Int -> Matrix Double
-distributional m' = run result
+distributional :: Matrix Int -> Acc (Matrix Double)
+distributional m' = result
  where
-    m = map fromIntegral $ use m'
+    m = map A.fromIntegral $ use m'
     n = dim m'
 
     diag_m = diag m
@@ -116,7 +123,7 @@ distributional m' = run result
     result = termDivNan z_1 z_2
 
 logDistributional :: Matrix Int -> Matrix Double
-logDistributional m = run
+logDistributional m = trace ("logDistributional, dim=" `mappend` show n) . run
                     $ diagNull n
                     $ matMiniMax
                     $ logDistributional' n m
@@ -124,11 +131,11 @@ logDistributional m = run
     n = dim m
 
 logDistributional' :: Int -> Matrix Int -> Acc (Matrix Double)
-logDistributional' n m' = result
+logDistributional' n m' = trace ("logDistributional'") result
  where
     -- From Matrix Int to Matrix Double, i.e :
     -- m :: Matrix Int -> Matrix Double
-    m = map fromIntegral $ use m'
+    m = map A.fromIntegral $ use m'
 
     -- Scalar. Sum of all elements of m.
     to = the $ sum (flatten m)
@@ -152,25 +159,39 @@ logDistributional' n m' = result
     -- m_{i,j} = log(to * n_{i,j} / s_{i,j}) otherwise.
     mi = (.*) (matrixEye n) 
         (map (lift1 (\x -> cond (x == 0) 0 (log (x * to)))) ((./) m ss))
+    -- mi_nnz :: Int
+    -- mi_nnz = flip indexArray Z . run $
+    --   foldAll (+) 0 $ map (\a -> ifThenElse (abs a < 10^(-6 :: Exp Int)) 0 1) mi
+
+    -- mi_total = n*n
+
+    -- reportMat :: String -> Int -> Int -> String
+    -- reportMat name nnz tot = name <> ": " <> show nnz <> "nnz / " <> show tot <>
+    --                          " | " <> show pc <> "%"
+    --   where pc = 100 * Prelude.fromIntegral nnz / Prelude.fromIntegral tot :: Double
 
     -- Tensor nxnxn. Matrix mi replicated along the 2nd axis.
-    w_1 = replicate (constant (Z :. All :. n :. All)) mi
+    -- w_1 = trace (reportMat "mi" mi_nnz mi_total) $ replicate (constant (Z :. All :. n :. All)) mi
+    -- w1_nnz :: Int
+    -- w1_nnz = flip indexArray Z . run $
+    --   foldAll (+) 0 $ map (\a -> ifThenElse (abs a < 10^(-6 :: Exp Int)) 0 1) w_1
+    -- w1_total = n*n*n
 
     -- Tensor nxnxn. Matrix mi replicated along the 1st axis.
-    w_2 = replicate (constant (Z :. n :. All :. All)) mi
+    -- w_2 = trace (reportMat "w1" w1_nnz w1_total) $ replicate (constant (Z :. n :. All :. All)) mi
 
     -- Tensor nxnxn.
-    w' = zipWith min w_1 w_2
+    -- w' = trace "w'" $ zipWith min w_1 w_2
 
     -- A predicate that is true when the input (i, j, k) satisfy 
     -- k /= i AND k /= j
-    k_diff_i_and_j = lift1 (\(Z :. i :. j :. k) -> ((&&) ((/=) k i) ((/=) k j)))
+    -- k_diff_i_and_j = lift1 (\(Z :. i :. j :. k) -> ((&&) ((/=) k i) ((/=) k j)))
 
     -- Matrix nxn. 
-    sumMin = sum (condOrDefault k_diff_i_and_j 0 w')
+    sumMin = trace "sumMin" $ sumMin_go n mi -- sum (condOrDefault k_diff_i_and_j 0 w')
 
     -- Matrix nxn. All columns are the same.
-    sumM = sum (condOrDefault k_diff_i_and_j 0 w_1)
+    sumM = trace "sumM" $ sumM_go n mi -- trace "sumM" $ sum (condOrDefault k_diff_i_and_j 0 w_1)
 
     result = termDivNan sumMin sumM
 
@@ -202,7 +223,7 @@ distributional'' m = -- run {- $ matMiniMax -}
                        $ filterWith 0 100
                        $ filter' 0
                        $ s_mi
-                       $ map fromIntegral
+                       $ map A.fromIntegral
                           {- from Int to Double -}
                        $ use m
                           {- push matrix in Accelerate type -}
@@ -246,3 +267,70 @@ distriTest :: Int -> Matrix Double
 distriTest n = logDistributional (theMatrixInt n)
 
 
+-- * sparse utils
+
+-- compact repr of "extend along an axis" op?
+-- general sparse repr ?
+
+type Extended sh = sh :. Int
+
+data Ext where
+  Along1 :: Int -> Ext
+  Along2 :: Int -> Ext
+
+along1 :: Int -> Ext
+along1 = Along1
+
+along2 :: Int -> Ext
+along2 = Along2
+
+type Delayed sh a = Exp sh -> Exp a
+
+data ExtArr sh a = ExtArr
+  { extSh  :: Extended sh
+  , extFun :: Delayed (Extended sh) a
+  }
+
+{-
+w_1_{i, j, k} = mi_{i, k}
+w_2_{i, j, k} = mi_{j, k}
+
+w'_{i, j, k} = min  w_1_{i, j, k}  w_2_{i, j, k}
+             = min  mi_{i, k}  mi_{j, k}
+
+w"_{i, j, k} = 0                          if i = k or j = k
+               min  mi_{i, k}  mi_{j, k}  otherwise
+
+w_1'_{i, j, k} = 0          if i = k or j = k
+                 mi_{i, k}  otherwise
+
+sumMin_{i, j} = sum_k of w"_{i, j, k}
+              = sum_k (k /= i && k /= j) of  min  mi_{i, k}  mi_{j, k}
+
+sumM_{i, j} = sum_k of w_1'_{i, j, k}
+            = sum_k (k /= i && k /= j) of mi_{i, k}
+
+-}
+
+sumM_go :: (Elt a, Num a) => Int -> Acc (Array DIM2 a) -> Acc (Array DIM2 a)
+sumM_go n mi = generate (lift (Z :. n :. n)) $ \coord ->
+  let (Z :. i :. j) = unlift coord in
+    Prelude.sum
+      [ cond (constant k /= i && constant k /= j)
+             (mi ! lift (constant Z :. i :. constant k))
+             0
+      | k <- [0 .. n-1]
+      ]
+
+sumMin_go :: (Elt a, Num a, Ord a) => Int -> Acc (Array DIM2 a) -> Acc (Array DIM2 a)
+sumMin_go n mi = generate (constant (Z :. n :. n)) $ \coord ->
+  let (Z :. i :. j) = unlift coord in
+    Prelude.sum
+      [ cond (constant k /= i && constant k /= j)
+             (min
+               (mi ! lift (constant Z :. i :. constant k))
+               (mi ! lift (constant Z :. j :. constant k))
+             )
+             0
+      | k <- [0 .. n-1]
+      ]

src/Gargantext/Core/Methods/Graph/BAC/Proxemy.hs

@@ -24,6 +24,7 @@ import qualified Data.Map as Map
 import qualified Data.List as List
 --import Gargantext.Core.Viz.Graph.IGraph
 import Gargantext.Core.Viz.Graph.FGL
+-- import qualified Graph.BAC.ProxemyOptim   as BAC
 
 type Length = Int
 type FalseReflexive = Bool

src/Gargantext/Core/Methods/Matrix/Accelerate/Utils.hs

@@ -31,11 +31,13 @@ module Gargantext.Core.Methods.Matrix.Accelerate.Utils
   where
 
 import qualified Data.Foldable as P (foldl1)
-import Debug.Trace (trace)
+-- import Debug.Trace (trace)
 import Data.Array.Accelerate
 import Data.Array.Accelerate.Interpreter (run)
 import qualified Gargantext.Prelude as P
 
+import Debug.Trace (trace)
+
 -- | Matrix cell by cell multiplication
 (.*) :: ( Shape ix
         , Slice ix
@@ -70,7 +72,7 @@ termDivNan :: ( Shape ix
      => Acc (Array ((ix :. Int) :. Int) a)
      -> Acc (Array ((ix :. Int) :. Int) a)
      -> Acc (Array ((ix :. Int) :. Int) a)
-termDivNan = zipWith (\i j -> cond ((==) j 0) 0 ((/) i j))
+termDivNan = trace "termDivNan" $ zipWith (\i j -> cond ((==) j 0) 0 ((/) i j))
 
 (.-) :: ( Shape ix
         , Slice ix
@@ -108,7 +110,7 @@ matrixIdentity n' =
             ones  = fill (index1 n)   1
             n = constant n'
         in
-        permute const zeros (\(unindex1 -> i) -> index2 i i) ones
+        permute const zeros (\(unindex1 -> i) -> Just_ $ index2 i i) ones
 
 
 matrixEye :: Num a => Dim -> Acc (Matrix a)
@@ -117,11 +119,11 @@ matrixEye n' =
             zeros  = fill (index1 n)   0
             n = constant n'
         in
-        permute const ones (\(unindex1 -> i) -> index2 i i) zeros
+        permute const ones (\(unindex1 -> i) -> Just_ $ index2 i i) zeros
 
 
 diagNull :: Num a => Dim -> Acc (Matrix a) -> Acc (Matrix a)
-diagNull n m = zipWith (*) m (matrixEye n)
+diagNull n m = trace ("diagNull") $ zipWith (*) m (matrixEye n)
 
 
 -- Returns an N-dimensional array with the values of x for the indices where
@@ -132,7 +134,7 @@ condOrDefault
 condOrDefault theCond def x = permute const zeros filterInd x
   where 
     zeros = fill (shape x) (def)
-    filterInd ix = (cond (theCond ix)) ix ignore
+    filterInd ix = (cond (theCond ix)) (Just_ ix) Nothing_
 
 -----------------------------------------------------------------------
 _runExp :: Elt e => Exp e -> e
@@ -161,7 +163,7 @@ matrix n l = fromList (Z :. n :. n) l
 -- >>> rank (matrix 3 ([1..] :: [Int]))
 -- 2
 rank :: (Matrix a) -> Int
-rank m = arrayRank $ arrayShape m
+rank m = arrayRank m
 
 -----------------------------------------------------------------------
 -- | Dimension of a square Matrix
@@ -240,7 +242,7 @@ divByDiag d mat = zipWith (/) mat (replicate (constant (Z :. (d :: Int) :. All))
 matMiniMax :: (Elt a, Ord a, P.Num a)
            => Acc (Matrix a)
            -> Acc (Matrix a)
-matMiniMax m = filterWith' miniMax' (constant 0) m
+matMiniMax m = trace "matMiniMax" $ filterWith' miniMax' (constant 0) m
   where
     miniMax' = the $ maximum $ minimum m
 
@@ -276,7 +278,7 @@ nullOf n' dir =
             zeros  = fill (index2 n n) 0
             n = constant n'
         in
-        permute const ones ( lift1 ( \(Z :. (i :: Exp Int) :. (_j:: Exp Int))
+        permute const ones ( Just_ . lift1 ( \(Z :. (i :: Exp Int) :. (_j:: Exp Int))
                                                 -> case dir of 
                                                      MatCol m -> (Z :. i :. m)
                                                      MatRow m -> (Z :. m :. i)
@@ -306,7 +308,7 @@ sumRowMin n m = {-trace (P.show $ run m') $-} m'
        $ P.map (\z -> sumRowMin1 n (constant z) m) [0..n-1]
 
 sumRowMin1 :: (Num a, Ord a) => Dim -> Exp Int -> Acc (Matrix a) -> Acc (Vector a)
-sumRowMin1 n x m = trace (P.show (run m,run $ transpose m)) $ m''
+sumRowMin1 n x m = {-trace (P.show (run m,run $ transpose m)) $-} m''
   where
     m'' = sum $ zipWith min (transpose m) m
     _m'  = zipWith (*) (zipWith (*) (nullOf n (MatCol x)) $ nullOfWithDiag n (MatRow x)) m

src/Gargantext/Core/Text/Corpus/API/Arxiv.hs

@@ -35,8 +35,8 @@ type Limit = Arxiv.Limit
 -- | TODO put default pubmed query in gargantext.ini
 -- by default: 10K docs
 get :: Lang -> Query -> Maybe Limit -> IO (Either ClientError (Maybe Integer, ConduitT () HyperdataDocument IO ()))
-get la q l = do
-  (cnt, resC) <- Arxiv.apiSimpleC l [Text.unpack q]
+get la q _l = do
+  (cnt, resC) <- Arxiv.apiSimpleC Nothing [Text.unpack q]
   pure $ Right (Just $ fromIntegral cnt, resC .| mapC (toDoc la))
 
 toDoc :: Lang -> Arxiv.Result -> HyperdataDocument

src/Gargantext/Core/Text/Corpus/API/Istex.hs

@@ -26,15 +26,16 @@ import qualified Gargantext.Core.Text.Corpus.Parsers.Date as Date
 import qualified ISTEX        as ISTEX
 import qualified ISTEX.Client as ISTEX
 
+
 get :: Lang -> Text -> Maybe Integer -> IO [HyperdataDocument]
-get la q ml = do
+get la q _ml = do
   --docs <- ISTEX.getMetadataWith q (fromIntegral <$> ml)
-  printDebug "[Istex.get] calling getMetadataScrollProgress for la" la
-  printDebug "[Istex.get] calling getMetadataScrollProgress for q" q
-  printDebug "[Istex.get] calling getMetadataScrollProgress for ml" ml
+  --printDebug "[Istex.get] calling getMetadataScrollProgress for la" la
+  --printDebug "[Istex.get] calling getMetadataScrollProgress for q" q
+  --printDebug "[Istex.get] calling getMetadataScrollProgress for ml" ml
   -- The "scroll" expects "d/h/m/s/ms" time interval. Let's set it to "1 month"
   --eDocs <- ISTEX.getMetadataScroll q ((\_n -> pack $ "1m") <$> ml) Nothing 0  --(fromIntegral <$> ml)
-  eDocs <- ISTEX.getMetadataScroll q "1m" Nothing 0  --(fromIntegral <$> ml)
+  eDocs <- ISTEX.getMetadataScroll (q <> " abstract:*")  "1m" Nothing 0  --(fromIntegral <$> ml)
   printDebug "[Istex.get] will print length" (0 :: Int)
   case eDocs of
     Left _ -> pure ()
@@ -57,15 +58,17 @@ toDoc' la docs' =  mapM (toDoc la) (ISTEX._documents_hits docs')
 -- TODO current year as default
 toDoc :: Lang -> ISTEX.Document -> IO HyperdataDocument
 toDoc la (ISTEX.Document i t a ab d s) = do
+  --printDebug "ISTEX date" d
   (utctime, (pub_year, pub_month, pub_day)) <-
         Date.dateSplit la (maybe (Just $ pack $ show Defaults.year) (Just . pack . show) d)
-  pure $ HyperdataDocument { _hd_bdd = Just "Istex"
-                           , _hd_doi = Just i
-                           , _hd_url = Nothing
-                           , _hd_uniqId = Nothing
+  --printDebug "toDoc Istex" (utctime, (pub_year, pub_month, pub_day))
+  pure $ HyperdataDocument { _hd_bdd       = Just "Istex"
+                           , _hd_doi       = Just i
+                           , _hd_url       = Nothing
+                           , _hd_uniqId    = Nothing
                            , _hd_uniqIdBdd = Nothing
-                           , _hd_page = Nothing
-                           , _hd_title = t
+                           , _hd_page      = Nothing
+                           , _hd_title     = t
                            , _hd_authors = Just $ foldl (\x y -> x <> ", " <> y) "" (map ISTEX._author_name a)
                            , _hd_institutes = Just $ foldl (\x y -> x <> ", " <> y) "" (concat $ (map ISTEX._author_affiliations) a)
                            , _hd_source = Just $ foldl (\x y -> x <> ", " <> y) "" (catMaybes $ map ISTEX._source_title s)
@@ -77,5 +80,5 @@ toDoc la (ISTEX.Document i t a ab d s) = do
                            , _hd_publication_hour = Nothing
                            , _hd_publication_minute = Nothing
                            , _hd_publication_second = Nothing
-                           , _hd_language_iso2 = Just $ (pack . show) la }
-                         
+                           , _hd_language_iso2 = Just $ (pack . show) la
+                           }

src/Gargantext/Core/Text/Corpus/Parsers/Date.hs

@@ -67,13 +67,15 @@ type Day   = Int
 
 -- | Date Parser
 -- Parses dates mentions in full text given the language.
--- >>> parse FR (pack "10 avril 1900 à 19H")
--- 1900-04-10 19:00:00 UTC
--- >>> parse EN (pack "April 10 1900")
--- 1900-04-10 00:00:00 UTC
+-- >>> parse FR (pack "1 avril 1900 à 19H")
+-- 1900-04-01 19:00:00 UTC
+-- >>> parse EN (pack "April 1 1900")
+-- 1900-04-01 00:00:00 UTC
 parse :: Lang -> Text -> IO UTCTime
 parse lang s = do
-  dateStr' <- parseRawSafe lang s
+  --printDebug "Date: " s
+  dateStr' <- pure $ dateFlow (DucklingFailure s) -- parseRawSafe lang s
+  --printDebug "Date': " dateStr'
   case dateFlow dateStr' of
     DateFlowSuccess ok -> pure ok
     _                  -> withDebugMode (DebugMode True)
@@ -92,7 +94,7 @@ data DateFlow = DucklingSuccess { ds_result  :: Text }
               | DucklingFailure { df_result  :: Text }
               | ReadFailure1    { rf1_result :: Text }
               | ReadFailure2    { rf2_result :: Text }
-              | DateFlowSuccess  { success :: UTCTime }
+              | DateFlowSuccess { success :: UTCTime }
               | DateFlowFailure
   deriving Show
 
@@ -125,7 +127,7 @@ readDate txt = do
 -- | To get Homogeinity of the languages
 --   TODO : put this in a more generic place in the source code
 parserLang :: Lang -> DC.Lang
-parserLang FR = DC.FR
+parserLang FR    = DC.FR
 parserLang EN    = DC.EN
 parserLang lang  = panic $ "[G.C.T.C.P.Date] Lang not implemented" <> (cs $ show lang)
 

src/Gargantext/Core/Text/List.hs

@@ -320,7 +320,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, _mapListSize)= do
           <>-} groupedMultTail
 
     -- Quick FIX
-    candNgramsElement = List.take 5000
+    candNgramsElement = List.take 1000
                       $ toNgramsElement cands <> toNgramsElement cands'
 
     result = Map.unionsWith (<>)

src/Gargantext/Core/Viz/Graph.hs

@@ -76,7 +76,8 @@ instance ToSchema Edge where
 data LegendField = LegendField { _lf_id :: Int
                                , _lf_color :: Text
                                , _lf_label :: Text
-   } deriving (Show, Generic)
+                               }
+  deriving (Show, Generic)
 $(deriveJSON (unPrefix "_lf_") ''LegendField)
 
 instance ToSchema LegendField where
@@ -96,10 +97,22 @@ instance ToSchema ListForGraph where
 
 makeLenses ''ListForGraph
 
---
+data Strength = Strong | Weak
+    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
+
+$(deriveJSON (unPrefix "") ''Strength)
+instance ToSchema Strength where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
+
+instance Arbitrary Strength where
+  arbitrary = elements $ [Strong, Weak]
+
+
+
 data GraphMetadata =
   GraphMetadata { _gm_title            :: Text          -- title of the graph
                 , _gm_metric           :: GraphMetric
+                , _gm_edgesStrength    :: Maybe Strength
                 , _gm_corpusId         :: [NodeId]      -- we can map with different corpus
                 , _gm_legend           :: [LegendField] -- legend of the Graph
                 , _gm_list             :: ListForGraph
@@ -113,6 +126,7 @@ instance ToSchema GraphMetadata where
 makeLenses ''GraphMetadata
 
 
+
 data Graph = Graph { _graph_nodes    :: [Node]
                    , _graph_edges    :: [Edge]
                    , _graph_metadata :: Maybe GraphMetadata

src/Gargantext/Core/Viz/Graph/API.hs

@@ -9,6 +9,7 @@ Portability : POSIX
 
 -}
 
+{-# LANGUAGE BangPatterns      #-}
 {-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
 {-# LANGUAGE TypeOperators     #-}
 
@@ -103,8 +104,9 @@ getGraph _uId nId = do
     Nothing     -> do
         let defaultMetric          = Order1
         let defaultPartitionMethod = Spinglass
-        graph' <- computeGraph cId defaultPartitionMethod (withMetric defaultMetric) NgramsTerms repo
-        mt     <- defaultGraphMetadata cId "Title" repo defaultMetric
+        let defaultEdgesStrength   = Strong
+        graph' <- computeGraph cId defaultPartitionMethod (withMetric defaultMetric) defaultEdgesStrength NgramsTerms repo
+        mt     <- defaultGraphMetadata cId "Title" repo defaultMetric defaultEdgesStrength
         let
           graph'' = set graph_metadata (Just mt) graph'
           hg = HyperdataGraphAPI graph'' camera
@@ -122,9 +124,11 @@ recomputeGraph :: FlowCmdM env err m
                -> NodeId
                -> PartitionMethod
                -> Maybe GraphMetric
+               -> Maybe Strength
                -> Bool
                -> m Graph
-recomputeGraph _uId nId method maybeDistance force = do
+recomputeGraph _uId nId method maybeDistance maybeStrength force = do
+  printDebug "recomputeGraph begins" (nId, method)
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
   let
     graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
@@ -138,22 +142,35 @@ recomputeGraph _uId nId method maybeDistance force = do
                    Nothing -> withMetric Order1
                    Just m  -> withMetric m
 
+    strength = case maybeStrength of
+                   Nothing -> case graph ^? _Just . graph_metadata . _Just . gm_edgesStrength of
+                        Nothing  -> Strong
+                        Just  mr -> fromMaybe Strong mr
+                   Just r  -> r
+
   mcId <- getClosestParentIdByType nId NodeCorpus
   let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
+  printDebug "recomputeGraph corpus" cId
 
   listId  <- defaultList cId
+  printDebug "recomputeGraph list" listId
   repo <- getRepo [listId]
   let v   = repo ^. unNodeStory . at listId . _Just . a_version
+  printDebug "recomputeGraph got repo, version: " v
 
   let computeG mt = do
-        g <- computeGraph cId method similarity NgramsTerms repo
+        printDebug "about to run computeGraph" ()
+        g <- computeGraph cId method similarity strength NgramsTerms repo
+        seq g $ printDebug "graph computed" ()
         let g' = set graph_metadata mt g
-        _ <- updateHyperdata nId (HyperdataGraph (Just g') camera)
+        seq g' $ printDebug "computed graph with new metadata" ()
+        nentries <- updateHyperdata nId (HyperdataGraph (Just g') camera)
+        printDebug "graph hyperdata updated" ("entries" :: [Char], nentries)
         pure g'
 
   case graph of
     Nothing     -> do
-      mt     <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeDistance)
+      mt     <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeDistance) strength
       g <- computeG $ Just mt
       pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" g
     Just graph' -> if (listVersion == Just v) && (not force)
@@ -167,29 +184,33 @@ computeGraph :: FlowCmdM env err m
              => CorpusId
              -> PartitionMethod
              -> Distance
+             -> Strength
              -> NgramsType
              -> NodeListStory
              -> m Graph
-computeGraph cId method d nt repo = do
+computeGraph cId method d strength nt repo = do
+  printDebug "computeGraph" (cId, method, nt)
   lId  <- defaultList cId
+  printDebug "computeGraph got list id: " lId
   lIds <- selectNodesWithUsername NodeList userMaster
-
+  printDebug "computeGraph got nodes with username: " userMaster
   let ngs = filterListWithRoot [MapTerm]
           $ mapTermListRoot [lId] nt repo
 
-  myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
+  !myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
          <$> getCoocByNgrams (Diagonal True)
          <$> groupNodesByNgrams ngs
          <$> getContextsByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
+  printDebug "computeGraph got coocs" (HashMap.size myCooc)
 
-  listNgrams <- getListNgrams [lId] nt
-
-  graph <- liftBase $ cooc2graphWith method d 0 myCooc
+  graph <- liftBase $ cooc2graphWith method d 0 strength myCooc
+  printDebug "computeGraph got graph" ()
 
-  let graph' = mergeGraphNgrams graph (Just listNgrams)
+  --listNgrams <- getListNgrams [lId] nt
+  --let graph' = mergeGraphNgrams graph (Just listNgrams)
   -- saveAsFileDebug "/tmp/graphWithNodes" graph'
 
-  pure graph'
+  pure graph
 
 
 defaultGraphMetadata :: HasNodeError err
@@ -197,23 +218,24 @@ defaultGraphMetadata :: HasNodeError err
                      -> Text
                      -> NodeListStory
                      -> GraphMetric
+                     -> Strength
                      -> Cmd err GraphMetadata
-defaultGraphMetadata cId t repo gm = do
+defaultGraphMetadata cId t repo gm str = do
   lId  <- defaultList cId
 
-  pure $ GraphMetadata {
-      _gm_title = t
-    , _gm_metric = gm
-    , _gm_corpusId = [cId]
-    , _gm_legend = [
-          LegendField 1 "#FFF" "Cluster1"
-        , LegendField 2 "#FFF" "Cluster2"
-        , LegendField 3 "#FFF" "Cluster3"
-        , LegendField 4 "#FFF" "Cluster4"
-        ]
-      , _gm_list = (ListForGraph lId (repo ^. unNodeStory . at lId . _Just . a_version))
-      , _gm_startForceAtlas = True
-    }
+  pure $ GraphMetadata { _gm_title         = t
+                       , _gm_metric        = gm
+                       , _gm_edgesStrength = Just str
+                       , _gm_corpusId      = [cId]
+                       , _gm_legend = [
+                             LegendField 1 "#FFF" "Cluster1"
+                           , LegendField 2 "#FFF" "Cluster2"
+                           , LegendField 3 "#FFF" "Cluster3"
+                           , LegendField 4 "#FFF" "Cluster4"
+                           ]
+                       , _gm_list  = (ListForGraph lId (repo ^. unNodeStory . at lId . _Just . a_version))
+                       , _gm_startForceAtlas = True
+                       }
                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
 
 ------------------------------------------------------------
@@ -243,7 +265,7 @@ graphRecompute u n logStatus = do
                    , _scst_remaining = Just 1
                    , _scst_events    = Just []
                    }
-  _g <- trace (show u) $ recomputeGraph u n Spinglass Nothing False
+  _g <- trace (show u) $ recomputeGraph u n Spinglass Nothing Nothing False
   pure  JobLog { _scst_succeeded = Just 1
                , _scst_failed    = Just 0
                , _scst_remaining = Just 0
@@ -298,7 +320,7 @@ recomputeVersions :: FlowCmdM env err m
                   => UserId
                   -> NodeId
                   -> m Graph
-recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing False
+recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing Nothing False
 
 ------------------------------------------------------------
 graphClone :: UserId

src/Gargantext/Core/Viz/Graph/Tools.hs

@@ -14,6 +14,8 @@ Portability : POSIX
 module Gargantext.Core.Viz.Graph.Tools
   where
 
+import Debug.Trace
+
 import Data.Aeson
 import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
@@ -24,12 +26,13 @@ import GHC.Generics (Generic)
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core.Methods.Distances (Distance(..), measure)
 import Gargantext.Core.Methods.Distances.Conditional (conditional)
-import Gargantext.Core.Methods.Graph.BAC.Proxemy (confluence)
+-- import Gargantext.Core.Methods.Graph.BAC.Proxemy (confluence)
 import Gargantext.Core.Statistics
 import Gargantext.Core.Viz.Graph
 import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Partitions, ToComId(..))
 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
 import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass)
+import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap)
 import Gargantext.Core.Viz.Graph.Utils (edgesFilter)
 import Gargantext.Prelude
 import Graph.Types (ClusterNode)
@@ -47,7 +50,7 @@ import qualified IGraph                   as Igraph
 import qualified IGraph.Algorithms.Layout as Layout
 
 
-data PartitionMethod = Spinglass | Confluence
+data PartitionMethod = Spinglass | Confluence | Infomap
     deriving (Generic, Eq, Ord, Enum, Bounded, Show)
 instance FromJSON  PartitionMethod
 instance ToJSON    PartitionMethod
@@ -89,21 +92,25 @@ cooc2graph' distance threshold myCooc
 cooc2graphWith :: PartitionMethod
                -> Distance
                -> Threshold
+               -> Strength
                -> HashMap (NgramsTerm, NgramsTerm) Int
                -> IO Graph
 cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
 cooc2graphWith Confluence= cooc2graphWith' (\x -> pure $ BAC.defaultClustering x)
+cooc2graphWith Infomap   = cooc2graphWith' (infomap "--silent --two-level -N2")
+                        -- TODO: change these options, or make them configurable in UI?
 
 
 cooc2graphWith' :: ToComId a
                => Partitions a
                -> Distance
                -> Threshold
+               -> Strength
                -> HashMap (NgramsTerm, NgramsTerm) Int
                -> IO Graph
-cooc2graphWith' doPartitions distance threshold myCooc = do
-  let
-    (distanceMap, diag, ti) = doDistanceMap distance threshold myCooc
+cooc2graphWith' doPartitions distance threshold strength myCooc = do
+  let (distanceMap, diag, ti) = doDistanceMap distance threshold strength myCooc
+  distanceMap `seq` trace "distanceMap OK" diag `seq` trace "diag OK" ti `seq` printDebug "ti done" ()
 
 --{- -- Debug
   -- saveAsFileDebug "/tmp/distanceMap" distanceMap
@@ -117,7 +124,7 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
                                 , "Maybe you should add more Map Terms in your list"
                                 , "Tutorial: link todo"
                                 ]
-
+  partitions `seq` printDebug "partitions done" ()
   let
     nodesApprox :: Int
     nodesApprox = n'
@@ -125,19 +132,26 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
         (as, bs) = List.unzip $ Map.keys distanceMap
         n' = Set.size $ Set.fromList $ as <> bs
     bridgeness' = bridgeness (fromIntegral nodesApprox) partitions distanceMap
-    confluence' = confluence (Map.keys bridgeness') 3 True False
-
-  pure $ data2graph ti diag bridgeness' confluence' partitions
+    confluence' = Map.empty -- confluence (Map.keys bridgeness') 3 True False
+  seq bridgeness' $ printDebug "bridgeness OK" ()
+  saveAsFileDebug "/tmp/bridgeness" bridgeness'
+  --seq confluence' $ printDebug "confluence OK" ()
+  --saveAsFileDebug "/tmp/confluence" confluence'
+  let g = data2graph ti diag bridgeness' confluence' partitions
+  --saveAsFileDebug "/tmp/graph" g
+  pure g
 
+type Reverse = Bool
 
 doDistanceMap :: Distance
               -> Threshold
+              -> Strength
               -> HashMap (NgramsTerm, NgramsTerm) Int
               -> ( Map (Int,Int) Double
                  , Map (Index, Index) Int
                  , Map NgramsTerm Index
                  )
-doDistanceMap Distributional threshold myCooc = (distanceMap, toIndex ti diag, ti)
+doDistanceMap Distributional threshold strength myCooc = (distanceMap, toIndex ti diag, ti)
   where
     -- TODO remove below
     (diag, theMatrix) = Map.partitionWithKey (\(x,y) _ -> x == y)
@@ -147,22 +161,23 @@ doDistanceMap Distributional threshold myCooc = (distanceMap, toIndex ti diag, t
     (ti, _it) = createIndices theMatrix
     tiSize  = Map.size ti
 
-    similarities = measure Distributional
-                 $ map2mat Square 0 tiSize
-                 $ toIndex ti theMatrix
+    similarities = (\m -> m `seq` trace "measure done" m)
+                 $ (\m -> m `seq` trace "map2mat done" (measure Distributional m))
+                 $ (\m -> m `seq` trace "toIndex done" (map2mat Square 0 tiSize m))
+                 $ theMatrix `seq` trace "theMatrix done" (toIndex ti theMatrix)
 
     links = round (let n :: Double = fromIntegral tiSize in n * (log n)^(2::Int))
 
-    distanceMap = Map.fromList
+    distanceMap = Map.fromList . trace "fromList" identity
                 $ List.take links
-                $ List.reverse
+                $ (if strength == Weak then List.reverse else identity)
                 $ List.sortOn snd
                 $ Map.toList
                 $ edgesFilter
-                $ Map.filter (> threshold)
-                $ mat2map similarities
+                $ (\m -> m `seq` trace "map2map done" (Map.filter (> threshold) m))
+                $ similarities `seq` mat2map (trace "similarities done" similarities)
 
-doDistanceMap Conditional threshold myCooc = (distanceMap, toIndex ti myCooc', ti)
+doDistanceMap Conditional threshold strength myCooc = (distanceMap, toIndex ti myCooc', ti)
   where
     myCooc' = Map.fromList $ HashMap.toList myCooc
     (ti, _it) = createIndices myCooc'
@@ -172,6 +187,7 @@ doDistanceMap Conditional threshold myCooc = (distanceMap, toIndex ti myCooc', t
     distanceMap = toIndex ti
                 $ Map.fromList
                 $ List.take links
+                $ (if strength == Weak then List.reverse else identity)
                 $ List.sortOn snd
                 $ HashMap.toList
                 $ HashMap.filter (> threshold)
@@ -321,11 +337,11 @@ filterByNeighbours threshold distanceMap = filteredMap
     indexes = List.nub $ List.concat $ map (\(idx,idx') -> [idx,idx'] ) $ Map.keys distanceMap
     filteredMap :: Map (Index, Index) Double
     filteredMap = Map.fromList
-                $ List.concat 
-                $ map (\idx -> 
+                $ List.concat
+                $ map (\idx ->
                           let selected = List.reverse
                                        $ List.sortOn snd
-                                       $ Map.toList 
+                                       $ Map.toList
                                        $ Map.filter (> 0)
                                        $ Map.filterWithKey (\(from,_) _ -> idx == from) distanceMap
                            in List.take (round threshold) selected
@@ -333,5 +349,3 @@ filterByNeighbours threshold distanceMap = filteredMap
 
 
 
-
-

src/Gargantext/Core/Viz/Graph/Tools/Infomap.hs

+module Gargantext.Core.Viz.Graph.Tools.Infomap where
+
+import Data.Map (Map)
+import Graph.Types
+import Prelude
+
+import qualified Data.Graph.Infomap          as I
+import qualified Data.Graph.Infomap.Internal as I
+
+
+infomap :: String -> Map (Int, Int) Double -> IO [ClusterNode]
+infomap infomapCfg gr = map mkClustNode <$> I.infomap infomapCfg gr
+
+  where mkClustNode (I.CNode nid cid) =
+          ClusterNode (fromIntegral nid) (fromIntegral cid)

src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs

@@ -103,6 +103,7 @@ data ContactWho =
              , _cw_lastName    :: Maybe Text
              , _cw_keywords :: [Text]
              , _cw_freetags :: [Text]
+             , _cw_description :: Maybe Text
   } deriving (Eq, Show, Generic)
 
 instance GQLType ContactWho where
@@ -120,7 +121,8 @@ contactWho fn ln =
              , _cw_firstName = Just fn
              , _cw_lastName = Just ln
              , _cw_keywords = []
-             , _cw_freetags = [] }
+             , _cw_freetags = []
+             , _cw_description = Nothing }
 
 data ContactWhere =
   ContactWhere { _cw_organization :: [Text]

src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs

@@ -25,16 +25,20 @@ import Gargantext.Database.Prelude (Cmd, mkCmd, JSONB)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 
+import Debug.Trace (trace)
+
 updateHyperdata :: ToJSON a => NodeId -> a -> Cmd err Int64
-updateHyperdata i h = mkCmd $ \c -> runUpdate_ c (updateHyperdataQuery i h)
+updateHyperdata i h = mkCmd $ \c -> putStrLn "before runUpdate_" >>
+                                    runUpdate_ c (updateHyperdataQuery i h) >>= \res ->
+                                    putStrLn "after runUpdate_" >> return res
 
 updateHyperdataQuery :: ToJSON a => NodeId -> a -> Update Int64
-updateHyperdataQuery i h = Update
+updateHyperdataQuery i h = seq h' $ trace "updateHyperdataQuery: encoded JSON" $ Update
    { uTable      = nodeTable
    , uUpdateWith = updateEasy (\  (Node _ni _nh _nt _nu _np _nn _nd _h)
-                                -> Node _ni _nh _nt _nu _np _nn _nd h'
+                                -> trace "updating mate" $ Node _ni _nh _nt _nu _np _nn _nd h'
                               )
-   , uWhere      = (\row -> _node_id row .== pgNodeId i )
+   , uWhere      = (\row -> trace "uWhere" $ _node_id row .== pgNodeId i )
    , uReturning  = rCount
    }
     where h' =  (sqlJSONB $ cs $ encode $ h)

stack.yaml

 resolver:
  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml
-flags: {}
+flags:
+    accelerate:
+        debug: true
 extra-package-dbs: []
 skip-ghc-check: true
 packages:
 - .
-
   #- 'deps/gargantext-graph'
   #- 'deps/haskell-opaleye'
 
@@ -34,7 +35,7 @@ extra-deps:
 - git: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude.git
   commit: 08096a4913572cf22762fa77613340207ec6d9fd
 - git: https://gitlab.iscpif.fr/gargantext/gargantext-graph.git
-  commit: f68f9e78ff4302f53d0855190574c2d818a00b4d
+  commit: 13131f5173e2e2ab35b968e53f0feaeee13ad8ac
   # Data Mining Libs
 - git: https://github.com/delanoe/data-time-segment.git
   commit: 10a416b9f6c443866b36479c3441ebb3bcdeb7ef
@@ -73,15 +74,15 @@ extra-deps:
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/pubmed.git
   commit: 02e03d9b856bd35d391f43da8525330f9d184615
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/istex.git
-  commit: 3888454a844180b87c8edd36b7e06fbdf8e9ffac
+  commit: a34bb341236d82cf3d488210bc1d8448a98f5808
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
   commit: 9a43470241690a19c1c381c42a62c5dd4e28dff2
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/isidore.git
   commit: 3db385e767d2100d8abe900833c6e7de3ac55e1b
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/arxiv-api.git
+  commit: 4d6ae5aad435c00cdae1d47ebb5281d13d7b172c
 #- git: https://gitlab.iscpif.fr/cgenie/arxiv-api.git
-  commit: f3e517cc40d92e282c5245b23d253d2ca3f802e5
-- arxiv-0.0.3@sha256:02de1114091d11f1f3ab401d104d125ad4301260806feb7f63b3dcefc7db88cf,1588
+#- arxiv-0.0.3@sha256:02de1114091d11f1f3ab401d104d125ad4301260806feb7f63b3dcefc7db88cf,1588
 
   # NP libs
   #- git: https://github.com/np/servant-job.git # waiting for PR
@@ -98,14 +99,21 @@ extra-deps:
 #- git: https://github.com/kaizhang/haskell-igraph.git
 - git: https://github.com/alpmestan/haskell-igraph.git
   commit: 9f55eb36639c8e0965c8bc539a57738869f33e9a
+- git: https://gitlab.iscpif.fr/gargantext/haskell-infomap.git
+  commit: 76b795c1eaca37f43418d07da9fbdf5f4e7d8f5c
 
   # Accelerate Linear Algebra and specific instances
-  # (UndecidableInstances for newer GHC version)
-- git: https://gitlab.iscpif.fr/anoe/accelerate.git
-  commit: f5c0e0071ec7b6532f9a9cd3eb33d14f340fbcc9
-- git: https://gitlab.iscpif.fr/anoe/accelerate-utility.git
-  commit: 83ada76e78ac10d9559af8ed6bd4064ec81308e4
-- accelerate-arithmetic-1.0.0.1@sha256:555639232aa5cad411e89247b27871d09352b987a754230a288c690b6de6d888,2096
+- git: https://github.com/alpmestan/accelerate.git
+  commit: 199a1f6594406229d3c5f402443b09d62f92e640
+- git: https://github.com/alpmestan/accelerate-arithmetic.git
+  commit: a110807651036ca2228a76507ee35bbf7aedf87a
+- git: https://gitlab.iscpif.fr/amestanogullari/accelerate-utility.git
+  commit: a3875fe652d3bb5acb522674c22c6c814c1b4ad0
+- git: https://github.com/alpmestan/accelerate-llvm.git
+  commit: 14629a850bb10fd1401e0ac1998df52c86e5c603
+  subdirs:
+    - accelerate-llvm/
+    - accelerate-llvm-native/
 - git: https://github.com/rspeer/wikiparsec.git
   commit: 9637a82344bb70f7fa8f02e75db3c081ccd434ce