merge with dev

README.md

@@ -18,6 +18,16 @@ progress. Please report and improve this documentation if you encounter issues.
 
 ### Build Core Code
 
+NOTE: Default build (with optimizations) requires large amounts of RAM (16GB at least). To avoid heavy compilation times and swapping out your machine, it is recommended to `stack build` with the `--fast-` flag, i.e.:
+``` sh
+stack --docker build --fast
+```
+or
+``` sh
+stack --nix build --fast
+```
+This might be related to the [broken Swagger `-O2` issue](https://github.com/haskell-servant/servant/issues/986).
+
 #### Docker
 
 ``` sh
@@ -92,7 +102,7 @@ For Docker env, first create the appropriate image:
 
 ``` sh
 cd devops/docker
-docker build -t fpco/stack-build:lts-14.27-garg .
+docker build -t fpco/stack-build:lts-16.26-garg .
 ```
 
 then run:

bin/gargantext-adaptative-phylo/Main.hs

@@ -30,7 +30,7 @@ import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
 import Gargantext.Core.Text.Context (TermList)
 import Gargantext.Core.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year)
 import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..),parseFile)
-import Gargantext.Core.Text.List.CSV (csvMapTermList)
+import Gargantext.Core.Text.List.Formats.CSV (csvMapTermList)
 import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList)
 import Gargantext.Core.Viz.AdaptativePhylo
 import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloStep)

bin/gargantext-cli/Main.hs

@@ -12,26 +12,23 @@ Main specifications to index a corpus with a term list
  -}
 
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeOperators     #-}
+{-# LANGUAGE TypeOperators      #-}
 {-# LANGUAGE Strict             #-}
 
 module Main where
 
 import Data.ByteString.Lazy (writeFile)
 
-import Data.Maybe (catMaybes)
 import Data.Text (pack)
 import qualified Data.Text as DT
 
 import Data.Tuple.Extra (both)
 import qualified Data.Vector as DV
-import qualified Data.Maybe  as DMaybe
 
 import Control.Monad (zipWithM)
 import Control.Monad.IO.Class
 
 import Data.Map (Map)
-import qualified Data.IntMap as DIM
 import qualified Data.Map    as DM
 
 import GHC.Generics
@@ -44,7 +41,6 @@ import System.IO (hPutStr, hFlush, stderr)
 import System.Environment
 import Control.Concurrent.Async as CCA (mapConcurrently)
 import Control.Concurrent (getNumCapabilities, myThreadId, threadCapability)
-import Prelude ((>>))
 
 import Gargantext.Prelude
 import Gargantext.Core
@@ -53,7 +49,7 @@ import Gargantext.Core.Text.Terms
 import Gargantext.Core.Text.Context
 import Gargantext.Core.Text.Terms.WithList
 import Gargantext.Core.Text.Corpus.Parsers.CSV (readFile, csv_title, csv_abstract, csv_publication_year)
-import Gargantext.Core.Text.List.CSV (csvMapTermList)
+import Gargantext.Core.Text.List.Formats.CSV (csvMapTermList)
 import Gargantext.Core.Text.Terms (terms)
 import Gargantext.Core.Text.Metrics.Count (coocOnContexts, Coocs)
 

bin/gargantext-import/Main.hs

@@ -29,7 +29,6 @@ import Gargantext.API.Prelude (GargError)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpusFile, flowAnnuaire, TermType(..))
-import Gargantext.Database.Query.Table.User (insertUsersDemo)
 import Gargantext.Database.Admin.Types.Hyperdata (toHyperdataDocument)
 import Gargantext.Database.Admin.Types.Node (CorpusId)
 import Gargantext.Database.Prelude (Cmd)
@@ -42,9 +41,6 @@ main = do
 
   --{-
 
-  let createUsers :: Cmd GargError Int64
-      createUsers = insertUsersDemo
-  
   let
     --tt = (Unsupervised EN 6 0 Nothing)
     tt = (Multi EN)
@@ -70,10 +66,6 @@ main = do
   --}
 
   withDevEnv iniPath $ \env -> do
-    _ <- if fun == "users"
-          then runCmdDev env createUsers
-          else pure 0 --(cs "false")
-
     _ <- if fun == "corpus"
           then runCmdDev env corpus
           else pure 0 --(cs "false")

bin/gargantext-init/Main.hs

@@ -20,10 +20,10 @@ import Data.Either (Either(..))
 import Gargantext.API.Dev (withDevEnv, runCmdDev)
 import Gargantext.API.Prelude (GargError)
 import Gargantext.API.Node () -- instances only
-import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Types.Individu (User(..), arbitraryNewUsers, NewUser(..), arbitraryUsername, GargPassword(..))
 import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMk_RootWithCorpus)
 import Gargantext.Database.Query.Table.Node (getOrMkList)
-import Gargantext.Database.Query.Table.User (insertUsersDemo)
+import Gargantext.Database.Query.Table.User (insertNewUsers, )
 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
@@ -31,6 +31,7 @@ import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
 import Gargantext.Database.Prelude (Cmd, )
 import Gargantext.Prelude
 import System.Environment (getArgs)
+import Prelude (getLine)
 
 -- TODO put this in gargantext.ini
 secret :: Text
@@ -40,12 +41,21 @@ main :: IO ()
 main = do
   [iniPath] <- getArgs
 
+  putStrLn "Enter master user (gargantua) _password_ :"
+  password  <- getLine
+
+  putStrLn "Enter master user (gargantua) _email_ :"
+  email     <- getLine
+
+
   let createUsers :: Cmd GargError Int64
-      createUsers = insertUsersDemo
+      createUsers = insertNewUsers (NewUser "gargantua" (cs email) (GargPassword $ cs password)
+                                   : arbitraryNewUsers
+                                   )
 
   let
     mkRoots :: Cmd GargError [(UserId, RootId)]
-    mkRoots = mapM getOrMkRoot $ map UserName ["gargantua", "user1", "user2", "user3"]
+    mkRoots = mapM getOrMkRoot $ map UserName ("gargantua" : arbitraryUsername)
     -- TODO create all users roots
 
   let

bin/gargantext-phylo/Main.hs

+{-|
+Module      : Main.hs
+Description : Gargantext starter binary with Phylo
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Phylo binaries
+
+ -}
+
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE Strict             #-}
+
+module Main where
+
+import Control.Concurrent.Async as CCA (mapConcurrently)
+import Control.Monad (mapM)
+import Data.Aeson
+import Data.List ((++),concat)
+import Data.Maybe
+import Data.Text (Text, unwords, unlines)
+import GHC.Generics
+import GHC.IO (FilePath)
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Prelude
+import Gargantext.Core.Text.Context (TermList)
+import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..),parseFile)
+import Gargantext.Core.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year)
+import Gargantext.Core.Text.List.Formats.CSV (csvMapTermList)
+import Gargantext.Core.Text.Terms.WithList
+import Gargantext.Core.Viz.Phylo
+import Gargantext.Core.Viz.Phylo.LevelMaker
+import Gargantext.Core.Viz.Phylo.Tools
+import Gargantext.Core.Viz.Phylo.View.Export
+import Gargantext.Core.Viz.Phylo.View.ViewMaker
+import System.Directory (doesFileExist)
+import System.Environment
+import qualified Data.ByteString.Lazy as L
+import qualified Data.List   as DL
+import qualified Data.Map    as DM
+import qualified Data.Text   as DT
+import qualified Data.Vector as DV
+import qualified Gargantext.Core.Text.Corpus.Parsers.CSV as CSV
+import qualified Prelude     as P
+
+
+--------------
+-- | Conf | --
+--------------
+
+
+type ListPath   = FilePath
+type FisPath    = FilePath
+type CorpusPath = FilePath
+data CorpusType = Wos | Csv deriving (Show,Generic) 
+type Limit = Int
+
+data Conf = 
+     Conf { corpusPath  :: CorpusPath
+          , corpusType  :: CorpusType
+          , listPath    :: ListPath
+          , fisPath     :: FilePath
+          , outputPath  :: FilePath
+          , phyloName   :: Text
+          , limit       :: Limit
+          , timeGrain   :: Int
+          , timeStep    :: Int
+          , timeFrame   :: Int
+          , timeFrameTh :: Double          
+          , timeTh      :: Double
+          , timeSens    :: Double
+          , reBranchThr :: Double
+          , reBranchNth :: Int
+          , clusterTh   :: Double
+          , clusterSens :: Double
+          , phyloLevel  :: Int
+          , viewLevel   :: Int
+          , fisSupport  :: Int
+          , fisClique   :: Int
+          , minSizeBranch :: Int 
+     } deriving (Show,Generic)
+
+instance FromJSON Conf
+instance ToJSON Conf
+
+instance FromJSON CorpusType
+instance ToJSON CorpusType
+
+
+decoder :: P.Either a b -> b
+decoder (P.Left _) = P.error "Error"
+decoder (P.Right x) = x
+
+-- | Get the conf from a Json file
+getJson :: FilePath -> IO L.ByteString
+getJson path = L.readFile path
+
+
+---------------
+-- | Parse | --
+---------------
+
+
+-- | To filter the Ngrams of a document based on the termList
+filterTerms :: Patterns -> (a, Text) -> (a, [Text])
+filterTerms patterns (y,d) = (y,termsInText patterns d)
+  where
+    --------------------------------------
+    termsInText :: Patterns -> Text -> [Text]
+    termsInText pats txt = DL.nub
+                         $ DL.concat
+                         $ map (map unwords)
+                         $ extractTermsWithList pats txt
+    --------------------------------------
+
+
+-- | To transform a Csv nfile into a readable corpus
+csvToCorpus :: Limit -> CorpusPath -> IO ([(Int,Text)])
+csvToCorpus limit csv = DV.toList
+                      -- . DV.reverse
+                      . DV.take limit
+                      -- . DV.reverse
+                      . DV.map (\n -> (csv_publication_year n, (csv_title n) <> " " <> (csv_abstract n)))
+                      . snd <$> CSV.readFile csv
+
+
+-- | To transform a Wos nfile into a readable corpus
+wosToCorpus :: Limit -> CorpusPath -> IO ([(Int,Text)])
+wosToCorpus limit path = DL.take limit
+                         . map (\d -> ((fromJust $_hd_publication_year d)
+                                    ,(fromJust $_hd_title d) <> " " <> (fromJust $_hd_abstract d)))
+                         . filter (\d -> (isJust $_hd_publication_year d)
+                                      && (isJust $_hd_title d)
+                                      && (isJust $_hd_abstract d))
+                         . concat
+                         <$> mapConcurrently (\idx -> parseFile WOS (path <> show(idx) <> ".txt")) [1..20]
+
+
+-- | To use the correct parser given a CorpusType
+fileToCorpus :: CorpusType -> Limit -> CorpusPath -> IO ([(Int,Text)])
+fileToCorpus format limit path = case format of 
+  Wos -> wosToCorpus limit path
+  Csv -> csvToCorpus limit path
+
+
+-- | To parse a file into a list of Document
+parse :: CorpusType -> Limit -> CorpusPath -> TermList -> IO [Document]
+parse format limit path l = do
+  corpus <- fileToCorpus format limit path
+  let patterns = buildPatterns l
+  pure $ map ( (\(y,t) -> Document y t) . filterTerms patterns) corpus
+
+
+-- | To parse an existing Fis file
+parseFis :: FisPath -> Text -> Int -> Int -> Int -> Int -> IO [PhyloFis]
+parseFis path name grain step support clique = do
+  fisExists <- doesFileExist (path <> (DT.unpack name) <> "_" <> show(grain) <> "_" <> show(step) <> "_" <> show(support) <> "_" <> show(clique) <> ".json")
+  if fisExists 
+    then do 
+      fisJson <- (eitherDecode <$> getJson (path <> (DT.unpack name) <> "_" <> show(grain) <> "_" <> show(step) <> "_" <> show(support) <> "_" <> show(clique) <> ".json")) :: IO (P.Either P.String [PhyloFis])
+      case fisJson of 
+        P.Left err -> do 
+                       putStrLn err
+                       pure []
+        P.Right fis -> pure fis
+    else pure []
+
+writeFis :: FisPath -> Text -> Int -> Int -> Int -> Int -> DM.Map (Date,Date) [PhyloFis] -> IO ()
+writeFis path name grain step support clique fis = do 
+  let fisPath = path <> (DT.unpack name) <> "_" <> show(grain) <> "_" <> show(step) <> "_" <> show(support) <> "_" <> show(clique) <> ".json"
+  L.writeFile fisPath $ encode (DL.concat $ DM.elems fis)
+
+--------------
+-- | Main | --
+--------------
+
+
+main :: IO ()
+main = do 
+
+  [jsonPath] <- getArgs
+
+  confJson <- (eitherDecode <$> getJson jsonPath) :: IO (P.Either P.String Conf)
+
+  case confJson of
+    P.Left err -> putStrLn err
+    P.Right conf -> do
+
+      termList <- csvMapTermList (listPath conf)
+
+      corpus <- parse (corpusType conf) (limit conf) (corpusPath conf) termList
+
+      putStrLn $ ("\n" <> show (length corpus) <> " parsed docs") 
+
+      fis <- parseFis (fisPath conf) (phyloName conf) (timeGrain conf) (timeStep conf) (fisSupport conf) (fisClique conf)
+
+      putStrLn $ ("\n" <> show (length fis) <> " parsed fis")
+
+      let fis'  = DM.fromListWith (++) $ DL.sortOn (fst . fst) $ map (\f -> (getFisPeriod f,[f])) fis    
+      
+      let query = PhyloQueryBuild (phyloName conf) "" (timeGrain conf) (timeStep conf) 
+                  (Fis $ FisParams True (fisSupport conf) (fisClique conf)) [] [] (WeightedLogJaccard $ WLJParams (timeTh conf) (timeSens conf)) (timeFrame conf) (timeFrameTh conf) 
+                  (reBranchThr conf) (reBranchNth conf) (phyloLevel conf)
+                  (RelatedComponents $ RCParams $ WeightedLogJaccard $ WLJParams (clusterTh conf) (clusterSens conf))
+
+      let queryView = PhyloQueryView (viewLevel conf) Merge False 1 [BranchAge,BranchBirth,BranchGroups] [SizeBranch $ SBParams (minSizeBranch conf)] [GroupLabelIncDyn,BranchPeakInc] (Just (ByBranchBirth,Asc)) Json Flat True           
+
+      let phylo = toPhylo query corpus termList fis'
+
+      writeFis (fisPath conf) (phyloName conf) (timeGrain conf) (timeStep conf) (fisSupport conf) (fisClique conf) (getPhyloFis phylo)
+
+      let view  = toPhyloView queryView phylo
+
+      putStrLn $ ("phylo completed until level " <> show (phyloLevel conf) <> ", export at level " <> show (viewLevel conf)) 
+
+      let outputFile = (outputPath conf) <> (DT.unpack $ phyloName conf)
+                                         <> "_" <> show (limit conf) <> "_"
+                                         <> "_" <> show (timeTh conf) <> "_"
+                                         <> "_" <> show (timeSens conf) <> "_"
+                                         <> "_" <> show (clusterTh conf) <> "_"
+                                         <> "_" <> show (clusterSens conf) 
+                                         <> ".dot"
+
+      P.writeFile outputFile $ dotToString $ viewToDot view      

bin/gargantext-upgrade/Main.hs

@@ -15,28 +15,41 @@ Import a corpus binary.
 
 module Main where
 
+import Gargantext.API.Admin.EnvTypes (DevEnv)
 import Gargantext.API.Dev (withDevEnv, runCmdDev)
 import Gargantext.API.Prelude (GargError)
 import Gargantext.API.Node () -- instances only
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye
-import Gargantext.Database.Prelude (Cmd, )
+import Gargantext.Database.Prelude (Cmd'', )
 import Gargantext.Prelude
 import System.Environment (getArgs)
+import Prelude (getLine)
 
+-- | PosTag
+import Gargantext.Database.Action.Flow (indexAllDocumentsWithPosTag)
+import Gargantext.Database.Query.Table.NgramsPostag (createTable_NgramsPostag)
 
 main :: IO ()
 main = do
   [iniPath] <- getArgs
 
+  putStrLn "Manual method (for now):"
+  putStrLn "Upgrade your schema database with the script:"
+  putStrLn "psql gargandbV5 < ./devops/postgres/upgrade/0.0.2.6.sql"
+  putStrLn "Then press enter key when you are done"
+  _ok  <- getLine
+
   let
-    updateNodes :: Cmd GargError [Int64]
-    updateNodes = updateNodesWithType_
-                    NodeList
-                    defaultHyperdataList
+    upgrade :: Cmd'' DevEnv GargError ()
+    upgrade = do
+      -- This method does not work for now
+      -- _ <- createTable_NgramsPostag
+      _ <- indexAllDocumentsWithPosTag
+      pure ()
 
   withDevEnv iniPath $ \env -> do
-    x <- runCmdDev env updateNodes
-    putStrLn $ show x
+    _ <- runCmdDev env upgrade
+    putStrLn "Uprade"
   pure ()

bin/install

 #!/bin/bash
 
-stack install --profile --test # --haddock
+stack install --profile --test --fast # --haddock

build-shell.nix

 { ghc
-, pkgs ? import ./pinned.nix {}
+, pkgs ? import ./pinned-20.09.nix {}
 }:
 let
   buildInputs = with pkgs; [

devops/docker/Dockerfile

-from fpco/stack-build:lts-14.27
+from fpco/stack-build:lts-16.26
 
 RUN apt-get update && \
     apt-get install -y git libigraph0-dev && \

devops/docker/docker-compose.yaml

@@ -4,8 +4,8 @@ services:
   postgres:
     image: 'postgres:latest'
     network_mode: host
-    ports:
-      - 5432:5432
+    #ports:
+      #- 5432:5432
     environment:
       POSTGRES_USER: gargantua
       POSTGRES_PASSWORD: C8kdcUrAQy66U
@@ -21,11 +21,13 @@ services:
     ports:
       - 8081:80
     environment:
-      PGADMIN_DEFAULT_EMAIL: admin
+      PGADMIN_DEFAULT_EMAIL: admin@localhost
       PGADMIN_DEFAULT_PASSWORD: admin
 
     depends_on:
       - postgres
+    links:
+      - postgres
 
   corenlp:
     image: 'cgenie/corenlp-garg'

devops/docker/docker-install

@@ -54,7 +54,7 @@ git clone https://gitlab.iscpif.fr/gargantext/purescript-gargantext
 ../install-deps $(pwd)
 
 pushd devops/docker
-docker build --pull -t fpco/stack-build:lts-14.22-garg .
+docker build --pull -t fpco/stack-build:lts-16.26-garg .
 popd
 
 #stack docker pull

devops/maintenance/index.html

+<!DOCTYPE html>
+<html xmlns="http://www.w3.org/1999/xhtml" lang="" xml:lang="">
+<head>
+  <meta charset="utf-8" />
+  <meta name="generator" content="pandoc" />
+  <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes" />
+  <title>index</title>
+  <style type="text/css">
+      code{white-space: pre-wrap;}
+      span.smallcaps{font-variant: small-caps;}
+      span.underline{text-decoration: underline;}
+      div.column{display: inline-block; vertical-align: top; width: 50%;}
+  </style>
+  <!--[if lt IE 9]>
+    <script src="//cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv-printshiv.min.js"></script>
+  <![endif]-->
+</head>
+<body>
+<p><img src="http://dl.gargantext.org/Logo_V4-min.png" title="V4 Logo" /></p>
+<p>Welcome,</p>
+<p>This server is on maintenance, see you back soon.</p>
+<p>(Sure, we take care of yours data, no worries :)</p>
+<p>Best regards, The GarganText Team CNRS/ISCPIF</p>
+</body>
+</html>

devops/maintenance/index.md

+
+![](http://dl.gargantext.org/Logo_V4-min.png "V4 Logo")
+
+Welcome,
+
+This server is on maintenance, see you back soon.
+
+(Sure, we take care of yours data, no worries :)
+
+Best regards,
+The GarganText Team
+CNRS/ISCPIF
+
+

devops/nginx/default

 
 ##
+## GargantText serveur configuration
+## Authors: team@gargantext.org
+## Licence CNRS/AGPLv3-MIT/CECILL-INRIA
+#
+# Fee free to improve it
+# Thanks for sharing to all community
+
+
+# Specific NGINX informations
+#
 # You should look at the following URL's in order to grasp a solid understanding
 # of Nginx configuration files in order to fully unleash the power of Nginx.
 # http://wiki.nginx.org/Pitfalls
@@ -12,16 +22,56 @@
 # Please see /usr/share/doc/nginx-doc/examples/ for more detailed examples.
 ##
 
+server {
+        
+    server_name doc.gargantext.org;
+
+    add_header Cache-Control "no-cache";
+
+    root /var/www/html/;
+    index index.html;
+ 
+
+    listen 443 ssl; # managed by Certbot
+    ssl_certificate /etc/letsencrypt/live/v4.gargantext.org/fullchain.pem; # managed by Certbot
+    ssl_certificate_key /etc/letsencrypt/live/v4.gargantext.org/privkey.pem; # managed by Certbot
+    include /etc/letsencrypt/options-ssl-nginx.conf; # managed by Certbot
+    ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem; # managed by Certbot
+
+}
+
+# Comment this for maintenance only
+server {
+        
+    #server_name v4.gargantext.org;
+    server_name maintenanceOnly.gargantext.org;
+
+    add_header Cache-Control "no-cache";
+
+    root /var/www/maintenance/;
+    index index.html;
+ 
+
+    listen 443 ssl; # managed by Certbot
+    ssl_certificate /etc/letsencrypt/live/v4.gargantext.org/fullchain.pem; # managed by Certbot
+    ssl_certificate_key /etc/letsencrypt/live/v4.gargantext.org/privkey.pem; # managed by Certbot
+    include /etc/letsencrypt/options-ssl-nginx.conf; # managed by Certbot
+    ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem; # managed by Certbot
+
+}
+
+
+
 
 server {
-    if ($host = dev.gargantext.org) {
+    if ($host = v4.gargantext.org) {
         return 301 https://$host$request_uri;
     } # managed by Certbot
 
 
     listen 80;
         
-    server_name dev.gargantext.org;
+    server_name v4.gargantext.org;
 
     add_header Cache-Control "no-cache";
 
@@ -30,7 +80,7 @@ server {
     }
 
     # Always redirect to https
-    return 301 https://dev.gargantext.org$request_uri;
+    return 301 https://v4.gargantext.org$request_uri;
 
 
 }
@@ -39,7 +89,7 @@ server {
     listen 443;
     listen [::]:443 ssl;
 
-    server_name dev.gargantext.org;
+    server_name v4.gargantext.org;
     
     # Some options configurations:    
     # https://github.com/h5bp/server-configs-nginx/blob/master/h5bp/location/expires.conf 
@@ -51,8 +101,8 @@ server {
     # listen [::]:443 ssl default_server;
     
     ssl on;
-    ssl_certificate /etc/letsencrypt/live/dev.gargantext.org/fullchain.pem; # managed by Certbot
-    ssl_certificate_key /etc/letsencrypt/live/dev.gargantext.org/privkey.pem; # managed by Certbot 
+    ssl_certificate /etc/letsencrypt/live/v4.gargantext.org/fullchain.pem; # managed by Certbot
+    ssl_certificate_key /etc/letsencrypt/live/v4.gargantext.org/privkey.pem; # managed by Certbot 
 
     # Note: You should disable gzip for SSL traffic.
     # See: https://bugs.debian.org/773332
@@ -81,7 +131,7 @@ server {
     # CORS config borrowed from: https://gist.github.com/pauloricardomg/7084524
     # NP: not sure we need CORS yet
     #
-    if ($http_origin ~* (^https?://(127.0.0.1|localhost|dev\.gargantext\.com))) {
+    if ($http_origin ~* (^https?://(127.0.0.1|localhost|v4\.gargantext\.com))) {
       set $cors "1";
     }
     #
@@ -115,10 +165,10 @@ server {
 
      location / {
        # https://stackoverflow.com/a/48708812
-       limit_except OPTIONS {
-         auth_basic           "Gargantext's Development Version";
-         auth_basic_user_file /etc/nginx/haskell_gargantext.htpasswd; 
-       }
+#       limit_except OPTIONS {
+#         auth_basic           "Gargantext's Development Version";
+#         auth_basic_user_file /etc/nginx/haskell_gargantext.htpasswd; 
+#       }
 
        proxy_set_header X-Real-IP         $remote_addr;
        proxy_set_header X-Forwarded-For   $proxy_add_x_forwarded_for;
@@ -134,5 +184,20 @@ server {
      access_log /var/log/nginx/access.log;
      error_log /var/log/nginx/error.log;
 
+
 }
 
+
+
+
+server {
+    if ($host = doc.gargantext.org) {
+        return 301 https://$host$request_uri;
+    } # managed by Certbot
+
+    listen 80;
+        
+    server_name doc.gargantext.org;
+    return 404; # managed by Certbot
+
+}

devops/nginx/frames/default

+##
+# You should look at the following URL's in order to grasp a solid understanding
+# of Nginx configuration files in order to fully unleash the power of Nginx.
+# https://www.nginx.com/resources/wiki/start/
+# https://www.nginx.com/resources/wiki/start/topics/tutorials/config_pitfalls/
+# https://wiki.debian.org/Nginx/DirectoryStructure
+#
+# In most cases, administrators will remove this file from sites-enabled/ and
+# leave it as reference inside of sites-available where it will continue to be
+# updated by the nginx packaging team.
+#
+# This file will automatically load configuration files provided by other
+# applications, such as Drupal or Wordpress. These applications will be made
+# available underneath a path with that package name, such as /drupal8.
+#
+# Please see /usr/share/doc/nginx-doc/examples/ for more detailed examples.
+##
+
+# Default server configuration
+#
+
+#upstream backend_istex{
+#    server 127.0.0.1:8080;
+#}
+
+
+#upstream backend_cillex{
+#    server 127.0.0.1:7080;
+#}
+
+#events {
+#    worker_connections 2000;
+#}
+
+
+
+server {
+	server_name write.frame.gargantext.org;
+	location / {
+		# include proxy_params;
+                proxy_pass http://localhost:3000;
+#		proxy_http_version 1.1;
+#		proxy_set_header Upgrade $http_upgrade;
+#		proxy_set_header Connection "upgrade";
+#		proxy_set_header Host $host;
+#		proxy_cookie_path / "/; secure; HttpOnly; SameSite=lax";
+
+		#proxy_set_header X-Real-IP $remote_addr;
+	#	proxy_cookie_domain $host $host;
+ 	#	proxy_ignore_headers  Cache-Control Expires Set-Cookie;
+               }
+
+    location /socket.io {
+        proxy_pass http://localhost:3000;
+        proxy_http_version 1.1;
+        proxy_set_header Upgrade $http_upgrade;
+        proxy_set_header Connection "Upgrade";
+        proxy_set_header Host $host;
+    }
+
+    listen 443 ssl; # managed by Certbot
+    ssl_certificate /etc/letsencrypt/live/searx.frame.gargantext.org/fullchain.pem; # managed by Certbot
+    ssl_certificate_key /etc/letsencrypt/live/searx.frame.gargantext.org/privkey.pem; # managed by Certbot
+    include /etc/letsencrypt/options-ssl-nginx.conf; # managed by Certbot
+    ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem; # managed by Certbot
+
+
+}
+
+
+server {
+	server_name write2.frame.gargantext.org;
+	location / {
+		# include proxy_params;
+                proxy_pass http://localhost:3001;
+#		proxy_http_version 1.1;
+#		proxy_set_header Upgrade $http_upgrade;
+#		proxy_set_header Connection "upgrade";
+#		proxy_set_header Host $host;
+#		proxy_cookie_path / "/; secure; HttpOnly; SameSite=lax";
+
+		#proxy_set_header X-Real-IP $remote_addr;
+	#	proxy_cookie_domain $host $host;
+ 	#	proxy_ignore_headers  Cache-Control Expires Set-Cookie;
+               }
+
+    listen 443 ssl; # managed by Certbot
+    ssl_certificate /etc/letsencrypt/live/write2.frame.gargantext.org/fullchain.pem; # managed by Certbot
+    ssl_certificate_key /etc/letsencrypt/live/write2.frame.gargantext.org/privkey.pem; # managed by Certbot
+    include /etc/letsencrypt/options-ssl-nginx.conf; # managed by Certbot
+    ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem; # managed by Certbot
+
+}
+
+
+
+
+
+
+
+server {
+	server_name calc.frame.gargantext.org;
+	location / {
+		include proxy_params;
+                proxy_pass http://localhost:8000;
+               }
+
+    listen 443 ssl; # managed by Certbot
+    ssl_certificate /etc/letsencrypt/live/searx.frame.gargantext.org/fullchain.pem; # managed by Certbot
+    ssl_certificate_key /etc/letsencrypt/live/searx.frame.gargantext.org/privkey.pem; # managed by Certbot
+    include /etc/letsencrypt/options-ssl-nginx.conf; # managed by Certbot
+    ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem; # managed by Certbot
+
+
+}
+
+
+#server {
+#	server_name hackmd.gargantext.org;
+#	location / {
+#		include proxy_params;
+#                proxy_pass http://localhost:8000;
+#               }
+#
+#    listen 443 ssl; # managed by Certbot
+#    ssl_certificate /etc/letsencrypt/live/cillex.gargantext.org/fullchain.pem; # managed by Certbot
+#    ssl_certificate_key /etc/letsencrypt/live/cillex.gargantext.org/privkey.pem; # managed by Certbot
+#    include /etc/letsencrypt/options-ssl-nginx.conf; # managed by Certbot
+#    ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem; # managed by Certbot
+#
+#}
+
+
+
+server {
+	server_name istex.frame.gargantext.org;
+	location / {
+		include proxy_params;
+                proxy_pass http://localhost:8080;
+               }
+
+    listen 443 ssl; # managed by Certbot
+    ssl_certificate /etc/letsencrypt/live/searx.frame.gargantext.org/fullchain.pem; # managed by Certbot
+    ssl_certificate_key /etc/letsencrypt/live/searx.frame.gargantext.org/privkey.pem; # managed by Certbot
+    include /etc/letsencrypt/options-ssl-nginx.conf; # managed by Certbot
+    ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem; # managed by Certbot
+
+
+
+
+}
+
+
+server {
+	server_name istex.gargantext.org;
+	location / {
+		include proxy_params;
+                proxy_pass http://localhost:8080;
+               }
+
+    listen 443 ssl; # managed by Certbot
+    ssl_certificate /etc/letsencrypt/live/searx.frame.gargantext.org/fullchain.pem; # managed by Certbot
+    ssl_certificate_key /etc/letsencrypt/live/searx.frame.gargantext.org/privkey.pem; # managed by Certbot
+    include /etc/letsencrypt/options-ssl-nginx.conf; # managed by Certbot
+    ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem; # managed by Certbot
+
+
+
+
+}
+
+
+server {
+	server_name searx.frame.gargantext.org;
+	location / {
+		include proxy_params;
+                proxy_pass http://localhost:8181;
+               }
+
+    listen 443 ssl; # managed by Certbot
+    ssl_certificate /etc/letsencrypt/live/searx.frame.gargantext.org/fullchain.pem; # managed by Certbot
+    ssl_certificate_key /etc/letsencrypt/live/searx.frame.gargantext.org/privkey.pem; # managed by Certbot
+    include /etc/letsencrypt/options-ssl-nginx.conf; # managed by Certbot
+    ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem; # managed by Certbot
+
+
+
+
+
+}
+
+
+# Virtual Host configuration for example.com
+#
+# You can move that to a different file under sites-available/ and symlink that
+# to sites-enabled/ to enable it.
+#
+#server {
+#	listen 80;
+#	listen [::]:80;
+#
+#	server_name example.com;
+#
+#	root /var/www/example.com;
+#	index index.html;
+#
+#	location / {
+#		try_files $uri $uri/ =404;
+#	}
+#}
+
+
+
+server {
+    if ($host = cillex.gargantext.org) {
+        return 301 https://$host$request_uri;
+    } # managed by Certbot
+
+
+	server_name cillex.gargantext.org;
+    return 404; # managed by Certbot
+
+
+
+    listen 443 ssl; # managed by Certbot
+    ssl_certificate /etc/letsencrypt/live/searx.frame.gargantext.org/fullchain.pem; # managed by Certbot
+    ssl_certificate_key /etc/letsencrypt/live/searx.frame.gargantext.org/privkey.pem; # managed by Certbot
+    include /etc/letsencrypt/options-ssl-nginx.conf; # managed by Certbot
+    ssl_dhparam /etc/letsencrypt/ssl-dhparams.pem; # managed by Certbot
+
+
+}
+
+
+
+server {
+    if ($host = searx.frame.gargantext.org) {
+        return 301 https://$host$request_uri;
+    } # managed by Certbot
+
+
+	server_name searx.frame.gargantext.org;
+    listen 80;
+    return 404; # managed by Certbot
+
+}
+
+
+server {
+    if ($host = istex.frame.gargantext.org) {
+        return 301 https://$host$request_uri;
+    } # managed by Certbot
+
+
+	server_name istex.frame.gargantext.org;
+    listen 80;
+    return 404; # managed by Certbot
+
+}
+
+
+server {
+    if ($host = calc.frame.gargantext.org) {
+        return 301 https://$host$request_uri;
+    } # managed by Certbot
+
+
+	server_name calc.frame.gargantext.org;
+    listen 80;
+    return 404; # managed by Certbot
+
+}
+
+server {
+    if ($host = write.frame.gargantext.org) {
+        return 301 https://$host$request_uri;
+    } # managed by Certbot
+
+
+	server_name write.frame.gargantext.org;
+    listen 80;
+    return 404; # managed by Certbot
+
+}
+
+server {
+    if ($host = write2.frame.gargantext.org) {
+        return 301 https://$host$request_uri;
+    } # managed by Certbot
+
+
+	server_name write2.frame.gargantext.org;
+    listen 80;
+    return 404; # managed by Certbot
+
+}
+
+
+
+
+server {
+    if ($host = istex.gargantext.org) {
+        return 301 https://$host$request_uri;
+    } # managed by Certbot
+
+
+	server_name istex.gargantext.org;
+    listen 80;
+    return 404; # managed by Certbot
+
+}
+
+
+
+
+server {
+    if ($host = cillex.gargantext.org) {
+        return 301 https://$host$request_uri;
+    } # managed by Certbot
+
+
+
+
+	server_name cillex.gargantext.org;
+	listen 80;
+    return 404; # managed by Certbot
+
+
+}

devops/postgres/schema.sql

@@ -39,6 +39,8 @@ CREATE TABLE public.nodes (
 );
 ALTER TABLE public.nodes OWNER TO gargantua;
 
+--------------------------------------------------------------
+-- | Ngrams
 CREATE TABLE public.ngrams (
     id SERIAL,
     terms CHARACTER varying(255),
@@ -47,6 +49,20 @@ CREATE TABLE public.ngrams (
 );
 ALTER TABLE public.ngrams OWNER TO gargantua;
 
+-- | Ngrams PosTag
+CREATE TABLE public.ngrams_postag (
+    id SERIAL,
+    lang_id INTEGER,
+    algo_id INTEGER,
+    postag CHARACTER varying(5),
+    ngrams_id INTEGER NOT NULL,
+    lemm_id   INTEGER NOT NULL,
+    score     INTEGER DEFAULT 1 ::integer NOT NULL,
+    FOREIGN KEY (ngrams_id) REFERENCES public.ngrams(id) ON DELETE CASCADE,
+    FOREIGN KEY (lemm_id)   REFERENCES public.ngrams(id) ON DELETE CASCADE
+);
+ALTER TABLE public.ngrams_postag OWNER TO gargantua;
+
 --------------------------------------------------------------
 CREATE TABLE public.node_ngrams (
     id SERIAL,
@@ -162,6 +178,7 @@ CREATE UNIQUE INDEX ON public.nodes USING btree (hash_id);
 
 CREATE UNIQUE INDEX ON public.ngrams (terms); -- TEST GIN
 CREATE        INDEX ON public.ngrams USING btree (id, terms);
+CREATE UNIQUE INDEX ON public.ngrams_postag (lang_id,algo_id,postag,ngrams_id,lemm_id);
 CREATE        INDEX ON public.node_ngrams USING btree (node_id,node_subtype);
 CREATE UNIQUE INDEX ON public.node_ngrams USING btree (node_id,node_subtype, ngrams_id);
 

devops/postgres/upgrade/0.0.2.6.sql

+    CREATE TABLE public.ngrams_postag (
+        id SERIAL,
+        lang_id INTEGER,
+        algo_id INTEGER,
+        postag CHARACTER varying(5),
+        ngrams_id INTEGER NOT NULL,
+        lemm_id   INTEGER NOT NULL,
+        score     INTEGER DEFAULT 1 ::integer NOT NULL,
+        FOREIGN KEY (ngrams_id) REFERENCES public.ngrams(id) ON DELETE CASCADE,
+        FOREIGN KEY (lemm_id)   REFERENCES public.ngrams(id) ON DELETE CASCADE
+    )  ;
+    -- ALTER TABLE public.ngrams_postag OWNER TO gargantua;
+
+    CREATE UNIQUE INDEX ON public.ngrams_postag (lang_id,algo_id,postag,ngrams_id,lemm_id);
+
+

package.yaml

 name: gargantext
-version: '0.0.1.91.3'
+version: '0.0.2.8'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data
@@ -58,6 +58,7 @@ library:
   - Gargantext.Database.Query.Table.User
   - Gargantext.Database.Query.Table.Node
   - Gargantext.Database.Query.Table.Node.UpdateOpaleye
+  - Gargantext.Database.Query.Table.NgramsPostag
   - Gargantext.Database.Prelude
   - Gargantext.Database.Admin.Trigger.Init
   - Gargantext.Database.Admin.Config
@@ -73,7 +74,7 @@ library:
   - Gargantext.Core.Text.Corpus.API
   - Gargantext.Core.Text.Corpus.Parsers.CSV
   - Gargantext.Core.Text.Examples
-  - Gargantext.Core.Text.List.CSV
+  - Gargantext.Core.Text.List.Formats.CSV
   - Gargantext.Core.Text.Metrics
   - Gargantext.Core.Text.Metrics.TFICF
   - Gargantext.Core.Text.Metrics.CharByChar
@@ -87,7 +88,6 @@ library:
   - Gargantext.Core.Text.Terms.WithList
   - Gargantext.Core.Text.Flow
   - Gargantext.Core.Viz.Graph
-  - Gargantext.Core.Viz.Graph.Distances.Matrice
   - Gargantext.Core.Viz.Graph.Index
   - Gargantext.Core.Viz.Phylo
   - Gargantext.Core.Viz.AdaptativePhylo
@@ -109,6 +109,8 @@ library:
   - SHA
   - Unique
   - accelerate
+  - accelerate-utility
+  - accelerate-arithmetic
   - aeson
   - aeson-lens
   - aeson-pretty
@@ -151,6 +153,7 @@ library:
   - full-text-search
   - fullstop
   - graphviz
+  - hashable
   - haskell-igraph
   - hlcm
   - hsparql

pinned-20.09.nix

+# this version of nixpkgs contains liblapack at ?
+# this version of nixpkgs contains gsl at ?
+import (builtins.fetchGit {
+  # Descriptive name to make the store path easier to identify
+  name = "nixos-20.09";
+  url = "https://github.com/nixos/nixpkgs/";
+  # `git ls-remote https://github.com/nixos/nixpkgs-channels nixos-20.09`
+  ref = "refs/heads/nixos-20.09";
+  rev = "19db3e5ea2777daa874563b5986288151f502e27";
+})

