Merge branch 'dev' into dev-phylo

README.md

@@ -39,17 +39,17 @@ issues.
 
 ### Initialization
 
-Users has to be created first
-1. stack ghci
-2. runCmd insertUsersDemo
+Users has to be created first (user1 is created as instance):
 
-Then you can log in with user1:1resu
+- stack install
+- ~/.local/bin/gargantext-init "gargantext.ini"
 
 ## Use Cases
 
 ### Multi-User with Graphical User Interface (Server Mode)
 
 ~/.local/bin/stack --docker exec gargantext-server -- --ini "gargantext.ini" --run Prod
+Then you can log in with user1:1resu
 
 
 ### Command Line Mode tools

bin/gargantext-init/Main.hs

+{-|
+Module      : Main.hs
+Description : Gargantext Import Corpus
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Import a corpus binary.
+
+ -}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE Strict            #-}
+
+module Main where
+
+import System.Environment (getArgs)
+import Gargantext.Prelude
+import Gargantext.Database.Flow (FlowCmdM, flowCorpusFile, getOrMkRoot)
+import Gargantext.Text.Corpus.Parsers (FileFormat(..))
+import Gargantext.Database.Utils (Cmd, )
+import Gargantext.Database.Types.Node (CorpusId, toHyperdataDocument, RootId)
+import Gargantext.Database.Schema.User (insertUsersDemo, UserId)
+import Gargantext.Text.Terms (TermType(..))
+import Gargantext.Core (Lang(..))
+import Gargantext.API -- (GargError)
+import Gargantext.API.Node () -- instances
+import Gargantext.API.Settings (withDevEnv, runCmdDev, DevEnv)
+--import Gargantext.Text.Corpus.Parsers.GrandDebat (readFile, GrandDebatReference(..))
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Control.Monad.IO.Class (liftIO)
+
+main :: IO ()
+main = do
+  [iniPath] <- getArgs
+
+  let createUsers :: Cmd GargError Int64
+      createUsers = insertUsersDemo
+  
+  let
+    mkRoots :: Cmd GargError (UserId, RootId)
+    mkRoots = getOrMkRoot "user1"
+
+
+  withDevEnv iniPath $ \env -> do
+    _ <- runCmdDev env createUsers
+    _ <- runCmdDev env mkRoots
+    pure ()

package.yaml

@@ -321,6 +321,20 @@ executables:
       - base
       - servant-server
 
+  gargantext-init:
+    main: Main.hs
+    source-dirs: bin/gargantext-init
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -O2
+    - -Wmissing-signatures
+    dependencies:
+      - gargantext
+      - base
+
+
 tests:
 #   garg-test:
 #     main: Main.hs

src/Gargantext/Database/Flow.hs

@@ -246,10 +246,9 @@ insertMasterDocs c lang hs  =  do
 
 type CorpusName = Text
 
-getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a)
-              => Username -> Either CorpusName [CorpusId] -> Maybe a
-              -> Cmd err (UserId, RootId, CorpusId)
-getOrMkRootWithCorpus username cName c = do
+
+getOrMkRoot :: (HasNodeError err) => Username -> Cmd err (UserId, RootId)
+getOrMkRoot username = do
   maybeUserId <- getUser username
   userId <- case maybeUserId of
         Nothing   -> nodeError NoUserFound
@@ -264,7 +263,14 @@ getOrMkRootWithCorpus username cName c = do
             False -> pure rootId'
 
   rootId <- maybe (nodeError NoRootFound) pure (head rootId'')
+  pure (userId, rootId)
 
+
+getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a)
+              => Username -> Either CorpusName [CorpusId] -> Maybe a
+              -> Cmd err (UserId, RootId, CorpusId)
+getOrMkRootWithCorpus username cName c = do
+  (userId, rootId) <- getOrMkRoot username
   corpusId'' <- if username == userMaster
                   then do
                     ns <- getCorporaWithParentId rootId

src/Gargantext/Text/List.hs

@@ -61,7 +61,6 @@ buildNgramsLists :: Lang -> Int -> Int -> StopSize -> UserCorpusId -> MasterCorp
                  -> Cmd err (Map NgramsType [NgramsElement])
 buildNgramsLists l n m s uCid mCid = do
   ngTerms     <- buildNgramsTermsList l n m s uCid mCid
-  --ngTerms     <- buildNgramsTermsList' uCid (ngramsGroup l n m) (isStopTerm s . fst) 500 50
   othersTerms <- mapM (buildNgramsOthersList uCid identity) [Authors, Sources, Institutes]
   pure $ Map.unions $ othersTerms <> [ngTerms]
 
@@ -72,9 +71,12 @@ buildNgramsOthersList uCid groupIt nt = do
   ngs <- groupNodesByNgramsWith groupIt <$> getNodesByNgramsUser uCid nt
 
   let
-    all' = Map.toList ngs
-  pure $ (toElements GraphTerm all') <> (toElements CandidateTerm all')
-  --pure $ (toElements GraphTerm $ take 10 all') <> (toElements CandidateTerm $ drop 10 all')
+    listSize = 9
+    all' = List.reverse $ List.sortOn (Set.size . snd . snd) $ Map.toList ngs
+    graphTerms = List.take listSize all'
+    candiTerms = List.drop listSize all'
+  pure $ Map.unionsWith (<>) [ toElements GraphTerm     graphTerms
+                             , toElements CandidateTerm candiTerms]
     where
       toElements nType x = Map.fromList [(nt, [ mkNgramsElement t nType Nothing (mSetFromList [])
                             | (t,_ns) <- x

stack.yaml

-resolver: lts-14.1
+resolver: lts-14.6
 flags: {}
 extra-package-dbs: []
 packages:
@@ -15,7 +15,7 @@ extra-deps:
 - git: https://gitlab.iscpif.fr/gargantext/hlcm.git
   commit: 6f0595d2421005837d59151a8b26eee83ebb67b5
 - git: https://github.com/delanoe/servant-static-th.git
-  commit: ba5347e7d8a13ce5275af8470c15b2305fbb23af
+  commit: 7d0e4dcd2cfe97f2843a70a0de10df32c309bcd1
 - git: https://github.com/delanoe/hstatistics.git
   commit: 90eef7604bb230644c2246eccd094d7bfefcb135
 - git: https://github.com/paulrzcz/HSvm.git