Merge remote-tracking branch 'gitlab/dev' into cm/update-corpus-button

.gitignore

@@ -19,6 +19,9 @@ TAGS
 *.swp
 .dir-locals.el
 
+# VSCode
+.vscode
+
 # UI
 gui
 purescript-gargantext
@@ -29,8 +32,9 @@ doc
 deps
 _darcs
 *.pdf
-*.sql
+*.png
 *.ini
+*.toml
 !test-data/test_config.ini
 
 # Runtime
@@ -45,3 +49,7 @@ devops/docker/js-cache
 
 cabal.project.local
 gargantext_profile_out.dot
+
+dev.jwk
+.psc-ide-port
+logs/

.gitlab-ci.yml

 # Optimising CI speed by using tips from https://blog.nimbleways.com/let-s-make-faster-gitlab-ci-cd-pipelines/
-image: adinapoli/gargantext:v3.4
+#image: adinapoli/gargantext:v3.4
+image: cgenie/gargantext:9.4.8
 
 variables:
   STACK_ROOT: "${CI_PROJECT_DIR}/.stack-root"
@@ -37,7 +38,7 @@ cabal:
       - .cabal/
     policy: pull-push
   script:
-    - nix-shell --run "./bin/update-project-dependencies $CABAL_STORE_DIR && cabal --store-dir=$CABAL_STORE_DIR v2-build --flags 'test-crypto no-phylo-debug-logs' --ghc-options='-O0 -fclear-plugins'"
+    - nix-shell --run "./bin/update-project-dependencies $CABAL_STORE_DIR && cabal --store-dir=$CABAL_STORE_DIR v2-build all --flags 'test-crypto no-phylo-debug-logs' --ghc-options='-O0 -fclear-plugins'"
   allow_failure: false
 
 bench:

.gitlab/issue_templates/default.md