server

-~/.local/bin/gargantext-server --ini gargantext.ini --run Dev +RTS # -p
+#!/bin/bash
+
+FOLDER="logs"
+FILE=$(date +%Y%m%d%H%M.log)
+LOGFILE=$FOLDER"/"$FILE
+
+mkdir -p $FOLDER
+
+~/.local/bin/gargantext-server --ini gargantext.ini --run Dev +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE # -p

shell.nix

@@ -6,10 +6,12 @@ pkgs.mkShell {
     #glibc
     #gmp
     #gsl
+    haskell-language-server
     #igraph
+    lorri
     #pcre
     #postgresql
-    #stack
+    stack
     #xz
   ];
 }

src/Gargantext/API.hs

@@ -49,7 +49,7 @@ import Servant
 import System.IO (FilePath)
 import Data.Text.IO (putStrLn)
 
-import Gargantext.API.Admin.Auth (AuthContext)
+import Gargantext.API.Admin.Auth.Types (AuthContext)
 import Gargantext.API.Admin.Settings (newEnv)
 import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings)
 import Gargantext.API.Ngrams (saveRepo)

src/Gargantext/API/Admin/Auth.hs

@@ -21,67 +21,36 @@ TODO-ACCESS Critical
 -}
 
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
 
 module Gargantext.API.Admin.Auth
-      where
+  ( auth
+  , withAccess
+  )
+  where
 
 import Control.Lens (view)
-import Data.Aeson.TH (deriveJSON)
-import Data.Swagger
-import Data.Text (Text)
 import Data.Text.Lazy (toStrict)
 import Data.Text.Lazy.Encoding (decodeUtf8)
-import GHC.Generics (Generic)
 import Servant
 import Servant.Auth.Server
-import Test.QuickCheck (elements, oneof)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import qualified Gargantext.Prelude.Crypto.Auth as Auth
 
 import Gargantext.API.Admin.Types
+import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC)
-import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..), arbitraryUsername, arbitraryPassword)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
 import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
 import Gargantext.Database.Query.Tree.Root (getRoot)
 import Gargantext.Database.Schema.Node (NodePoly(_node_id))
-import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId, ListId, DocId)
+import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId)
 import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool, HasConfig)
 import Gargantext.Prelude hiding (reverse)
 import Gargantext.Database.Query.Table.User
 
 ---------------------------------------------------
 
--- | Main types for AUTH API
-data AuthRequest = AuthRequest { _authReq_username :: Username
-                               , _authReq_password :: GargPassword
-                               }
-  deriving (Generic)
-
--- TODO: Use an HTTP error to wrap AuthInvalid
-data AuthResponse = AuthResponse { _authRes_valid :: Maybe AuthValid
-                                 , _authRes_inval :: Maybe AuthInvalid
-                                 }
-  deriving (Generic)
-
-data AuthInvalid = AuthInvalid { _authInv_message :: Text }
-  deriving (Generic)
-
-data AuthValid = AuthValid { _authVal_token   :: Token
-                           , _authVal_tree_id :: TreeId
-                           }
-  deriving (Generic)
-
-type Token  = Text
-type TreeId = NodeId
-
 -- | Main functions of authorization
 
--- | Main types of authorization
-data CheckAuth = InvalidUser | InvalidPassword | Valid Token TreeId
-  deriving (Eq)
-
 makeTokenForUser :: (HasSettings env, HasJoseError err)
                  => NodeId -> Cmd' env err Token
 makeTokenForUser uid = do
@@ -119,23 +88,8 @@ auth (AuthRequest u p) = do
     InvalidPassword -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid password")
     Valid to trId   -> pure $ AuthResponse (Just $ AuthValid to trId) Nothing
 
-newtype AuthenticatedUser = AuthenticatedUser
-  { _authUser_id :: NodeId
-  } deriving (Generic)
-
-$(deriveJSON (unPrefix "_authUser_") ''AuthenticatedUser)
-
-instance ToSchema AuthenticatedUser where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authUser_")
-
-instance ToJWT AuthenticatedUser
-instance FromJWT AuthenticatedUser
-
 --type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser)
 
--- TODO-SECURITY why is the CookieSettings necessary?
-type AuthContext = '[JWTSettings, CookieSettings] -- , BasicAuthCfg
-
 {-
 instance FromBasicAuthData AuthenticatedUser where
   fromBasicAuthData authData authCheckFunction = authCheckFunction authData
@@ -147,43 +101,6 @@ authCheck _env (BasicAuthData login password) = pure $
   maybe Indefinite Authenticated $ TODO
 -}
 