+
+## Summary
+
+(Summarize the bug encountered concisely with the version of code)
+
+## Steps to reproduce
+
+(How one can reproduce the issue - this is very important)
+
+## What is the current bug behavior?
+
+(What actually happens)
+
+## What is the expected correct behavior?
+
+(What you should see instead)
+
+## Relevant logs and/or screenshots
+
+(Paste any relevant logs - use code blocks (```) to format console output, logs, and code, as
+it's very hard to read otherwise.)
+
+## Possible fixes
+
+(If you can, link to the line of code that might be responsible for the problem)
+
+

CONTRIBUTING.md

-# Contributing
-
-## Code contribution
-
-We use Git to share and merge our code.
-
-## Style
-
-We are using the common Haskell Style:
-https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md
-
-## Code Of Conduct
-
-Be constructive as sharing our code of conduct
-
-## Chat with us
-
-We are on IRC:  [irc.oftc.net, channel #gargantext](ircs://irc.oftc.net:6697/#gargantext)
-
-You can join via Matrix, just search for: #_oftc_#gargantext:matrix.org
-
-You can also join via XMPP: <xmpp://#gargantext%irc.oftc.net@irc.jabberfr.org?join>

DEVELOPER_GUIDELINES.md

@@ -39,6 +39,7 @@ all developers about how to:
 
 The rest of the document try to answer all those questions.
 
+
 ## Glossary
 
 - GIT: _Git_ is a distributed version control system
@@ -57,7 +58,29 @@ The rest of the document try to answer all those questions.
 
 The following is a non-exhaustive list of the development guidelines.
 
-### Main working Branches
+### Style
+
+When we code, we try to use the [common Haskell Style guide](https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md).
+
+1. For new files, use the referenced style guide;
+2. For older files, which might have been written using a different code style, try to respect whichever style guide was used to write the file (to ensure consistency and minimise unwanted changes);
+3. Resist the urge of making style modifications mixed to general refactoring; rather separate those into independent commits, so that they are easy to revert if unwanted / not needed
+
+### Code Of Conduct
+
+Please be constructive as sharing our [code of conduct](https://gitlab.iscpif.fr/gargantext/main/blob/master/CODE_OF_CONDUCT.md).
+
+### Chat with us !
+
+We are on IRC:  [irc.oftc.net, channel #gargantext](ircs://irc.oftc.net:6697/#gargantext)
+
+You can join via Matrix, just search for: #_oftc_#gargantext:matrix.org
+
+You can also join via XMPP: <xmpp://#gargantext%irc.oftc.net@irc.jabberfr.org?join>
+
+## Git Collaboration Guidelines
+
+### Git Main working Branches
 
 3 main branches are used in the distributed version control system (Git) of GarganText:
 - _dev_ branch for latest development

bench-data/phylo/bpa-config.json

 {
-    "corpusPath"     : "Gargantext_DocsList-nodeId-185487.csv",
-    "listPath"       : "Gargantext_NgramsList-185488.csv",
+    "corpusPath"     : "Gargantext_DocsList-nodeId-185487.tsv",
+    "listPath"       : "Gargantext_NgramsList-185488.tsv",
     "outputPath"     : "data",
     "corpusParser"   : {
-        "tag" : "Csv",
-        "_csv_limit" : 1500000
+        "tag" : "Tsv",
+        "_tsv_limit" : 1500000
     },
     "listParser" : "V3",
     "phyloName"      : "bpa",

bench/Main.hs

-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications  #-}
+
 module Main where
 
 import Control.DeepSeq

bin/gargantext-admin/Main.hs

-{-|
-Module      : Main.hs
-Description : Gargantext Admin tools
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
-
-
- -}
-
-{-# LANGUAGE Strict            #-}
-
-module Main where
-
-import Gargantext.API.Dev (withDevEnv, runCmdDev)
-import Gargantext.API.Errors.Types
-import Gargantext.Database.Action.User.New (newUsers)
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd'')
-import Gargantext.Prelude
-import Gargantext.API.Admin.EnvTypes (DevEnv)
-import qualified Data.List.NonEmpty as NE
-
-main :: IO ()
-main = do
-  (iniPath:mails) <- getArgs
-
-  withDevEnv iniPath $ \env -> do
-    x <- runCmdDev env ((newUsers $ NE.map cs (NE.fromList mails)) :: Cmd'' DevEnv BackendInternalError (NonEmpty UserId))
-    putStrLn (show x :: Text)
-  pure ()

bin/gargantext-cbor2json/Main.hs

-
-import Prelude (IO, id, (.))
-import Data.Aeson (encode)
-import Codec.Serialise (deserialise)
-import qualified Data.ByteString.Lazy as L
-import Gargantext.Core.NodeStory (NodeListStory)
-
-main :: IO ()
-main = L.interact (encode . (id :: NodeListStory -> NodeListStory) . deserialise)

bin/gargantext-central-exchange/Main.hs

+{-|
+Module      : Main.hs
+Description : Gargantext central exchange for async notifications
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+ -}
+
+{-# LANGUAGE Strict            #-}
+
+module Main where
+
+import Control.Concurrent (threadDelay)
+import Control.Monad (join, mapM_)
+import Data.ByteString.Char8 qualified as C
+import Data.Text qualified as T
+import Gargantext.Core.AsyncUpdates.CentralExchange (gServer)
+import Gargantext.Core.AsyncUpdates.Constants (ceBind, ceConnect)
+import Gargantext.Prelude
+import Nanomsg
+import Options.Applicative
+
+
+data Command =
+    CEServer
+  | SimpleServer
+  | WSServer
+  | Client
+
+
+parser :: Parser (IO ())
+parser = subparser
+    ( command "ce-server" (info (pure gServer) idm)
+   <> command "simple-server" (info (pure simpleServer) idm)
+   <> command "ws-server" (info (pure wsServer) idm)
+   <> command "client" (info (pure gClient) idm) )
+
+
+main :: IO ()
+main = join $ execParser (info parser idm)
+
+simpleServer :: IO ()
+simpleServer = do
+  withSocket Pull $ \s -> do
+    _ <- bind s ceBind
+    putText "[simpleServer] receiving"
+    forever $ do
+      mr <- recv s
+      C.putStrLn mr
+      -- case mr of
+      --   Nothing -> pure ()
+      --   Just r -> C.putStrLn r
+      -- threadDelay 10000
+
+wsServer :: IO ()
+wsServer = do
+  withSocket Pull $ \ws -> do
+    _ <- bind ws "ws://*:5560"
+    forever $ do
+      putText "[wsServer] receiving"
+      r <- recv ws
+      C.putStrLn r
+    
+gClient :: IO ()
+gClient = do
+    withSocket Push $ \s -> do
+      _ <- connect s ceConnect
+      -- let str = C.unwords (take 10 $ repeat "hello")
+      let str = "{\"type\": \"update_tree_first_level\", \"node_id\": -1}"
+      C.putStrLn $ C.pack "sending: " <> str
+      send s str
+
+    withSocket Push $ \s -> do
+      _ <- connect s ceConnect
+      let str2 = "{\"type\": \"update_tree_first_level\", \"node_id\": -2}"
+      C.putStrLn $ C.pack "sending: " <> str2
+      send s str2
+

bin/gargantext-cli/CLI/Admin.hs

+
+module CLI.Admin (
+    adminCLI
+  , adminCmd
+  ) where
+
+import CLI.Parsers
+import CLI.Types
+import Data.List.NonEmpty qualified as NE
+import Data.Text qualified as T
+import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Dev
+import Gargantext.API.Errors
+import Gargantext.Core.Types
+import Gargantext.Database.Action.User.New
+import Gargantext.Database.Prelude
+import Gargantext.Prelude
+import Options.Applicative
+import Prelude (String)
+
+adminCLI :: AdminArgs -> IO ()
+adminCLI (AdminArgs settingsPath mails) = do
+  withDevEnv settingsPath $ \env -> do
+    x <- runCmdDev env ((newUsers $ NE.map cs (NE.fromList mails)) :: Cmd'' DevEnv BackendInternalError (NonEmpty UserId))
+    putStrLn (show x :: Text)
+
+adminCmd :: HasCallStack => Mod CommandFields CLI
+adminCmd = command "admin" (info (helper <*> fmap CLISub admin_p) (progDesc "Create users."))
+
+admin_p :: Parser CLICmd
+admin_p = fmap CCMD_admin $ AdminArgs
+  <$> settings_p
+  <*> ( option (maybeReader emails_p) ( long "emails"
+                      <> metavar "email1,email2,..."
+                      <> help "A comma-separated list of emails."
+                      ) )
+
+emails_p :: String -> Maybe [String]
+emails_p s = case T.splitOn "," (T.pack s) of
+  [] -> Nothing
+  xs -> pure $ map T.unpack xs

bin/gargantext-golden-file-diff/Main.hs → bin/gargantext-cli/CLI/FileDiff.hs

 
-module Main where
+module CLI.FileDiff where
 
-import Prelude
+import CLI.Types
+import Data.List qualified as L
+import Data.Text qualified as T
+import Data.Text.IO qualified as TIO
 import Data.TreeDiff.Class
 import Data.TreeDiff.Pretty
-import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
-import System.Environment (getArgs)
-import System.Exit (exitFailure)
-import Control.Monad (unless)
-import qualified Data.List as L
+import Gargantext.Prelude (HasCallStack, unless, exitFailure)
+import Options.Applicative
+import Prelude
 
 -- | Renders in a pretty way the content of two golden files. The
 -- first file should contain the expected output, the second the
 -- actual data generated by the test suite.
-main :: IO ()
-main = do
-  (refPath:newPath:_) <- getArgs
+fileDiffCLI :: GoldenFileDiffArgs -> IO ()
+fileDiffCLI (GoldenFileDiffArgs refPath newPath) = do
   ref <- T.lines <$> TIO.readFile refPath
   new <- T.lines <$> TIO.readFile newPath
 
@@ -25,3 +24,17 @@ main = do
   unless (L.null differences) $ do
     putStrLn $ show $ ansiWlEditExpr $ ediff' (map fst differences) (map snd differences)
     exitFailure
+
+fileDiffCmd :: HasCallStack => Mod CommandFields CLI
+fileDiffCmd = command "golden-file-diff" (info (helper <*> fmap CLISub filediff_p) (progDesc "Compare the output of two golden files."))
+
+filediff_p :: Parser CLICmd
+filediff_p = fmap CCMD_golden_file_diff $ GoldenFileDiffArgs
+  <$> ( strOption ( long "expected"
+                    <> metavar "FILEPATH"
+                    <> help "Path to the file containing the expected output."
+                    ) )
+  <*> ( strOption ( long "actual"
+                    <> metavar "FILEPATH"
+                    <> help "Path to the file containing the actual output."
+                    ) )

bin/gargantext-cli/CLI/FilterTermsAndCooc.hs

+
+module CLI.FilterTermsAndCooc (
+    filterTermsAndCoocCmd
+  , filterTermsAndCoocCLI
+
+  -- * Testing functions
+  , testCorpus
+  , testTermList
+  ) where
+
+import CLI.Types
+import Control.Concurrent.Async as CCA (mapConcurrently)
+import Data.Aeson ( encode )
+import Data.Map.Strict qualified as DM
+import Data.Text (pack)
+import Data.Text qualified as DT
+import Data.Text.Lazy qualified as DTL
+import Data.Text.Lazy.Encoding qualified as TLE
+import Data.Tuple.Extra (both)
+import Data.Vector qualified as DV
+import GHC.Generics
+import Gargantext.Core.Text.Context (TermList)
+import Gargantext.Core.Text.Corpus.Parsers.TSV (readTSVFile, tsv_title, tsv_abstract, tsv_publication_year, fromMIntOrDec, defaultYear)
+import Gargantext.Core.Text.List.Formats.TSV (tsvMapTermList)
+import Gargantext.Core.Text.Metrics.Count (coocOnContexts, Coocs)
+import Gargantext.Core.Text.Terms.WithList ( Patterns, buildPatterns, extractTermsWithList )
+import Gargantext.Prelude
+import Options.Applicative
+
+------------------------------------------------------------------------
+-- OUTPUT format
+
+data CoocByYear = CoocByYear { year         :: Int
+                             , nbContexts   :: NbContexts
+                             , coocurrences :: Map (Text, Text) Coocs
+                             } deriving (Show, Generic)
+
+data CoocByYears = CoocByYears { years :: [CoocByYear] }
+  deriving (Show, Generic)
+
+type NbContexts = Int
+
+instance ToJSON CoocByYear
+instance ToJSON CoocByYears
+------------------------------------------------------------------------
+
+filterTermsAndCoocCLI :: CorpusFile -> TermListFile -> OutputFile -> IO ()
+filterTermsAndCoocCLI (CorpusFile corpusFile) (TermListFile termListFile) (OutputFile outputFile) = do
+  --corpus :: IO (DM.IntMap [[Text]])
+  eCorpusFile <- readTSVFile corpusFile
+  case eCorpusFile of
+    Right cf -> do
+      let corpus = DM.fromListWith (<>)
+                   . DV.toList
+                   . DV.map (\n -> (fromMIntOrDec defaultYear $ tsv_publication_year n, [(tsv_title n) <> " " <> (tsv_abstract n)]))
+                   . snd $ cf
+
+      -- termListMap :: [Text]
+      termList <- tsvMapTermList termListFile
+
+      putText $ show $ length termList
+
+      let patterns = buildPatterns termList
+
+      -- r <- mapConcurrentlyChunked (filterTermsAndCooc patterns) (DM.toList corpus)
+      r <-  mapConcurrently (filterTermsAndCooc patterns) (DM.toList corpus)
+      writeFile outputFile $ DTL.toStrict $ TLE.decodeUtf8 $ encode (CoocByYears r)
+    Left e -> panicTrace $ "Error: " <> e
+
+
+
+
+filterTermsAndCooc
+  :: Patterns
+     -> (Int, [Text])
+     -> IO CoocByYear -- (Int, (Map (Text, Text) Coocs))
+filterTermsAndCooc patterns (year, ts) = do
+  logWork "start"
+  r <- coocOnContexts identity <$> mapM (\x -> {-log "work" >>-} terms' patterns x) ts
+  logWork "stop"
+  pure $ CoocByYear year (length ts) (DM.mapKeys (both DT.unwords) r)
+  where
+
+    logWork m = do
+      tid    <- myThreadId
+      (p, _) <- threadCapability tid
+      putText . unwords $
+        ["filterTermsAndCooc:", m, show year, "on proc", show p]
+
+--terms' :: Patterns -> Text -> Corpus [[Text]]
+terms' :: Applicative f => Patterns -> Text -> f [[Text]]
+terms' pats txt = pure $ concat $ extractTermsWithList pats txt
+
+
+-- | TODO Minimal Example
+--testCooc = do
+--  let patterns = buildPatterns testTermList
+--  mapM (\x -> {-log "work" >>-} terms' patterns x) $ catMaybes $ map (head . snd) testCorpus
+--  --mapConcurrently (filterTermsAndCooc patterns) testCorpus
+
+
+testCorpus :: [(Int, [Text])]
+testCorpus = [ (1998, [pack "The beees"])
+             , (1999, [ pack "The bees and the flowers"
+                      --, pack "The bees and the flowers"
+                      ])
+             ]
+
+testTermList :: TermList
+testTermList = [ ([pack "bee"], [[pack "bees"]])
+               , ([pack "flower"], [[pack "flowers"]])
+               ]
+
+--
+-- CLI API
+--
+
+filterTermsAndCoocCmd :: HasCallStack => Mod CommandFields CLI
+filterTermsAndCoocCmd = command "filter-terms" (info (helper <*> fmap CLISub filterTerms) (progDesc "Filter Terms and Cooc."))
+
+filterTerms :: Parser CLICmd
+filterTerms = CCMD_filter_terms_and_cooc
+  <$> (option str (long "corpus-file" <> metavar "FILE"))
+  <*> (option str (long "terms-list-file" <> metavar "FILE"))
+  <*> (option str (long "output-file" <> metavar "FILE"))

bin/gargantext-import/Main.hs → bin/gargantext-cli/CLI/Import.hs

 {-|
-Module      : Main.hs
+Module      : Import.hs
 Description : Gargantext Import Corpus
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -12,10 +12,14 @@ Import a corpus binary.
  -}
 
 {-# LANGUAGE Strict            #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE LambdaCase #-}
 
-module Main where
+module CLI.Import where
 
-import Data.Text qualified as Text
+import CLI.Parsers
+import CLI.Types
 import Gargantext.API.Admin.EnvTypes (DevEnv(..), DevJobHandle(..))
 import Gargantext.API.Dev (withDevEnv, runCmdGargDev)
 import Gargantext.API.Errors.Types ( BackendInternalError )
@@ -23,66 +27,62 @@ import Gargantext.API.Node () -- instances
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..))
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Core.Types.Query (Limit)
+import Gargantext.Core.Types.Query
 import Gargantext.Database.Action.Flow (flowCorpusFile, flowAnnuaire, TermType(..))
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node (CorpusId)
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusName))
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs.Monad ( MonadJobStatus, JobHandle )
+import Options.Applicative
+import Prelude (String)
+import qualified Data.Text as T
 
 
-main :: IO ()
-main = do
-  [fun, user, name, iniPath, limit, corpusPath] <- getArgs
-
-  --{-
-
+importCLI :: ImportArgs -> IO ()
+importCLI (ImportArgs fun user name settingsPath limit corpusPath) = do
   let
-    --tt = (Unsupervised EN 6 0 Nothing)
-    tt = (Multi EN)
-    format = CsvGargV3 -- CsvHal --WOS
-    limit' = case (readMaybe limit :: Maybe Limit) of
-      Nothing -> panicTrace $ "Cannot read limit: " <> (Text.pack limit)
-      Just l  -> l
+    tt     = Multi EN
+    format = TsvGargV3
     corpus :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
     mkCorpusUser = MkCorpusUserNormalCorpusName (UserName $ cs user) (cs name :: Text)
-    corpus = flowCorpusFile mkCorpusUser limit' tt  format Plain corpusPath Nothing DevJobHandle
+    corpus = flowCorpusFile mkCorpusUser limit tt  format Plain corpusPath Nothing DevJobHandle
 
-    corpusCsvHal :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
-    corpusCsvHal = flowCorpusFile mkCorpusUser limit' tt CsvHal Plain corpusPath Nothing DevJobHandle
+    corpusTsvHal :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
+    corpusTsvHal = flowCorpusFile mkCorpusUser limit tt TsvHal Plain corpusPath Nothing DevJobHandle
 
     annuaire :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
     annuaire = flowAnnuaire (MkCorpusUserNormalCorpusName (UserName $ cs user) "Annuaire") (Multi EN) corpusPath DevJobHandle
 
-  {-
-  let debatCorpus :: forall m. FlowCmdM DevEnv BackendInternalError m => m CorpusId
-      debatCorpus = do
-        docs <- liftIO ( splitEvery 500
-                       <$> take (read limit :: Int)
-                       <$> readFile corpusPath
-                       :: IO [[GrandDebatReference ]]
-                       )
-        flowCorpus (Text.pack user) (Text.pack name) (Multi FR) (map (map toHyperdataDocument) docs)
-  --}
+  withDevEnv settingsPath $ \env -> do
+    void $ case fun of
+      IF_corpus
+        -> runCmdGargDev env corpus
+      IF_corpusTsvHal
+        -> runCmdGargDev env corpusTsvHal
+      IF_annuaire
+        -> runCmdGargDev env annuaire
+
+importCmd :: HasCallStack => Mod CommandFields CLI
+importCmd = command "import" (info (helper <*> fmap CLISub import_p) (progDesc "Import CLI."))
 
-  withDevEnv iniPath $ \env -> do
-    _ <- if fun == "corpus"
-          then runCmdGargDev env corpus
-          else pure 0 --(cs "false")
+renderImportFunction :: ImportFunction -> T.Text
+renderImportFunction = T.drop 3 . T.pack . show
 
-    _ <- if fun == "corpusCsvHal"
-          then runCmdGargDev env corpusCsvHal
-          else pure 0 --(cs "false")
+import_p :: Parser CLICmd
+import_p = fmap CCMD_import $ ImportArgs
+  <$> ( option (eitherReader function_p) ( long "function"
+                    <> help ("The function to use, one between: " <> (T.unpack $ T.intercalate "," $ map renderImportFunction [minBound .. maxBound]))
+                    ) )
+  <*> ( option str ( long "user") )
+  <*> ( option str ( long "name") )
+  <*> settings_p
+  <*> (fmap Limit ( option auto ( long "limit" <> metavar "INT" <> help "The limit for the query") ))
+  <*> ( option str ( long "corpus-path" <> help "Path to corpus file") )
 
-    _ <- if fun == "annuaire"
-            then runCmdGargDev env annuaire
-            else pure 0
-    {-
-    _ <- if corpusType == "csv"
-            then runCmdDev env csvCorpus
-            else if corpusType == "debat"
-              then runCmdDev env debatCorpus
-              else panic "corpusType unknown: try \"csv\" or \"debat\""
-    -}
-    pure ()
+function_p :: String -> Either String ImportFunction
+function_p = \case
+  "corpus"       -> Right IF_corpus
+  "corpusTsvHal" -> Right IF_corpusTsvHal
+  "annuaire"     -> Right IF_annuaire
+  xs             -> Left $ "Unrecognised function: " <> xs

bin/gargantext-cli/CLI/Ini.hs

+{-|
+Module      : Ini.hs
+Description : Gargantext Ini file
+Copyright   : (c) CNRS, 2024-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Import a corpus binary.
+
+ -}
+
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE Strict            #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeApplications #-}
+
+module CLI.Ini where
+
+import CLI.Types
+import Control.Monad.Logger (LogLevel(LevelDebug))
+import Data.Text qualified as T
+import Data.Text.IO qualified as T (writeFile)
+import Database.PostgreSQL.Simple qualified as PGS
+import Gargantext.Core.Config qualified as Config
+import Gargantext.Core.Config.Ini.Ini qualified as Ini
+import Gargantext.Core.Config.Ini.Mail qualified as IniMail
+import Gargantext.Core.Config.Ini.NLP qualified as IniNLP
+import Gargantext.Core.Config.Types qualified as CTypes
+import Gargantext.Prelude
+import Options.Applicative
+import Servant.Client.Core (parseBaseUrl)
+import Toml qualified
+
+
+iniCLI :: IniArgs -> IO ()
+iniCLI iniArgs = do
+  let iniPath  = fromMaybe "gargantext.ini"           $ ini_path  iniArgs
+  let tomlPath = fromMaybe "gargantext-settings.toml" $ toml_path iniArgs
+  putStrLn $ "Reading configuration from file " <> iniPath <> "..."
+  ini <- Ini.readConfig iniPath
+  iniMail <- IniMail.readConfig iniPath
+  iniNLP <- IniNLP.readConfig iniPath
+  connInfo <- Ini.readDBConfig iniPath
+  let c = convertConfigs ini iniMail iniNLP connInfo
+  T.writeFile tomlPath (show (Toml.encode c) :: Text)
+  putStrLn $ "Converted configuration into TOML and wrote it to file " <> tomlPath
+
+iniCmd :: HasCallStack => Mod CommandFields CLI
+iniCmd = command "ini" (info (helper <*> fmap CLISub iniParser)
+                       (progDesc "Parse .ini file and output a corresponding .toml file."))
+
+iniParser :: Parser CLICmd
+iniParser = fmap CCMD_ini $ IniArgs <$>
+  (optional . strOption $ long "ini-path"  <> help "Path to the input ini file"   ) <*>
+  (optional . strOption $ long "toml-path" <> help "Path to the output .toml file")
+
+convertConfigs :: Ini.GargConfig -> IniMail.MailConfig -> IniNLP.NLPConfig -> PGS.ConnectInfo -> Config.GargConfig
+convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
+  Config.GargConfig { _gc_secrets = CTypes.SecretsConfig { _s_master_user = _gc_masteruser
+                                                         , _s_secret_key = _gc_secretkey
+                                                         , _s_jwk_file = CTypes.JWKFile "dev.jwk" }
+                    , _gc_datafilepath
+                    , _gc_mail_config = iniMail
+                    , _gc_nlp_config = nlpConfig
+                    , _gc_frontend_config = mkFrontendConfig ini
+                    , _gc_database_config = connInfo
+                    , _gc_notifications_config = defaultNotificationsConfig
+                    , _gc_frames = CTypes.FramesConfig { _f_write_url = _gc_frame_write_url
+                                                       , _f_calc_url = _gc_frame_calc_url
+                                                       , _f_visio_url = _gc_frame_visio_url
+                                                       , _f_searx_url = _gc_frame_searx_url
+                                                       , _f_istex_url = _gc_frame_istex_url }
+                    , _gc_jobs = CTypes.JobsConfig { _jc_max_docs_parsers = _gc_max_docs_parsers
+                                                   , _jc_max_docs_scrapers = _gc_max_docs_scrapers
+                                                   , _jc_js_job_timeout = _gc_js_job_timeout
+                                                   , _jc_js_id_timeout = _gc_js_id_timeout }
+                    , _gc_apis = CTypes.APIsConfig { _ac_pubmed_api_key = _gc_pubmed_api_key
+                                                   , _ac_epo_api_url = _gc_epo_api_url
+                                                   , _ac_scrapyd_url }
+                    , _gc_log_level = LevelDebug
+                    }
+  where
+    _ac_scrapyd_url =
+      case parseBaseUrl "http://localhost:6800" of
+        Nothing -> panicTrace "Cannot parse base url for scrapyd"
+        Just b -> b
+
+mkFrontendConfig :: Ini.GargConfig -> CTypes.FrontendConfig
+mkFrontendConfig (Ini.GargConfig { .. }) =
+  CTypes.FrontendConfig { _fc_url = _gc_url
+                        , _fc_backend_name = _gc_backend_name
+                        , _fc_url_backend_api = _gc_url_backend_api
+                        , _fc_cors
+                        , _fc_microservices
+                        , _fc_appPort = 3000
+                        , _fc_cookie_settings = CTypes.defaultCookieSettings }
+  where
+    _fc_cors = CTypes.CORSSettings { _corsAllowedOrigins = [
+                                         toCORSOrigin "https://demo.gargantext.org"
+                                       , toCORSOrigin "https://formation.gargantext.org"
+                                       , toCORSOrigin "https://academia.sub.gargantext.org"
+                                       , toCORSOrigin "https://cnrs.gargantext.org"
+                                       , toCORSOrigin "https://imt.sub.gargantext.org"
+                                       , toCORSOrigin "https://helloword.gargantext.org"
+                                       , toCORSOrigin "https://complexsystems.gargantext.org"
+                                       , toCORSOrigin "https://europa.gargantext.org"
+                                       , toCORSOrigin "https://earth.sub.gargantext.org"
+                                       , toCORSOrigin "https://health.sub.gargantext.org"
+                                       , toCORSOrigin "https://msh.sub.gargantext.org"
+                                       , toCORSOrigin "https://dev.sub.gargantext.org"
+                                       , toCORSOrigin "http://localhost:8008"
+                                       , toCORSOrigin "http://localhost:8108"
+                                       , toCORSOrigin "http://localhost:3000"
+                                       ]
+                                   , _corsAllowedHosts = []
+                                   , _corsUseOriginsForHosts = True }
+    _fc_microservices = CTypes.MicroServicesSettings { _msProxyPort = 8009
+                                                     , _msProxyEnabled = False }
+    toCORSOrigin :: Text -> CTypes.CORSOrigin
+    toCORSOrigin url =
+      case parseBaseUrl (T.unpack url) of
+        Nothing -> panicTrace $ "Cannot parse base url for: " <> url
+        Just b -> CTypes.CORSOrigin b
+
+defaultNotificationsConfig :: CTypes.NotificationsConfig
+defaultNotificationsConfig =
+  CTypes.NotificationsConfig { _nc_central_exchange_bind = "tcp://*:5560"
+                             , _nc_central_exchange_connect = "tcp://localhost:5560"
+                             , _nc_dispatcher_bind = "tcp://*:5561"
+                             , _nc_dispatcher_connect = "tcp://localhost:5561" }

bin/gargantext-init/Main.hs → bin/gargantext-cli/CLI/Init.hs

 {-|
-Module      : Main.hs
-Description : Gargantext Import Corpus
+Module      : Init.hs
+Description : Gargantext Init Script
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-Import a corpus binary.
+Initialise the Gargantext dataset.
 
  -}
 
 {-# LANGUAGE Strict            #-}
 
-module Main where
+module CLI.Init where
 
+import CLI.Parsers
+import CLI.Types
 import Data.List.NonEmpty qualified as NE
 import Gargantext.API.Dev (withDevEnv, runCmdDev)
 import Gargantext.API.Errors.Types
 import Gargantext.API.Node () -- instances only
+import Gargantext.Core.Config (GargConfig(..))
+import Gargantext.Core.Config.Types (SecretsConfig(..))
+import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.Types.Individu (User(..), arbitraryNewUsers, NewUser(..), arbitraryUsername, GargPassword(..))
 import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
 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 (Cmd, DBCmd)
+import Gargantext.Database.Prelude (DBCmd')
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Database.Query.Table.User (insertNewUsers, )
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserMaster))
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (GargConfig(..), readConfig)
+import Options.Applicative
 
 
-main :: IO ()
-main = do
-  params@[iniPath] <- getArgs
-
-  _ <- if length params /= 1
-      then panicTrace "USAGE: ./gargantext-init gargantext.ini"
-      else pure ()
-
+initCLI :: InitArgs -> IO ()
+initCLI (InitArgs settingsPath) = do
   putStrLn ("Enter master user (gargantua) _password_ :" :: Text)
   password  <- getLine
 
   putStrLn ("Enter master user (gargantua) _email_ :" :: Text)
   email     <- getLine
 
-  cfg       <- readConfig         iniPath
-  let secret = _gc_secretkey cfg
+  cfg       <- readConfig         settingsPath
+  let secret = _s_secret_key $ _gc_secrets cfg
 
-  let createUsers :: Cmd BackendInternalError Int64
+  let createUsers :: forall env. DBCmd' env BackendInternalError Int64
       createUsers = insertNewUsers (NewUser "gargantua" (cs email) (GargPassword $ cs password)
                                    NE.:| arbitraryNewUsers
                                    )
 
   let
-    mkRoots :: Cmd BackendInternalError [(UserId, RootId)]
+    mkRoots :: forall env. DBCmd' env BackendInternalError [(UserId, RootId)]
     mkRoots = mapM getOrMkRoot $ map UserName ("gargantua" : arbitraryUsername)
     -- TODO create all users roots
 
   let
-    initMaster :: Cmd BackendInternalError (UserId, RootId, CorpusId, ListId)
+    initMaster :: forall env. DBCmd' env BackendInternalError (UserId, RootId, CorpusId, ListId)
     initMaster = do
       (masterUserId, masterRootId, masterCorpusId)
                   <- getOrMkRootWithCorpus MkCorpusUserMaster
@@ -69,10 +69,16 @@ main = do
       _triggers    <- initLastTriggers masterListId
       pure (masterUserId, masterRootId, masterCorpusId, masterListId)
 
-  withDevEnv iniPath $ \env -> do
+  withDevEnv settingsPath $ \env -> do
     _ <- runCmdDev env (initFirstTriggers secret :: DBCmd BackendInternalError [Int64])
     _ <- runCmdDev env createUsers
     x <- runCmdDev env initMaster
     _ <- runCmdDev env mkRoots
     putStrLn (show x :: Text)
-    pure ()
+
+initCmd :: HasCallStack => Mod CommandFields CLI
+initCmd = command "init" (info (helper <*> fmap CLISub init_p) (progDesc "Initialise this Gargantext instance."))
+
+init_p :: Parser CLICmd
+init_p = fmap CCMD_init $ InitArgs
+  <$> settings_p

bin/gargantext-cli/CLI/Invitations.hs

+{-|
+Module      : Invitations.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 CLI.Invitations where
+
+import CLI.Parsers
+import CLI.Types
+import Gargantext.API.Dev (withDevEnv, runCmdDev)
+import Gargantext.API.Errors.Types
+import Gargantext.API.Node () -- instances only
+import Gargantext.API.Node.Share qualified as Share
+import Gargantext.API.Node.Share.Types qualified as Share
+import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
+import Gargantext.Core.NLP (HasNLPServer)
+import Gargantext.Core.Types
+import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Database.Prelude (CmdRandom)
+import Gargantext.Prelude
+import Options.Applicative
+import Prelude (String)
+
+invitationsCLI :: InvitationsArgs -> IO ()
+invitationsCLI (InvitationsArgs settingsPath user node_id email) = do
+  -- _cfg       <- readConfig settingsPath
+
+  let invite :: ( CmdRandom env BackendInternalError m
+                , HasNLPServer env
+                , CET.HasCentralExchangeNotification env ) => m Int
+      invite = Share.api (UserName $ cs user) node_id (Share.ShareTeamParams $ cs email)
+
+  withDevEnv settingsPath $ \env -> do
+    void $ runCmdDev env invite
+
+invitationsCmd :: HasCallStack => Mod CommandFields CLI
+invitationsCmd = command "invitations" (info (helper <*> fmap CLISub invitations_p) (progDesc "Mailing invitations."))
+
+invitations_p :: Parser CLICmd
+invitations_p = fmap CCMD_invitations $ InvitationsArgs
+  <$> settings_p
+  <*> ( strOption ( long "user" ) )
+  <*> ( option (eitherReader node_p)  ( long "node-id" <> metavar "POSITIVE-INT" <> help "The node ID.") )
+  <*> ( strOption ( long "email" <> help "The email address.") )
+
+node_p :: String -> Either String NodeId
+node_p i = case readMaybe i of
+  Nothing -> Left $ i <> " is not a valid integer."
+  Just xs
+    | xs < 0 -> Left $ "The node id needs to be a positive integer."
+    | otherwise
+    -> Right $ UnsafeMkNodeId xs

bin/gargantext-db-obfuscation/Main.hs → bin/gargantext-cli/CLI/ObfuscateDB.hs

@@ -28,8 +28,10 @@ https://stackoverflow.com/questions/876522/creating-a-copy-of-a-database-in-post
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE Strict            #-}
 
-module Main where
-
+module CLI.ObfuscateDB (
+    obfuscateDB
+  , obfuscateDBCmd
+  ) where
 
 import Data.Text qualified as T
 import Database.PostgreSQL.Simple qualified as PSQL
@@ -37,23 +39,16 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.Core (toDBid)
 import Gargantext.Database.Admin.Config ()
 import Gargantext.Database.Admin.Types.Node (NodeType(..))
-import Gargantext.Prelude hiding (option)
+import Gargantext.Prelude
 import Gargantext.Prelude.Database (runPGSExecute, runPGSQuery)
-import Options.Applicative.Simple
-
-
+import CLI.Types
+import Options.Applicative
 
-data Args = Args {
-    dbHost     :: Text
-  , dbPort     :: Int
-  , dbName     :: Text
-  , dbUser     :: Text
-  , dbPassword :: Text
-  } deriving (Show, Eq)
+obfuscateDBCmd :: HasCallStack => Mod CommandFields CLI
+obfuscateDBCmd = command "obfuscate-db" (info (helper <*> fmap CLISub obfuscateDB_p) (progDesc "Obfuscate a cloned Gargantext DB."))
 
-
-args :: Parser Args
-args = Args
+obfuscateDB_p :: Parser CLICmd
+obfuscateDB_p = fmap CCMD_obfuscate_db $ ObfuscateDBArgs
   <$> ( strOption ( long "db-host"
                     <> metavar "db-host"
                     <> help "Location of the DB server"
@@ -71,17 +66,9 @@ args = Args
   <*> ( strOption ( long "db-password"
                     <> metavar "db-password"
                     <> value "" ))
-  
-
-main :: IO ()
-main = do
-  (opts, ()) <-
-    simpleOptions "0.0.1"
-                  "gargantext DB obfuscation"
-                  "Obfuscates a cloned Gargantext DB"
-                  args
-                  empty
 
+obfuscateDB :: ObfuscateDBArgs -> IO ()
+obfuscateDB opts = do
   putText $ show opts
 
   let ci = PSQL.ConnectInfo { connectHost     = T.unpack $ dbHost opts
@@ -101,7 +88,7 @@ main = do
 obfuscateNotes :: PSQL.Connection -> IO ()
 obfuscateNotes c = do
   let nt = toDBid Notes
-  
+
   _ <- runPGSExecute c [sql|UPDATE nodes SET name = concat('notes-', id) WHERE typename = ?;|] (PSQL.Only nt)
 
   nsNew <- runPGSQuery c [sql|SELECT id, name FROM nodes WHERE typename = ?|] (PSQL.Only nt) :: IO [(Int, Text)]

bin/gargantext-cli/CLI/Parsers.hs

+
+{-| Common parsers for the CLI. -}
+
+module CLI.Parsers where
+
+import Prelude
+import Gargantext.Core.Config.Types (SettingsFile(..))
+import Options.Applicative
+
+settings_p :: Parser SettingsFile
+settings_p = maybe (SettingsFile "gargantext-settings.toml") SettingsFile <$>
+  optional ( strOption ( long "settings-path"
+                    <> short 'c'
+                    <> metavar "FILEPATH"
+                    <> value "gargantext-settings.toml"
+                    <> showDefault
+                    <> help "Location of the gargantext-settings.toml file"
+                    ) )

bin/gargantext-cli/CLI/Phylo.hs

+{-|
+Module      : Phylo.hs
+Description : Gargantext starter binary with Adaptative Phylo
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Adaptative Phylo binaries
+ -}
+
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE Strict             #-}
+
+module CLI.Phylo where
+
+import CLI.Phylo.Common
+import CLI.Types
+import Data.Aeson (eitherDecodeFileStrict')
+import Data.List  (nub)
+import Data.Text qualified as T
+import GHC.IO.Encoding
+import Gargantext.Core.Viz.Phylo
+import Gargantext.Core.Viz.Phylo.API.Tools
+import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
+import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloWithoutLink)
+import Gargantext.Core.Viz.Phylo.PhyloTools  (printIOMsg, printIOComment, setConfig)
+import Gargantext.Prelude hiding (hash, replace)
+import Options.Applicative
+import System.Directory (doesFileExist)
+
+phyloCLI :: PhyloArgs -> IO ()
+phyloCLI (PhyloArgs configPath) = do
+  setLocaleEncoding utf8
+  config_e <- eitherDecodeFileStrict' configPath
+  case config_e of
+    Left err -> panicTrace $ T.pack err
+    Right config -> do
+      currentLocale <- getLocaleEncoding
+      printIOMsg $ "Machine locale: " <> show currentLocale
+      printIOMsg "Starting the reconstruction"
+      printIOMsg "Parse the corpus"
+      mapList <-  fileToList (listParser config) (listPath config)
+
+      corpus  <- if (defaultMode config)
+                  then fileToDocsDefault (corpusParser config) (corpusPath config) [Year 3 1 5,Month 3 1 5,Week 4 2 5] mapList
+                  else fileToDocsAdvanced (corpusParser config) (corpusPath config) (timeUnit config)  mapList
+
+      printIOComment (show (length corpus) <> " parsed docs from the corpus")
+
+      printIOComment (show (length $ nub $ concat $ map text corpus) <> " Size ngs_coterms")
+
+      printIOComment (show (length mapList) <> " Size ngs_terms List Map Ngrams")
+
+      printIOMsg "Reconstruct the phylo"
+
+      -- check the existing backup files
+
+      let backupPhyloWithoutLink = (outputPath config) <> "backupPhyloWithoutLink_" <> (configToSha BackupPhyloWithoutLink config) <> ".json"
+      let backupPhylo = (outputPath config) <> "backupPhylo_"   <> (configToSha BackupPhylo config) <> ".json"
+
+      phyloWithoutLinkExists <- doesFileExist backupPhyloWithoutLink
+      phyloExists   <- doesFileExist backupPhylo
+
+      -- reconstruct the phylo
+
+      phylo <- if phyloExists
+                  then do
+                    printIOMsg "Reconstruct the phylo from an existing file"
+                    readPhylo backupPhylo
+                  else do
+                    if phyloWithoutLinkExists
+                      then do
+                        printIOMsg "Reconstruct the phylo from an existing file without links"
+                        phyloWithoutLink <- readPhylo backupPhyloWithoutLink
+                        writePhylo backupPhyloWithoutLink phyloWithoutLink
+                        pure $ toPhylo (setConfig config phyloWithoutLink)
+                      else do
+                        printIOMsg "Reconstruct the phylo from scratch"
+                        phyloWithoutLink <- pure $ toPhyloWithoutLink corpus config
+                        writePhylo backupPhyloWithoutLink phyloWithoutLink
+                        pure $ toPhylo (setConfig config phyloWithoutLink)
+
+      writePhylo backupPhylo phylo
+
+      printIOMsg "End of reconstruction, start the export"
+
+      let dot = toPhyloExport (setConfig config phylo)
+
+      let output = configToLabel config
+
+      dotToFile output dot
+
+phyloCmd :: HasCallStack => Mod CommandFields CLI
+phyloCmd = command "phylo" (info (helper <*> fmap CLISub phylo_p) (progDesc "Phylo toolkit."))
+
+phylo_p :: Parser CLICmd
+phylo_p = fmap CCMD_phylo $ PhyloArgs
+  <$> ( strOption ( long "config"
+                    <> metavar "FILEPATH"
+                    <> help "Path to a file containing a JSON to be parsed into a PhyloConfig"
+                    ) )

bin/gargantext-phylo/Phylo/Common.hs → bin/gargantext-cli/CLI/Phylo/Common.hs

-{-# LANGUAGE OverloadedStrings #-}
-module Common where
+module CLI.Phylo.Common where
 
 import Control.Concurrent.Async (mapConcurrently)
 import Crypto.Hash.SHA256 (hash)
@@ -15,9 +14,9 @@ import Gargantext.API.Ngrams.Prelude (toTermList)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Text.Context (TermList)
 import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..), parseFile)
-import Gargantext.Core.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year, csv_publication_month, csv_publication_day, csv'_source, csv'_title, csv'_abstract, csv'_publication_year, csv'_publication_month, csv'_publication_day, csv'_weight)
-import Gargantext.Core.Text.Corpus.Parsers.CSV qualified as Csv
-import Gargantext.Core.Text.List.Formats.CSV (csvMapTermList)
+import Gargantext.Core.Text.Corpus.Parsers.TSV (tsv_title, tsv_abstract, tsv_publication_year, tsv_publication_month, tsv_publication_day, tsv'_source, tsv'_title, tsv'_abstract, tsv'_publication_year, tsv'_publication_month, tsv'_publication_day, tsv'_weight)
+import Gargantext.Core.Text.Corpus.Parsers.TSV qualified as Tsv
+import Gargantext.Core.Text.List.Formats.TSV (tsvMapTermList)
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
 import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList)
 import Gargantext.Core.Types.Main (ListType(..))
@@ -76,29 +75,31 @@ wosToDocs limit patterns time path = do
                 <$> fromRight [] <$> parseFile WOS Plain (path <> file) ) files
 
 
--- To transform a Csv file into a list of Document
-csvToDocs :: CorpusParser -> Patterns -> TimeUnit -> FilePath -> IO [Document]
-csvToDocs parser patterns time path =
+-- To transform a Tsv file into a list of Document
+tsvToDocs :: CorpusParser -> Patterns -> TimeUnit -> FilePath -> IO [Document]
+tsvToDocs parser patterns time path =
   case parser of
-    Wos  _     -> Prelude.error "csvToDocs: unimplemented"
-    Csv  limit -> Vector.toList
+    Wos  _     -> Prelude.error "tsvToDocs: unimplemented"
+    Tsv  limit -> Vector.toList
       <$> Vector.take limit
-      <$> Vector.map (\row -> Document (toPhyloDate  (Csv.fromMIntOrDec Csv.defaultYear $ csv_publication_year row) (fromMaybe Csv.defaultMonth $ csv_publication_month row) (fromMaybe Csv.defaultDay $ csv_publication_day row) time)
-                                       (toPhyloDate' (Csv.fromMIntOrDec Csv.defaultYear $ csv_publication_year row) (fromMaybe Csv.defaultMonth $ csv_publication_month row) (fromMaybe Csv.defaultDay $ csv_publication_day row) time)
-                                       (termsInText patterns $ (csv_title row) <> " " <> (csv_abstract row))
+      <$> Vector.map (\row -> Document (toPhyloDate  (Tsv.fromMIntOrDec Tsv.defaultYear $ tsv_publication_year row) (fromMaybe Tsv.defaultMonth $ tsv_publication_month row) (fromMaybe Tsv.defaultDay $ tsv_publication_day row) time)
+                                       (toPhyloDate' (Tsv.fromMIntOrDec Tsv.defaultYear $ tsv_publication_year row) (fromMaybe Tsv.defaultMonth $ tsv_publication_month row) (fromMaybe Tsv.defaultDay $ tsv_publication_day row) time)
+                                       (termsInText patterns $ (tsv_title row) <> " " <> (tsv_abstract row))
                                        Nothing
                                        []
                                        time
-                     ) <$> snd <$> either (\err -> panicTrace $ "CSV error" <> (show err)) identity <$> Csv.readCSVFile path
-    Csv' limit -> Vector.toList
+                     ) <$> snd <$> either (\err -> panicTrace $ "TSV error" <> (show err)) identity <$> Tsv.readTSVFile path
+    Tsv' limit -> Vector.toList
       <$> Vector.take limit
-      <$> Vector.map (\row -> Document (toPhyloDate  (csv'_publication_year row) (csv'_publication_month row) (csv'_publication_day row) time)
-                                       (toPhyloDate' (csv'_publication_year row) (csv'_publication_month row) (csv'_publication_day row) time)
-                                       (termsInText patterns $ (csv'_title row) <> " " <> (csv'_abstract row))
-                                       (Just $ csv'_weight row)
-                                       (map (T.strip . pack) $ splitOn ";" (unpack $ (csv'_source row)))
+      <$> Vector.map (\row -> Document (toPhyloDate  (tsv'_publication_year row) (tsv'_publication_month row) (tsv'_publication_day row) time)
+                                       (toPhyloDate' (tsv'_publication_year row) (tsv'_publication_month row) (tsv'_publication_day row) time)
+                                       (termsInText patterns $ (tsv'_title row) <> " " <> (tsv'_abstract row))
+                                       (Just $ tsv'_weight row)
+                                       (map (T.strip . pack) $ splitOn ";" (unpack $ (tsv'_source row)))
                                        time
-                     ) <$> snd <$> Csv.readWeightedCsv path
+                     ) <$> snd <$> Tsv.readWeightedTsv path
+    Csv _  -> panicTrace "CSV is currently not supported."
+    Csv' _ -> panicTrace "CSV is currently not supported."
 
 
 -- To parse a file into a list of Document
@@ -107,8 +108,10 @@ fileToDocsAdvanced parser path time lst = do
   let patterns = buildPatterns lst
   case parser of
       Wos limit  -> wosToDocs limit  patterns time path
-      Csv  _     -> csvToDocs parser patterns time path
-      Csv' _     -> csvToDocs parser patterns time path
+      Tsv  _     -> tsvToDocs parser patterns time path
+      Tsv' _     -> tsvToDocs parser patterns time path
+      Csv  _     -> panicTrace "CSV is currently not supported."
+      Csv' _     -> panicTrace "CSV is currently not supported."
 
 fileToDocsDefault :: CorpusParser -> FilePath -> [TimeUnit] -> TermList -> IO [Document]
 fileToDocsDefault parser path timeUnits lst = 
@@ -140,7 +143,7 @@ readListV4 path = do
 fileToList  :: ListParser -> FilePath -> IO TermList
 fileToList parser path =
   case parser of
-    V3 -> csvMapTermList path
+    V3 -> tsvMapTermList path
     V4 -> fromJust
       <$> toTermList MapTerm NgramsTerms
       <$> readListV4 path

bin/gargantext-phylo-profile/Main.hs → bin/gargantext-cli/CLI/Phylo/Profile.hs

-{-# LANGUAGE OverloadedStrings #-}
-module Main where
+module CLI.Phylo.Profile where
 
-import Common
+import CLI.Phylo.Common
 import Data.Aeson
 import Data.List (nub)
 import Gargantext.Core.Viz.Phylo
 import Gargantext.Core.Viz.Phylo.API.Tools
 import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
 import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloWithoutLink)
-import Gargantext.Core.Viz.Phylo.PhyloTools  (printIOMsg, printIOComment, setConfig, toPeriods, getTimePeriod, getTimeStep)
+import Gargantext.Core.Viz.Phylo.PhyloTools
 import GHC.IO.Encoding
 import GHC.Stack
 import Paths_gargantext
 import Prelude
-import qualified Data.Text as T
-import Shelly
+import Shelly hiding (command)
 import System.Directory
+import Options.Applicative
+import CLI.Types
 
 --------------
 -- | Main | --
@@ -26,7 +26,7 @@ phyloConfig outdir = PhyloConfig {
     corpusPath = "corpus.csv"
   , listPath = "list.csv"
   , outputPath = outdir
-  , corpusParser = Csv {_csv_limit = 150000}
+  , corpusParser = Tsv {_tsv_limit = 150000}
   , listParser = V4
   , phyloName = "phylo_profile_test"
   , phyloScale = 2
@@ -46,8 +46,8 @@ phyloConfig outdir = PhyloConfig {
   }
 
 
-main :: HasCallStack => IO ()
-main = do
+phyloProfileCLI :: HasCallStack => IO ()
+phyloProfileCLI = do
 
     shelly $ escaping False $ withTmpDir $ \tdir -> do
       curDir <- pwd
@@ -110,3 +110,8 @@ main = do
 
           dotToFile output dot
         echo "Done."
+
+phyloProfileCmd :: HasCallStack => Mod CommandFields CLI
+phyloProfileCmd =
+  command "phylo-profile" (info (helper <*> fmap CLISub (pure CCMD_phylo_profile))
+                          (progDesc "Helper to profile phylo code."))

bin/gargantext-cli/CLI/Server/Routes.hs

+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-orphans     #-}
+
+module CLI.Server.Routes (
+    routesCLI
+  , routesCmd
+  ) where
+
+import CLI.Types
+import Data.Aeson.Encode.Pretty
+import Data.ByteString qualified as B
+import Data.ByteString.Lazy qualified as BL
+import Gargantext.API.Routes.Named
+import Options.Applicative
+import Prelude
+import Servant.API
+import Servant.API.Routes
+import Servant.API.WebSocket qualified as WS (WebSocketPending)
+import Servant.Auth qualified as Servant
+
+routesCmd :: Mod CommandFields CLI
+routesCmd = command "routes" (info (helper <*> (fmap CLISub $ fmap CCMD_routes routesParser))
+                                   (progDesc "Server routes related commands."))
+
+routesParser :: Parser CLIRoutes
+routesParser = hsubparser (
+  (command "list" (info (helper <*> list_p)
+                                   (progDesc "List all the available routes, computed by the Routes types."))) <>
+  (command "export" (info (helper <*> export_p)
+                                   (progDesc "Exports all the routes into a file, for golden-diff testing.")))
+  )
+
+list_p :: Parser CLIRoutes
+list_p = pure CLIR_list
+
+export_p :: Parser CLIRoutes
+export_p = CLIR_export <$>
+  strOption ( long "file" <> metavar "output.json" <> help "Export the routes to a file." )
+
+instance HasRoutes api => HasRoutes (Servant.Auth xs a :> api) where
+  getRoutes = getRoutes @api
+
+instance HasRoutes WS.WebSocketPending where
+  getRoutes = []
+
+instance HasRoutes Raw where
+  getRoutes = []
+
+routesCLI :: CLIRoutes -> IO ()
+routesCLI = \case
+  CLIR_list
+    -> printRoutes @(NamedRoutes API)
+  (CLIR_export filePath)
+    -> B.writeFile filePath . BL.toStrict $ encodePretty (getRoutes @(NamedRoutes API))

bin/gargantext-cli/CLI/Types.hs

+
+module CLI.Types where
+
+import Data.String
+import Data.Text (Text)
+import Gargantext.Core.Config.Types (SettingsFile(..))
+import Gargantext.Core.Types (NodeId)
+import Gargantext.Core.Types.Query
+import Prelude
+
+newtype CorpusFile = CorpusFile { _CorpusFile :: FilePath }
+  deriving (Show, Eq, IsString)
+
+newtype TermListFile = TermListFile { _TermsListFile :: FilePath }
+  deriving (Show, Eq, IsString)
+
+newtype OutputFile = OutputFile { _OutputFile :: FilePath }
+  deriving (Show, Eq, IsString)
+
+data ObfuscateDBArgs = ObfuscateDBArgs {
+    dbHost     :: !Text
+  , dbPort     :: !Int
+  , dbName     :: !Text
+  , dbUser     :: !Text
+  , dbPassword :: !Text
+  } deriving (Show, Eq)
+
+data AdminArgs = AdminArgs
+  { settingsPath :: !SettingsFile
+  , emails       :: [String]
+  } deriving (Show, Eq)
+
+data ImportFunction
+  = IF_corpus
+  | IF_corpusTsvHal
+  | IF_annuaire
+  deriving (Show, Eq, Enum, Bounded)
+
+data ImportArgs = ImportArgs
+  { imp_function :: !ImportFunction
+  , imp_user     :: !Text
+  , imp_name     :: !Text
+  , imp_settings :: !SettingsFile
+  , imp_limit    :: !Limit
+  , imp_corpus_path :: !FilePath
+  } deriving (Show, Eq)
+
+data IniArgs = IniArgs
+  { ini_path  :: !(Maybe FilePath)
+  , toml_path :: !(Maybe FilePath)
+  } deriving (Show, Eq)
+
+data InitArgs = InitArgs
+  { init_settings :: !SettingsFile
+  } deriving (Show, Eq)
+
+data InvitationsArgs = InvitationsArgs
+  { inv_settings :: !SettingsFile
+  , inv_user    :: !Text
+  , inv_node_id :: !NodeId
+  , inv_email   :: !Text
+  } deriving (Show, Eq)
+
+data PhyloArgs = PhyloArgs
+  { phylo_config :: !FilePath
+  } deriving (Show, Eq)
+
+data UpgradeArgs = UpgradeArgs
+  { upgrade_settings :: !SettingsFile
+  } deriving (Show, Eq)
+
+data GoldenFileDiffArgs = GoldenFileDiffArgs
+  { gdf_expected :: !FilePath
+  , gdf_actual   :: !FilePath
+  } deriving (Show, Eq)
+
+data CLIRoutes
+  = CLIR_list
+  | CLIR_export FilePath
+  deriving (Show, Eq)
+
+data CLICmd
+  = CCMD_clean_csv_corpus
+  | CCMD_filter_terms_and_cooc !CorpusFile !TermListFile !OutputFile
+  | CCMD_obfuscate_db !ObfuscateDBArgs
+  | CCMD_admin !AdminArgs
+  | CCMD_import !ImportArgs
+  | CCMD_ini !IniArgs
+  | CCMD_init !InitArgs
+  | CCMD_invitations !InvitationsArgs
+  | CCMD_phylo !PhyloArgs
+  | CCMD_phylo_profile
+  | CCMD_upgrade !UpgradeArgs
+  | CCMD_golden_file_diff !GoldenFileDiffArgs
+  | CCMD_routes !CLIRoutes
+  deriving (Show, Eq)
+
+data CLI =
+  CLISub CLICmd
+  deriving (Show, Eq)
+
+

bin/gargantext-upgrade/Main.hs → bin/gargantext-cli/CLI/Upgrade.hs

 {-|
-Module      : Main.hs
+Module      : Upgrade.hs
 Description : Gargantext Import Corpus
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -7,24 +7,29 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-Import a corpus binary.
+Upgrade a gargantext node.
 
  -}
 
 {-# LANGUAGE Strict            #-}
 {-# LANGUAGE QuasiQuotes       #-}
 
-module Main where
+module CLI.Upgrade where
 
+import CLI.Types
+import CLI.Parsers
 import Data.List qualified as List (cycle, concat, take, unlines)
 import Gargantext.API.Dev (withDevEnv)
 import Gargantext.API.Node () -- instances only
+import Gargantext.Core.Config (GargConfig(..))
+import Gargantext.Core.Config.Types (SecretsConfig(..))
+import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (GargConfig(..), readConfig)
+import Options.Applicative
 import Prelude qualified
 
-main :: IO ()
-main = do
+upgradeCLI :: UpgradeArgs -> IO ()
+upgradeCLI (UpgradeArgs settingsFile) = do
 
   let ___ = putStrLn ((List.concat
                        $ List.take 72
@@ -34,11 +39,6 @@ main = do
   putStrLn ("GarganText upgrade to version 0.0.6.9.9.4.4" :: Text)
   ___
 
-  params@[iniPath] <- getArgs
-  _ <- if length params /= 1
-         then panicTrace "Usage: ./gargantext-upgrade gargantext.ini"
-         else pure ()
-
   putStrLn $ List.unlines
            [ "Your Database defined in gargantext.ini will be upgraded."
            , "We stronlgy recommend you to make a backup using pg_dump."
@@ -48,10 +48,10 @@ main = do
 
   _ok  <- getLine
 
-  cfg       <- readConfig         iniPath
-  let _secret = _gc_secretkey cfg
+  cfg       <- readConfig settingsFile
+  let _secret = _s_secret_key $ _gc_secrets cfg
 
-  withDevEnv iniPath $ \_env -> do
+  withDevEnv settingsFile $ \_env -> do
     -- _ <- runCmdDev env addIndex
     -- _ <- runCmdDev env refreshIndex
 
@@ -92,3 +92,10 @@ main = do
 --         CREATE INDEX IF NOT EXISTS node_stories_ngrams_id_idx
 --           ON node_stories(ngrams_id);
 --   |]
+
+upgradeCmd :: HasCallStack => Mod CommandFields CLI
+upgradeCmd = command "upgrade" (info (helper <*> fmap CLISub upgrade_p) (progDesc "Upgrade a Gargantext node."))
+
+upgrade_p :: Parser CLICmd
+upgrade_p = fmap CCMD_upgrade $ UpgradeArgs
+  <$> settings_p

bin/gargantext-cli/CleanCsvCorpus.hs

-{-|
-Module      : CleanCsvCorpus.hs
-Description : Gargantext starter
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
-Given a Gargantext CSV File and its Query This script cleans and
-compress the contexts around the main terms of the query.
--}
-
-
-module CleanCsvCorpus  where
-
-import Data.SearchEngine qualified as S
-import Data.Set qualified as S
-import Data.Text (pack)
-import Data.Vector (Vector)
-import Data.Vector qualified as V
-import Gargantext.Core.Text.Corpus.Parsers.CSV qualified as CSV
-import Gargantext.Core.Text.Search
-import Gargantext.Prelude
-------------------------------------------------------------------------
-
-type Query = [S.Term]
-
-filterDocs :: [DocId] -> Vector CSV.CsvGargV3 -> Vector CSV.CsvGargV3
-filterDocs docIds = V.filter (\doc -> S.member (CSV.d_docId doc) $ S.fromList docIds )
-
-
-main :: IO ()
-main = do
-  let rPath = "/tmp/Gargantext_Corpus.csv"
-  let wPath = "/tmp/Gargantext_Corpus_bis.csv"
-  --let q = ["water", "scarcity", "morocco", "shortage","flood"]
-  let q = ["gratuit", "gratuité", "culture", "culturel"]
-
-  eDocs <- CSV.readCSVFile rPath
-  case eDocs of
-    Right (h, csvDocs) -> do
-      putStrLn ("Number of documents before:" <> show (V.length csvDocs) :: Text)
-      putStrLn ("Mean size of docs:" <> show ( CSV.docsSize csvDocs) :: Text)
-
-      let docs   = CSV.toDocs csvDocs
-      let engine = S.insertDocs docs initialDocSearchEngine
-      let docIds = S.query engine (map pack q)
-      let docs'  = CSV.fromDocs $ filterDocs docIds (V.fromList docs)
-
-      putStrLn ("Number of documents after:" <> show (V.length docs') :: Text)
-      putStrLn ("Mean size of docs:" <> show (CSV.docsSize docs') :: Text)
-
-      CSV.writeFile wPath (h, docs')
-    Left e -> panicTrace $ "Error: " <> e

bin/gargantext-cli/Main.hs

@@ -12,129 +12,78 @@ Main specifications to index a corpus with a term list
  -}
 
 {-# LANGUAGE Strict             #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Main where
 
-import Control.Concurrent.Async as CCA (mapConcurrently)
-import Data.Aeson ( ToJSON, encode )
-import Data.List.Split (chunksOf)
-import Data.Map.Strict qualified as DM
-import Data.Text (pack)
-import Data.Text qualified as DT
-import Data.Text.Lazy qualified as DTL
-import Data.Text.Lazy.Encoding qualified as TLE
-import Data.Tuple.Extra (both)
-import Data.Vector qualified as DV
-import Gargantext.Core.Text.Context (TermList)
-import Gargantext.Core.Text.Corpus.Parsers.CSV (readCSVFile, csv_title, csv_abstract, csv_publication_year, fromMIntOrDec, defaultYear)
-import Gargantext.Core.Text.List.Formats.CSV (csvMapTermList)
-import Gargantext.Core.Text.Metrics.Count (coocOnContexts, Coocs)
-import Gargantext.Core.Text.Terms.WithList ( Patterns, buildPatterns, extractTermsWithList )
-import Gargantext.Prelude
-import System.IO (hFlush)
+import Prelude
+
+import CLI.FilterTermsAndCooc
+import CLI.ObfuscateDB (obfuscateDB, obfuscateDBCmd)
+import CLI.Types
+import Options.Applicative
+import CLI.Admin (adminCLI, adminCmd)
+import CLI.FileDiff (fileDiffCLI, fileDiffCmd)
+import CLI.Import (importCLI, importCmd)
+import CLI.Ini (iniCLI, iniCmd)
+import CLI.Init (initCLI, initCmd)
+import CLI.Invitations (invitationsCLI, invitationsCmd)
+import CLI.Phylo (phyloCLI, phyloCmd)
+import CLI.Phylo.Profile (phyloProfileCLI, phyloProfileCmd)
+import CLI.Server.Routes (routesCLI, routesCmd)
+import CLI.Upgrade (upgradeCLI, upgradeCmd)
+
+runCLI :: CLI -> IO ()
+runCLI = \case
+  CLISub CCMD_clean_csv_corpus
+    -> putStrLn "TODO."
+  CLISub (CCMD_filter_terms_and_cooc corpusFile termListFile outputFile)
+    -> filterTermsAndCoocCLI corpusFile termListFile outputFile
+  CLISub (CCMD_obfuscate_db args)
+    -> obfuscateDB args
+  CLISub (CCMD_admin args)
+    -> adminCLI args
+  CLISub (CCMD_import args)
+    -> importCLI args
+  CLISub (CCMD_ini args)
+    -> iniCLI args
+  CLISub (CCMD_init args)
+    -> initCLI args
+  CLISub (CCMD_invitations args)
+    -> invitationsCLI args
+  CLISub (CCMD_phylo args)
+    -> phyloCLI args
+  CLISub CCMD_phylo_profile
+    -> phyloProfileCLI
+  CLISub (CCMD_upgrade args)
+    -> upgradeCLI args
+  CLISub (CCMD_golden_file_diff args)
+    -> fileDiffCLI args
+  CLISub (CCMD_routes args)
+    -> routesCLI args
 
-------------------------------------------------------------------------
--- OUTPUT format
-
-data CoocByYear = CoocByYear { year         :: Int
-                             , nbContexts   :: NbContexts
-                             , coocurrences :: Map (Text, Text) Coocs
-                             } deriving (Show, Generic)
-
-data CoocByYears = CoocByYears { years :: [CoocByYear] }
-  deriving (Show, Generic)
-
-type NbContexts = Int
-
-instance ToJSON CoocByYear
-instance ToJSON CoocByYears
-------------------------------------------------------------------------
-
-filterTermsAndCooc
-  :: Patterns
-     -> (Int, [Text])
-     -> IO CoocByYear -- (Int, (Map (Text, Text) Coocs))
-filterTermsAndCooc patterns (year, ts) = do
-  logWork "start"
-  r <- coocOnContexts identity <$> mapM (\x -> {-log "work" >>-} terms' patterns x) ts
-  logWork "stop"
-  pure $ CoocByYear year (length ts) (DM.mapKeys (both DT.unwords) r)
-  where
-
-    logWork m = do
-      tid    <- myThreadId
-      (p, _) <- threadCapability tid
-      putText . unwords $
-        ["filterTermsAndCooc:", m, show year, "on proc", show p]
 
 main :: IO ()
-main = do
-  [corpusFile, termListFile, outputFile] <- getArgs
-
-  --corpus :: IO (DM.IntMap [[Text]])
-  eCorpusFile <- readCSVFile corpusFile
-  case eCorpusFile of
-    Right cf -> do
-      let corpus = DM.fromListWith (<>)
-                   . DV.toList
-                   . DV.map (\n -> (fromMIntOrDec defaultYear $ csv_publication_year n, [(csv_title n) <> " " <> (csv_abstract n)]))
-                   . snd $ cf
-
-      -- termListMap :: [Text]
-      termList <- csvMapTermList termListFile
-
-      putText $ show $ length termList
-
-      let patterns = buildPatterns termList
-
-      -- r <- mapConcurrentlyChunked (filterTermsAndCooc patterns) (DM.toList corpus)
-      r <-  mapConcurrently (filterTermsAndCooc patterns) (DM.toList corpus)
-      writeFile outputFile $ DTL.toStrict $ TLE.decodeUtf8 $ encode (CoocByYears r)
-    Left e -> panicTrace $ "Error: " <> e
-
-
-
-------------------------------------------------------------------------
--- | Tools
-mapMP :: MonadIO m => (a -> m b) -> [a] -> m [b]
-mapMP f xs = do
-    bs <- zipWithM g (cycle "-\\|/") xs
-    liftIO $ hPutStr stderr ("\rDone\n" :: Text)
-    pure bs
+main = runCLI =<< execParser opts
   where
-    g c x = do
-      liftIO $ hPutStr stderr ['\r',c]
-      liftIO $ hFlush  stderr
-      f x
-
--- | Optimi that need further developments (not used yet)
-mapConcurrentlyChunked :: (a -> IO b) -> [a] -> IO [b]
-mapConcurrentlyChunked f ts = do
-  caps <- getNumCapabilities
-  let n = 1 `max` (length ts `div` caps)
-  concat <$> mapConcurrently (mapM f) (chunksOf n ts)
-
-
---terms' :: Patterns -> Text -> Corpus [[Text]]
-terms' :: Applicative f => Patterns -> Text -> f [[Text]]
-terms' pats txt = pure $ concat $ extractTermsWithList pats txt
-
-
--- | TODO Minimal Example
---testCooc = do
---  let patterns = buildPatterns testTermList
---  mapM (\x -> {-log "work" >>-} terms' patterns x) $ catMaybes $ map (head . snd) testCorpus
---  --mapConcurrently (filterTermsAndCooc patterns) testCorpus
-
-
-testCorpus :: [(Int, [Text])]
-testCorpus = [ (1998, [pack "The beees"])
-             , (1999, [ pack "The bees and the flowers"
-                      --, pack "The bees and the flowers"
-                      ])
-             ]
-
-testTermList :: TermList
-testTermList = [ ([pack "bee"], [[pack "bees"]])
-               , ([pack "flower"], [[pack "flowers"]])
-               ]
+    opts = info (helper <*> allOptions)
+      ( fullDesc
+     <> progDesc "CLI for the gargantext-server. Type --help for all the commands."
+     <> header "gargantext-cli tools" )
+
+allOptions :: Parser CLI
+allOptions = subparser (
+                 filterTermsAndCoocCmd <>
+                 obfuscateDBCmd <>
+                 adminCmd <>
+                 importCmd <>
+                 iniCmd <>
+                 initCmd <>
+                 invitationsCmd <>
+                 phyloCmd <>
+                 phyloProfileCmd <>
+                 upgradeCmd <>
+                 fileDiffCmd <>
+                 routesCmd
+                 )

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 Gargantext.API.Dev (withDevEnv, runCmdDev)
-import Gargantext.API.Node () -- instances only
-import Gargantext.API.Errors.Types
-import Gargantext.Core.NLP (HasNLPServer)
-import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (CmdRandom)
-import Gargantext.Prelude
-import Gargantext.Prelude.Config (readConfig)
-import Prelude (read)
-import qualified Gargantext.API.Node.Share as Share
-
-main :: IO ()
-main = do
-  params@[iniPath,user,node_id,email] <- getArgs
-
-  _ <- if length params /= 4
-      then panicTrace "USAGE: ./gargantext-init gargantext.ini username node_id student@university.edu"
-      else pure ()
-
-  _cfg       <- readConfig         iniPath
-
-  let invite :: (CmdRandom env BackendInternalError m, HasNLPServer env) => m Int
-      invite = Share.api (UserName $ cs user) (UnsafeMkNodeId $ (read node_id :: Int)) (Share.ShareTeamParams $ cs email)
-
-  withDevEnv iniPath $ \env -> do
-    _ <- runCmdDev env invite
-    pure ()

bin/gargantext-phylo/Main.hs

-{-|
-Module      : Main.hs
-Description : Gargantext starter binary with Adaptative Phylo
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
-Adaptative Phylo binaries
- -}
-
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeOperators      #-}
-{-# LANGUAGE Strict             #-}
-
-module Main where
-
-import Control.Concurrent.Async (mapConcurrently)
-import Crypto.Hash.SHA256 (hash)
-import Data.Aeson
-import Data.ByteString.Char8 qualified as C8
-import Data.List  (nub, isSuffixOf, tail)
-import Data.List.Split
-import Data.Maybe (fromJust)
-import Data.Text  (unpack, replace, pack)
-import Data.Text qualified as T
-import Data.Vector qualified as Vector
-import GHC.IO.Encoding
-import Gargantext.API.Ngrams.Prelude (toTermList)
-import Gargantext.API.Ngrams.Types
-import Gargantext.Core.Text.Context (TermList)
-import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..), parseFile)
-import Gargantext.Core.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year, csv_publication_month, csv_publication_day, csv'_source, csv'_title, csv'_abstract, csv'_publication_year, csv'_publication_month, csv'_publication_day, csv'_weight)
-import Gargantext.Core.Text.Corpus.Parsers.CSV qualified as Csv
-import Gargantext.Core.Text.List.Formats.CSV (csvMapTermList)
-import Gargantext.Core.Text.Ngrams (NgramsType(..))
-import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList)
-import Gargantext.Core.Types.Main (ListType(..))
-import Gargantext.Core.Viz.Phylo
-import Gargantext.Core.Viz.Phylo.API.Tools
-import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
-import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloWithoutLink)
-import Gargantext.Core.Viz.Phylo.PhyloTools  (printIOMsg, printIOComment, setConfig, toPeriods, getTimePeriod, getTimeStep)
-import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
-import Gargantext.Prelude hiding (hash, replace)
-import Prelude qualified
-import System.Directory (listDirectory,doesFileExist)
-import Common
-
-main :: IO ()
-main = do
-
-    setLocaleEncoding utf8
-    currentLocale <- getLocaleEncoding
-    printIOMsg $ "Machine locale: " <> show currentLocale
-    printIOMsg "Starting the reconstruction"
-
-    printIOMsg "Read the configuration file"
-    [args]   <- getArgs
-    jsonArgs <- (eitherDecode <$> readJson args) :: IO (Either Prelude.String PhyloConfig)
-
-    case jsonArgs of
-        Left err     -> putStrLn err
-        Right config -> do
-
-            printIOMsg "Parse the corpus"
-            mapList <-  fileToList (listParser config) (listPath config)
-
-            corpus  <- if (defaultMode config)
-                        then fileToDocsDefault (corpusParser config) (corpusPath config) [Year 3 1 5,Month 3 1 5,Week 4 2 5] mapList
-                        else fileToDocsAdvanced (corpusParser config) (corpusPath config) (timeUnit config)  mapList
-
-            printIOComment (show (length corpus) <> " parsed docs from the corpus")
-
-            printIOComment (show (length $ nub $ concat $ map text corpus) <> " Size ngs_coterms")
-
-            printIOComment (show (length mapList) <> " Size ngs_terms List Map Ngrams")
-
-            printIOMsg "Reconstruct the phylo"
-
-            -- check the existing backup files
-
-            let backupPhyloWithoutLink = (outputPath config) <> "backupPhyloWithoutLink_" <> (configToSha BackupPhyloWithoutLink config) <> ".json"
-            let backupPhylo = (outputPath config) <> "backupPhylo_"   <> (configToSha BackupPhylo config) <> ".json"
-
-            phyloWithoutLinkExists <- doesFileExist backupPhyloWithoutLink
-            phyloExists   <- doesFileExist backupPhylo
-
-            -- reconstruct the phylo
-
-            phylo <- if phyloExists
-                        then do
-                          printIOMsg "Reconstruct the phylo from an existing file"
-                          readPhylo backupPhylo
-                        else do
-                          if phyloWithoutLinkExists
-                            then do
-                              printIOMsg "Reconstruct the phylo from an existing file without links"
-                              phyloWithoutLink <- readPhylo backupPhyloWithoutLink
-                              writePhylo backupPhyloWithoutLink phyloWithoutLink
-                              pure $ toPhylo (setConfig config phyloWithoutLink)
-                            else do
-                              printIOMsg "Reconstruct the phylo from scratch"
-                              phyloWithoutLink <- pure $ toPhyloWithoutLink corpus config
-                              writePhylo backupPhyloWithoutLink phyloWithoutLink
-                              pure $ toPhylo (setConfig config phyloWithoutLink)
-
-            writePhylo backupPhylo phylo
-
-            printIOMsg "End of reconstruction, start the export"
-
-            let dot = toPhyloExport (setConfig config phylo)
-
-            let output = configToLabel config
-
-            dotToFile output dot

bin/gargantext-server/Main.hs

@@ -15,7 +15,7 @@ Script to start gargantext with different modes (Dev, Prod, Mock).
 {-# LANGUAGE StandaloneDeriving   #-}
 {-# LANGUAGE Strict               #-}
 {-# LANGUAGE TypeOperators        #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE TypeFamilies #-}
 
 
@@ -24,11 +24,13 @@ module Main where
 
 import Data.Text (unpack)
 import Data.Version (showVersion)
+import GHC.IO.Encoding
 import Gargantext.API (startGargantext) -- , startGargantextMock)
 import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Admin.Settings
+import Gargantext.Core.Config.Types (SettingsFile(..))
 import Gargantext.Prelude
 import Gargantext.System.Logging
-import GHC.IO.Encoding
 import Options.Generic
 import System.Exit (exitSuccess)
 import qualified Paths_gargantext as PG -- cabal magic build module
@@ -43,8 +45,8 @@ data MyOptions w =
                         <?> "Possible modes: Dev | Mock | Prod"
             , port :: w ::: Maybe Int
                         <?> "By default: 8008"
-            , ini  :: w ::: Maybe Text
-                        <?> "Ini-file path of gargantext.ini"
+            , toml :: w ::: Maybe FilePath
+                        <?> "By default: gargantext-settings.toml"
             , version :: w ::: Bool
                         <?> "Show version number and exit"
             }
@@ -60,7 +62,7 @@ main = withLogger () $ \ioLogger -> do
   setLocaleEncoding utf8
   currentLocale <- getLocaleEncoding
 
-  MyOptions myMode myPort myIniFile myVersion  <- unwrapRecord
+  MyOptions myMode myPort mb_tomlFile myVersion  <- unwrapRecord
           "Gargantext server"
   ---------------------------------------------------------------
   if myVersion then do
@@ -73,14 +75,14 @@ main = withLogger () $ \ioLogger -> do
         Just p  -> p
         Nothing -> 8008
 
-      myIniFile' = case myIniFile of
-          Nothing -> panicTrace "[ERROR] gargantext.ini needed"
+      tomlFile = SettingsFile $ case mb_tomlFile of
+          Nothing -> "gargantext-settings.toml"
           Just i  -> i
 
   ---------------------------------------------------------------
   let start = case myMode of
         Mock -> panicTrace "[ERROR] Mock mode unsupported"
-        _ -> startGargantext myMode myPort' (unpack myIniFile')
+        _ -> startGargantext myMode myPort' tomlFile
   logMsg ioLogger INFO $ "Starting with "   <> show myMode <> " mode."
   logMsg ioLogger INFO $ "Machine locale: " <> show currentLocale
   start

bin/install

@@ -4,5 +4,5 @@ echo "GarganText, build, install, test and documentation"
 nix-shell --run "cabal update                                     \\
                  && cabal v2-build --ghc-options=-O2              \\
                  && cabal --overwrite-policy=always install       \\
-                 && cabal v2-test --test-show-details=streaming   \\
+                 && cabal v2-test                               \\
                  && cabal haddock"

bin/metrics/histo/users.sql

 
-\COPY (select count(*), date_trunc('month', a.date_joined) from auth_user a group by 2) TO '/tmp/users.csv' (FORMAT csv);
+\COPY (select count(*), date_trunc('month', a.date_joined) from auth_user a group by 2 ORDER BY 2) TO '/tmp/users.csv' (FORMAT csv);
 
 
 

bin/metrics/metrics

+#!/bin/bash
+
+
+for f in bin/metrics/histo/*sql ; do
+  ./bin/psql gargantext.ini < $f
+done
+

bin/track_haskell_deps.hs

@@ -12,11 +12,8 @@ stack exec ghc -- --make -O2 -threaded scripts/haskell/dependencies.hs
 -}
 
 {-# LANGUAGE BangPatterns        #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections       #-}
-{-# LANGUAGE NumericUnderscores  #-}
 {-# LANGUAGE ViewPatterns        #-}
 
 module Main where

bin/update-project-dependencies

@@ -18,12 +18,12 @@ fi
 # with the `sha256sum` result calculated on the `cabal.project` and
 # `cabal.project.freeze`. This ensures the files stay deterministic so that CI
 # cache can kick in.
-expected_cabal_project_hash="0d3f7f5beed88c1afe95e0df8a91080440ba59049f3610bf2343132635038d22"
-expected_cabal_project_freeze_hash="9b2cac3a02e9b129bd80253fc407782bf10c7ed62ed21be41c720d30ed17ef53"
+expected_cabal_project_hash="3afb11e01938b74ae8419caa160180d8f8628a67315a2d689c3a42a76463071e"
+expected_cabal_project_freeze_hash="de1726d350936da5f5e15140e3be29bb4f44757c5702defe995c2386f1b4a741"
+
 
 cabal --store-dir=$STORE_DIR v2-build --dry-run
-cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml
-cabal --store-dir=$STORE_DIR v2-freeze
+cabal2stack --system-ghc --allow-newer --resolver lts-21.25 --resolver-file devops/stack/lts-21.25.yaml -o stack.yaml
 
 # Run 'sed' to remove the constraint for 'gargantext', as it doesn't make sense and
 # for the test we need to run this with a different flag.

cabal.project

 -- Generated by stack2cabal
 
-index-state: 2023-12-10T10:34:46Z
+-- index-state: 2023-12-10T10:34:46Z
+index-state: 2024-09-12T03:02:26Z
 
-with-compiler: ghc-9.4.7
+with-compiler: ghc-9.4.8
 optimization: 2
 
 packages:
@@ -29,7 +30,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/opaleye-textsearch.git
-    tag: cb07b604bfb7a22aa21dd8918de5cb65c8a4bdf1
+    tag: 04b5c9044fef44393b66bffa258ca0b0f59c1087
 
 source-repository-package
     type: git
@@ -51,8 +52,8 @@ source-repository-package
 
 source-repository-package
     type: git
-    location: https://github.com/alpmestan/servant-job.git
-    tag: b4182487cfe479777c11ca19f3c0d47840b376f6
+    location: https://github.com/adinapoli/servant-job.git
+    tag: 74a3296dfe1f0c4a3ade91336dcc689330e84156
 
 source-repository-package
     type: git
@@ -63,7 +64,8 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/chessai/eigen.git
-    tag: 8fff32a43df743c8c83428a86dd566a0936a4fba
+    tag: 1790fdf9138970dde0dbabf8b270698145a4a88c
+    -- tag: 8fff32a43df743c8c83428a86dd566a0936a4fba
 
 source-repository-package
     type: git
@@ -88,12 +90,12 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/epo-proxy-api.git
-    tag: 9225d046083853200b9045c8d71161e6a234fc5c
+    tag: cf4e5004f3b002bdef3fcab95e3559d65cdcd858
 
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
-    tag: b99b9e568c8bdc73af2b8016ed03ba5ee83c2030
+    tag: 229fdf40b8ccecd527fca5a7bbb554b0deb540dc
 
 source-repository-package
     type: git
@@ -108,7 +110,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/crawlers/openalex.git
-    tag: ceb8f2cebd4890b6d9d151ab01ee14e925bc0499
+    tag: 4eec15855207dc74afc75b94c3764eede4de7b55
 
 source-repository-package
     type: git
@@ -123,8 +125,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude
-    -- tag: 618f711a530df56caefbb1577c4bf3d5ff45e214
-    tag: d4f9bee483d41bbdf8ab4e09efb5a5a8216edff4
+    tag: bb15d828d5ef36eeaa84cccb00598b585048c88e
 
 source-repository-package
     type: git
@@ -165,12 +166,76 @@ source-repository-package
     type: git
     location: https://github.com/robstewart57/rdf4h.git
     tag: 4fd2edf30c141600ffad6d730cc4c1c08a6dbce4
+
+-- FIXME(adn) Compat-shim while we wait for upstream to catch-up
+source-repository-package
+    type: git
+    location: https://github.com/garganscript/nanomsg-haskell
+    tag: 5868db564d7d3c4568ccd11c852292b834d26c55
     
-allow-older: *
-allow-newer: *
+-- source-repository-package
+--     type: git
+--     location: https://github.com/jimenezrick/nng-haskell
+--     tag: 31e52d7bc720e5fb9daf1c1e8bc1fd156d577af2
+        
+source-repository-package
+    type: git
+    location: https://github.com/adinapoli/http-reverse-proxy.git
+    tag: c90b7bc55b0e628d0b71ccee4e222833a19792f8
+
+source-repository-package
+    type: git
+    location: https://github.com/fpringle/servant-routes.git
+    tag: 7694f62af6bc1596d754b42af16da131ac403b3a
+
+source-repository-package
+    type: git
+    location: https://github.com/glguy/toml-parser
+    tag: toml-parser-2.0.1.0
+
+source-repository-package
+    type: git
+    location: https://gitlab.iscpif.fr/gargantext/haskell-throttle
+    tag: 02f5ed9ee2d6cce45161addf945b88bc6adf9059
+
+        
+allow-newer:
+             accelerate-arithmetic:accelerate
+           , MissingH:base
+           , accelerate-utility:accelerate
+           , base:*
+           , crawlerHAL:servant
+           , crawlerISTEX:servant
+           , crawlerPubMed:servant
+           , crawlerPubMed:servant-client-core
+           , iso639:aeson
+           , iso639:text
+           , morpheus-graphql-app:text
+           , morpheus-graphql-client:text
+           , morpheus-graphql-code-gen-utils:text
+           , morpheus-graphql-code-gen:text
+           , morpheus-graphql-core:text
+           , morpheus-graphql-server:text
+           , morpheus-graphql-subscriptions:text
+           , morpheus-graphql:text
+           , servant-client:servant
+           , servant-client:servant-client-core
+           , servant-ekg:base
+           , servant-ekg:hashable
+           , servant-ekg:servant
+           , servant-ekg:text
+           , servant-ekg:time
+           , servant-xml-conduit:base
+           , servant-xml-conduit:bytestring
+           , servant-xml-conduit:servant
+           , stemmer:base
+allow-older: aeson:hashable
+           , crawlerHAL:servant-client
+           , haskell-throttle:time
+           , hsparql:rdf4h
 
 package gargantext
-    ghc-options: -fwrite-ide-info -hiedir=".stack-work/hiedb"
+    ghc-options: -fwrite-ide-info
     
 package hmatrix
     ghc-options: -O2 -fsimpl-tick-factor=10000 -fdicts-cheap -fdicts-strict -flate-dmd-anal -fno-state-hack

cabal.project.local_toCopy

+package gargantext
+    ghc-options: -fwrite-ide-info
+
+package gargantext-admin
+    ghc-options: -O0
+
+package gargantext-cli
+    ghc-options: -O0
+
+package gargantext-db-obfuscation
+    ghc-options: -O0
+
+package gargantext-import
+    ghc-options: -O0
+
+package gargantext-init
+    ghc-options: -O0
+
+package gargantext-invitations
+    ghc-options: -O0
+
+package gargantext-phylo
+    ghc-options: -O0
+
+package gargantext-server
+    ghc-options: -O0
+
+package gargantext-upgrade
+    ghc-options: -O0
+
+package gargantext-graph
+    ghc-options: -O0
+
+package hmatrix
+    ghc-options: -O0
+
+package sparse-linear
+    ghc-options: -O0
+

devops/docker/Dockerfile

@@ -3,7 +3,7 @@ FROM ubuntu:noble
 ## NOTA BENE: In order for this to be built successfully, you have to run ./devops/coreNLP/build.sh first.
 
 ARG DEBIAN_FRONTEND=noninteractive
-ARG GHC=9.4.7
+ARG GHC=9.4.8
 ARG CORENLP=4.5.4
 ARG CORE
 COPY ./shell.nix                                       /builds/gargantext/shell.nix

devops/docker/docker-compose.yaml

 version: '3'
 
 services:
+  caddy:
+    image: caddy:alpine
+    network: host
+    ports:
+      - 8108:8108
+    volumes:
+      - ./Caddyfile:/etc/caddy/Caddyfile:ro
+      - ../../purescript-gargantext:/srv/purescript-gargantext:ro
+
   #postgres11:
   #  #image: 'postgres:latest'
   #  image: 'postgres:11'
@@ -36,33 +45,35 @@ services:
       - ../dbs:/dbs
       - ../postgres/schema.sql:/docker-entrypoint-initdb.d/schema.sql:ro
 
-  pgadmin:
-    image: 'dpage/pgadmin4'
-    ports:
-      - 8081:80
-    environment:
-      PGADMIN_DEFAULT_EMAIL: admin@localhost.lan
-      PGADMIN_DEFAULT_PASSWORD: admin
+  # NOTE: Use dbeaver instead, it's nicer and remembers passwords
+  # (unlike pgadmin when you remove the docker volume)
+  # pgadmin:
+  #   image: 'dpage/pgadmin4'
+  #   ports:
+  #     - 8081:80
+  #   environment:
+  #     PGADMIN_DEFAULT_EMAIL: admin@localhost.lan
+  #     PGADMIN_DEFAULT_PASSWORD: admin
 
-    depends_on:
-      - postgres
-    links:
-      - postgres
-    volumes:
-      - pgadmin:/var/lib/pgadmin
+  #   depends_on:
+  #     - postgres
+  #   links:
+  #     - postgres
+  #   volumes:
+  #     - pgadmin:/var/lib/pgadmin
 
-  corenlp:
-    #image: 'cgenie/corenlp-garg:latest'
-    image: 'cgenie/corenlp-garg:4.5.4'
-    ports:
-      - 9000:9000
+  # corenlp:
+  #   #image: 'cgenie/corenlp-garg:latest'
+  #   image: 'cgenie/corenlp-garg:4.5.4'
+  #   ports:
+  #     - 9000:9000
 
-  johnsnownlp:
-    image: 'johnsnowlabs/nlp-server:latest'
-    volumes:
-      - js-cache:/home/johnsnowlabs/cache_pretrained
-    ports:
-      - 5000:5000
+  # johnsnownlp:
+  #   image: 'johnsnowlabs/nlp-server:latest'
+  #   volumes:
+  #     - js-cache:/home/johnsnowlabs/cache_pretrained
+  #   ports:
+  #     - 5000:5000
 
 volumes:
   #garg-pgdata:

devops/postgres/upgrade/0.0.7.3.sql

+-- This removes the trigger prevening ngrams deletion
+-- because the function was not working.
+
+DROP TRIGGER check_ngrams_json_trg ON ngrams;
+DROP FUNCTION check_ngrams_json;