--- | Instances
-$(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
-instance ToSchema AuthRequest where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authReq_")
-
-instance Arbitrary AuthRequest where
-  arbitrary = elements [ AuthRequest u p
-                       | u <- arbitraryUsername
-                       , p <- arbitraryPassword
-                       ]
-
-$(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
-instance ToSchema AuthResponse where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authRes_")
-instance Arbitrary AuthResponse where
-  arbitrary = oneof [ AuthResponse Nothing . Just      <$> arbitrary
-                    , flip AuthResponse Nothing . Just <$> arbitrary ]
-
-$(deriveJSON (unPrefix "_authInv_") ''AuthInvalid)
-instance ToSchema AuthInvalid where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authInv_")
-instance Arbitrary AuthInvalid where
-  arbitrary = elements [ AuthInvalid m 
-                       | m <- [ "Invalid user", "Invalid password"]
-                       ]
-
-$(deriveJSON (unPrefix "_authVal_") ''AuthValid)
-instance ToSchema AuthValid where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authVal_")
-instance Arbitrary AuthValid where
-  arbitrary = elements [ AuthValid to tr
-                       | to <- ["token0", "token1"]
-                       , tr <- [1..3]
-                       ]
-
-data PathId = PathNode NodeId | PathNodeNode ListId DocId
-
 withAccessM :: (CmdM env err m, HasServerError err)
             => UserId
             -> PathId

src/Gargantext/API/Admin/Auth/Types.hs

+{-|
+Module      : Gargantext.API.Admin.Auth.Types
+Description : Types for Server API Auth Module
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module Gargantext.API.Admin.Auth.Types
+      where
+
+import Data.Aeson.TH (deriveJSON)
+import Data.Swagger
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Servant.Auth.Server
+import Test.QuickCheck (elements, oneof)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+
+import Gargantext.Core.Types.Individu (Username, GargPassword(..), arbitraryUsername, arbitraryPassword)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Database.Admin.Types.Node (NodeId(..), ListId, DocId)
+import Gargantext.Prelude hiding (reverse)
+
+---------------------------------------------------
+
+-- | Main types for AUTH API
+data AuthRequest = AuthRequest { _authReq_username :: Username
+                               , _authReq_password :: GargPassword
+                               }
+  deriving (Generic)
+
+-- TODO: Use an HTTP error to wrap AuthInvalid
+data AuthResponse = AuthResponse { _authRes_valid :: Maybe AuthValid
+                                 , _authRes_inval :: Maybe AuthInvalid
+                                 }
+  deriving (Generic)
+
+data AuthInvalid = AuthInvalid { _authInv_message :: Text }
+  deriving (Generic)
+
+data AuthValid = AuthValid { _authVal_token   :: Token
+                           , _authVal_tree_id :: TreeId
+                           }
+  deriving (Generic)
+
+type Token  = Text
+type TreeId = NodeId
+
+data CheckAuth = InvalidUser | InvalidPassword | Valid Token TreeId
+  deriving (Eq)
+
+newtype AuthenticatedUser = AuthenticatedUser
+  { _authUser_id :: NodeId
+  } deriving (Generic)
+
+$(deriveJSON (unPrefix "_authUser_") ''AuthenticatedUser)
+
+instance ToSchema AuthenticatedUser where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authUser_")
+
+instance ToJWT AuthenticatedUser
+instance FromJWT AuthenticatedUser
+
+-- TODO-SECURITY why is the CookieSettings necessary?
+type AuthContext = '[JWTSettings, CookieSettings] -- , BasicAuthCfg
+
+-- | Instances
+$(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
+instance ToSchema AuthRequest where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authReq_")
+
+instance Arbitrary AuthRequest where
+  arbitrary = elements [ AuthRequest u p
+                       | u <- arbitraryUsername
+                       , p <- arbitraryPassword
+                       ]
+
+$(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
+instance ToSchema AuthResponse where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authRes_")
+instance Arbitrary AuthResponse where
+  arbitrary = oneof [ AuthResponse Nothing . Just      <$> arbitrary
+                    , flip AuthResponse Nothing . Just <$> arbitrary ]
+
+$(deriveJSON (unPrefix "_authInv_") ''AuthInvalid)
+instance ToSchema AuthInvalid where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authInv_")
+instance Arbitrary AuthInvalid where
+  arbitrary = elements [ AuthInvalid m 
+                       | m <- [ "Invalid user", "Invalid password"]
+                       ]
+
+$(deriveJSON (unPrefix "_authVal_") ''AuthValid)
+instance ToSchema AuthValid where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authVal_")
+instance Arbitrary AuthValid where
+  arbitrary = elements [ AuthValid to tr
+                       | to <- ["token0", "token1"]
+                       , tr <- [1..3]
+                       ]
+
+data PathId = PathNode NodeId | PathNodeNode ListId DocId
\ No newline at end of file

src/Gargantext/API/Admin/EnvTypes.hs

@@ -37,7 +37,7 @@ data Env = Env
 makeLenses ''Env
 
 instance HasConfig Env where
-  config = env_config
+  hasConfig = env_config
 
 instance HasConnectionPool Env where
   connPool = env_pool
@@ -78,7 +78,7 @@ data DevEnv = DevEnv
 makeLenses ''DevEnv
 
 instance HasConfig DevEnv where
-  config = dev_env_config
+  hasConfig = dev_env_config
 
 instance HasConnectionPool DevEnv where
   connPool = dev_env_pool
@@ -93,4 +93,4 @@ instance HasRepo DevEnv where
   repoEnv = dev_env_repo
 
 instance HasSettings DevEnv where
-  settings = dev_env_settings
\ No newline at end of file
+  settings = dev_env_settings

src/Gargantext/API/Admin/Orchestrator.hs

@@ -9,9 +9,6 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE TypeOperators     #-}
-
 module Gargantext.API.Admin.Orchestrator where
 
 import Control.Lens hiding (elements)

src/Gargantext/API/Admin/Settings.hs

@@ -10,7 +10,7 @@ Portability : POSIX
 TODO-SECURITY: Critical
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
 
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell     #-}
@@ -111,9 +111,9 @@ repoSaverAction repoDir a = do
 -- If repoSaverAction start taking more time than the debounceFreq then it should
 -- be increased.
 mkRepoSaver :: RepoDirFilePath -> MVar NgramsRepo -> IO (IO ())
-mkRepoSaver repoDir repo_var = mkDebounce settings
+mkRepoSaver repoDir repo_var = mkDebounce settings'
   where
-    settings = defaultDebounceSettings
+    settings' = defaultDebounceSettings
                  { debounceFreq   = let n = 6 :: Int in 10^n  -- 1 second
                  , debounceAction = withMVar repo_var (repoSaverAction repoDir)
                    -- Here this not only `readMVar` but `takeMVar`.
@@ -162,27 +162,27 @@ devJwkFile = "dev.jwk"
 newEnv :: PortNumber -> FilePath -> IO Env
 newEnv port file = do
   manager     <- newTlsManager
-  settings    <- devSettings devJwkFile <&> appPort .~ port -- TODO read from 'file'
-  when (port /= settings ^. appPort) $
+  settings'    <- devSettings devJwkFile <&> appPort .~ port -- TODO read from 'file'
+  when (port /= settings' ^. appPort) $
     panic "TODO: conflicting settings of port"
 
-  config       <- readConfig file
+  config'       <- readConfig file
   self_url     <- parseBaseUrl $ "http://0.0.0.0:" <> show port
   dbParam      <- databaseParameters file
   pool         <- newPool dbParam
-  repo         <- readRepoEnv (_gc_repofilepath config)
+  repo         <- readRepoEnv (_gc_repofilepath config')
   scrapers_env <- newJobEnv defaultSettings manager
   logger       <- newStderrLoggerSet defaultBufSize
 
   pure $ Env
-    { _env_settings = settings
+    { _env_settings = settings'
     , _env_logger   = logger
     , _env_pool     = pool
     , _env_repo     = repo
     , _env_manager  = manager
     , _env_scrapers = scrapers_env
     , _env_self_url = self_url
-    , _env_config   = config
+    , _env_config   = config'
     }
 
 newPool :: ConnectInfo -> IO (Pool Connection)
@@ -191,7 +191,7 @@ newPool param = createPool (connect param) close 1 (60*60) 8
 cleanEnv :: (HasConfig env, HasRepo env) => env -> IO ()
 cleanEnv env = do
   r <- takeMVar (env ^. repoEnv . renv_var)
-  repoSaverAction (env ^. config . gc_repofilepath) r
+  repoSaverAction (env ^. hasConfig . gc_repofilepath) r
   unlockFile (env ^. repoEnv . renv_lock)
 
-type IniPath  = FilePath
\ No newline at end of file
+type IniPath  = FilePath

src/Gargantext/API/Count.hs

@@ -10,7 +10,7 @@ Portability : POSIX
 Count API part of Gargantext.
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
 
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TypeOperators      #-}

src/Gargantext/API/Flow.hs

@@ -10,12 +10,6 @@ Portability : POSIX
 
 -}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-{-# LANGUAGE ScopedTypeVariables  #-}
-{-# LANGUAGE TemplateHaskell      #-}
-{-# LANGUAGE TypeOperators        #-}
-
 module Gargantext.API.Flow
   where
 

src/Gargantext/API/Metrics.hs

@@ -19,16 +19,17 @@ module Gargantext.API.Metrics
     where
 
 import Control.Lens
-import qualified Data.Map as Map
 import Data.Text (Text)
 import Data.Time (UTCTime)
-import Servant
-
+import Data.Vector (Vector)
 import Gargantext.API.HashedResponse
-import Gargantext.API.Ngrams.NTree
+import Gargantext.API.Ngrams.NgramsTree
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude (GargServer)
+import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
 import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..))
+import Gargantext.Core.Viz.Chart
+import Gargantext.Core.Viz.Types
 import Gargantext.Database.Action.Flow
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..), hl_chart, hl_pie, hl_scatter, hl_tree)
 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
@@ -39,9 +40,8 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
-import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
-import Gargantext.Core.Viz.Chart
-import Gargantext.Core.Viz.Types
+import Servant
+import qualified Data.HashMap.Strict                as HashMap
 import qualified Gargantext.Database.Action.Metrics as Metrics
 
 -------------------------------------------------------------
@@ -78,7 +78,7 @@ getScatter cId maybeListId tabType _maybeLimit = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let HyperdataList { _hl_scatter = scatterMap } = node ^. node_hyperdata
-      mChart = Map.lookup tabType scatterMap
+      mChart = HashMap.lookup tabType scatterMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -111,9 +111,9 @@ updateScatter' cId maybeListId tabType maybeLimit = do
   (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
 
   let
-    metrics      = map (\(Scored t s1 s2) -> Metric t s1 s2 (listType t ngs'))
-                 $ map normalizeLocal scores
-    listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
+    metrics      = fmap (\(Scored t s1 s2) -> Metric (unNgramsTerm t) s1 s2 (listType t ngs'))
+                 $ fmap normalizeLocal scores
+    listType t m = maybe (panic errorMsg) fst $ HashMap.lookup t m
     errorMsg     = "API.Node.metrics: key absent"
 
   listId <- case maybeListId of
@@ -122,7 +122,7 @@ updateScatter' cId maybeListId tabType maybeLimit = do
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
       scatterMap = hl ^. hl_scatter
-  _ <- updateHyperdata listId $ hl { _hl_scatter = Map.insert tabType (Metrics metrics) scatterMap }
+  _ <- updateHyperdata listId $ hl { _hl_scatter = HashMap.insert tabType (Metrics metrics) scatterMap }
 
   pure $ Metrics metrics
 
@@ -172,7 +172,7 @@ getChart cId _start _end maybeListId tabType = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let chartMap = node ^. node_hyperdata ^. hl_chart
-      mChart = Map.lookup tabType chartMap
+      mChart = HashMap.lookup tabType chartMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -209,7 +209,7 @@ updateChart' cId maybeListId tabType _maybeLimit = do
   let hl = node ^. node_hyperdata
       chartMap = hl ^. hl_chart
   h <- histoData cId
-  _ <- updateHyperdata listId $ hl { _hl_chart = Map.insert tabType (ChartMetrics h) chartMap }
+  _ <- updateHyperdata listId $ hl { _hl_chart = HashMap.insert tabType (ChartMetrics h) chartMap }
 
   pure $ ChartMetrics h
 
@@ -258,7 +258,7 @@ getPie cId _start _end maybeListId tabType = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let pieMap = node ^. node_hyperdata ^. hl_pie
-      mChart = Map.lookup tabType pieMap
+      mChart = HashMap.lookup tabType pieMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -296,7 +296,7 @@ updatePie' cId maybeListId tabType _maybeLimit = do
       pieMap = hl ^. hl_pie
 
   p <- chartData cId (ngramsTypeFromTabType tabType) MapTerm
-  _ <- updateHyperdata listId $ hl { _hl_pie = Map.insert tabType (ChartMetrics p) pieMap }
+  _ <- updateHyperdata listId $ hl { _hl_pie = HashMap.insert tabType (ChartMetrics p) pieMap }
 
   pure $ ChartMetrics p
 
@@ -317,24 +317,18 @@ type TreeApi = Summary " Tree API"
            :> QueryParam  "list"       ListId
            :> QueryParamR "ngramsType" TabType
            :> QueryParamR "listType"   ListType
-           :> Get '[JSON] (HashedResponse (ChartMetrics [MyTree]))
+           :> Get '[JSON] (HashedResponse (ChartMetrics (Vector NgramsTree)))
         :<|> Summary "Tree Chart update"
                 :> QueryParam  "list"       ListId
                 :> QueryParamR "ngramsType" TabType
                 :> QueryParamR "listType"   ListType
                 :> Post '[JSON] ()
           :<|> "hash" :>
-                  Summary "Tree Hash"
+                 Summary "Tree Hash"
               :> QueryParam  "list"       ListId
               :> QueryParamR "ngramsType" TabType
               :> QueryParamR "listType"   ListType
               :> Get '[JSON] Text
-
-                -- Depending on the Type of the Node, we could post
-                -- New documents for a corpus
-                -- New map list terms
-             -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
-
 treeApi :: NodeId -> GargServer TreeApi
 treeApi id' = getTree id'
          :<|> updateTree id'
@@ -347,7 +341,7 @@ getTree :: FlowCmdM env err m
         -> Maybe ListId
         -> TabType
         -> ListType
-        -> m (HashedResponse (ChartMetrics [MyTree]))
+        -> m (HashedResponse (ChartMetrics (Vector NgramsTree)))
 getTree cId _start _end maybeListId tabType listType = do
   listId <- case maybeListId of
     Just lid -> pure lid
@@ -355,7 +349,7 @@ getTree cId _start _end maybeListId tabType listType = do
 
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let treeMap = node ^. node_hyperdata ^. hl_tree
-      mChart = Map.lookup tabType treeMap
+      mChart = HashMap.lookup tabType treeMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -383,17 +377,17 @@ updateTree' :: FlowCmdM env err m =>
   -> Maybe ListId
   -> TabType
   -> ListType
-  -> m (ChartMetrics [MyTree])
+  -> m (ChartMetrics (Vector NgramsTree))
 updateTree' cId maybeListId tabType listType = do
   listId <- case maybeListId of
     Just lid -> pure lid
     Nothing  -> defaultList cId
 
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let hl = node ^. node_hyperdata
-      treeMap = hl ^. hl_tree
+  let hl      = node ^. node_hyperdata
+      treeMap = hl  ^. hl_tree
   t <- treeData cId (ngramsTypeFromTabType tabType) listType
-  _ <- updateHyperdata listId $ hl { _hl_tree = Map.insert tabType (ChartMetrics t) treeMap }
+  _ <- updateHyperdata listId $ hl { _hl_tree = HashMap.insert tabType (ChartMetrics t) treeMap }
 
   pure $ ChartMetrics t
 

src/Gargantext/API/Ngrams/NTree.hs → src/Gargantext/API/Ngrams/NgramsTree.hs

 {-|
-Module      : Gargantext.API.Ngrams.NTree
+Module      : Gargantext.API.Ngrams.NgramsTree
 Description : Tree of Ngrams
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -11,65 +11,67 @@ Portability : POSIX
 
 {-# LANGUAGE TemplateHaskell   #-}
 
-module Gargantext.API.Ngrams.NTree
+module Gargantext.API.Ngrams.NgramsTree
   where
 
 import Data.Aeson.TH (deriveJSON)
-import Data.Text (Text)
-import Data.Tree
+import Data.HashMap.Strict (HashMap)
 import Data.Maybe (catMaybes)
-import Data.Map (Map)
 import Data.Set (Set)
 import Data.Swagger
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import qualified Data.List as List
+import Data.Text (Text)
+import Data.Tree
 import GHC.Generics (Generic)
-import Test.QuickCheck
-
-import Gargantext.Prelude
-
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types (ListType(..), NodeId)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Prelude
+import Test.QuickCheck
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.List as List
+import qualified Data.Set as Set
 
 type Children = Text
 type Root = Text
 
-data MyTree = MyTree { mt_label :: Text
-                     , mt_value :: Double
-                     , mt_children :: [MyTree]
-                  } deriving (Generic, Show)
+data NgramsTree = NgramsTree { mt_label :: Text
+                             , mt_value :: Double
+                             , mt_children :: [NgramsTree]
+                             }
+    deriving (Generic, Show)
 
-toMyTree :: Tree (Text,Double) -> MyTree
-toMyTree (Node (l,v) xs) = MyTree l v (map toMyTree xs)
+toNgramsTree :: Tree (NgramsTerm,Double) -> NgramsTree
+toNgramsTree (Node (NgramsTerm l,v) xs) = NgramsTree l v (map toNgramsTree xs)
 
-deriveJSON (unPrefix "mt_") ''MyTree
+deriveJSON (unPrefix "mt_") ''NgramsTree
 
-instance ToSchema MyTree where
+instance ToSchema NgramsTree where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "mt_")
-instance Arbitrary MyTree
+instance Arbitrary NgramsTree
   where
-    arbitrary = MyTree <$> arbitrary <*> arbitrary <*> arbitrary
+    arbitrary = NgramsTree <$> arbitrary <*> arbitrary <*> arbitrary
 
-toTree :: ListType -> Map Text (Set NodeId) -> Map Text NgramsRepoElement -> [MyTree]
-toTree lt vs m = map toMyTree $ unfoldForest buildNode roots
+toTree :: ListType
+       -> HashMap NgramsTerm (Set NodeId)
+       -> HashMap NgramsTerm NgramsRepoElement
+       -> [NgramsTree]
+toTree lt vs m = map toNgramsTree $ unfoldForest buildNode roots
   where
     buildNode r = maybe ((r, value r),[])
-                        (\x -> ((r, value r), unNgramsTerm <$> (mSetToList $ _nre_children x)))
-                        (Map.lookup r m)
+                        (\x -> ((r, value r), mSetToList $ _nre_children x))
+                        (HashMap.lookup r m)
 
-    value l = maybe 0 (fromIntegral . Set.size) $ Map.lookup l vs
+    value l = maybe 0 (fromIntegral . Set.size) $ HashMap.lookup l vs
 
     rootsCandidates :: [NgramsTerm]
     rootsCandidates = catMaybes
                     $ List.nub
                     $ map (\(c, c') -> case _nre_root c' of
-                                       Nothing -> Just $ NgramsTerm c
-                                       _ -> _nre_root c') (Map.toList m)
+                                       Nothing -> Just c
+                                       _ -> _nre_root c') (HashMap.toList m)
 
     roots = map fst
           $ filter (\(_,l) -> l == lt)
           $ catMaybes
-          $ map (\c -> (,) <$> Just c <*> (_nre_list <$> Map.lookup c m))
-          $ (unNgramsTerm <$> rootsCandidates)
+          $ map (\c -> (,) <$> Just c <*> (_nre_list <$> HashMap.lookup c m))
+          $ rootsCandidates

src/Gargantext/API/Ngrams/Tools.hs

@@ -9,29 +9,30 @@ Portability : POSIX
 
 -}
 
+{-# LANGUAGE TypeFamilies #-}
 
 module Gargantext.API.Ngrams.Tools
   where
 
 import Control.Concurrent
-import Control.Lens (_Just, (^.), at, view)
+import Control.Lens (_Just, (^.), at, view, At, Index, IxValue)
 import Control.Monad.Reader
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
+import Data.HashMap.Strict (HashMap)
+import Data.Hashable (Hashable)
 import Data.Set (Set)
-import Data.Text (Text)
 import Data.Validity
-
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types (ListType(..), NodeId, ListId)
 import Gargantext.Database.Schema.Ngrams (NgramsType)
 import Gargantext.Prelude
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 
 mergeNgramsElement :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
 mergeNgramsElement _neOld neNew = neNew
 
-type RootTerm = Text
+type RootTerm = NgramsTerm
 
 getRepo :: RepoCmdM env err m => m NgramsRepo
 getRepo = do
@@ -39,87 +40,105 @@ getRepo = do
   liftBase $ readMVar v
 
 listNgramsFromRepo :: [ListId] -> NgramsType
-                   -> NgramsRepo -> Map Text NgramsRepoElement
-listNgramsFromRepo nodeIds ngramsType repo = Map.mapKeys unNgramsTerm ngrams
+                   -> NgramsRepo -> HashMap NgramsTerm NgramsRepoElement
+listNgramsFromRepo nodeIds ngramsType repo = ngrams
   where
     ngramsMap = repo ^. r_state . at ngramsType . _Just
 
-    ngrams    = Map.unionsWith mergeNgramsElement
+    -- TODO HashMap linked
+    ngrams    = HM.fromList $ Map.toList $ Map.unionsWith mergeNgramsElement
                 [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
 
+
+
 -- TODO-ACCESS: We want to do the security check before entering here.
 --              Add a static capability parameter would be nice.
 --              Ideally this is the access to `repoVar` which needs to
 --              be properly guarded.
 getListNgrams :: RepoCmdM env err m
               => [ListId] -> NgramsType
-              -> m (Map Text NgramsRepoElement)
+              -> m (HashMap NgramsTerm NgramsRepoElement)
 getListNgrams nodeIds ngramsType = listNgramsFromRepo nodeIds ngramsType <$> getRepo
 
-getTermsWith :: (RepoCmdM env err m, Ord a)
-          => (Text -> a ) -> [ListId]
+getTermsWith :: (RepoCmdM env err m, Eq a, Hashable a)
+          => (NgramsTerm -> a) -> [ListId]
           -> NgramsType -> ListType
-          -> m (Map a [a])
-getTermsWith f ls ngt lt = Map.fromListWith (<>)
-                      <$> map (toTreeWith f)
-                      <$> Map.toList
-                      <$> Map.filter (\f' -> (fst f') == lt)
+          -> m (HashMap a [a])
+getTermsWith f ls ngt lt = HM.fromListWith (<>)
+                      <$> map toTreeWith
+                      <$> HM.toList
+                      <$> HM.filter (\f' -> fst f' == lt)
                       <$> mapTermListRoot ls ngt
                       <$> getRepo
   where
-    toTreeWith f'' (t, (_lt, maybeRoot)) = case maybeRoot of
-      Nothing -> (f'' t, [])
-      Just  r -> (f'' r, map f'' [t])
+    toTreeWith (t, (_lt, maybeRoot)) = case maybeRoot of
+      Nothing -> (f t, [])
+      Just  r -> (f r, [f t])
 
 mapTermListRoot :: [ListId]
                 -> NgramsType
                 -> NgramsRepo
-                -> Map Text (ListType, (Maybe Text))
+                -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
 mapTermListRoot nodeIds ngramsType repo =
-  Map.fromList [ (t, (_nre_list nre, unNgramsTerm <$> _nre_root nre))
-               | (t, nre) <- Map.toList ngrams
-               ]
-  where ngrams = listNgramsFromRepo nodeIds ngramsType repo
+      (\nre -> (_nre_list nre, _nre_root nre))
+  <$> listNgramsFromRepo nodeIds ngramsType repo
+
+filterListWithRootHashMap :: ListType
+                          -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
+                          -> HashMap NgramsTerm (Maybe RootTerm)
+filterListWithRootHashMap lt m = snd <$> HM.filter isMapTerm m
+  where
+    isMapTerm (l, maybeRoot) = case maybeRoot of
+      Nothing -> l == lt
+      Just  r -> case HM.lookup r m of
+        Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> unNgramsTerm r
+        Just  (l',_) -> l' == lt
 
 filterListWithRoot :: ListType
-                   -> Map Text (ListType, Maybe Text)
-                   -> Map Text (Maybe RootTerm)
-filterListWithRoot lt m = Map.fromList
-                    $ map (\(t,(_,r)) -> (t,r))
-                    $ filter isMapTerm (Map.toList m)
+                   -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
+                   -> HashMap NgramsTerm (Maybe RootTerm)
+filterListWithRoot lt m = snd <$> HM.filter isMapTerm m
   where
-    isMapTerm (_t,(l, maybeRoot)) = case maybeRoot of
+    isMapTerm (l, maybeRoot) = case maybeRoot of
       Nothing -> l == lt
-      Just  r -> case Map.lookup r m of
-        Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> r
+      Just  r -> case HM.lookup r m of
+        Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> unNgramsTerm r
         Just  (l',_) -> l' == lt
 
-groupNodesByNgrams :: Map Text (Maybe RootTerm)
-                   -> Map Text (Set NodeId)
-                   -> Map Text (Set NodeId)
-groupNodesByNgrams syn occs = Map.fromListWith (<>) occs'
+groupNodesByNgrams :: ( At root_map
+                      , Index root_map ~ NgramsTerm
+                      , IxValue root_map ~ Maybe RootTerm
+                      )
+                   => root_map
+                   -> HashMap NgramsTerm (Set NodeId)
+                   -> HashMap NgramsTerm (Set NodeId)
+groupNodesByNgrams syn occs = HM.fromListWith (<>) occs'
   where
-    occs' = map toSyn (Map.toList occs)
-    toSyn (t,ns) = case Map.lookup t syn of
-      Nothing -> panic $ "[Garg.API.Ngrams.Tools.groupNodesByNgrams] unknown key: " <> t
+    occs' = map toSyn (HM.toList occs)
+    toSyn (t,ns) = case syn ^. at t of
+      Nothing -> panic $ "[Garg.API.Ngrams.Tools.groupNodesByNgrams] unknown key: " <> unNgramsTerm t
       Just  r -> case r of
         Nothing  -> (t, ns)
         Just  r' -> (r',ns)
 
 data Diagonal = Diagonal Bool
 
-getCoocByNgrams :: Diagonal -> Map Text (Set NodeId) -> Map (Text, Text) Int
+getCoocByNgrams :: Diagonal -> HashMap NgramsTerm (Set NodeId) -> HashMap (NgramsTerm, NgramsTerm) Int
 getCoocByNgrams = getCoocByNgrams' identity
 
 
-getCoocByNgrams' :: (Ord a, Ord c) => (b -> Set c) -> Diagonal -> Map a b -> Map (a, a) Int
+getCoocByNgrams' :: (Hashable a, Ord a, Ord c) => (b -> Set c) -> Diagonal -> HashMap a b -> HashMap (a, a) Int
 getCoocByNgrams' f (Diagonal diag) m =
-  Map.fromList [( (t1,t2)
-                , maybe 0 Set.size $ Set.intersection
-                                  <$> (fmap f $ Map.lookup t1 m)
-                                  <*> (fmap f $ Map.lookup t2 m)
-                ) | (t1,t2) <- case diag of
-                                 True   -> [ (x,y) | x <- Map.keys m, y <- Map.keys m, x <= y]
-                                 False  -> listToCombi identity (Map.keys m)
-               ]
-
+  HM.fromList [( (t1,t2)
+               , maybe 0 Set.size $ Set.intersection
+                                 <$> (fmap f $ HM.lookup t1 m)
+                                 <*> (fmap f $ HM.lookup t2 m)
+               )
+              | (t1,t2) <- if diag then
+                             [ (x,y) | x <- ks, y <- ks, x <= y] -- TODO if we keep a Data.Map here it might be
+                                                                 -- more efficient to enumerate all the y <= x.
+                           else
+                             listToCombi identity ks
+              ]
+
+  where ks = HM.keys m

src/Gargantext/API/Ngrams/Types.hs

@@ -19,6 +19,7 @@ import Data.Aeson hiding ((.=))
 import Data.Aeson.TH (deriveJSON)
 import Data.Either (Either(..))
 import Data.Foldable
+import Data.Hashable (Hashable)
 import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
 import qualified Data.List as List
 import Data.Map.Strict (Map)
@@ -38,6 +39,7 @@ import Data.Validity
 import Database.PostgreSQL.Simple.FromField (FromField, fromField, ResultError(ConversionFailed), returnError)
 import GHC.Generics (Generic)
 import Servant hiding (Patch)
+import Servant.Job.Utils (jsonOptions)
 import System.FileLock (FileLock)
 import Test.QuickCheck (elements, frequency)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -45,11 +47,12 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import Protolude (maybeToEither)
 import Gargantext.Prelude
 
+import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
 import Gargantext.Core.Text (size)
-import Gargantext.Core.Types (ListType(..), NodeId)
+import Gargantext.Core.Types (ListType(..), ListId, NodeId)
 import Gargantext.Core.Types (TODO)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema)
-import Gargantext.Database.Prelude (fromField', CmdM')
+import Gargantext.Database.Prelude (fromField', CmdM', HasConnectionPool, HasConfig)
 import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 
 ------------------------------------------------------------------------
@@ -59,6 +62,9 @@ data TabType   = Docs   | Trash   | MoreFav | MoreTrash
                | Contacts
   deriving (Bounded, Enum, Eq, Generic, Ord, Show)
 
+
+instance Hashable TabType
+
 instance FromHttpApiData TabType
    where
     parseUrlPiece "Docs"       = pure Docs
@@ -119,7 +125,14 @@ instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
 
 ------------------------------------------------------------------------
 newtype NgramsTerm = NgramsTerm { unNgramsTerm :: Text }
-  deriving (Ord, Eq, Show, Generic, ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema)
+  deriving (Ord, Eq, Show, Generic, ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema, Hashable)
+
+
+instance IsHashable NgramsTerm where
+  hash (NgramsTerm t) = hash t
+
+instance Monoid NgramsTerm where
+  mempty = NgramsTerm ""
 
 instance FromJSONKey NgramsTerm where
   fromJSONKey = FromJSONKeyTextParser $ \t -> pure $ NgramsTerm $ strip t
@@ -341,11 +354,13 @@ isRem = (== remPatch)
 
 type PatchMap = PM.PatchMap
 
-
 newtype PatchMSet a = PatchMSet (PatchMap a AddRem)
   deriving (Eq, Show, Generic, Validity, Semigroup, Monoid, Group,
             Transformable, Composable)
 
+unPatchMSet :: PatchMSet a -> PatchMap a AddRem
+unPatchMSet (PatchMSet a) = a
+
 type ConflictResolutionPatchMSet a = a -> ConflictResolutionReplace (Maybe ())
 type instance ConflictResolution (PatchMSet a) = ConflictResolutionPatchMSet a
 
@@ -635,7 +650,24 @@ instance (Typeable a, ToSchema a) => ToSchema (Versioned a) where
   declareNamedSchema = wellNamedSchema "_v_"
 instance Arbitrary a => Arbitrary (Versioned a) where
   arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
+------------------------------------------------------------------------
+type Count = Int
 
+data VersionedWithCount a = VersionedWithCount
+  { _vc_version :: Version
+  , _vc_count   :: Count
+  , _vc_data    :: a
+  }
+  deriving (Generic, Show, Eq)
+deriveJSON (unPrefix "_vc_") ''VersionedWithCount
+makeLenses ''VersionedWithCount
+instance (Typeable a, ToSchema a) => ToSchema (VersionedWithCount a) where
+  declareNamedSchema = wellNamedSchema "_vc_"
+instance Arbitrary a => Arbitrary (VersionedWithCount a) where
+  arbitrary = VersionedWithCount 1 1 <$> arbitrary -- TODO 1 is constant so far
+
+toVersionedWithCount :: Count -> Versioned a -> VersionedWithCount a
+toVersionedWithCount count (Versioned version data_) = VersionedWithCount version count data_
 ------------------------------------------------------------------------
 data Repo s p = Repo
   { _r_version :: !Version
@@ -643,7 +675,7 @@ data Repo s p = Repo
   , _r_history :: ![p]
     -- first patch in the list is the most recent
   }
-  deriving (Generic)
+  deriving (Generic, Show)
 
 instance (FromJSON s, FromJSON p) => FromJSON (Repo s p) where
   parseJSON = genericParseJSON $ unPrefix "_r_"
@@ -705,8 +737,10 @@ instance HasRepoSaver RepoEnv where
   repoSaver = renv_saver
 
 type RepoCmdM   env err m =
-  ( CmdM' env err m
-  , HasRepo     env
+  ( CmdM'             env err m
+  , HasRepo           env
+  , HasConnectionPool env
+  , HasConfig         env
   )
 
 
@@ -735,3 +769,17 @@ ngramsTypeFromTabType tabType =
       Terms      -> TableNgrams.NgramsTerms
       _          -> panic $ lieu <> "No Ngrams for this tab"
       -- TODO: This `panic` would disapear with custom NgramsType.
+
+----
+-- Async task
+
+data UpdateTableNgramsCharts = UpdateTableNgramsCharts
+  { _utn_tab_type :: !TabType
+  , _utn_list_id  :: !ListId
+  } deriving (Eq, Show, Generic)
+
+makeLenses ''UpdateTableNgramsCharts
+instance FromJSON UpdateTableNgramsCharts where
+  parseJSON = genericParseJSON $ jsonOptions "_utn_"
+instance ToSchema UpdateTableNgramsCharts where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_utn_")

src/Gargantext/API/Node.hs

@@ -40,7 +40,8 @@ import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
-import Gargantext.API.Admin.Auth (withAccess, PathId(..))
+import Gargantext.API.Admin.Auth.Types (PathId(..))
+import Gargantext.API.Admin.Auth (withAccess)
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
 import Gargantext.API.Ngrams.Types (TabType(..))
@@ -132,6 +133,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "ngrams"     :> TableNgramsApi
 
              :<|> "category"   :> CatApi
+             :<|> "score"      :> ScoreApi
              :<|> "search"     :> (Search.API Search.SearchResult)
              :<|> "share"      :> Share.API
 
@@ -209,10 +211,11 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            -- TODO gather it
            :<|> tableApi             id'
            :<|> apiNgramsTableCorpus id'
-            
+
            :<|> catApi      id'
+           :<|> scoreApi    id'
            :<|> Search.api  id'
-           :<|> Share.api   id'
+           :<|> Share.api   (RootId $ NodeId uId) id'
            -- Pairing Tools
            :<|> pairWith    id'
            :<|> pairs       id'
@@ -259,6 +262,27 @@ catApi = putCat
     putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
     putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
 
+------------------------------------------------------------------------
+type ScoreApi =  Summary " To Score NodeNodes"
+            :> ReqBody '[JSON] NodesToScore
+            :> Put     '[JSON] [Int]
+
+data NodesToScore = NodesToScore { nts_nodesId :: [NodeId]
+                                 , nts_score :: Int
+                                 }
+  deriving (Generic)
+
+-- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
+instance FromJSON  NodesToScore
+instance ToJSON    NodesToScore
+instance ToSchema  NodesToScore
+
+scoreApi :: CorpusId -> GargServer ScoreApi
+scoreApi = putScore
+  where
+    putScore :: CorpusId -> NodesToScore -> Cmd err [Int]
+    putScore cId cs' = nodeNodesScore $ map (\n -> (cId, n, nts_score cs')) (nts_nodesId cs')
+
 ------------------------------------------------------------------------
 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
 -- Pairing utilities to move elsewhere
@@ -291,10 +315,15 @@ pairWith cId aId lId = do
 
 
 ------------------------------------------------------------------------
-type TreeAPI   = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
+type TreeAPI   = QueryParams "type" NodeType
+                  :> Get '[JSON] (Tree NodeTree)
+                  :<|> "first-level"
+                      :> QueryParams "type" NodeType
+                      :> Get '[JSON] (Tree NodeTree)
 
 treeAPI :: NodeId -> GargServer TreeAPI
-treeAPI = tree TreeAdvanced
+treeAPI id = tree TreeAdvanced id
+        :<|> tree TreeFirstLevel id
 
 ------------------------------------------------------------------------
 -- | TODO Check if the name is less than 255 char

src/Gargantext/API/Node/Contact.hs

@@ -55,8 +55,8 @@ type API = "contact" :> Summary "Contact endpoint"
 
 
 api :: UserId -> CorpusId -> GargServer API
-api uid cid =  (api_async   (RootId (NodeId uid)) cid)
-          :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid cid)
+api uid cid =  (api_async   (RootId (NodeId                   uid)) cid)
+          :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid   cid)
 
 type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
 ------------------------------------------------------------------------

src/Gargantext/API/Node/Corpus/Export.hs

@@ -13,27 +13,18 @@ Main exports of Gargantext:
 - lists
 -}
 
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE TypeOperators     #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
 module Gargantext.API.Node.Corpus.Export
   where
 
-
-import Data.Aeson.TH (deriveJSON)
 import Data.Map (Map)
 import Data.Maybe (fromMaybe)
 import Data.Set (Set)
-import Data.Swagger
-import Data.Text (Text)
-import GHC.Generics (Generic)
+import Gargantext.API.Node.Corpus.Export.Types
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo)
 import Gargantext.API.Prelude (GargNoServer)
 import Gargantext.Prelude.Crypto.Hash (hash)
 import Gargantext.Core.Types
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNgramsByNodeOnlyUser)
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
@@ -45,59 +36,10 @@ import Gargantext.Database.Query.Table.NodeNode (selectDocNodes)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Database.Schema.Node (_node_id, _node_hyperdata)
 import Gargantext.Prelude
-import Servant
 import qualified Data.List as List
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-
-
--- Corpus Export
-data Corpus =
-  Corpus { _c_corpus :: [Document]
-         , _c_hash   :: Hash
-         } deriving (Generic)
-
--- | Document Export
-data Document =
-  Document { _d_document :: Node HyperdataDocument
-           , _d_ngrams   :: Ngrams
-           , _d_hash     :: Hash
-           } deriving (Generic)
-
-data Ngrams =
-  Ngrams { _ng_ngrams :: [Text]
-         , _ng_hash   :: Hash
-         } deriving (Generic)
-
-type Hash = Text
--------
-instance ToSchema Corpus where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_c_")
-
-instance ToSchema Document where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_d_")
-
-instance ToSchema Ngrams where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ng_")
-
-instance (ToSchema a) => ToSchema (Node a) where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_node_")
-
--------
-instance ToParamSchema Corpus where
-  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
-
-instance ToParamSchema Document where
-  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
-
-instance ToParamSchema Ngrams where
-  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
---------------------------------------------------
-type API = Summary "Corpus Export"
-            :> "export"
-            :> QueryParam "listId"     ListId
-            :> QueryParam "ngramsType" NgramsType
-            :> Get '[JSON] Corpus
+import qualified Data.HashMap.Strict as HashMap
 
 --------------------------------------------------
 -- | Hashes are ordered by Set
@@ -119,13 +61,13 @@ getCorpus cId lId nt' = do
   ngs  <- getNodeNgrams cId lId nt repo
   let  -- uniqId is hash computed already for each document imported in database
     r = Map.intersectionWith (\a b -> Document a (Ngrams (Set.toList b) (hash b)) (d_hash a b)
-                             ) ns ngs
+                             ) ns (Map.map (Set.map unNgramsTerm) ngs)
           where
             d_hash  a b = hash [ fromMaybe "" (_hd_uniqId $ _node_hyperdata a)
-                                       , hash b
-                                       ]
+                               , hash b
+                               ]
   pure $ Corpus (Map.elems r) (hash $ List.map _d_hash
-                                            $ Map.elems r
+                                    $ Map.elems r
                               )
 
 getNodeNgrams :: HasNodeError err
@@ -133,7 +75,7 @@ getNodeNgrams :: HasNodeError err
         -> Maybe ListId
         -> NgramsType
         -> NgramsRepo
-        -> Cmd err (Map NodeId (Set Text))
+        -> Cmd err (Map NodeId (Set NgramsTerm))
 getNodeNgrams cId lId' nt repo = do
   lId <- case lId' of
     Nothing -> defaultList cId
@@ -141,17 +83,10 @@ getNodeNgrams cId lId' nt repo = do
 
   lIds <- selectNodesWithUsername NodeList userMaster
   let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
-  r <- getNgramsByNodeOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
+  -- TODO HashMap
+  r <- getNgramsByNodeOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
   pure r
 
-
-$(deriveJSON (unPrefix "_c_") ''Corpus)
-$(deriveJSON (unPrefix "_d_") ''Document)
-$(deriveJSON (unPrefix "_ng_") ''Ngrams)
-
-
 -- TODO
 -- Exports List
 -- Version number of the list
-
-

src/Gargantext/API/Node/Corpus/Export/Types.hs

+{-|
+Module      : Gargantext.API.Node.Corpus.Export.Types
+Description : Types for Gargantext.API.Node.Corpus.Export
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators   #-}
+
+module Gargantext.API.Node.Corpus.Export.Types where
+
+import Data.Aeson.TH (deriveJSON)
+import Data.Swagger
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Gargantext.Core.Types
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
+import Gargantext.Database.Schema.Ngrams (NgramsType(..))
+import Servant
+
+
+-- Corpus Export
+data Corpus =
+  Corpus { _c_corpus :: [Document]
+         , _c_hash   :: Hash
+         } deriving (Generic)
+
+-- | Document Export
+data Document =
+  Document { _d_document :: Node HyperdataDocument
+           , _d_ngrams   :: Ngrams
+           , _d_hash     :: Hash
+           } deriving (Generic)
+
+data Ngrams =
+  Ngrams { _ng_ngrams :: [Text]
+         , _ng_hash   :: Hash
+         } deriving (Generic)
+
+type Hash = Text
+-------
+instance ToSchema Corpus where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_c_")
+
+instance ToSchema Document where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_d_")
+
+instance ToSchema Ngrams where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ng_")
+
+-------
+instance ToParamSchema Corpus where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+instance ToParamSchema Document where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+instance ToParamSchema Ngrams where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+--------------------------------------------------
+type API = Summary "Corpus Export"
+            :> "export"
+            :> QueryParam "listId"     ListId
+            :> QueryParam "ngramsType" NgramsType
+            :> Get '[JSON] Corpus
+
+$(deriveJSON (unPrefix "_c_") ''Corpus)
+$(deriveJSON (unPrefix "_d_") ''Document)
+$(deriveJSON (unPrefix "_ng_") ''Ngrams)
\ No newline at end of file

src/Gargantext/API/Node/Corpus/New.hs

@@ -41,6 +41,7 @@ import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Node.Corpus.New.File
 import Gargantext.API.Node.Types
 import Gargantext.Core (Lang(..){-, allLangs-})
+import Gargantext.Database.Action.Mail (sendMail)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpus, getDataText, flowDataText, TermType(..), DataOrigin(..){-, allDataOrigins-})
@@ -187,7 +188,7 @@ addToCorpusWithQuery :: FlowCmdM env err m
                        -> Maybe Integer
                        -> (JobLog -> m ())
                        -> m JobLog
-addToCorpusWithQuery u cid (WithQuery q dbs l _nid) maybeLimit logStatus = do
+addToCorpusWithQuery user cid (WithQuery q dbs l _nid) maybeLimit logStatus = do
   -- TODO ...
   logStatus JobLog { _scst_succeeded = Just 0
                    , _scst_failed    = Just 0
@@ -207,8 +208,10 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) maybeLimit logStatus = do
                    , _scst_events    = Just []
                    }
 
-  cids <- mapM (\txt -> flowDataText u txt (Multi l) cid) txts
+  cids <- mapM (\txt -> flowDataText user txt (Multi l) cid) txts
   printDebug "corpus id" cids
+  printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
+  sendMail user
   -- TODO ...
   pure      JobLog { _scst_succeeded = Just 3
                    , _scst_failed    = Just 0
@@ -268,6 +271,9 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
                      (map (map toHyperdataDocument) docs)
 
   printDebug "Extraction finished   : " cid
+  printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
+  sendMail user
+
   pure      JobLog { _scst_succeeded = Just 2
                    , _scst_failed    = Just 0
                    , _scst_remaining = Just 0
@@ -339,6 +345,10 @@ addToCorpusWithFile user cid nwf@(NewWithFile _d _l fName) logStatus = do
     _     -> pure ()
 
   printDebug "[addToCorpusWithFile] File upload to corpus finished: " cid
+
+  printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
+  sendMail user
+
   pure $ JobLog { _scst_succeeded = Just 1
                 , _scst_failed    = Just 0
                 , _scst_remaining = Just 0

src/Gargantext/API/Node/Share.hs

@@ -19,18 +19,21 @@ import Data.Aeson
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Servant
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
-
 import Gargantext.API.Prelude
-import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
 import Gargantext.Database.Action.Share (ShareNodeWith(..))
 import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish)
+import Gargantext.Database.Action.User
+import Gargantext.Database.Action.User.New
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude
+import Gargantext.Database.Query.Tree (findNodesWithType)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Prelude
+import Servant
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+import qualified Data.List as List
 
 ------------------------------------------------------------------------
 data ShareNodeParams = ShareTeamParams   { username :: Text  }
@@ -49,13 +52,48 @@ instance Arbitrary ShareNodeParams where
                        ]
 ------------------------------------------------------------------------
 -- TODO permission
+-- TODO refactor userId which is used twice
+-- TODO change return type for better warning/info/success/error handling on the front
 api :: HasNodeError err
-    => NodeId
+    => User
+    -> NodeId
     -> ShareNodeParams
-    -> Cmd err Int
-api nId (ShareTeamParams user) =
-  fromIntegral <$> DB.shareNodeWith (ShareNodeWith_User NodeFolderShared (UserName user)) nId 
-api nId2 (SharePublicParams nId1) =
+    -> CmdR err Int
+api userInviting nId (ShareTeamParams user') = do
+  user <- case guessUserName user' of
+    Nothing    -> pure user'
+    Just (u,_) -> do
+      isRegistered <- getUserId' (UserName u)
+      case isRegistered of
+        Just _  -> do
+          printDebug "[G.A.N.Share.api]" ("Team shared with " <> u)
+          pure u
+        Nothing -> do
+          username' <- getUsername userInviting
+          _ <- case List.elem username' arbitraryUsername of
+            True  -> do
+              printDebug "[G.A.N.Share.api]" ("Demo users are not allowed to invite" :: Text)
+              pure ()
+            False -> do
+              -- TODO better analysis of the composition of what is shared
+              children <- findNodesWithType nId [NodeList] [ NodeFolderShared
+                                                           , NodeTeam
+                                                           , NodeFolder
+                                                           , NodeCorpus
+                                                           ]
+              _ <- case List.null children of
+                True -> do
+                  printDebug "[G.A.N.Share.api]" ("Invitation is enabled if you share a corpus at least" :: Text)
+                  pure 0
+                False -> do 
+                  printDebug "[G.A.N.Share.api]" ("Your invitation is sent to: " <> user')
+                  newUsers [user']
+              pure ()
+          pure u
+
+  fromIntegral <$> DB.shareNodeWith (ShareNodeWith_User NodeFolderShared (UserName user)) nId
+api _uId nId2 (SharePublicParams nId1) =
+
   fromIntegral <$> DB.shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId1) nId2
 
 ------------------------------------------------------------------------

src/Gargantext/API/Node/Update.hs

@@ -30,7 +30,7 @@ import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
-import Gargantext.Core.Viz.Graph.Distances (GraphMetric(..), Distance(..))
+import Gargantext.Core.Methods.Distances (GraphMetric(..), Distance(..))
 import Gargantext.Database.Action.Flow.Pairing (pairing)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node

src/Gargantext/API/Prelude.hs

@@ -68,7 +68,7 @@ type ErrC err =
   )
 
 type GargServerC env err m =
-  ( CmdM' env err m
+  ( CmdRandom env err m
   , EnvC  env
   , ErrC      err
   )

src/Gargantext/API/Public.hs

@@ -9,7 +9,6 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE TemplateHaskell     #-}
 {-# LANGUAGE TypeOperators       #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -24,23 +23,25 @@ import Data.List (replicate, null)
 import Data.Aeson
 import Data.Swagger
 import GHC.Generics (Generic)
+import Servant
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+
+import qualified Data.List as List
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
 import Gargantext.API.Prelude
 import Gargantext.API.Node.File
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Admin.Types.Hyperdata.CorpusField
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.NodeNode (selectPublicNodes)
 import Gargantext.Core.Utils.DateUtils (utc2year)
-import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Schema.Node -- (NodePoly(..))
 import Gargantext.Prelude
-import Servant
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
-
-import qualified Data.List as List
-import qualified Data.Map as Map
-import qualified Data.Set as Set
 
 ------------------------------------------------------------------------
 type API =  API_Home

src/Gargantext/API/Routes.hs

@@ -9,10 +9,9 @@ Portability : POSIX
 
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
 
 {-# LANGUAGE ConstraintKinds      #-}
-{-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeOperators        #-}
 {-# LANGUAGE KindSignatures       #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
@@ -28,7 +27,8 @@ import Control.Concurrent (threadDelay)
 import Control.Lens (view)
 import Data.Text (Text)
 import Data.Validity
-import Gargantext.API.Admin.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), withAccess, PathId(..))
+import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..), PathId(..))
+import Gargantext.API.Admin.Auth (withAccess)
 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
 import Gargantext.API.Count  (CountAPI, count, Query)
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableDoc)
@@ -46,12 +46,13 @@ import Servant.Auth as SA
 import Servant.Auth.Swagger ()
 import Servant.Job.Async
 import Servant.Swagger.UI
-import qualified Gargantext.API.Ngrams.List           as List
-import qualified Gargantext.API.Node.Contact          as Contact
-import qualified Gargantext.API.Node.Corpus.Annuaire  as Annuaire
-import qualified Gargantext.API.Node.Corpus.Export    as Export
-import qualified Gargantext.API.Node.Corpus.New       as New
-import qualified Gargantext.API.Public                as Public
+import qualified Gargantext.API.Ngrams.List              as List
+import qualified Gargantext.API.Node.Contact             as Contact
+import qualified Gargantext.API.Node.Corpus.Annuaire     as Annuaire
+import qualified Gargantext.API.Node.Corpus.Export       as Export
+import qualified Gargantext.API.Node.Corpus.Export.Types as Export
+import qualified Gargantext.API.Node.Corpus.New          as New
+import qualified Gargantext.API.Public                   as Public
 
 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
 -- | TODO          :<|> Summary "Latest API" :> GargAPI'
@@ -94,10 +95,12 @@ type GargPrivateAPI' =
                            :> Capture "node_id" NodeId
                            :> NodeAPI HyperdataAny
 
+--{-
            -- Corpus endpoints
            :<|> "corpus"   :> Summary "Corpus endpoint"
                            :> Capture "corpus_id" CorpusId
                            :> NodeAPI HyperdataCorpus
+--}
 
            :<|> "corpus"   :> Summary "Corpus endpoint"
                            :> Capture "node1_id" NodeId
@@ -109,6 +112,12 @@ type GargPrivateAPI' =
                            :> Export.API
 
            -- Annuaire endpoint
+{-
+           :<|> "contact"  :> Summary "Contact endpoint"
+                           :> Capture "contact_id" ContactId
+                           :> NodeAPI HyperdataContact
+--}
+
            :<|> "annuaire" :> Summary "Annuaire endpoint"
                            :> Capture "annuaire_id" AnnuaireId
                            :> NodeAPI HyperdataAnnuaire
@@ -116,11 +125,11 @@ type GargPrivateAPI' =
            :<|> "annuaire" :> Summary "Contact endpoint"
                            :> Capture "annuaire_id" NodeId
                            :> Contact.API
-
            -- Document endpoint
            :<|> "document" :> Summary "Document endpoint"
                            :> Capture "doc_id" DocId
-                           :> "ngrams" :> TableNgramsApi
+                           :> "ngrams"
+                           :> TableNgramsApi
 
         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
             -- TODO-SECURITY
@@ -156,11 +165,11 @@ type GargPrivateAPI' =
            :<|> "lists"  :> Summary "List export API"
                          :> Capture "listId" ListId
                          :> List.API
-
+{-
            :<|> "wait"   :> Summary "Wait test"
                          :> Capture "x" Int
                          :> WaitAPI -- Get '[JSON] Int
-
+-}
 -- /mv/<id>/<id>
 -- /merge/<id>/<id>
 -- /rename/<id>
@@ -205,6 +214,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   uid
      :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      uid
      :<|> Export.getCorpus   -- uid
+ --    :<|> nodeAPI     (Proxy :: Proxy HyperdataContact)  uid
      :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) uid
      :<|> Contact.api uid
 
@@ -230,7 +240,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      -- :<|> New.api  uid -- TODO-SECURITY
      -- :<|> New.info uid -- TODO-SECURITY
      :<|> List.api
-     :<|> waitAPI
+--     :<|> waitAPI
 
 
 ----------------------------------------------------------------------
@@ -248,9 +258,9 @@ waitAPI n = do
 addCorpusWithQuery :: User -> GargServer New.AddWithQuery
 addCorpusWithQuery user cid =
   serveJobsAPI $
-    JobFunction (\q log -> do
-      limit <- view $ config . gc_max_docs_scrapers
-      New.addToCorpusWithQuery user cid q (Just limit) (liftBase . log)
+    JobFunction (\q log' -> do
+      limit <- view $ hasConfig . gc_max_docs_scrapers
+      New.addToCorpusWithQuery user cid q (Just limit) (liftBase . log')
       {- let log' x = do
         printDebug "addToCorpusWithQuery" x
         liftBase $ log x
@@ -267,25 +277,25 @@ addWithFile cid i f =
 addCorpusWithForm :: User -> GargServer New.AddWithForm
 addCorpusWithForm user cid =
   serveJobsAPI $
-    JobFunction (\i log ->
+    JobFunction (\i log' ->
       let
-        log' x = do
+        log'' x = do
           printDebug "addToCorpusWithForm" x
-          liftBase $ log x
-      in New.addToCorpusWithForm user cid i log')
+          liftBase $ log' x
+      in New.addToCorpusWithForm user cid i log'')
 
 addCorpusWithFile :: User -> GargServer New.AddWithFile
 addCorpusWithFile user cid =
   serveJobsAPI $
-    JobFunction (\i log ->
+    JobFunction (\i log' ->
       let
-        log' x = do
+        log'' x = do
           printDebug "addToCorpusWithFile" x
-          liftBase $ log x
-      in New.addToCorpusWithFile user cid i log')
+          liftBase $ log' x
+      in New.addToCorpusWithFile user cid i log'')
 
 addAnnuaireWithForm :: GargServer Annuaire.AddWithForm
 addAnnuaireWithForm cid =
   serveJobsAPI $
-    JobFunction (\i log -> Annuaire.addToAnnuaireWithForm cid i (liftBase . log))
+    JobFunction (\i log' -> Annuaire.addToAnnuaireWithForm cid i (liftBase . log'))
 

src/Gargantext/API/Search.hs

@@ -10,8 +10,6 @@ Portability : POSIX
 Count API part of Gargantext.
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TypeOperators      #-}
 {-# LANGUAGE DeriveAnyClass     #-}
@@ -27,15 +25,17 @@ import Data.Time (UTCTime)
 import GHC.Generics (Generic)
 import Gargantext.API.Prelude (GargServer)
 import Gargantext.Core.Utils.Prefix (unPrefixSwagger, unCapitalize, dropPrefix)
-import Gargantext.Database.Query.Facet
-import Gargantext.Database.Action.Search
 import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
+import Gargantext.Database.Action.Search
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact(..), HyperdataDocument(..), ContactWho(..))
+import Gargantext.Database.Admin.Types.Hyperdata.Contact (_cw_organization)
 import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Facet
 import Gargantext.Prelude
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
+import qualified Data.Text as Text
 
 -----------------------------------------------------------------------
 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
@@ -47,16 +47,25 @@ type API results = Summary "Search endpoint"
                  :> QueryParam "order"  OrderBy
                  :> Post '[JSON] results
 -----------------------------------------------------------------------
+-- | Api search function
 api :: NodeId -> GargServer (API SearchResult)
+
 api nId (SearchQuery q SearchDoc) o l order =
-  SearchResult <$> SearchResultDoc <$> map toRow <$> searchInCorpus nId False q o l order
+  SearchResult <$> SearchResultDoc
+               <$> map (toRow nId)
+               <$> searchInCorpus nId False q o l order
+
 api nId (SearchQuery q SearchContact) o l order = do
   printDebug "isPairedWith" nId
   aIds <- isPairedWith nId NodeAnnuaire
   -- TODO if paired with several corpus
   case head aIds of
-    Nothing  -> pure $ SearchResult $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
-    Just aId -> SearchResult <$> SearchResultContact <$> map toRow <$> searchInCorpusWithContacts nId aId q o l order
+    Nothing  -> pure $ SearchResult
+              $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
+    Just aId -> SearchResult
+            <$> SearchResultContact
+            <$> map (toRow aId)
+            <$> searchInCorpusWithContacts nId aId q o l order
 api _ _ _ _ _ = undefined
 
 -----------------------------------------------------------------------
@@ -105,8 +114,7 @@ instance Arbitrary SearchQuery where
   -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
 -----------------------------------------------------------------------
 data SearchResult =
-  SearchResult { result :: !SearchResultTypes
-              }
+  SearchResult { result :: !SearchResultTypes}
   | SearchResultErr !Text
     deriving (Generic)
 
@@ -167,6 +175,7 @@ data Row =
              , c_created    :: !UTCTime
              , c_hyperdata  :: !HyperdataRow
              , c_score      :: !Int
+             , c_annuaireId :: !NodeId
              }
   deriving (Generic)
 
@@ -188,16 +197,17 @@ instance ToSchema Row where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 
 class ToRow a where
-  toRow :: a -> Row
+  toRow :: NodeId -> a -> Row
 
 instance ToRow FacetDoc where
-  toRow (FacetDoc nId utc t h mc md) = Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 md)
+  toRow _ (FacetDoc nId utc t h mc _md sc) =
+    Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 sc)
 
 -- | TODO rename FacetPaired
 type FacetContact = FacetPaired Int UTCTime HyperdataContact Int
 
 instance ToRow FacetContact where
-  toRow (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s
+  toRow annuaireId (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s annuaireId
 
 
 --------------------------------------------------------------------
@@ -258,7 +268,7 @@ class ToHyperdataRow a where
   toHyperdataRow :: a -> HyperdataRow
 
 instance ToHyperdataRow HyperdataDocument where
-  toHyperdataRow (HyperdataDocument b d u ui ub p t a i s abs pd py pm pda ph pmin psec l) =
+  toHyperdataRow (HyperdataDocument b d u ui ub p t a i s abs' pd py pm pda ph pmin psec l) =
     HyperdataRowDocument
       (fromMaybe "" b)
       (fromMaybe "" d)
@@ -270,7 +280,7 @@ instance ToHyperdataRow HyperdataDocument where
       (fromMaybe "" a)
       (fromMaybe "" i)
       (fromMaybe "" s)
-      (fromMaybe "" abs)
+      (fromMaybe "" abs')
       (fromMaybe "" pd)
       (fromMaybe 2020 py)
       (fromMaybe 1 pm)
@@ -281,5 +291,9 @@ instance ToHyperdataRow HyperdataDocument where
       (fromMaybe "EN" l)
 
 instance ToHyperdataRow HyperdataContact where
-  toHyperdataRow (HyperdataContact _ (Just (ContactWho _ fn ln _ _)) _ _ _ _ _ _ ) = HyperdataRowContact (fromMaybe "FN" fn) (fromMaybe "LN" ln) "Labs"
-  toHyperdataRow (HyperdataContact _ _ _ _ _ _ _ _ ) = HyperdataRowContact "FirstName" "LastName" "Labs"
+  toHyperdataRow (HyperdataContact _ (Just (ContactWho _ fn ln _ _)) ou _ _ _ _ _ ) =
+    HyperdataRowContact (fromMaybe "FirstName" fn) (fromMaybe "LastName" ln) ou'
+      where
+        ou' = maybe "CNRS" (Text.intercalate " " . _cw_organization) (head ou)
+  toHyperdataRow (HyperdataContact _ _ _ _ _ _ _ _ ) =
+    HyperdataRowContact "FirstName" "LastName" "Labs"

src/Gargantext/API/Server.hs

@@ -25,7 +25,8 @@ import qualified Paths_gargantext           as PG -- cabal magic build module
 
 import qualified Gargantext.API.Public      as Public
 
-import Gargantext.API.Admin.Auth (AuthContext, auth)
+import Gargantext.API.Admin.Auth.Types (AuthContext)
+import Gargantext.API.Admin.Auth (auth)
 import Gargantext.API.Admin.FrontEnd (frontEndServer)
 import Gargantext.API.Prelude
 import Gargantext.API.Routes
@@ -33,7 +34,7 @@ import Gargantext.API.Swagger (swaggerDoc)
 import Gargantext.API.ThrowAll (serverPrivateGargAPI)
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (gc_url_backend_api)
-import Gargantext.Database.Prelude (config)
+import Gargantext.Database.Prelude (hasConfig)
 
 
 serverGargAPI :: Text -> GargServerM env err GargAPI
@@ -57,7 +58,7 @@ server env = do
             (Proxy :: Proxy GargAPI)
             (Proxy :: Proxy AuthContext)
             transform
-            (serverGargAPI (env ^. config . gc_url_backend_api))
+            (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
      :<|> frontEndServer
   where
     transform :: forall a. GargM env GargError a -> Handler a
@@ -66,4 +67,4 @@ server env = do
 
 showAsServantErr :: GargError -> ServerError
 showAsServantErr (GargServerError err) = err
-showAsServantErr a = err500 { errBody = BL8.pack $ show a }
\ No newline at end of file
+showAsServantErr a = err500 { errBody = BL8.pack $ show a }

src/Gargantext/API/Table.hs

@@ -45,17 +45,22 @@ import Gargantext.API.Ngrams.Types (TabType(..))
 import Gargantext.API.Prelude (GargServer)
 import Gargantext.Core.Types (Offset, Limit, TableResult(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
 import Gargantext.Database.Action.Search
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
+import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
 import Gargantext.Prelude
 
 ------------------------------------------------------------------------
 
 type TableApi = Summary "Table API"
               :> QueryParam "tabType" TabType
+              :> QueryParam "list" ListId
+              :> QueryParam "limit" Int
+              :> QueryParam "offset" Int
+              :> QueryParam "orderBy" OrderBy
+              :> QueryParam "query" Text
               :> Get    '[JSON] (HashedResponse FacetTableResult)
             :<|> Summary "Table API (POST)"
               :> ReqBody '[JSON] TableQuery
@@ -70,7 +75,7 @@ data TableQuery = TableQuery
   , tq_limit   :: Int
   , tq_orderBy :: OrderBy
   , tq_view    :: TabType
-  , tq_query  :: Text
+  , tq_query   :: Text
   } deriving (Generic)
 
 type FacetTableResult = TableResult FacetDoc
@@ -90,14 +95,21 @@ tableApi id' = getTableApi id'
           :<|> getTableHashApi id'
 
 
-getTableApi :: NodeId -> Maybe TabType -> Cmd err (HashedResponse FacetTableResult)
-getTableApi cId tabType = do
-  t <- getTable cId tabType Nothing Nothing Nothing
+getTableApi :: NodeId
+            -> Maybe TabType
+            -> Maybe ListId
+            -> Maybe Int
+            -> Maybe Int
+            -> Maybe OrderBy
+            -> Maybe Text
+            -> Cmd err (HashedResponse FacetTableResult)
+getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery = do
+  printDebug "[getTableApi] mQuery" mQuery
+  t <- getTable cId tabType mOffset mLimit mOrderBy mQuery
   pure $ constructHashedResponse t
 
-
 postTableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
-postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order)
+postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing
 postTableApi cId (TableQuery o l order ft q) = case ft of
       Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
       Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
@@ -105,7 +117,7 @@ postTableApi cId (TableQuery o l order ft q) = case ft of
 
 getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text
 getTableHashApi cId tabType = do
-  HashedResponse { hash = h } <- getTableApi cId tabType
+  HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
   pure h
 
 searchInCorpus' :: CorpusId
@@ -121,21 +133,29 @@ searchInCorpus' cId t q o l order = do
   pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
 
 
-getTable :: NodeId -> Maybe TabType
-         -> Maybe Offset  -> Maybe Limit
-         -> Maybe OrderBy -> Cmd err FacetTableResult
-getTable cId ft o l order = do
-  docs      <- getTable' cId ft o l order
-  docsCount <- runCountDocuments cId (if ft == Just Trash then True else False)
+getTable :: NodeId
+         -> Maybe TabType
+         -> Maybe Offset
+         -> Maybe Limit
+         -> Maybe OrderBy
+         -> Maybe Text
+         -> Cmd err FacetTableResult
+getTable cId ft o l order query = do
+  docs      <- getTable' cId ft o l order query
+  docsCount <- runCountDocuments cId (ft == Just Trash) query
   pure $ TableResult { tr_docs = docs, tr_count = docsCount }
 
-getTable' :: NodeId -> Maybe TabType
-         -> Maybe Offset  -> Maybe Limit
-         -> Maybe OrderBy -> Cmd err [FacetDoc]
-getTable' cId ft o l order =
+getTable' :: NodeId
+          -> Maybe TabType
+          -> Maybe Offset
+          -> Maybe Limit
+          -> Maybe OrderBy
+          -> Maybe Text
+          -> Cmd err [FacetDoc]
+getTable' cId ft o l order query =
   case ft of
-    (Just Docs)      -> runViewDocuments cId False o l order
-    (Just Trash)     -> runViewDocuments cId True  o l order
+    (Just Docs)      -> runViewDocuments cId False o l order query
+    (Just Trash)     -> runViewDocuments cId True  o l order query
     (Just MoreFav)   -> moreLike cId o l order IsFav
     (Just MoreTrash) -> moreLike cId o l order IsTrash
     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)

src/Gargantext/API/ThrowAll.hs

@@ -15,10 +15,11 @@ Portability : POSIX
 
 module Gargantext.API.ThrowAll where
 
-import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.Except (MonadError(..))
 import Control.Lens ((#))
 import Servant
 import Servant.Auth.Server (AuthResult(..))
+
 import Gargantext.Prelude
 import Gargantext.API.Prelude (GargServerM, _ServerError)
 import Gargantext.API.Routes (GargPrivateAPI, serverPrivateGargAPI')
@@ -46,4 +47,4 @@ instance {-# OVERLAPPABLE #-} (MonadError e m) => ThrowAll' e (m a) where
 serverPrivateGargAPI :: GargServerM env err GargPrivateAPI
 serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser
 serverPrivateGargAPI _                     = throwAll' (_ServerError # err401)
--- Here throwAll' requires a concrete type for the monad.
\ No newline at end of file
+-- Here throwAll' requires a concrete type for the monad.

src/Gargantext/Core.hs

@@ -9,17 +9,18 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE TemplateHaskell    #-}
-
 module Gargantext.Core
   where
 
-import Gargantext.Prelude
-import GHC.Generics (Generic)
+import Data.Text (Text)
 import Data.Aeson
 import Data.Either(Either(Left))
+import Data.Hashable (Hashable)
 import Data.Swagger
+import GHC.Generics (Generic)
+import Gargantext.Prelude
 import Servant.API
+
 ------------------------------------------------------------------------
 -- | Language of a Text
 -- For simplicity, we suppose text has an homogenous language
@@ -44,9 +45,40 @@ instance FromJSON Lang
 instance ToSchema Lang
 instance FromHttpApiData Lang
   where
-    parseUrlPiece "EN" = pure EN
-    parseUrlPiece "FR" = pure FR
+    parseUrlPiece "EN"  = pure EN
+    parseUrlPiece "FR"  = pure FR
     parseUrlPiece "All" = pure All
-    parseUrlPiece _            = Left "Unexpected value of OrderBy"
+    parseUrlPiece _     = Left "Unexpected value of OrderBy"
+instance Hashable Lang
+
 allLangs :: [Lang]
 allLangs = [minBound ..]
+
+class HasDBid a where
+  toDBid   :: a   -> Int
+  fromDBid :: Int -> a
+
+instance HasDBid Lang where
+  toDBid All = 0
+  toDBid FR  = 1
+  toDBid EN  = 2
+
+  fromDBid 0 = All
+  fromDBid 1 = FR
+  fromDBid 2 = EN
+  fromDBid _ = panic "HasDBid lang, not implemented"
+
+------------------------------------------------------------------------
+type Form = Text
+type Lem  = Text
+------------------------------------------------------------------------
+data PosTagAlgo = CoreNLP
+  deriving (Show, Read, Eq, Ord, Generic)
+
+instance Hashable PosTagAlgo
+
+instance HasDBid PosTagAlgo where
+  toDBid CoreNLP = 1
+  fromDBid 1 = CoreNLP
+  fromDBid _ = panic "HasDBid posTagAlgo : Not implemented"
+

src/Gargantext/Core/Ext/IMT.hs

@@ -20,7 +20,7 @@ import qualified Data.List   as DL
 import qualified Data.Vector as DV
 import qualified Data.Map    as M
 
-import Gargantext.Core.Text.Metrics.Freq as F
+import Gargantext.Core.Text.Metrics.Utils      as Utils
 import Gargantext.Core.Text.Corpus.Parsers.CSV as CSV
 
 data School = School { school_shortName :: Text
@@ -115,7 +115,7 @@ publisBySchool hal_data' = Gargantext.Prelude.map (\(i,n) -> (M.lookup i mapIdSc
                         $ DL.reverse
                         $ DL.sortOn snd
                         $ M.toList
-                        $ F.freq
+                        $ Utils.freq
                         $ DL.concat
                         $ DV.toList
                         $ DV.map (\n -> splitOn ( ", ") (csvHal_instStructId_i n) )

src/Gargantext/Core/Ext/IMTUser.hs

@@ -13,72 +13,138 @@ Here is writtent a common interface.
 -}
 
 
-module Gargantext.Core.Ext.IMTUser (deserialiseImtUsersFromFile)
+module Gargantext.Core.Ext.IMTUser -- (deserialiseImtUsersFromFile)
   where
 
 import Codec.Serialise
+import Data.Csv
+import Data.Either
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
+import Data.Vector (Vector)
 import GHC.Generics (Generic)
+import Gargantext.Core.Text.Corpus.Parsers.CSV
 import Gargantext.Database.Admin.Types.Hyperdata.Contact
 import Gargantext.Prelude
+import System.FilePath.Posix (takeExtension)
 import System.IO (FilePath)
-import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Vector          as Vector
 
 ------------------------------------------------------------------------
+readFile_Annuaire :: FilePath -> IO [HyperdataContact]
+readFile_Annuaire fp = case takeExtension fp of
+    ".csv"  -> readCSVFile_Annuaire fp
+    ".data" -> deserialiseImtUsersFromFile fp
+    _       -> panic "[G.C.E.I.readFile_Annuaire] extension unknown"
 
-instance Serialise IMTUser
-
-deserialiseImtUsersFromFile :: FilePath -> IO [HyperdataContact]
-deserialiseImtUsersFromFile filepath = map imtUser2gargContact <$> deserialiseFromFile' filepath
-
-deserialiseFromFile' :: FilePath -> IO [IMTUser]
-deserialiseFromFile' filepath = deserialise <$> BSL.readFile filepath
-
+------------------------------------------------------------------------
 data IMTUser = IMTUser
-  { id        :: Text
-  , entite    :: Maybe Text
-  , mail      :: Maybe Text
-  , nom       :: Maybe Text
-  , prenom    :: Maybe Text
-  , fonction  :: Maybe Text
-  , tel       :: Maybe Text
-  , fax       :: Maybe Text
-  , service   :: Maybe Text
-  , groupe    :: Maybe Text
-  , bureau    :: Maybe Text
-  , url       :: Maybe Text
-  , pservice  :: Maybe Text
-  , pfonction :: Maybe Text
-  , afonction :: Maybe Text
-  , grprech   :: Maybe Text
-  , lieu      :: Maybe Text
+  { id         :: Maybe Text
+  , entite     :: Maybe Text
+  , mail       :: Maybe Text
+  , nom        :: Maybe Text
+  , prenom     :: Maybe Text
+  , fonction   :: Maybe Text
+  , fonction2  :: Maybe Text
+  , tel        :: Maybe Text
+  , fax        :: Maybe Text
+  , service    :: Maybe Text
+  , groupe     :: Maybe Text
+  , entite2    :: Maybe Text
+  , service2   :: Maybe Text
+  , groupe2    :: Maybe Text
+  , bureau     :: Maybe Text
+  , url        :: Maybe Text
+  , pservice   :: Maybe Text
+  , pfonction  :: Maybe Text
+  , afonction  :: Maybe Text
+  , afonction2 :: Maybe Text
+  , grprech      :: Maybe Text
+  , appellation  :: Maybe Text
+  , lieu         :: Maybe Text
   , aprecision   :: Maybe Text
   , atel         :: Maybe Text
   , sexe         :: Maybe Text
   , statut       :: Maybe Text
   , idutilentite :: Maybe Text
-  , entite2  :: Maybe Text
-  , service2 :: Maybe Text
-  , groupe2  :: Maybe Text
-  , actif    :: Maybe Text
+  , actif             :: Maybe Text
   , idutilsiecoles    :: Maybe Text
   , date_modification :: Maybe Text
   } deriving (Eq, Show, Generic)
 
+-- | CSV instance
+instance FromNamedRecord IMTUser where
+  parseNamedRecord r = IMTUser <$> r .: "id"
+                               <*> r .: "entite"
+                               <*> r .: "mail"
+                               <*> r .: "nom"
+                               <*> r .: "prenom"
+                               <*> r .: "fonction"
+                               <*> r .: "fonction2"
+                               <*> r .: "tel"
+                               <*> r .: "fax"
+                               <*> r .: "service"
+                               <*> r .: "groupe"
+                               <*> r .: "entite2"
+                               <*> r .: "service2"
+                               <*> r .: "groupe2"
+                               <*> r .: "bureau"
+                               <*> r .: "url"
+                               <*> r .: "pservice"
+                               <*> r .: "pfonction"
+                               <*> r .: "afonction"
+                               <*> r .: "afonction2"
+                               <*> r .: "grprech"
+                               <*> r .: "appellation"
+                               <*> r .: "lieu"
+                               <*> r .: "aprecision"
+                               <*> r .: "atel"
+                               <*> r .: "sexe"
+                               <*> r .: "statut"
+                               <*> r .: "idutilentite"
+                               <*> r .: "actif"
+                               <*> r .: "idutilsiecoles"
+                               <*> r .: "date_modification"
+
+headerCSVannuaire :: Header
+headerCSVannuaire =
+  header ["id","entite","mail","nom","prenom","fonction","fonction2","tel","fax","service","groupe","entite2","service2","groupe2","bureau","url","pservice","pfonction","afonction","afonction2","grprech","appellation","lieu","aprecision","atel","sexe","statut","idutilentite","actif","idutilsiecoles","date_modification"]
+
+
+readCSVFile_Annuaire :: FilePath -> IO [HyperdataContact]
+readCSVFile_Annuaire fp = do
+  users <- snd <$> readCSVFile_Annuaire' fp
+  pure $ map imtUser2gargContact $ Vector.toList users
+
+readCSVFile_Annuaire' :: FilePath -> IO (Header, Vector IMTUser)
+readCSVFile_Annuaire' = fmap readCsvHalLazyBS' . BL.readFile
+  where
+    readCsvHalLazyBS' :: BL.ByteString -> (Header, Vector IMTUser)
+    readCsvHalLazyBS' bs = case decodeByNameWith csvDecodeOptions bs of
+          Left  e    -> panic (cs e)
+          Right rows -> rows
+
+------------------------------------------------------------------------
+-- | Serialization for optimization
+instance Serialise IMTUser
+deserialiseImtUsersFromFile :: FilePath -> IO [HyperdataContact]
+deserialiseImtUsersFromFile filepath = map imtUser2gargContact <$> deserialiseFromFile' filepath
+
+deserialiseFromFile' :: FilePath -> IO [IMTUser]
+deserialiseFromFile' filepath = deserialise <$> BL.readFile filepath
+
+------------------------------------------------------------------------
 imtUser2gargContact :: IMTUser -> HyperdataContact
-imtUser2gargContact (IMTUser id' entite' mail' nom' prenom' fonction' tel' _fax'
-                     service' _groupe' bureau' url' _pservice' _pfonction' _afonction'
-                     _grprech' lieu' _aprecision' _atel' _sexe' _statut' _idutilentite'
-                     _entite2' _service2' _group2' _actif' _idutilsiecoles' date_modification')
+imtUser2gargContact (IMTUser id' entite' mail' nom' prenom' fonction' _fonction2' tel' _fax'
+                     service' _groupe' _entite2 _service2 _group2 bureau' url' _pservice' _pfonction' _afonction' _afonction2'
+                     _grprech' _appellation' lieu' _aprecision' _atel' _sexe' _statut' _idutilentite'
+                     _actif' _idutilsiecoles' date_modification')
                   = HyperdataContact (Just "IMT Annuaire") (Just qui) [ou] ((<>) <$> (fmap (\p -> p <> " ") prenom') <*> nom') entite' date_modification' Nothing Nothing
                     where
-                      qui = ContactWho (Just id') prenom' nom' (catMaybes [service']) []
+                      qui = ContactWho id' prenom' nom' (catMaybes [service']) []
                       ou  = ContactWhere (toList entite') (toList service') fonction' bureau' (Just "France") lieu' contact Nothing Nothing
                       contact = Just $ ContactTouch mail' tel' url'
                       -- meta    = ContactMetaData (Just "IMT annuaire") date_modification'
                       toList Nothing  = []
                       toList (Just x) = [x]
-                             
-
-

src/Gargantext/Core/Flow/Types.hs

@@ -14,14 +14,10 @@ Portability : POSIX
 
 module Gargantext.Core.Flow.Types where
 
-import Control.Lens -- (Lens')
-import Data.Map (Map)
-
-import Gargantext.Core.Text (HasText(..))
+import Control.Lens
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Schema.Node (node_hash_id)
-import Gargantext.Database.Schema.Ngrams (Ngrams, NgramsType)
 import Gargantext.Prelude
 import Gargantext.Prelude.Crypto.Hash (Hash)
 
@@ -41,17 +37,10 @@ instance UniqId (Node a)
   where
     uniqId = node_hash_id
 
+
+{-
 data DocumentIdWithNgrams a = DocumentIdWithNgrams
-  { documentWithId  :: !(DocumentWithId a)
+  { documentWithId  :: !(Indexed NodeId a)
   , documentNgrams :: !(Map Ngrams (Map NgramsType Int))
   } deriving (Show)
-
-data DocumentWithId a = DocumentWithId
-  { documentId   :: !NodeId
-  , documentData :: !a
-  } deriving (Show)
-
-instance HasText a => HasText (DocumentWithId a)
-  where
-    hasText (DocumentWithId _ a) = hasText a
-
+-}

src/Gargantext/Core/Mail.hs

+{-|
+Module      : Gargantext.Core.Mail
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+TODO put main configuration variables in gargantext.ini
+
+-}
+
+module Gargantext.Core.Mail
+  where
+
+import Data.Text (Text, unlines, splitOn)
+import Gargantext.Core.Types.Individu
+import Gargantext.Prelude
+import Gargantext.Prelude.Mail (gargMail, GargMail(..))
+import qualified Data.List as List
+
+-- | Tool to put elsewhere
+isEmail :: Text -> Bool
+isEmail = ((==) 2) . List.length . (splitOn "@")
+
+------------------------------------------------------------------------
+data SendEmail    = SendEmail Bool
+
+type EmailAddress  = Text
+type Name          = Text
+type ServerAddress = Text
+
+data MailModel = Invitation { invitation_user :: NewUser GargPassword }
+               | PassUpdate { passUpdate_user :: NewUser GargPassword }
+               | MailInfo   { mailInfo_username :: Name
+                            , mailInfo_address  :: EmailAddress
+                            }
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+mail :: ServerAddress -> MailModel -> IO ()
+mail server model = gargMail (GargMail m (Just u) subject body)
+  where
+    (m,u)   = email_to         model
+    subject = email_subject    model
+    body    = emailWith server model
+
+------------------------------------------------------------------------
+emailWith :: ServerAddress -> MailModel -> Text
+emailWith server model =
+  unlines $ [ "Hello" ]
+          <> bodyWith server model
+          <> email_disclaimer
+          <> email_signature
+
+------------------------------------------------------------------------
+email_to :: MailModel -> (EmailAddress, Name)
+email_to (Invitation user) = email_to' user
+email_to (PassUpdate user) = email_to' user
+email_to (MailInfo u m)    = (m, u)
+
+email_to' :: NewUser GargPassword -> (EmailAddress, Name)
+email_to' (NewUser u m _) = (m,u)
+
+------------------------------------------------------------------------
+bodyWith :: ServerAddress -> MailModel -> [Text]
+bodyWith server (Invitation u) = [ "Congratulation, you have been granted a beta user account to test the"
+                                 , "new GarganText platform!"
+                                 ] <> (email_credentials server u)
+
+bodyWith server (PassUpdate u) = [ "Your account password have been updated on the GarganText platform!"
+                                 ] <> (email_credentials server u)
+
+bodyWith server (MailInfo _ _) = [ "Your last analysis is over on the server: " <> server]
+
+------------------------------------------------------------------------
+email_subject :: MailModel -> Text
+email_subject (Invitation _) = "[GarganText] Invitation"
+email_subject (PassUpdate _) = "[GarganText] Update"
+email_subject (MailInfo _ _) = "[GarganText] Info"
+
+
+email_credentials :: ServerAddress -> NewUser GargPassword -> [Text]
+email_credentials server (NewUser u _ (GargPassword p)) =
+          [ ""
+          , "You can log in to: " <> server
+          , "Your username is: "  <> u
+          , "Your password is: "  <> p
+          , ""
+          ]
+
+email_disclaimer :: [Text]
+email_disclaimer =
+            [ ""
+            , "If you log in you agree with the following terms of use:"
+            , "          https://gitlab.iscpif.fr/humanities/tofu/tree/master"
+            , ""
+            , ""
+            , "/!\\ Please note that your account is opened for beta tester only. Hence"
+            , "we cannot guarantee neither the perenniality nor the stability of the"
+            , "service at this stage. It is therefore advisable to back up important"
+            , "data regularly."
+            , ""
+            , "/!\\ Gargantext is an academic service supported by ISC-PIF partners."
+            , "In case of congestion on this service, access to members of the ISC-PIF"
+            , "partners will be privileged."
+            , ""
+            , "Your feedback will be valuable for further development of the platform,"
+            , "do not hesitate to contact us and to contribute on our forum:"
+            , ""
+            , "     https://discourse.iscpif.fr/c/gargantext"
+            , ""
+            ]
+
+email_signature :: [Text]
+email_signature =
+          [ "With our best regards,"
+          , "-- "
+          , "The Gargantext Team (CNRS)"
+          ]
+

src/Gargantext/Core/Viz/Graph/Distances.hs → src/Gargantext/Core/Methods/Distances.hs

@@ -11,7 +11,7 @@ Portability : POSIX
 
 {-# LANGUAGE Strict            #-}
 
-module Gargantext.Core.Viz.Graph.Distances
+module Gargantext.Core.Methods.Distances
   where
 
 import Data.Aeson
@@ -20,7 +20,8 @@ import Data.Swagger
 import GHC.Generics (Generic)
 import Gargantext.Prelude (Ord, Eq, Int, Double)
 import Gargantext.Prelude (Show)
-import Gargantext.Core.Viz.Graph.Distances.Matrice (measureConditional, distributional)
+import Gargantext.Core.Methods.Distances.Accelerate.Conditional (measureConditional)
+import Gargantext.Core.Methods.Distances.Accelerate.Distributional (distributional)
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary

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

+{-|
+Module      : Gargantext.Core.Methods.Distances.Accelerate.Conditional
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+This module aims at implementig distances of terms context by context is
+the same referential of corpus.
+
+Implementation use Accelerate library which enables GPU and CPU computation
+See Gargantext.Core.Methods.Graph.Accelerate)
+
+-}
+
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns        #-}
+
+module Gargantext.Core.Methods.Distances.Accelerate.Conditional
+  where
+
+-- import qualified Data.Foldable as P (foldl1)
+-- import Debug.Trace (trace)
+import Data.Array.Accelerate
+import Data.Array.Accelerate.Interpreter (run)
+import Gargantext.Core.Methods.Matrix.Accelerate.Utils
+import Gargantext.Core.Methods.Distances.Accelerate.SpeGen
+import qualified Gargantext.Prelude as P
+
+
+-- * Metrics of proximity
+-----------------------------------------------------------------------
+-- ** Conditional distance
+
+-- *** Conditional distance (basic)
+
+-- | Conditional distance (basic version)
+--
+-- 2 main metrics are actually implemented in order to compute the
+-- proximity of two terms: conditional and distributional
+--
+-- Conditional metric is an absolute metric which reflects
+-- interactions of 2 terms in the corpus.
+measureConditional :: Matrix Int -> Matrix Double
+measureConditional m = run $ zipWith (/) m' (matSumCol d m')
+  where
+    m' = map fromIntegral (use m)
+    d  = dim m
+
+
+-- *** Conditional distance (advanced)
+
+-- | Conditional distance (advanced version)
+--
+-- The conditional metric P(i|j) of 2 terms @i@ and @j@, also called
+-- "confidence" , is the maximum probability between @i@ and @j@ to see
+-- @i@ in the same context of @j@ knowing @j@.
+--
+-- If N(i) (resp. N(j)) is the number of occurrences of @i@ (resp. @j@)
+-- in the corpus and _[n_{ij}\] the number of its occurrences we get:
+--
+-- \[P_c=max(\frac{n_i}{n_{ij}},\frac{n_j}{n_{ij}} )\]
+conditional' :: Matrix Int -> (Matrix GenericityInclusion, Matrix SpecificityExclusion)
+conditional' m = ( run $ ie $ map fromIntegral $ use m
+                 , run $ sg $ map fromIntegral $ use m
+                 )
+  where
+    ie :: Acc (Matrix Double) -> Acc (Matrix Double)
+    ie mat = map (\x -> x / (2*n-1)) $ zipWith (+) (xs mat) (ys mat)
+    sg :: Acc (Matrix Double) -> Acc (Matrix Double)
+    sg mat = map (\x -> x / (2*n-1)) $ zipWith (-) (xs mat) (ys mat)
+
+    n :: Exp Double
+    n = P.fromIntegral r
+
+    r :: Dim
+    r = dim m
+
+    xs :: Acc (Matrix Double) -> Acc (Matrix Double)
+    xs mat = zipWith (-) (matSumCol r $ matProba r mat) (matProba r mat)
+    ys :: Acc (Matrix Double) -> Acc (Matrix Double)
+    ys mat = zipWith (-) (matSumCol r $ transpose $ matProba r mat) (matProba r mat)
+

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

+{-|
+Module      : Gargantext.Core.Methods.Distances.Accelerate.Distributional
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+
+* Distributional Distance metric
+__Definition :__ Distributional metric is a relative metric which depends on the
+selected list, it represents structural equivalence of mutual information.
+
+__Objective :__ We want to compute with matrices processing the similarity between term $i$ and term $j$ :
+ distr(i,j)=$\frac{\Sigma_{k \neq i,j} min(\frac{n_{ik}^2}{n_{ii}n_{kk}},\frac{n_{jk}^2}{n_{jj}n_{kk}})}{\Sigma_{k \neq i}\frac{n_{ik}^2}{ n_{ii}n_{kk}}}$
+
+where $n_{ij}$ is the cooccurrence between term $i$ and term $j$
+
+* For a vector V=[$x_1$ ... $x_n$], we note $|V|_1=\Sigma_ix_i$
+* operator : .* and ./ cell by cell multiplication and division of the matrix
+* operator * is the matrix multiplication
+* Matrice M=[$n_{ij}$]$_{i,j}$
+* opérateur : Diag(M)=[$n_{ii}$]$_i$ (vecteur)
+* Id= identity matrix
+* O=[1]$_{i,j}$ (matrice one)
+* D(M)=Id .* M
+* O * D(M) =[$n_{jj}$]$_{i,j}$
+* D(M) * O =[$n_{ii}$]$_{i,j}$
+* $V_i=[0~0~0~1~0~0~0]'$ en i
+* MI=(M ./ O * D(M)) .* (M / D(M) * O )
+* distr(i,j)=$\frac{|min(V'_i * (MI-D(MI)),V'_j * (MI-D(MI)))|_1}{|V'_i.(MI-D(MI))|_1}$
+
+[Specifications written by David Chavalarias on Garg v4 shared NodeWrite, team Pyremiel 2020]
+
+-}
+
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns        #-}
+
+module Gargantext.Core.Methods.Distances.Accelerate.Distributional
+  where
+
+-- import qualified Data.Foldable as P (foldl1)
+-- import Debug.Trace (trace)
+import Data.Array.Accelerate as A
+import Data.Array.Accelerate.Interpreter (run)
+import Gargantext.Core.Methods.Matrix.Accelerate.Utils
+import qualified Gargantext.Prelude as P
+
+-- | `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$.
+--
+-- ## Basic example with Matrix of size 3: 
+--
+-- >>> theMatrixInt 3
+-- Matrix (Z :. 3 :. 3)
+--   [ 7, 4, 0,
+--     4, 5, 3,
+--     0, 3, 4]
+--
+-- >>> distributional $ theMatrixInt 3
+-- Matrix (Z :. 3 :. 3)
+--   [ 1.0, 0.0, 0.9843749999999999,
+--     0.0, 1.0,                0.0,
+--     1.0, 0.0,                1.0]
+--
+-- ## Basic example with Matrix of size 4: 
+--
+-- >>> theMatrixInt 4
+-- Matrix (Z :. 4 :. 4)
+--   [ 4, 1, 2, 1,
+--     1, 4, 0, 0,
+--     2, 0, 3, 3,
+--     1, 0, 3, 3]
+--
+-- >>> distributional $ theMatrixInt 4
+-- Matrix (Z :. 4 :. 4)
+--   [                  1.0,                   0.0, 0.5714285714285715, 0.8421052631578947,
+--                      0.0,                   1.0,                1.0,                1.0,
+--     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
+ where
+    m = map fromIntegral $ use m'
+    n = dim m'
+
+    diag_m = diag m
+
+    d_1 = replicate (constant (Z :. n :. All)) diag_m
+    d_2 = replicate (constant (Z :. All :. n)) diag_m
+
+    mi    = (.*) ((./) m d_1) ((./) m d_2)
+
+    -- w = (.-) mi d_mi
+    
+    -- The matrix permutations is taken care of below by directly replicating
+    -- the matrix mi, making the matrix w unneccessary and saving one step.
+    w_1 = replicate (constant (Z :. All :. n :. All)) mi
+    w_2 = replicate (constant (Z :. n :. All :. All)) mi
+    w' = zipWith min w_1 w_2
+
+    -- The matrix ii = [r_{i,j,k}]_{i,j,k} has r_(i,j,k) = 0 if k = i OR k = j 
+    -- and r_(i,j,k) = 1 otherwise (i.e. k /= i AND k /= j). 
+    ii = generate (constant (Z :. n :. n :. n)) 
+        (lift1 (\(Z :. i :. j :. k) -> cond ((&&) ((/=) k i) ((/=) k j)) 1 0))
+
+    z_1 = sum ((.*) w' ii)
+    z_2 = sum ((.*) w_1 ii)
+
+    result = termDivNan z_1 z_2
+
+logDistributional :: Matrix Int -> Matrix Double
+logDistributional m' = run result
+ where
+    m = map fromIntegral $ use m'
+    n = dim m'
+
+    -- Scalar. Sum of all elements of m.
+    to = the $ sum (flatten m)
+
+    -- Diagonal matrix with the diagonal of m.
+    d_m = (.*) m (matrixIdentity n)
+
+    -- Size n vector. s = [s_i]_i
+    s = sum ((.-) m d_m)
+
+    -- Matrix nxn. Vector s replicated as rows. 
+    s_1 = replicate (constant (Z :. All :. n)) s
+    -- Matrix nxn. Vector s replicated as columns. 
+    s_2 = replicate (constant (Z :. n :. All)) s
+
+    -- Matrix nxn. ss = [s_i * s_j]_{i,j}. Outer product of s with itself. 
+    ss = (.*) s_1 s_2
+
+    -- Matrix nxn. mi = [m_{i,j}]_{i,j} where 
+    -- m_{i,j} = 0 if n_{i,j} = 0 or i = j, 
+    -- 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))
+
+    -- Tensor nxnxn. Matrix mi replicated along the 2nd axis.
+    w_1 = replicate (constant (Z :. All :. n :. All)) mi
+
+    -- Tensor nxnxn. Matrix mi replicated along the 1st axis.
+    w_2 = replicate (constant (Z :. n :. All :. All)) mi
+
+    -- Tensor nxnxn.
+    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)))
+
+    -- Matrix nxn. 
+    sumMin = 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)
+
+    result = termDivNan sumMin sumM
+
+
+-- The distributional metric P(c) of @i@ and @j@ terms is: \[
+-- S_{MI} = \frac {\sum_{k \neq i,j ; MI_{ik} >0}^{} \min(MI_{ik},
+-- MI_{jk})}{\sum_{k \neq i,j ; MI_{ik}>0}^{}} \]
+--
+-- Mutual information
+-- \[S_{MI}({i},{j}) = \log(\frac{C{ij}}{E{ij}})\]
+--
+-- Number of cooccurrences of @i@ and @j@ in the same context of text
+--                        \[C{ij}\]
+--
+-- The expected value of the cooccurrences @i@ and @j@ (given a map list of size @n@)
+--            \[E_{ij}^{m} = \frac {S_{i} S_{j}} {N_{m}}\]
+--
+-- Total cooccurrences of term @i@ given a map list of size @m@
+--            \[S_{i} = \sum_{j, j \neq i}^{m} S_{ij}\]
+--
+-- Total cooccurrences of terms given a map list of size @m@
+--            \[N_{m} = \sum_{i,i \neq i}^{m} \sum_{j, j \neq j}^{m} S_{ij}\]
+--
+
+distributional'' :: Matrix Int -> Matrix Double
+distributional'' m = -- run {- $ matMiniMax -}
+                   run  $ diagNull n
+                       $ rIJ n
+                       $ filterWith 0 100
+                       $ filter' 0
+                       $ s_mi
+                       $ map fromIntegral
+                          {- from Int to Double -}
+                       $ use m
+                          {- push matrix in Accelerate type -}
+  where
+
+    _ri :: Acc (Matrix Double) -> Acc (Matrix Double)
+    _ri mat = mat1 -- zipWith (/) mat1 mat2
+      where
+        mat1 = matSumCol n $ zipWith min (_myMin mat) (_myMin $ filterWith 0 100 $ diagNull n $ transpose mat)
+        _mat2 = total mat
+
+    _myMin :: Acc (Matrix Double) -> Acc (Matrix Double)
+    _myMin = replicate (constant (Z :. n :. All)) . minimum
+
+
+    -- TODO fix NaN
+    -- Quali TEST: OK
+    s_mi :: Acc (Matrix Double) -> Acc (Matrix Double)
+    s_mi m' = zipWith (\x y -> log (x / y)) (diagNull n m')
+            $ zipWith (/) (crossProduct n m') (total m')
+            -- crossProduct n m'
+
+
+    total :: Acc (Matrix Double) -> Acc (Matrix Double)
+    total = replicate (constant (Z :. n :. n)) . sum . sum
+
+    n :: Dim
+    n = dim m
+
+rIJ :: (Elt a, Ord a, P.Fractional (Exp a), P.Num a)
+    => Dim -> Acc (Matrix a) -> Acc (Matrix a)
+rIJ n m = matMiniMax $ divide a b
+  where
+    a = sumRowMin n m
+    b = sumColMin n m
+
+-- * For Tests (to be removed)
+-- | Test perfermance with this matrix
+-- TODO : add this in a benchmark folder
+distriTest :: Int -> Matrix Double
+distriTest n = distributional (theMatrixInt n)
+
+

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

+{-|
+Module      : Gargantext.Core.Methods.Distances.Accelerate.SpeGen
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+This module aims at implementig distances of terms context by context is
+the same referential of corpus.
+
+Implementation use Accelerate library which enables GPU and CPU computation
+See Gargantext.Core.Methods.Graph.Accelerate)
+
+-}
+
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns        #-}
+
+module Gargantext.Core.Methods.Distances.Accelerate.SpeGen
+  where
+
+-- import qualified Data.Foldable as P (foldl1)
+-- import Debug.Trace (trace)
+import Data.Array.Accelerate
+import Data.Array.Accelerate.Interpreter (run)
+import Gargantext.Core.Methods.Matrix.Accelerate.Utils
+import qualified Gargantext.Prelude as P
+
+
+-----------------------------------------------------------------------
+-----------------------------------------------------------------------
+-- * Specificity and Genericity
+
+{- | Metric Specificity and genericity: select terms
+
+- let N termes and occurrences of i \[N{i}\]
+
+- Cooccurrences of i and j \[N{ij}\]
+- Probability to get i given j : \[P(i|j)=N{ij}/N{j}\]
+
+- Genericity of i  \[Gen(i)  = \frac{\sum_{j \neq i,j} P(i|j)}{N-1}\]
+- Specificity of j \[Spec(i) = \frac{\sum_{j \neq i,j} P(j|i)}{N-1}\]
+
+- \[Inclusion (i) = Gen(i) + Spec(i)\)
+- \[GenericityScore = Gen(i)- Spec(i)\]
+
+- References: Science mapping with asymmetrical paradigmatic proximity
+Jean-Philippe Cointet (CREA, TSV), David Chavalarias (CREA) (Submitted
+on 15 Mar 2008), Networks and Heterogeneous Media 3, 2 (2008) 267 - 276,
+arXiv:0803.2315 [cs.OH]
+-}
+type GenericityInclusion  = Double
+type SpecificityExclusion = Double
+
+data SquareMatrix      = SymetricMatrix | NonSymetricMatrix
+type SymetricMatrix    = Matrix
+type NonSymetricMatrix = Matrix
+
+
+incExcSpeGen :: Matrix Int
+             -> ( Vector GenericityInclusion
+                , Vector SpecificityExclusion
+                )
+incExcSpeGen m = (run' inclusionExclusion m, run' specificityGenericity m)
+  where
+    run' fun mat = run $ fun $ map fromIntegral $ use mat
+
+    -- | Inclusion (i) = Gen(i)+Spec(i)
+    inclusionExclusion :: Acc (Matrix Double) -> Acc (Vector Double)
+    inclusionExclusion mat = zipWith (+) (pV mat) (pV mat)
+
+    -- | Genericity score = Gen(i)- Spec(i)
+    specificityGenericity :: Acc (Matrix Double) -> Acc (Vector Double)
+    specificityGenericity mat = zipWith (+) (pH mat) (pH mat)
+
+    -- | Gen(i)  : 1/(N-1)*Sum(j!=i, P(i|j)) : Genericity  of i
+    pV :: Acc (Matrix Double) -> Acc (Vector Double)
+    pV mat = map (\x -> (x-1)/(cardN-1)) $ sum $ p_ij mat
+
+    -- | Spec(i) : 1/(N-1)*Sum(j!=i, P(j|i)) : Specificity of j
+    pH :: Acc (Matrix Double) -> Acc (Vector Double)
+    pH mat = map (\x -> (x-1)/(cardN-1)) $ sum $ p_ji mat
+
+    cardN :: Exp Double
+    cardN = constant (P.fromIntegral (dim m) :: Double)
+
+
+-- | P(i|j) = Nij /N(jj) Probability to get i given j
+--p_ij :: (Elt e, P.Fractional (Exp e)) => Acc (SymetricMatrix e) -> Acc (Matrix e)
+p_ij :: (Elt e, P.Fractional (Exp e)) => Acc (Matrix e) -> Acc (Matrix e)
+p_ij m = zipWith (/) m (n_jj m)
+  where
+    n_jj :: Elt e => Acc (SymetricMatrix e) -> Acc (Matrix e)
+    n_jj myMat' = backpermute (shape m)
+                         (lift1 ( \(Z :. (_ :: Exp Int) :. (j:: Exp Int))
+                                   -> (Z :. j :. j)
+                                )
+                         ) myMat'
+
+-- | P(j|i) = Nij /N(ii) Probability to get i given j
+-- to test
+p_ji :: (Elt e, P.Fractional (Exp e))
+     => Acc (Array DIM2 e)
+     -> Acc (Array DIM2 e)
+p_ji = transpose . p_ij
+
+
+-- | Step to ckeck the result in visual/qualitative tests
+incExcSpeGen_proba :: Matrix Int -> Matrix Double
+incExcSpeGen_proba m = run' pro m
+  where
+    run' fun mat = run $ fun $ map fromIntegral $ use mat
+
+    pro mat = p_ji mat
+
+{-
+-- | Hypothesis to test maybe later (or not)
+-- TODO ask accelerate for instances to ease such writtings:
+p_ :: (Elt e, P.Fractional (Exp e)) => Acc (Array DIM2 e) -> Acc (Array DIM2 e)
+p_ m = zipWith (/) m (n_ m)
+  where
+    n_ :: Elt e => Acc (SymetricMatrix e) -> Acc (Matrix e)
+    n_ m = backpermute (shape m)
+                         (lift1 ( \(Z :. (i :: Exp Int) :. (j:: Exp Int))
+                                   -> (ifThenElse (i < j) (lift (Z :. j :. j)) (lift (Z :. i :. i)) :: Exp DIM2)
+                                )
+                         ) m
+-}
+

src/Gargantext/Core/Viz/Graph/Distances/Conditional.hs → src/Gargantext/Core/Methods/Distances/Conditional.hs

 {-|
-Module      : Gargantext.Graph.Distances.Conditional
+Module      : Gargantext.Core.Methods.Distances
 Description : 
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -12,7 +12,7 @@ Motivation and definition of the @Conditional@ distance.
 
 {-# LANGUAGE BangPatterns      #-}
 {-# LANGUAGE Strict            #-}
-module Gargantext.Core.Viz.Graph.Distances.Conditional
+module Gargantext.Core.Methods.Distances.Conditional
   where
 
 import Data.Matrix hiding (identity)

src/Gargantext/Core/Viz/Graph/Distances/Distributional.hs → src/Gargantext/Core/Methods/Distances/Distributional.hs

 {-|
-Module      : Gargantext.Graph.Distances.Distributional
-Description : 
+Module      : Gargantext.Core.Methods.Distances.Distributional
+Description :
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
@@ -14,7 +14,7 @@ Motivation and definition of the @Distributional@ distance.
 {-# LANGUAGE Strict            #-}
 
 
-module Gargantext.Core.Viz.Graph.Distances.Distributional
+module Gargantext.Core.Methods.Distances.Distributional
   where
 
 import Data.Matrix hiding (identity)

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

@@ -14,7 +14,7 @@ Références:
 -}
 
 
-module Gargantext.Core.Viz.Graph.Proxemy
+module Gargantext.Core.Methods.Graph.BAC.Proxemy
   where
 
 --import Debug.SimpleReflect
@@ -28,17 +28,17 @@ import Gargantext.Core.Viz.Graph.FGL
 type Length = Int
 type FalseReflexive = Bool
 type NeighborsFilter = Graph_Undirected -> Node -> [Node]
-type We = Bool
+type RmEdge = Bool
 
-confluence :: [(Node,Node)] -> Length -> FalseReflexive -> We -> Map (Node,Node) Double
-confluence ns l fr we = similarity_conf (mkGraphUfromEdges ns) l fr we
+confluence :: [(Node,Node)] -> Length -> FalseReflexive -> RmEdge -> Map (Node,Node) Double
+confluence ns = similarity_conf (mkGraphUfromEdges ns)
 
-similarity_conf :: Graph_Undirected -> Length -> FalseReflexive -> We -> Map (Node,Node) Double
-similarity_conf g l fr we = Map.fromList [ ((x,y), similarity_conf_x_y g (x,y) l fr we)
+similarity_conf :: Graph_Undirected -> Length -> FalseReflexive -> RmEdge -> Map (Node,Node) Double
+similarity_conf g l fr rm = Map.fromList [ ((x,y), similarity_conf_x_y g (x,y) l fr rm)
                                          | x <- nodes g, y <- nodes g, x < y]
 
-similarity_conf_x_y :: Graph_Undirected -> (Node,Node) -> Length -> FalseReflexive -> We -> Double
-similarity_conf_x_y g (x,y) l r we = similarity
+similarity_conf_x_y :: Graph_Undirected -> (Node,Node) -> Length -> FalseReflexive -> RmEdge -> Double
+similarity_conf_x_y g (x,y) l r rm_e = similarity
   where
     similarity :: Double
     similarity | denominator == 0 = 0
@@ -52,11 +52,11 @@ similarity_conf_x_y g (x,y) l r we = similarity
     xline :: Map Node Double
     xline    = prox_markov g [x] l r filterNeighbors'
       where
-        filterNeighbors' | we == True = filterNeighbors
+        filterNeighbors' | rm_e == True = filterNeighbors
                          | otherwise  = rm_edge_neighbors (x,y)
 
     pair_is_edge :: Bool
-    pair_is_edge | we == True = False
+    pair_is_edge | rm_e == True = False
                  | otherwise  = List.elem y (filterNeighbors g x)
 
     lim_SC :: Double

src/Gargantext/Core/Viz/Graph/MaxClique.hs → src/Gargantext/Core/Methods/Graph/MaxClique.hs

@@ -6,8 +6,9 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-- First written by Bruno Gaume in Python        (see below for details)
-- Then  written by Alexandre Delanoë in Haskell (see below for details)
+- Result of the workshop, Pyremiel 2019
+  - First written by Bruno Gaume in Python        (see below for details)
+  - Then  written by Alexandre Delanoë in Haskell (see below for details)
 
 # By Bruno Gaume:
 def fast_maximal_cliques(g):
@@ -48,7 +49,7 @@ def fast_maximal_cliques(g):
 
 
 
-module Gargantext.Core.Viz.Graph.MaxClique
+module Gargantext.Core.Methods.Graph.MaxClique
   where
 
 import Data.Maybe (catMaybes)
@@ -61,14 +62,13 @@ import Data.Set (fromList, toList, isSubsetOf)
 import Data.Graph.Inductive hiding (Graph, neighbors, subgraph, (&))
 import Gargantext.Core.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfromEdges)
 import Gargantext.Core.Viz.Graph.Tools (cooc2graph',cooc2graph'', Threshold)
-import Gargantext.Core.Viz.Graph.Distances (Distance)
+import Gargantext.Core.Methods.Distances (Distance)
 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex)
 import Gargantext.Core.Viz.AdaptativePhylo
 -- import Debug.Trace (trace)
 type Graph = Graph_Undirected
 type Neighbor = Node
 
-
 -- | getMaxCliques
 -- TODO chose distance order
 getMaxCliques :: Ord a => CliqueFilter -> Distance -> Threshold -> Map (a, a) Int -> [[a]]

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

@@ -9,8 +9,6 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE InstanceSigs      #-}
-
 module Gargantext.Core.Text.Corpus.API
   ( ExternalAPIs(..)
   , Query
@@ -30,19 +28,22 @@ import qualified Gargantext.Core.Text.Corpus.API.Isidore as ISIDORE
 import qualified Gargantext.Core.Text.Corpus.API.Istex   as ISTEX
 import qualified Gargantext.Core.Text.Corpus.API.Pubmed  as PUBMED
 
+-- | TODO put in gargantext.init
+default_limit :: Maybe Integer
+default_limit = Just 10000
+
 -- | Get External API metadata main function
 get :: ExternalAPIs
     -> Lang
     -> Query
     -> Maybe Limit
     -> IO [HyperdataDocument]
-get PubMed  _la q l = PUBMED.get   q l -- EN only by default
-get HAL      la q l = HAL.get   la q l
-get IsTex    la q l = ISTEX.get la q l
-get Isidore  la q l = ISIDORE.get la (fromIntegral <$> l) (Just q) Nothing
+get PubMed  _la q _l = PUBMED.get   q default_limit -- EN only by default
+get HAL      la q _l = HAL.get   la q default_limit
+get IsTex    la q _l = ISTEX.get la q default_limit
+get Isidore  la q _l = ISIDORE.get la (fromIntegral <$> default_limit) (Just q) Nothing
 get _        _  _ _ = undefined
 
 -- | Some Sugar for the documentation
 type Query = PUBMED.Query
 type Limit = PUBMED.Limit
-

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

@@ -9,7 +9,6 @@ Portability : POSIX
 
 -}
 
-
 module Gargantext.Core.Text.Corpus.API.Hal
     where
 
@@ -26,11 +25,11 @@ import qualified HAL.Doc.Corpus as HAL
 
 get :: Lang -> Text -> Maybe Integer -> IO [HyperdataDocument]
 get la q ml = do
-  docs <- HAL.getMetadataWith q (fromIntegral <$> ml)
+  docs <- HAL.getMetadataWith q (Just 0) (fromIntegral <$> ml)
   either (panic . pack . show) (\d -> mapM (toDoc' la) $ HAL._docs d) docs
 
 toDoc' :: Lang -> HAL.Corpus -> IO HyperdataDocument
-toDoc' la (HAL.Corpus i t ab d s aus affs) = do
+toDoc' la (HAL.Corpus i t ab d s aus affs struct_id) = do
   (utctime, (pub_year, pub_month, pub_day)) <- Date.dateSplit la (maybe (Just "2019") Just d)
   pure $ HyperdataDocument (Just "Hal")
                    (Just $ pack $ show i)
@@ -40,7 +39,7 @@ toDoc' la (HAL.Corpus i t ab d s aus affs) = do
                    Nothing
                    (Just $ intercalate " " t)
                    (Just $ foldl (\x y -> x <> ", " <> y) "" aus)
-                   (Just $ foldl (\x y -> x <> ", " <> y) "" affs)
+                   (Just $ foldl (\x y -> x <> ", " <> y) "" $ affs <> map (cs . show) struct_id)
                    (Just $ maybe "Nothing" identity s)
                    (Just $ intercalate " " ab)
                    (fmap (pack . show) utctime)

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

@@ -28,8 +28,12 @@ import qualified PUBMED.Parser as PubMedDoc
 type Query = Text
 type Limit = PubMed.Limit
 
+
+-- | TODO put default pubmed query in gargantext.ini
+-- by default: 10K docs
 get :: Query -> Maybe Limit -> IO [HyperdataDocument]
-get q l = either (\e -> panic $ "CRAWL: PubMed" <> e) (map (toDoc EN)) <$> PubMed.getMetadataWith q l
+get q l = either (\e -> panic $ "CRAWL: PubMed" <> e) (map (toDoc EN))
+        <$> PubMed.getMetadataWith q l
 
 toDoc :: Lang -> PubMedDoc.PubMed -> HyperdataDocument
 toDoc l (PubMedDoc.PubMed (PubMedDoc.PubMedArticle t j as aus)
@@ -42,7 +46,7 @@ toDoc l (PubMedDoc.PubMed (PubMedDoc.PubMedArticle t j as aus)
                                  Nothing
                                  t
                                  (authors aus)
-                                 Nothing
+                                 (institutes aus)
                                  j
                                  (abstract as)
                                  (Just $ Text.pack $ show a)
@@ -57,7 +61,18 @@ toDoc l (PubMedDoc.PubMed (PubMedDoc.PubMedArticle t j as aus)
         authors :: Maybe [PubMedDoc.Author] -> Maybe Text
         authors aus' = case aus' of
             Nothing -> Nothing
-            Just au -> Just $ (Text.intercalate ", ") $ catMaybes $ map PubMedDoc.foreName au
+            Just au -> Just $ (Text.intercalate ", ")
+                            $ catMaybes
+                            $ map (\n -> PubMedDoc.foreName n <> Just " " <> PubMedDoc.lastName n) au
+
+        institutes :: Maybe [PubMedDoc.Author] -> Maybe Text
+        institutes aus' = case aus' of
+            Nothing -> Nothing
+            Just au -> Just $ (Text.intercalate ", ")
+                            $ (map (Text.replace ", " " - "))
+                            $ catMaybes
+                            $ map PubMedDoc.affiliation au
+
 
         abstract :: Maybe [Text] -> Maybe Text
         abstract as' = fmap (Text.intercalate ", ") as'

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

@@ -34,7 +34,8 @@ import Gargantext.Core.Text.Context
 
 ---------------------------------------------------------------
 headerCsvGargV3 :: Header
-headerCsvGargV3 = header [ "title"
+headerCsvGargV3 =
+  header [ "title"
          , "source"
          , "publication_year"
          , "publication_month"
@@ -44,9 +45,9 @@ headerCsvGargV3 = header [ "title"
          ]
 ---------------------------------------------------------------
 data CsvGargV3 = CsvGargV3
-    { d_docId  :: !Int
-    , d_title  :: !Text
-    , d_source :: !Text
+    { d_docId             :: !Int
+    , d_title             :: !Text
+    , d_source            :: !Text
     , d_publication_year  :: !Int
     , d_publication_month :: !Int
     , d_publication_day   :: !Int
@@ -115,14 +116,14 @@ splitDoc m splt doc = let docSize = (length $ csv_abstract doc) in
         where
           firstDoc = CsvDoc t s py pm pd firstAbstract auth
           firstAbstract = head' "splitDoc'1" abstracts
-          
+
           nextDocs = map (\txt -> CsvDoc
                                     (head' "splitDoc'2" $ sentences txt)
                                     s py pm pd 
                                     (unsentences $ tail' "splitDoc'1" $ sentences txt)
                                     auth
                           ) (tail' "splitDoc'2" abstracts)
-          
+
           abstracts    = (splitBy $ contextSize) abst
 
 ---------------------------------------------------------------
@@ -226,7 +227,6 @@ readCsvLazyBS bs = case decodeByNameWith csvDecodeOptions bs of
       Right csvDocs -> csvDocs
 
 ------------------------------------------------------------------------
-
 -- | TODO use readFileLazy
 readCsvHal :: FilePath -> IO (Header, Vector CsvHal)
 readCsvHal = fmap readCsvHalLazyBS . BL.readFile
@@ -307,11 +307,11 @@ instance ToNamedRecord CsvHal where
   toNamedRecord (CsvHal t s py  pm pd abst aut  url isbn iss j lang  doi auth inst dept lab team doct) = 
     namedRecord [ "title"  .= t
                 , "source" .= s
-                
+
                 , "publication_year"  .= py
                 , "publication_month" .= pm
                 , "publication_day"   .= pd
-                
+
                 , "abstract"          .= abst
                 , "authors"           .= aut
 
@@ -320,13 +320,13 @@ instance ToNamedRecord CsvHal where
                 , "issue_s"            .= iss
                 , "journalPublisher_s" .= j
                 , "language_s"         .= lang
-                
+
                 , "doiId_s"            .= doi
                 , "authId_i"           .= auth
                 , "instStructId_i"     .= inst
                 , "deptStructId_i"     .= dept
                 , "labStructId_i"      .= lab
-                
+ 
                 , "rteamStructId_i"    .= team
                 , "docType_s"          .= doct
                ]
@@ -389,7 +389,6 @@ parseHal' :: BL.ByteString -> [HyperdataDocument]
 parseHal' = V.toList . V.map csvHal2doc . snd . readCsvHalLazyBS 
 
 ------------------------------------------------------------------------
-
 parseCsv :: FilePath -> IO [HyperdataDocument]
 parseCsv fp = V.toList <$> V.map csv2doc <$> snd <$> readFile fp
 

src/Gargantext/Core/Text/Metrics/FrequentItemSet.hs

@@ -25,19 +25,15 @@ module Gargantext.Core.Text.Metrics.FrequentItemSet
   )
   where
 
-import Prelude (Functor(..)) -- TODO
-import qualified Data.Map.Strict as Map
-import Data.Map.Strict (Map)
-import qualified Data.Set as Set
-import Data.Set (Set)
-import qualified Data.Vector as V
-
 import Data.List (concat, null)
+import Data.Map.Strict (Map)
 import Data.Maybe (catMaybes)
-
-import HLCM
-
+import Data.Set (Set)
 import Gargantext.Prelude
+import HLCM
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified Data.Vector as V
 
 data Size = Point Int | Segment Int Int