Merge remote-tracking branch 'origin/adinapoli/issue-261' into dev

.gitlab-ci.yml

 # Optimising CI speed by using tips from https://blog.nimbleways.com/let-s-make-faster-gitlab-ci-cd-pipelines/
-image: adinapoli/gargantext:v2.1
+image: adinapoli/gargantext:v2.3
 
 variables:
   STACK_ROOT: "${CI_PROJECT_DIR}/.stack-root"
   STACK_OPTS: "--system-ghc"
   CABAL_STORE_DIR: "${CI_PROJECT_DIR}/.cabal"
+  CORENLP: "4.5.4"
   FF_USE_FASTZIP: "true"
   ARTIFACT_COMPRESSION_LEVEL: "fast"
   CACHE_COMPRESSION_LEVEL: "fast"
@@ -77,12 +78,17 @@ test:
       mkdir -p /root/.cache/cabal/logs
       chown -R test:test /root/.cache/cabal/logs/
       chown -R test:test /root/.cache/cabal/packages/hackage.haskell.org/
-      nix-shell --run "chown -R test:test /root/.config/ && su -m test -c \"export PATH=$PATH:$TEST_NIX_PATH && cd /builds/gargantext/haskell-gargantext && $CABAL --store-dir=$CABAL_STORE_DIR v2-test --test-show-details=streaming --flags test-crypto --ghc-options='-O0 -fclear-plugins'\""
+
+      mkdir -p /builds/gargantext/haskell-gargantext/devops/coreNLP/stanford-corenlp-current
+      cp -R /root/devops/coreNLP/stanford-corenlp-${CORENLP}/* /builds/gargantext/haskell-gargantext/devops/coreNLP/stanford-corenlp-current/
+
+      nix-shell --run "chown -R test:test /root/.config/ && su -m test -c \"export PATH=$PATH:$TEST_NIX_PATH && cd /builds/gargantext/haskell-gargantext; $CABAL --store-dir=$CABAL_STORE_DIR v2-test --test-show-details=streaming --flags test-crypto --ghc-options='-O0 -fclear-plugins'\""
       chown -R root:root dist-newstyle/
       chown -R root:root /root/
       chown -R root:root $CABAL_STORE_DIR
       chown -R root:root /root/.cache/cabal/logs/
       chown -R root:root /root/.cache/cabal/packages/hackage.haskell.org/
+      chown -Rh root:root /builds/gargantext/haskell-gargantext/devops/coreNLP/stanford-corenlp-current
 
 #docs:
 #  stage: docs

bin/gargantext-init/Main.hs

@@ -25,7 +25,7 @@ import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, )
+import Gargantext.Database.Prelude (Cmd, DBCmd)
 import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Database.Query.Table.User (insertNewUsers, )
 import Gargantext.Prelude
@@ -73,7 +73,7 @@ main = do
       pure (masterUserId, masterRootId, masterCorpusId, masterListId)
 
   withDevEnv iniPath $ \env -> do
-    _ <- runCmdDev env (initFirstTriggers secret :: Cmd GargError [Int64])
+    _ <- runCmdDev env (initFirstTriggers secret :: DBCmd GargError [Int64])
     _ <- runCmdDev env createUsers
     x <- runCmdDev env initMaster
     _ <- runCmdDev env mkRoots

bin/update-cabal-project

@@ -11,8 +11,8 @@ STORE_DIR="${1:-$DEFAULT_STORE}"
 # `expected_cabal_project_freeze_hash` with the
 # `sha256sum` result calculated on the `cabal.project` and `cabal.project.freeze`.
 # This ensures the files stay deterministic so that CI cache can kick in.
-expected_cabal_project_hash="eb12c232115b3fffa1f81add7c83d921e5899c7712eddee6100ff8df7305088e"
-expected_cabal_project_freeze_hash="b7acfd12c970323ffe2c6684a13130db09d8ec9fa5676a976afed329f1ef3436"
+expected_cabal_project_hash="297d2ac44b8a2e65a9d7bbbe1fb6e5e0ff46b144300501c14e5e424e77aa1abf"
+expected_cabal_project_freeze_hash="2d3704d107bd8d08056ce4f0eb1f42202cb7f49a67c62a2445a6c70c7235f861"
 
 cabal --store-dir=$STORE_DIR v2-update 'hackage.haskell.org,2023-06-24T21:28:46Z'
 

cabal.project

@@ -7,6 +7,16 @@ with-compiler: ghc-8.10.7
 packages:
     ./
 
+source-repository-package
+    type: git
+    location: https://github.com/adinapoli/boolexpr.git
+    tag: 91928b5d7f9342e9865dde0d94862792d2b88779
+
+source-repository-package
+    type: git
+    location: https://github.com/adinapoli/haskell-opaleye.git
+    tag: e9a29582ac66198dd2c2fdc3f8c8a4b1e6fbe004
+
 source-repository-package
     type: git
     location: https://github.com/alpmestan/accelerate.git
@@ -56,11 +66,6 @@ source-repository-package
     location: https://github.com/delanoe/patches-map
     tag: 76cae88f367976ff091e661ee69a5c3126b94694
 
-source-repository-package
-    type: git
-    location: https://github.com/garganscript/haskell-opaleye.git
-    tag: a5693a2010e6d13f51cdc576fa1dc9985e79ee0e
-
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/amestanogullari/accelerate-utility.git

cabal.project.freeze

@@ -384,7 +384,6 @@ constraints: any.AC-Angle ==1.0,
              any.bodhi ==0.1.0,
              any.boltzmann-samplers ==0.1.1.0,
              any.boolean-like ==0.1.1.0,
-             any.boolexpr ==0.2,
              any.boolsimplifier ==0.1.8,
              any.boots ==0.2.0.1,
              any.bordacount ==0.1.0.0,

devops/docker/Dockerfile

 FROM ubuntu:jammy
 
+## NOTA BENE: In order for this to be built successfully, you have to run ./devops/coreNLP/build.sh first.
+
 ARG DEBIAN_FRONTEND=noninteractive
 ARG GHC=8.10.7
 ARG STACK=2.7.3
 ARG CABAL=3.10.1.0
+ARG CORENLP=4.5.4
+ARG CORE
 COPY ./shell.nix                                       /builds/gargantext/shell.nix
 COPY ./nix/pkgs.nix                                    /builds/gargantext/nix/pkgs.nix
 COPY ./nix/pinned-22.05.nix                            /builds/gargantext/nix/pinned-22.05.nix
@@ -14,6 +18,8 @@ COPY ./nix/overlays/Cabal-syntax-3.10.1.0.nix          /builds/gargantext/nix/ov
 COPY ./nix/overlays/directory-1.3.7.0.nix              /builds/gargantext/nix/overlays/directory-1.3.7.0.nix
 COPY ./nix/overlays/hackage-security-0.6.2.3.nix       /builds/gargantext/nix/overlays/hackage-security-0.6.2.3.nix
 COPY ./nix/overlays/process-1.6.15.0.nix               /builds/gargantext/nix/overlays/process-1.6.15.0.nix
+COPY ./devops/coreNLP/build.sh                         /root/devops/coreNLP/build.sh
+COPY ./devops/coreNLP/startServer.sh                   /root/devops/coreNLP/startServer.sh
 
 ENV TZ=Europe/Rome
 RUN apt-get update && \
@@ -43,7 +49,9 @@ RUN apt-get update && \
       wget \
       vim \
       xz-utils \
-      zlib1g-dev && \
+      zlib1g-dev \
+      openjdk-18-jdk \
+      unzip && \
     apt-get clean && rm -rf /var/lib/apt/lists/* && \
     mkdir -m 0755 /nix && groupadd -r nixbld && chown root /nix && \
     for n in $(seq 1 10); do useradd -c "Nix build user $n" -d /var/empty -g nixbld -G nixbld -M -N -r -s "$(command -v nologin)" "nixbld$n"; done
@@ -52,6 +60,8 @@ RUN gpg --batch --keyserver keys.openpgp.org     --recv-keys 7D1E8AFD1D4A16D71FA
     gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
 SHELL ["/bin/bash", "-o", "pipefail", "-c"]
 
+RUN cd /root/devops/coreNLP; ./build.sh
+
 RUN set -o pipefail && \
     bash <(curl -L https://releases.nixos.org/nix/nix-2.15.0/install) --no-daemon && \
     locale-gen en_US.UTF-8 && chown root -R /nix

devops/postgres/schema.sql

@@ -272,7 +272,7 @@ CREATE INDEX        ON public.contexts USING btree (user_id, typename, parent_id
 CREATE INDEX        ON public.contexts USING btree (id, typename, date ASC);
 CREATE INDEX        ON public.contexts USING btree (id, typename, date DESC);
 CREATE INDEX        ON public.contexts USING btree (typename, id);
-CREATE UNIQUE INDEX IF NOT EXISTS ON public.contexts USING btree (hash_id);
+CREATE UNIQUE INDEX ON public.contexts USING btree (hash_id);
 
 CREATE INDEX ON public.nodescontexts_nodescontexts USING btree (nodescontexts1, nodescontexts2);
 -- CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqId'::text)));

gargantext.cabal

@@ -58,6 +58,7 @@ library
       Gargantext.API.Node
       Gargantext.API.Node.Corpus.New
       Gargantext.API.Node.Corpus.Types
+      Gargantext.API.Node.Corpus.Update
       Gargantext.API.Node.File
       Gargantext.API.Node.Share
       Gargantext.API.Prelude
@@ -85,6 +86,7 @@ library
       Gargantext.Core.Text.Terms
       Gargantext.Core.Text.Terms.Eleve
       Gargantext.Core.Text.Terms.Mono
+      Gargantext.Core.Text.Terms.Mono.Stem.En
       Gargantext.Core.Text.Terms.Multi
       Gargantext.Core.Text.Terms.Multi.Lang.En
       Gargantext.Core.Text.Terms.Multi.Lang.Fr
@@ -112,13 +114,17 @@ library
       Gargantext.Core.Viz.Types
       Gargantext.Database.Action.Flow
       Gargantext.Database.Action.Flow.Types
+      Gargantext.Database.Action.Search
       Gargantext.Database.Action.User
       Gargantext.Database.Action.User.New
       Gargantext.Database.Admin.Config
       Gargantext.Database.Admin.Trigger.Init
       Gargantext.Database.Admin.Types.Hyperdata
+      Gargantext.Database.Admin.Types.Hyperdata.Corpus
+      Gargantext.Database.Admin.Types.Hyperdata.Document
       Gargantext.Database.Admin.Types.Node
       Gargantext.Database.Prelude
+      Gargantext.Database.Query.Facet
       Gargantext.Database.Query.Table.NgramsPostag
       Gargantext.Database.Query.Table.Node
       Gargantext.Database.Query.Table.Node.Error
@@ -126,6 +132,7 @@ library
       Gargantext.Database.Query.Tree.Root
       Gargantext.Database.Query.Table.User
       Gargantext.Database.Schema.Ngrams
+      Gargantext.Database.Schema.Node
       Gargantext.Database.Schema.User
       Gargantext.Defaults
       Gargantext.System.Logging
@@ -173,7 +180,6 @@ library
       Gargantext.API.Node.Corpus.New.File
       Gargantext.API.Node.Corpus.New.Types
       Gargantext.API.Node.Corpus.Searx
-      Gargantext.API.Node.Corpus.Update
       Gargantext.API.Node.Document.Export
       Gargantext.API.Node.Document.Export.Types
       Gargantext.API.Node.DocumentsFromWriteNodes
@@ -250,7 +256,6 @@ library
       Gargantext.Core.Text.Samples.PL
       Gargantext.Core.Text.Samples.ZH
       Gargantext.Core.Text.Terms.Mono.Stem
-      Gargantext.Core.Text.Terms.Mono.Stem.En
       Gargantext.Core.Text.Terms.Mono.Token
       Gargantext.Core.Text.Terms.Mono.Token.En
       Gargantext.Core.Text.Terms.Multi.Group
@@ -288,7 +293,6 @@ library
       Gargantext.Database.Action.Metrics.NgramsByContext
       Gargantext.Database.Action.Metrics.TFICF
       Gargantext.Database.Action.Node
-      Gargantext.Database.Action.Search
       Gargantext.Database.Action.Share
       Gargantext.Database.Action.TSQuery
       Gargantext.Database.Admin.Access
@@ -298,11 +302,9 @@ library
       Gargantext.Database.Admin.Trigger.NodesContexts
       Gargantext.Database.Admin.Types.Hyperdata.Any
       Gargantext.Database.Admin.Types.Hyperdata.Contact
-      Gargantext.Database.Admin.Types.Hyperdata.Corpus
       Gargantext.Database.Admin.Types.Hyperdata.CorpusField
       Gargantext.Database.Admin.Types.Hyperdata.Dashboard
       Gargantext.Database.Admin.Types.Hyperdata.Default
-      Gargantext.Database.Admin.Types.Hyperdata.Document
       Gargantext.Database.Admin.Types.Hyperdata.File
       Gargantext.Database.Admin.Types.Hyperdata.Folder
       Gargantext.Database.Admin.Types.Hyperdata.Frame
@@ -315,7 +317,6 @@ library
       Gargantext.Database.Admin.Types.Metrics
       Gargantext.Database.GargDB
       Gargantext.Database.Query
-      Gargantext.Database.Query.Facet
       Gargantext.Database.Query.Facet.Types
       Gargantext.Database.Query.Filter
       Gargantext.Database.Query.Join
@@ -344,7 +345,6 @@ library
       Gargantext.Database.Schema.ContextNodeNgrams
       Gargantext.Database.Schema.ContextNodeNgrams2
       Gargantext.Database.Schema.NgramsPostag
-      Gargantext.Database.Schema.Node
       Gargantext.Database.Schema.Node_NodeNgramsNodeNgrams
       Gargantext.Database.Schema.NodeContext
       Gargantext.Database.Schema.NodeContext_NodeContext
@@ -884,6 +884,8 @@ test-suite garg-test-tasty
       Core.Text.Flow
       Core.Utils
       Database.Operations
+      Database.Operations.DocumentSearch
+      Database.Operations.Types
       Graph.Clustering
       Graph.Distance
       Ngrams.Lang
@@ -942,11 +944,13 @@ test-suite garg-test-tasty
     , lens >= 5.2.2 && < 5.3
     , monad-control >= 1.0.3 && < 1.1
     , mtl ^>= 2.2.2
+    , network-uri
     , parsec ^>= 3.1.14.0
     , patches-class ^>= 0.1.0.1
     , patches-map ^>= 0.1.0.1
     , postgres-options >= 0.2 && < 0.3
     , postgresql-simple >= 0.6.4 && < 0.7
+    , process ^>= 1.6.13.2
     , quickcheck-instances ^>= 0.3.25.2
     , raw-strings-qq
     , recover-rtti >= 0.4 && < 0.5
@@ -971,6 +975,8 @@ test-suite garg-test-hspec
   main-is: hspec/Main.hs
   other-modules:
       Database.Operations
+      Database.Operations.DocumentSearch
+      Database.Operations.Types
       Paths_gargantext
   hs-source-dirs:
       test
@@ -1022,11 +1028,13 @@ test-suite garg-test-hspec
     , lens >= 5.2.2 && < 5.3
     , monad-control >= 1.0.3 && < 1.1
     , mtl ^>= 2.2.2
+    , network-uri
     , parsec ^>= 3.1.14.0
     , patches-class ^>= 0.1.0.1
     , patches-map ^>= 0.1.0.1
     , postgres-options >= 0.2 && < 0.3
     , postgresql-simple >= 0.6.4 && < 0.7
+    , process ^>= 1.6.13.2
     , quickcheck-instances ^>= 0.3.25.2
     , raw-strings-qq
     , recover-rtti >= 0.4 && < 0.5

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

@@ -16,7 +16,7 @@ import Gargantext.Core.Text.List.Group.WithStem ({-StopSize(..),-} GroupParams(.
 import Gargantext.Core.Text.Terms (TermType(..))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Utils.Prefix (unPrefix)
-import Gargantext.Database.Action.Flow (insertMasterDocs) --, DataText(..))
+import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus) --, DataText(..))
 import Gargantext.Database.Action.Flow.List (flowList_DbRepo)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.User (getUserId)
@@ -33,13 +33,12 @@ import Gargantext.Prelude.Config
 import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..))
 import Network.HTTP.Client
 import Network.HTTP.Client.TLS
-import Protolude (catMaybes, encodeUtf8, rightToMaybe, Text)
+import Protolude (catMaybes, encodeUtf8, rightToMaybe, Text, void)
 import qualified Data.Aeson as Aeson
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Text as T
 import qualified Data.Text as Text
 import qualified Gargantext.Core.Text.Corpus.API as API
-import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
 import qualified Prelude
 
 langToSearx :: Lang -> Text
@@ -133,8 +132,7 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
     -}
   --_ <- flowDataText user (DataNew [docs']) (Multi l) cId Nothing logStatus
   let mCorpus = Nothing :: Maybe HyperdataCorpus
-  ids <- insertMasterDocs mCorpus (Multi l) docs'
-  _ <- Doc.add cId ids
+  void $ addDocumentsToHyperCorpus server mCorpus (Multi l) cId docs'
   (_masterUserId, _masterRootId, masterCorpusId)
     <- getOrMk_RootWithCorpus (UserName userMaster) (Left "") mCorpus
   let gp = GroupWithPosTag l server HashMap.empty

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

@@ -7,17 +7,18 @@ import Control.Lens
 import Control.Monad
 import Data.Proxy
 import Gargantext.Core
-import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus
 import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs
 
 -- | Updates the 'HyperdataCorpus' with the input 'Lang'.
-addLanguageToCorpus :: (FlowCmdM env err m, MonadJobStatus m)
+addLanguageToCorpus :: (HasNodeError err, DbCmd' env err m, MonadJobStatus m)
                     => CorpusId
                     -> Lang
                     -> m ()

src/Gargantext/API/Node/DocumentUpload.hs

@@ -16,17 +16,17 @@ import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Prelude
 import Gargantext.Core (Lang(..))
+import Gargantext.Core.NLP (nlpServerGet)
 import Gargantext.Core.Text.Corpus.Parsers.Date (dateSplit)
+import Gargantext.Core.Text.Terms (TermType(..))
 import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
+import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus)
 import Gargantext.Database.Action.Flow.Types
-import Gargantext.Core.Text.Terms (TermType(..))
-import Gargantext.Database.Action.Flow (insertMasterDocs)
+import Gargantext.Database.Admin.Types.Hyperdata.Corpus
 import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
-import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
 import Gargantext.Prelude
-import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus(..))
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 
 
@@ -117,6 +117,6 @@ documentUpload nId doc = do
                              , _hd_publication_second = Nothing
                              , _hd_language_iso2 = Just $ view du_language doc }
 
-  docIds <- insertMasterDocs (Nothing :: Maybe HyperdataCorpus) (Multi EN) [hd]
-  _ <- Doc.add cId docIds
-  pure docIds
+  let lang = EN
+  ncs <- view $ nlpServerGet lang
+  addDocumentsToHyperCorpus ncs (Nothing :: Maybe HyperdataCorpus) (Multi lang) cId [hd]

src/Gargantext/API/Search.hs

@@ -17,24 +17,28 @@ Count API part of Gargantext.
 module Gargantext.API.Search
       where
 
-import Data.Aeson hiding (defaultTaggedObject)
 -- import Data.List (concat)
+import Data.Aeson hiding (defaultTaggedObject)
 import Data.Swagger hiding (fieldLabelModifier, Contact)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Gargantext.API.Prelude (GargServer)
+import Gargantext.Core.Text.Corpus.Query (RawQuery (..), parseQuery)
 import Gargantext.Core.Types.Query (Limit, Offset)
 import Gargantext.Core.Types.Search
 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
 import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
 import Gargantext.Database.Action.Search
-import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Admin.Types.Node hiding (DEBUG)
 import Gargantext.Database.Query.Facet
 import Gargantext.Prelude
+import Gargantext.System.Logging
 import Gargantext.Utils.Aeson (defaultTaggedObject)
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
+import qualified Data.Text as T
+import Data.Either
 
 -----------------------------------------------------------------------
 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
@@ -48,22 +52,28 @@ type API results = Summary "Search endpoint"
 -----------------------------------------------------------------------
 -- | Api search function
 api :: NodeId -> GargServer (API SearchResult)
-api nId (SearchQuery q SearchDoc) o l order =
-  SearchResult <$> SearchResultDoc
-               <$> map (toRow nId)
-               <$> searchInCorpus nId False q o l order
-               -- <$> searchInCorpus nId False (concat 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 aId)
-            <$> searchInCorpusWithContacts nId aId q o l order
+api nId (SearchQuery rawQuery SearchDoc) o l order = do
+  case parseQuery rawQuery of
+    Left  err -> pure $ SearchResult $ SearchNoResult (T.pack err)
+    Right q   -> do
+      $(logLocM) DEBUG $ T.pack "New search started with query = " <> (getRawQuery rawQuery)
+      SearchResult <$> SearchResultDoc
+                   <$> map (toRow nId)
+                   <$> searchInCorpus nId False q o l order
+api nId (SearchQuery rawQuery SearchContact) o l order = do
+  case parseQuery rawQuery of
+    Left  err -> pure $ SearchResult $ SearchNoResult (T.pack err)
+    Right q   -> 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 aId)
+                <$> searchInCorpusWithContacts nId aId q o l order
 api _nId (SearchQuery _q SearchDocWithNgrams) _o _l _order = undefined
 
 -----------------------------------------------------------------------
@@ -82,7 +92,7 @@ instance Arbitrary SearchType where
 
 -----------------------------------------------------------------------
 data SearchQuery =
-  SearchQuery { query    :: ![Text]
+  SearchQuery { query    :: !RawQuery
               , expected :: !SearchType
               }
     deriving (Generic)
@@ -97,7 +107,7 @@ instance ToSchema SearchQuery
 -}
 
 instance Arbitrary SearchQuery where
-  arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
+  arbitrary = elements [SearchQuery (RawQuery "electrodes") SearchDoc]
   -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
 -----------------------------------------------------------------------
 data SearchResult =

src/Gargantext/API/Server.hs

@@ -83,7 +83,7 @@ showAsServantErr :: GargError -> ServerError
 showAsServantErr (GargNodeError err@(NoListFound {})) = err404 { errBody = BL8.pack $ show err }
 showAsServantErr (GargNodeError err@NoRootFound) = err404 { errBody = BL8.pack $ show err }
 showAsServantErr (GargNodeError err@NoCorpusFound) = err404 { errBody = BL8.pack $ show err }
-showAsServantErr (GargNodeError err@NoUserFound) = err404 { errBody = BL8.pack $ show err }
+showAsServantErr (GargNodeError err@NoUserFound{}) = err404 { errBody = BL8.pack $ show err }
 showAsServantErr (GargNodeError err@(DoesNotExist {})) = err404 { errBody = BL8.pack $ show err }
 showAsServantErr (GargServerError err) = err
 showAsServantErr a = err500 { errBody = BL8.pack $ show a }
@@ -92,7 +92,7 @@ showAsServantJSONErr :: GargError -> ServerError
 showAsServantJSONErr (GargNodeError err@(NoListFound {})) = err404 { errBody = Aeson.encode err }
 showAsServantJSONErr (GargNodeError err@NoRootFound) = err404 { errBody = Aeson.encode err }
 showAsServantJSONErr (GargNodeError err@NoCorpusFound) = err404 { errBody = Aeson.encode err }
-showAsServantJSONErr (GargNodeError err@NoUserFound) = err404 { errBody = Aeson.encode err }
+showAsServantJSONErr (GargNodeError err@NoUserFound{}) = err404 { errBody = Aeson.encode err }
 showAsServantJSONErr (GargNodeError err@(DoesNotExist {})) = err404 { errBody = Aeson.encode err }
 showAsServantJSONErr (GargServerError err) = err
 showAsServantJSONErr a = err500 { errBody = Aeson.encode a }

src/Gargantext/API/Table.hs

@@ -36,6 +36,7 @@ import Data.Maybe
 import Data.Swagger
 import Data.Text (Text())
 import GHC.Generics (Generic)
+import Prelude
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -43,16 +44,19 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import Gargantext.API.HashedResponse
 import Gargantext.API.Ngrams.Types (TabType(..))
 import Gargantext.API.Prelude (GargServer)
+import Gargantext.Core.Text.Corpus.Query (RawQuery, parseQuery, getRawQuery)
 import Gargantext.Core.Types (TableResult(..))
 import Gargantext.Core.Types.Query (Offset, Limit)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
 import Gargantext.Database.Action.Search
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
-import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
+import Gargantext.Database.Admin.Types.Node hiding (ERROR, DEBUG)
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
+import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Prelude
+import Gargantext.System.Logging
+import qualified Data.Text as T
 
 ------------------------------------------------------------------------
 
@@ -61,7 +65,7 @@ type TableApi = Summary "Table API"
               :> QueryParam "limit" Limit
               :> QueryParam "offset" Offset
               :> QueryParam "orderBy" OrderBy
-              :> QueryParam "query" Text
+              :> QueryParam "query" RawQuery
               :> QueryParam "year" Text
               :> Get    '[JSON] (HashedResponse FacetTableResult)
             :<|> Summary "Table API (POST)"
@@ -77,7 +81,7 @@ data TableQuery = TableQuery
   , tq_limit        :: Limit
   , tq_orderBy      :: OrderBy
   , tq_view         :: TabType
-  , tq_query        :: Text
+  , tq_query        :: RawQuery
   } deriving (Generic)
 
 type FacetTableResult = TableResult FacetDoc
@@ -101,46 +105,72 @@ tableApi id' = getTableApi id'
           :<|> getTableHashApi id'
 
 
-getTableApi :: HasNodeError err
+getTableApi :: (CmdM env err m, HasNodeError err, MonadLogger m)
             => NodeId
             -> Maybe TabType
             -> Maybe Limit
             -> Maybe Offset
             -> Maybe OrderBy
+            -> Maybe RawQuery
             -> Maybe Text
-            -> Maybe Text
-            -> Cmd err (HashedResponse FacetTableResult)
-getTableApi cId tabType mLimit mOffset mOrderBy mQuery mYear = do
-  -- printDebug "[getTableApi] mQuery" mQuery
-  -- printDebug "[getTableApi] mYear" mYear
-  t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
-  pure $ constructHashedResponse t
-
-postTableApi :: HasNodeError err
-             => NodeId -> TableQuery -> Cmd err FacetTableResult
-postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing 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)
-      x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
-
-getTableHashApi :: HasNodeError err
-                => NodeId -> Maybe TabType -> Cmd err Text
+            -> m (HashedResponse FacetTableResult)
+getTableApi cId tabType mLimit mOffset mOrderBy mQuery mYear =
+  case mQuery of
+    Nothing -> get_table
+    Just "" -> get_table
+    Just q  -> case tabType of
+      Just Docs
+        -> do
+          $(logLocM) DEBUG $ "New search with query " <> getRawQuery q
+          constructHashedResponse <$> searchInCorpus' cId False q mOffset mLimit mOrderBy
+      Just Trash
+        -> constructHashedResponse <$> searchInCorpus' cId True q mOffset mLimit mOrderBy
+      _ -> get_table
+
+  where
+    get_table = do
+      $(logLocM) DEBUG $ "getTable cId = " <> T.pack (show cId)
+      t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
+      pure $ constructHashedResponse t
+
+postTableApi :: (CmdM env err m, MonadLogger m, HasNodeError err) => NodeId -> TableQuery -> m FacetTableResult
+postTableApi cId tq = case tq of
+ TableQuery o l order ft "" -> do
+   $(logLocM) DEBUG $ "New search with no query"
+   getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing Nothing
+ TableQuery o l order ft q  -> case ft of
+   Docs  -> do
+     $(logLocM) DEBUG $ "New search with query " <> getRawQuery q
+     searchInCorpus' cId False q (Just o) (Just l) (Just order)
+   Trash -> searchInCorpus' cId True  q (Just o) (Just l) (Just order)
+   x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
+
+getTableHashApi :: (CmdM env err m, HasNodeError err, MonadLogger m)
+                => NodeId
+                -> Maybe TabType
+                -> m Text
 getTableHashApi cId tabType = do
   HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
   pure h
 
-searchInCorpus' :: CorpusId
+searchInCorpus' :: (CmdM env err m, MonadLogger m)
+                => CorpusId
                 -> Bool
-                -> [Text]
+                -> RawQuery
                 -> Maybe Offset
                 -> Maybe Limit
                 -> Maybe OrderBy
-                -> Cmd err FacetTableResult
+                -> m FacetTableResult
 searchInCorpus' cId t q o l order = do
-  docs          <- searchInCorpus cId t q o l order
-  countAllDocs  <- searchCountInCorpus cId t q
-  pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
+  case parseQuery q of
+    -- FIXME(adn) The error handling needs to be monomorphic over GargErr.
+    Left noParseErr -> do
+      $(logLocM) ERROR $ "Invalid input query " <> (getRawQuery q) <> " , error = " <> (T.pack noParseErr)
+      pure $ TableResult 0 []
+    Right boolQuery -> do
+      docs          <- searchInCorpus cId t boolQuery o l order
+      countAllDocs  <- searchCountInCorpus cId t boolQuery
+      pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
 
 
 getTable :: HasNodeError err
@@ -149,13 +179,15 @@ getTable :: HasNodeError err
          -> Maybe Offset
          -> Maybe Limit
          -> Maybe OrderBy
-         -> Maybe Text
+         -> Maybe RawQuery
          -> Maybe Text
          -> Cmd err FacetTableResult
-getTable cId ft o l order query year = do
+getTable cId ft o l order raw_query year = do
   docs      <- getTable' cId ft o l order query year
   docsCount <- runCountDocuments cId (ft == Just Trash) query year
   pure $ TableResult { tr_docs = docs, tr_count = docsCount }
+  where
+    query = getRawQuery <$> raw_query
 
 getTable' :: HasNodeError err
           => NodeId

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

@@ -6,6 +6,7 @@ module Gargantext.Core.Text.Corpus.Query (
   , Limit(..)
   , getQuery
   , parseQuery
+  , mapQuery
   , renderQuery
   , interpretQuery
   , ExternalAPIs(..)
@@ -93,3 +94,6 @@ parseQuery (RawQuery txt) = bimap show (Query . BoolExpr.boolTreeToCNF) $
 
 renderQuery :: Query -> RawQuery
 renderQuery (Query cnf) = RawQuery . T.pack $ BoolExpr.boolExprPrinter (showsPrec 0) (BoolExpr.fromCNF cnf) ""
+
+mapQuery :: (Term -> Term) -> Query -> Query
+mapQuery f = Query . fmap f . getQuery

src/Gargantext/Core/Text/Terms.hs

@@ -56,7 +56,7 @@ import Gargantext.Core.Text.Terms.Mono.Stem (stem)
 import Gargantext.Core.Text.Terms.Mono.Token.En (tokenize)
 import Gargantext.Core.Text.Terms.Multi (multiterms)
 import Gargantext.Core.Types
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.Ngrams (insertNgrams)
 import Gargantext.Database.Query.Table.NgramsPostag (NgramsPostag(..), insertNgramsPostag, np_form, np_lem)
 import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..), ngramsTerms, text2ngrams, NgramsId)
@@ -121,9 +121,10 @@ instance Hashable ExtractedNgrams
 class ExtractNgramsT h
   where
     extractNgramsT :: HasText h
-                   => TermType Lang
+                   => NLPServerConfig
+                   -> TermType Lang
                    -> h
-                   -> Cmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
+                   -> DBCmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
 ------------------------------------------------------------------------
 enrichedTerms :: Lang -> PosTagAlgo -> POS -> Terms -> NgramsPostag
 enrichedTerms l pa po (Terms ng1 ng2) =
@@ -148,7 +149,7 @@ extracted2ngrams (SimpleNgrams   ng) = ng
 extracted2ngrams (EnrichedNgrams ng) = view np_form ng
 
 ---------------------------
-insertExtractedNgrams :: [ ExtractedNgrams ] -> Cmd err (HashMap Text NgramsId)
+insertExtractedNgrams :: [ ExtractedNgrams ] -> DBCmd err (HashMap Text NgramsId)
 insertExtractedNgrams ngs = do
   let (s, e) = List.partition isSimpleNgrams ngs
   m1 <- insertNgrams       (map unSimpleNgrams   s)

src/Gargantext/Core/Types/Individu.hs

 {-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-|
 Module      : Gargantext.Core.Types.Individu
@@ -25,11 +26,19 @@ import GHC.Generics (Generic)
 import Gargantext.Database.Admin.Types.Node (NodeId, UserId)
 import Gargantext.Prelude hiding (reverse)
 import qualified Gargantext.Prelude.Crypto.Auth as Auth
+import qualified Data.Text as T
 
 -- FIXME UserName used twice
 data User = UserDBId UserId | UserName Text | RootId NodeId | UserPublic
   deriving (Eq)
 
+renderUser :: User -> T.Text
+renderUser = \case
+  UserDBId urId -> T.pack (show urId)
+  UserName txt  -> txt
+  RootId   nId  -> T.pack (show nId)
+  UserPublic    -> T.pack "public"
+
 type Username = Text
 
 type HashPassword    = Auth.PasswordHash Auth.Argon2

src/Gargantext/Database/Action/Flow.hs

@@ -38,6 +38,7 @@ module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
   , flowAnnuaire
   , insertMasterDocs
   , saveDocNgramsWith
+  , addDocumentsToHyperCorpus
 
   , reIndexWith
   , docNgrams
@@ -73,7 +74,7 @@ import Data.Tuple.Extra (first, second)
 import GHC.Generics (Generic)
 import GHC.Num (fromInteger)
 import Gargantext.API.Ngrams.Tools (getTermsWith)
-import Gargantext.Core (Lang(..), PosTagAlgo(..))
+import Gargantext.Core (Lang(..), PosTagAlgo(..), NLPServerConfig)
 import Gargantext.Core (withDefaultLanguage)
 import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)
 import Gargantext.Core.Flow.Types
@@ -287,25 +288,43 @@ flow :: forall env err m a c.
 flow c u cn la mfslw (mLength, docsC) jobHandle = do
   (_userId, userCorpusId, listId) <- createNodes u cn c
   -- TODO if public insertMasterDocs else insertUserDocs
-  runConduit $ zipSources (yieldMany [1..]) docsC
+  nlpServer <- view $ nlpServerGet (_tt_lang la)
+  runConduit $ zipSources (yieldMany ([1..] :: [Int])) docsC
                  .| CList.chunksOf 100
-                 .| mapM_C (\docs -> void $ insertDocs' docs >>= Doc.add userCorpusId)
+                 .| mapM_C (addDocumentsWithProgress nlpServer userCorpusId)
                  .| sinkNull
 
   $(logLocM) DEBUG "Calling flowCorpusUser"
   flowCorpusUser (la ^. tt_lang) u userCorpusId listId c mfslw
 
   where
-    insertDocs' :: [(Integer, a)] -> m [NodeId]
-    insertDocs' [] = pure []
-    insertDocs' docs = do
-      $(logLocM) DEBUG $ T.pack $ "calling insertDoc, ([idx], mLength) = " <> show (fst <$> docs, mLength)
-      ids <- insertMasterDocs c la (snd <$> docs)
+    addDocumentsWithProgress :: NLPServerConfig -> CorpusId -> [(Int, a)] -> m ()
+    addDocumentsWithProgress nlpServer userCorpusId docsChunk = do
+      $(logLocM) DEBUG $ T.pack $ "calling insertDoc, ([idx], mLength) = " <> show (fst <$> docsChunk, mLength)
+      docs <- addDocumentsToHyperCorpus nlpServer c la userCorpusId (map snd docsChunk)
       markProgress (length docs) jobHandle
-      pure ids
+
+
+-- | Given a list of corpus documents and a 'NodeId' identifying the 'CorpusId', adds
+-- the given documents to the corpus. Returns the Ids of the inserted documents.
+addDocumentsToHyperCorpus :: ( DbCmd' env err m
+                             , HasNodeError err
+                             , FlowCorpus document
+                             , MkCorpus corpus
+                             )
+                             => NLPServerConfig
+                             -> Maybe corpus
+                             -> TermType Lang
+                             -> CorpusId
+                             -> [document]
+                             -> m [DocId]
+addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
+  ids <- insertMasterDocs ncs mb_hyper la docs
+  void $ Doc.add corpusId ids
+  pure ids
 
 ------------------------------------------------------------------------
-createNodes :: ( FlowCmdM env err m
+createNodes :: ( DbCmd' env err m, HasNodeError err
                , MkCorpus c
                )
             => User
@@ -371,15 +390,17 @@ flowCorpusUser l user userCorpusId listId ctype mfslw = do
   pure userCorpusId
 
 
-insertMasterDocs :: ( FlowCmdM env err m
+insertMasterDocs :: ( DbCmd' env err m
+                    , HasNodeError err
                     , FlowCorpus a
                     , MkCorpus   c
                     )
-                 => Maybe c
+                 => NLPServerConfig
+                 -> Maybe c
                  -> TermType Lang
                  -> [a]
                  -> m [DocId]
-insertMasterDocs c lang hs  =  do
+insertMasterDocs ncs c lang hs  =  do
   (masterUserId, _, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) c
   (ids', documentsWithId) <- insertDocs masterUserId masterCorpusId (map (toNode masterUserId Nothing) hs )
   _ <- Doc.add masterCorpusId ids'
@@ -392,7 +413,7 @@ insertMasterDocs c lang hs  =  do
   mapNgramsDocs' :: HashMap ExtractedNgrams (Map NgramsType (Map NodeId (Int, TermsCount)))
                 <- mapNodeIdNgrams
                 <$> documentIdWithNgrams
-                      (extractNgramsT $ withLang lang documentsWithId)
+                      (extractNgramsT ncs $ withLang lang documentsWithId)
                       documentsWithId
 
   lId      <- getOrMkList masterCorpusId masterUserId
@@ -402,7 +423,7 @@ insertMasterDocs c lang hs  =  do
   -- _cooc <- insertDefaultNode NodeListCooc lId masterUserId
   pure ids'
 
-saveDocNgramsWith :: (FlowCmdM env err m)
+saveDocNgramsWith :: (DbCmd' env err m)
                   => ListId
                   -> HashMap ExtractedNgrams (Map NgramsType (Map NodeId (Int, TermsCount)))
                   -> m ()
@@ -438,9 +459,10 @@ saveDocNgramsWith lId mapNgramsDocs' = do
 
 ------------------------------------------------------------------------
 -- TODO Type NodeDocumentUnicised
-insertDocs :: ( FlowCmdM env err m
+insertDocs :: ( DbCmd' env err m
               -- , FlowCorpus a
               , FlowInsertDB a
+              , HasNodeError err
               )
               => UserId
               -> CorpusId
@@ -486,9 +508,9 @@ mergeData rs = catMaybes . map toDocumentWithId . Map.toList
 ------------------------------------------------------------------------
 documentIdWithNgrams :: HasNodeError err
                      => (a
-                     -> Cmd err (HashMap b (Map NgramsType Int, TermsCount)))
+                     -> DBCmd err (HashMap b (Map NgramsType Int, TermsCount)))
                      -> [Indexed NodeId a]
-                     -> Cmd err [DocumentIdWithNgrams a b]
+                     -> DBCmd err [DocumentIdWithNgrams a b]
 documentIdWithNgrams f = traverse toDocumentIdWithNgrams
   where
     toDocumentIdWithNgrams d = do
@@ -519,10 +541,10 @@ mapNodeIdNgrams = HashMap.unionsWith (Map.unionWith (Map.unionWith addTuples)) .
 ------------------------------------------------------------------------
 instance ExtractNgramsT HyperdataContact
   where
-    extractNgramsT l hc = HashMap.mapKeys (cleanExtractedNgrams 255) <$> extract l hc
+    extractNgramsT _ncs l hc = HashMap.mapKeys (cleanExtractedNgrams 255) <$> extract l hc
       where
         extract :: TermType Lang -> HyperdataContact
-                -> Cmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
+                -> DBCmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
         extract _l hc' = do
           let authors = map text2ngrams
                       $ maybe ["Nothing"] (\a -> [a])
@@ -533,15 +555,15 @@ instance ExtractNgramsT HyperdataContact
 
 instance ExtractNgramsT HyperdataDocument
   where
-    extractNgramsT :: TermType Lang
+    extractNgramsT :: NLPServerConfig
+                   -> TermType Lang
                    -> HyperdataDocument
-                   -> Cmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
-    extractNgramsT lang hd = HashMap.mapKeys (cleanExtractedNgrams 255) <$> extractNgramsT' lang hd
+                   -> DBCmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
+    extractNgramsT ncs lang hd = HashMap.mapKeys (cleanExtractedNgrams 255) <$> extractNgramsT' hd
       where
-        extractNgramsT' :: TermType Lang
-                        -> HyperdataDocument
-                       -> Cmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
-        extractNgramsT' lang' doc = do
+        extractNgramsT' :: HyperdataDocument
+                        -> DBCmd err (HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
+        extractNgramsT' doc = do
           let source    = text2ngrams
                         $ maybe "Nothing" identity
                         $ _hd_source doc
@@ -554,11 +576,9 @@ instance ExtractNgramsT HyperdataDocument
                          $ maybe ["Nothing"] (splitOn Authors (doc^. hd_bdd))
                          $ _hd_authors doc
 
-          ncs <- view (nlpServerGet $ lang' ^. tt_lang)
-
-          termsWithCounts' <- map (\(t, cnt) -> (enrichedTerms (lang' ^. tt_lang) CoreNLP NP t, cnt))
+          termsWithCounts' <- map (\(t, cnt) -> (enrichedTerms (lang ^. tt_lang) CoreNLP NP t, cnt))
                               <$> concat
-                              <$> liftBase (extractTerms ncs lang' $ hasText doc)
+                              <$> liftBase (extractTerms ncs lang $ hasText doc)
 
           pure $ HashMap.fromList
                $  [(SimpleNgrams source, (Map.singleton Sources     1, 1))                    ]
@@ -568,7 +588,7 @@ instance ExtractNgramsT HyperdataDocument
 
 instance (ExtractNgramsT a, HasText a) => ExtractNgramsT (Node a)
   where
-    extractNgramsT l (Node { _node_hyperdata = h }) = extractNgramsT l h
+    extractNgramsT ncs l (Node { _node_hyperdata = h }) = extractNgramsT ncs l h
 
 instance HasText a => HasText (Node a)
   where
@@ -592,9 +612,11 @@ extractInsert :: FlowCmdM env err m
               => [Node HyperdataDocument] -> m ()
 extractInsert docs = do
   let documentsWithId = map (\doc -> Indexed (doc ^. node_id) doc) docs
+  let lang = EN
+  ncs <- view $ nlpServerGet lang
   mapNgramsDocs' <- mapNodeIdNgrams
                 <$> documentIdWithNgrams
-                    (extractNgramsT $ withLang (Multi EN) documentsWithId)
+                    (extractNgramsT ncs $ withLang (Multi lang) documentsWithId)
                     documentsWithId
   _ <- insertExtractedNgrams $ HashMap.keys mapNgramsDocs'
   pure ()

src/Gargantext/Database/Action/Flow/Utils.hs

@@ -17,7 +17,7 @@ import Data.Map.Strict (Map)
 import Data.HashMap.Strict (HashMap)
 import Gargantext.Core.Types (TermsCount)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.ContextNodeNgrams
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Types
@@ -35,7 +35,7 @@ data DocumentIdWithNgrams a b =
 
 insertDocNgrams :: ListId
                 -> HashMap (Indexed NgramsId Ngrams) (Map NgramsType (Map DocId (Int, TermsCount)))
-                -> Cmd err Int
+                -> DBCmd err Int
 insertDocNgrams lId m = do
   -- printDebug "[insertDocNgrams] ns" ns
   insertContextNodeNgrams ns

src/Gargantext/Database/Action/Search.hs

@@ -11,51 +11,90 @@ Portability : POSIX
 {-# LANGUAGE Arrows            #-}
 {-# LANGUAGE LambdaCase         #-}
 
-module Gargantext.Database.Action.Search where
+module Gargantext.Database.Action.Search (
+    searchInCorpus
+  , searchInCorpusWithContacts
+  , searchCountInCorpus
+  , searchInCorpusWithNgrams
+  , searchDocInDatabase
+  ) where
 
 import Control.Arrow (returnA)
 import Control.Lens ((^.), view)
-import qualified Data.List as List
-import qualified Data.Map.Strict as Map
 import Data.Maybe
-import qualified Data.Set as Set
-import Data.Text (Text, unpack, intercalate)
+import Data.Profunctor.Product (p4)
+import Data.Text (Text, unpack)
 import Data.Time (UTCTime)
 import Gargantext.Core
+import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Query (IsTrash, Limit, Offset)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..), HyperdataContact(..))
-import Gargantext.Database.Prelude (Cmd, runOpaQuery, runCountOpaQuery)
+import Gargantext.Database.Prelude (runOpaQuery, runCountOpaQuery, DBCmd)
 import Gargantext.Database.Query.Facet
 import Gargantext.Database.Query.Filter
-import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
 import Gargantext.Database.Query.Table.Context
 import Gargantext.Database.Query.Table.ContextNodeNgrams (queryContextNodeNgramsTable)
+import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
 import Gargantext.Database.Query.Table.NodeContext
 import Gargantext.Database.Query.Table.NodeContext_NodeContext
+import Gargantext.Database.Schema.Context
 import Gargantext.Database.Schema.ContextNodeNgrams (ContextNodeNgramsPoly(..))
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Database.Schema.Node
-import Gargantext.Database.Schema.Context
 import Gargantext.Prelude
-import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
 import Opaleye hiding (Order)
-import Data.Profunctor.Product (p4)
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified Gargantext.Core.Text.Corpus.Query as API
 import qualified Opaleye as O hiding (Order)
+import Data.BoolExpr
+import qualified Data.Text as T
+
+--
+-- Interpreting a query into a Postgres' TSQuery
+--
+
+queryToTsSearch :: API.Query -> Field SqlTSQuery
+queryToTsSearch q = sqlToTSQuery $ T.unpack $ (API.interpretQuery q transformAST)
+  where
+    transformAST :: BoolExpr Term -> T.Text
+    transformAST ast = case ast of
+      BAnd sub1 sub2
+        -> " (" <> transformAST sub1 <> " & " <> transformAST sub2 <> ") "
+      BOr sub1 sub2
+        -> " (" <> transformAST sub1 <> " | " <> transformAST sub2 <> ") "
+      BNot (BConst (Negative term))
+        -> transformAST (BConst (Positive term)) -- double negation
+      BNot sub
+        -> "!" <> transformAST sub
+      -- BTrue cannot happen is the query parser doesn't support parsing 'TRUE' alone.
+      BTrue
+        -> T.empty
+      -- BTrue cannot happen is the query parser doesn't support parsing 'FALSE' alone.
+      BFalse
+        -> T.empty
+      BConst (Positive (Term term))
+        -> T.intercalate " & " $ T.words term
+      -- We can handle negatives via `ANDNOT` with itself.
+      BConst (Negative (Term term))
+        -> "!" <> term
+
 
 ------------------------------------------------------------------------
 searchDocInDatabase :: HasDBid NodeType
                     => ParentId
                     -> Text
-                    -> Cmd err [(NodeId, HyperdataDocument)]
+                    -> DBCmd err [(NodeId, HyperdataDocument)]
 searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
   where
     -- | Global search query where ParentId is Master Node Corpus Id
     queryDocInDatabase :: ParentId -> Text -> O.Select (Column SqlInt4, Column SqlJsonb)
     queryDocInDatabase _p q = proc () -> do
         row <- queryNodeSearchTable -< ()
-        restrict -< (_ns_search row)    @@ (sqlTSQuery (unpack q))
+        restrict -< (_ns_search row)    @@ (sqlToTSQuery (unpack q))
         restrict -< (_ns_typename row) .== (sqlInt4 $ toDBid NodeDocument)
         returnA  -< (_ns_id row, _ns_hyperdata row)
 
@@ -71,7 +110,7 @@ searchInCorpusWithNgrams :: HasDBid NodeType
                -> Maybe Offset
                -> Maybe Limit
                -> Maybe OrderBy
-               -> Cmd err [FacetDoc]
+               -> DBCmd err [FacetDoc]
 searchInCorpusWithNgrams _cId _lId _t _ngt _q _o _l _order = undefined
 
 -- | Compute TF-IDF for all 'ngramIds' in given 'CorpusId'. In this
@@ -79,11 +118,11 @@ searchInCorpusWithNgrams _cId _lId _t _ngt _q _o _l _order = undefined
 -- ratio of "number of times our terms appear in given document" and
 -- "number of all terms in document" and return a sorted list of
 -- document ids
-tfidfAll :: (HasDBid NodeType, HasNodeError err) => CorpusId -> [Int] -> Cmd err [Int]
-tfidfAll cId ngramIds = do
+_tfidfAll :: (HasDBid NodeType, HasNodeError err) => CorpusId -> [Int] -> DBCmd err [Int]
+_tfidfAll cId ngramIds = do
   let ngramIdsSet = Set.fromList ngramIds
   lId <- defaultList cId
-  docsWithNgrams <- runOpaQuery (queryListWithNgrams lId ngramIds) :: Cmd err [(Int, Int, Int)]
+  docsWithNgrams <- runOpaQuery (_queryListWithNgrams lId ngramIds) :: DBCmd err [(Int, Int, Int)]
   -- NOTE The query returned docs with ANY ngramIds. We need to further
   -- restrict to ALL ngramIds.
   let docsNgramsM =
@@ -111,8 +150,8 @@ tfidfAll cId ngramIds = do
 
 -- | Query for searching the 'context_node_ngrams' table so that we
 -- find docs with ANY given 'ngramIds'.
-queryListWithNgrams :: ListId -> [Int] -> Select (Column SqlInt4, Column SqlInt4, Column SqlInt4)
-queryListWithNgrams lId ngramIds = proc () -> do
+_queryListWithNgrams :: ListId -> [Int] -> Select (Column SqlInt4, Column SqlInt4, Column SqlInt4)
+_queryListWithNgrams lId ngramIds = proc () -> do
   row <- queryContextNodeNgramsTable -< ()
   restrict -< (_cnng_node_id row) .== (pgNodeId lId)
   restrict -< in_ (sqlInt4 <$> ngramIds) (_cnng_ngrams_id row)
@@ -133,31 +172,29 @@ queryListWithNgrams lId ngramIds = proc () -> do
 searchInCorpus :: HasDBid NodeType
                => CorpusId
                -> IsTrash
-               -> [Text]
+               -> API.Query
                -> Maybe Offset
                -> Maybe Limit
                -> Maybe OrderBy
-               -> Cmd err [FacetDoc]
+               -> DBCmd err [FacetDoc]
 searchInCorpus cId t q o l order = runOpaQuery
                                  $ filterWith o l order
                                  $ queryInCorpus cId t
-                                 $ intercalate " | "
-                                 $ map stemIt q
+                                 $ API.mapQuery (Term . stemIt . getTerm) q
 
 searchCountInCorpus :: HasDBid NodeType
                     => CorpusId
                     -> IsTrash
-                    -> [Text]
-                    -> Cmd err Int
+                    -> API.Query
+                    -> DBCmd err Int
 searchCountInCorpus cId t q = runCountOpaQuery
                             $ queryInCorpus cId t
-                            $ intercalate " | "
-                            $ map stemIt q
+                            $ API.mapQuery (Term . stemIt . getTerm) q
 
 queryInCorpus :: HasDBid NodeType
               => CorpusId
               -> IsTrash
-              -> Text
+              -> API.Query
               -> O.Select FacetDocRead
 queryInCorpus cId t q = proc () -> do
   c <- queryContextSearchTable -< ()
@@ -169,7 +206,7 @@ queryInCorpus cId t q = proc () -> do
                  else matchMaybe (view nc_category <$> nc) $ \case
                         Nothing -> toFields False
                         Just c' -> c' .>= sqlInt4 1
-  restrict -< (c ^. cs_search)           @@ sqlTSQuery (unpack q)
+  restrict -< (c ^. cs_search)           @@ queryToTsSearch q
   restrict -< (c ^. cs_typename )       .== sqlInt4 (toDBid NodeDocument)
   returnA  -< FacetDoc { facetDoc_id         = c^.cs_id
                        , facetDoc_created    = c^.cs_date
@@ -185,23 +222,22 @@ searchInCorpusWithContacts
   :: HasDBid NodeType
   => CorpusId
   -> AnnuaireId
-  -> [Text]
+  -> API.Query
   -> Maybe Offset
   -> Maybe Limit
   -> Maybe OrderBy
-  -> Cmd err [FacetPaired Int UTCTime HyperdataContact Int]
+  -> DBCmd err [FacetPaired Int UTCTime HyperdataContact Int]
 searchInCorpusWithContacts cId aId q o l _order =
   runOpaQuery $ limit'   l
               $ offset'  o
               $ orderBy (desc _fp_score)
               $ selectGroup cId aId
-              $ intercalate " | "
-              $ map stemIt q
+              $ API.mapQuery (Term . stemIt . getTerm) q
 
 selectGroup :: HasDBid NodeType
             => CorpusId
             -> AnnuaireId
-            -> Text
+            -> API.Query
             -> Select FacetPairedRead
 selectGroup cId aId q = proc () -> do
   (a, b, c, d) <- aggregate (p4 (groupBy, groupBy, groupBy, O.sum))
@@ -213,7 +249,7 @@ selectContactViaDoc
   :: HasDBid NodeType
   => CorpusId
   -> AnnuaireId
-  -> Text
+  -> API.Query
   -> SelectArr ()
                ( Field SqlInt4
                , Field SqlTimestamptz
@@ -225,7 +261,7 @@ selectContactViaDoc cId aId query = proc () -> do
   (contact, annuaire, _, corpus, doc) <- queryContactViaDoc -< ()
   restrict -< matchMaybe (view cs_search <$> doc) $ \case
     Nothing -> toFields False
-    Just s  -> s @@ sqlTSQuery (unpack query)
+    Just s  -> s @@ queryToTsSearch query
   restrict -< (view cs_typename <$> doc)          .=== justFields (sqlInt4 (toDBid NodeDocument))
   restrict -< (view nc_node_id <$> corpus)        .=== justFields (pgNodeId cId)
   restrict -< (view nc_node_id <$> annuaire)      .=== justFields (pgNodeId aId)

src/Gargantext/Database/Action/User.hs

@@ -28,7 +28,7 @@ getUserLightWithId :: HasNodeError err => UserId -> DBCmd err UserLight
 getUserLightWithId i = do
   candidates <- head <$> getUsersWithId (UserDBId i)
   case candidates of
-    Nothing -> nodeError NoUserFound
+    Nothing -> nodeError (NoUserFound (UserDBId i))
     Just u  -> pure u
 
 getUserLightDB :: HasNodeError err => User -> DBCmd err UserLight
@@ -44,7 +44,7 @@ getUserId :: HasNodeError err
 getUserId u = do
   maybeUser <- getUserId' u
   case maybeUser of
-    Nothing -> nodeError NoUserFound
+    Nothing -> nodeError (NoUserFound u)
     Just u'  -> pure u'
 
 getUserId' :: HasNodeError err

src/Gargantext/Database/Admin/Trigger/ContextNodeNgrams.hs

@@ -20,11 +20,12 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.Core
 -- import Gargantext.Core.Types.Main (ListType(CandidateTerm))
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
-import Gargantext.Database.Prelude (Cmd, execPGSQuery)
+-- (ListId, CorpusId, NodeId)
+import Gargantext.Database.Prelude (execPGSQuery, DBCmd)
 import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as DPS
 
-triggerCountInsert :: HasDBid NodeType => Cmd err Int64
+triggerCountInsert :: HasDBid NodeType => DBCmd err Int64
 triggerCountInsert = execPGSQuery query (toDBid NodeDocument, toDBid NodeList)
   where
     query :: DPS.Query
@@ -60,7 +61,7 @@ triggerCountInsert = execPGSQuery query (toDBid NodeDocument, toDBid NodeList)
           EXECUTE PROCEDURE set_ngrams_global_count();
    |]
 
-triggerCountInsert2 :: HasDBid NodeType => Cmd err Int64
+triggerCountInsert2 :: HasDBid NodeType => DBCmd err Int64
 triggerCountInsert2 = execPGSQuery query ( toDBid NodeCorpus
                                          , toDBid NodeDocument
                                          , toDBid NodeList

src/Gargantext/Database/Admin/Trigger/Contexts.hs

@@ -20,12 +20,13 @@ import Data.Text (Text)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.Core (HasDBid(..))
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
-import Gargantext.Database.Prelude (Cmd, execPGSQuery)
+-- (ListId, CorpusId, NodeId)
+import Gargantext.Database.Prelude (execPGSQuery, DBCmd)
 import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as DPS
 
 
-triggerSearchUpdate :: HasDBid NodeType => Cmd err Int64
+triggerSearchUpdate :: HasDBid NodeType => DBCmd err Int64
 triggerSearchUpdate = execPGSQuery query ( toDBid NodeDocument
                                          , toDBid NodeDocument
                                          , toDBid NodeContact
@@ -37,10 +38,10 @@ triggerSearchUpdate = execPGSQuery query ( toDBid NodeDocument
         RETURNS trigger AS $$
         begin
           IF new.typename = ? AND new.hyperdata @> '{"language_iso2":"EN"}' THEN
-            new.search := to_tsvector( 'english' , (new.hyperdata ->> 'title') || ' ' || (new.hyperdata ->> 'abstract'));
+            new.search := to_tsvector( 'english' , new.hyperdata::jsonb );
 
           ELSIF new.typename = ? AND new.hyperdata @> '{"language_iso2":"FR"}' THEN
-            new.search := to_tsvector( 'french' , (new.hyperdata ->> 'title') || ' ' || (new.hyperdata ->> 'abstract'));
+            new.search := to_tsvector( 'english' , new.hyperdata::jsonb );
 
           ELSIF new.typename = ? THEN
             new.search := to_tsvector( 'french' , (new.hyperdata ->> 'prenom')
@@ -48,7 +49,7 @@ triggerSearchUpdate = execPGSQuery query ( toDBid NodeDocument
                                          || ' ' || (new.hyperdata ->> 'fonction')
                                      );
           ELSE
-            new.search := to_tsvector( 'english' , (new.hyperdata ->> 'title') || ' ' || (new.hyperdata ->> 'abstract'));
+            new.search := to_tsvector( 'english' , new.hyperdata::jsonb );
           END IF;
           return new;
         end
@@ -69,7 +70,7 @@ triggerSearchUpdate = execPGSQuery query ( toDBid NodeDocument
 
 type Secret = Text
 
-triggerUpdateHash :: HasDBid NodeType => Secret -> Cmd err Int64
+triggerUpdateHash :: HasDBid NodeType => Secret -> DBCmd err Int64
 triggerUpdateHash secret = execPGSQuery query ( toDBid NodeDocument
                                               , toDBid NodeContact
                                               , secret

src/Gargantext/Database/Admin/Trigger/Init.hs

@@ -20,16 +20,17 @@ import Data.Text (Text)
 import Gargantext.Database.Admin.Trigger.ContextNodeNgrams (triggerCountInsert, triggerCountInsert2)
 import Gargantext.Database.Admin.Trigger.Contexts (triggerSearchUpdate, triggerUpdateHash)
 import Gargantext.Database.Admin.Trigger.NodesContexts ({-triggerDeleteCount,-} triggerInsertCount, triggerUpdateAdd, triggerUpdateDel, MasterListId) -- , triggerCoocInsert)
-import Gargantext.Database.Prelude (Cmd)
+-- , triggerCoocInsert)
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Prelude
 
 ------------------------------------------------------------------------
-initFirstTriggers :: Text -> Cmd err [Int64]
+initFirstTriggers :: Text -> DBCmd err [Int64]
 initFirstTriggers secret = do
   t0  <- triggerUpdateHash secret
   pure [t0]
 
-initLastTriggers :: MasterListId -> Cmd err [Int64]
+initLastTriggers :: MasterListId -> DBCmd err [Int64]
 initLastTriggers lId = do
   t0  <- triggerSearchUpdate
   t1 <- triggerCountInsert

src/Gargantext/Database/Admin/Trigger/NodesContexts.hs

@@ -20,13 +20,14 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.Core
 import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
-import Gargantext.Database.Prelude (Cmd, execPGSQuery)
+-- (ListId, CorpusId, NodeId)
+import Gargantext.Database.Prelude (execPGSQuery, DBCmd)
 import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as DPS
 
 type MasterListId = ListId
 
-triggerInsertCount :: MasterListId -> Cmd err Int64
+triggerInsertCount :: MasterListId -> DBCmd err Int64
 triggerInsertCount lId = execPGSQuery query (lId, nodeTypeId NodeList)
   where
     query :: DPS.Query
@@ -62,7 +63,7 @@ triggerInsertCount lId = execPGSQuery query (lId, nodeTypeId NodeList)
   |]
 
 
-triggerUpdateAdd :: MasterListId -> Cmd err Int64
+triggerUpdateAdd :: MasterListId -> DBCmd err Int64
 triggerUpdateAdd lId = execPGSQuery query (lId, nodeTypeId NodeList)
   where
     query :: DPS.Query
@@ -102,7 +103,7 @@ triggerUpdateAdd lId = execPGSQuery query (lId, nodeTypeId NodeList)
   |]
 
 
-triggerUpdateDel :: MasterListId -> Cmd err Int64
+triggerUpdateDel :: MasterListId -> DBCmd err Int64
 triggerUpdateDel lId = execPGSQuery query (lId, nodeTypeId NodeList)
   where
     query :: DPS.Query
@@ -144,7 +145,7 @@ triggerUpdateDel lId = execPGSQuery query (lId, nodeTypeId NodeList)
 
 
 
-triggerDeleteCount :: MasterListId -> Cmd err Int64
+triggerDeleteCount :: MasterListId -> DBCmd err Int64
 triggerDeleteCount lId = execPGSQuery query (lId, toDBid NodeList)
   where
     query :: DPS.Query

src/Gargantext/Database/Prelude.hs

@@ -138,7 +138,7 @@ runOpaQuery :: Default FromFields fields haskells
             -> DBCmd err [haskells]
 runOpaQuery q = mkCmd $ \c -> runSelect c q
 
-runCountOpaQuery :: Select a -> Cmd err Int
+runCountOpaQuery :: Select a -> DBCmd err Int
 runCountOpaQuery q = do
   counts <- mkCmd $ \c -> runSelect c $ countRows q
   -- countRows is guaranteed to return a list with exactly one row so DL.head is safe here
@@ -151,7 +151,7 @@ formatPGSQuery q a = mkCmd $ \conn -> PGS.formatQuery conn q a
 runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
 runPGSQuery' q a = mkCmd $ \conn -> PGS.query conn q a
 
-runPGSQuery :: ( CmdM env err m
+runPGSQuery :: ( DbCmd' env err m
                , PGS.FromRow r, PGS.ToRow q
                )
                => PGS.Query -> q -> m [r]
@@ -189,7 +189,7 @@ runPGSQuery_ q = mkCmd $ \conn -> catch (PGS.query_ conn q) printError
       hPutStrLn stderr (fromQuery q)
       throw (SomeException e)
 
-execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err Int64
+execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> DBCmd err Int64
 execPGSQuery q a = mkCmd $ \conn -> PGS.execute conn q a
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Query/Table/ContextNodeNgrams.hs

@@ -23,7 +23,7 @@ module Gargantext.Database.Query.Table.ContextNodeNgrams
   where
 
 import Gargantext.Database.Admin.Types.Node (pgNodeId, pgContextId)
-import Gargantext.Database.Prelude (Cmd, mkCmd)
+import Gargantext.Database.Prelude (mkCmd, DBCmd)
 import Gargantext.Database.Schema.Ngrams (pgNgramsTypeId)
 import Gargantext.Database.Schema.ContextNodeNgrams
 import Gargantext.Database.Schema.Prelude
@@ -34,7 +34,7 @@ queryContextNodeNgramsTable :: Query ContextNodeNgramsRead
 queryContextNodeNgramsTable = selectTable contextNodeNgramsTable
 
 -- | Insert utils
-insertContextNodeNgrams :: [ContextNodeNgrams] -> Cmd err Int
+insertContextNodeNgrams :: [ContextNodeNgrams] -> DBCmd err Int
 insertContextNodeNgrams = insertContextNodeNgramsW
                      . map (\(ContextNodeNgrams c n ng nt w dc) ->
                               ContextNodeNgrams (pgContextId c)
@@ -45,7 +45,7 @@ insertContextNodeNgrams = insertContextNodeNgramsW
                                                 (sqlInt4 dc)
                             )
 
-insertContextNodeNgramsW :: [ContextNodeNgramsWrite] -> Cmd err Int
+insertContextNodeNgramsW :: [ContextNodeNgramsWrite] -> DBCmd err Int
 insertContextNodeNgramsW nnnw =
   mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
     where

src/Gargantext/Database/Query/Table/ContextNodeNgrams2.hs

@@ -25,7 +25,7 @@ module Gargantext.Database.Query.Table.ContextNodeNgrams2
 import Gargantext.Database.Schema.Prelude
 import Gargantext.Database.Schema.ContextNodeNgrams2
 import Gargantext.Database.Admin.Types.Node (pgNodeId)
-import Gargantext.Database.Prelude (Cmd, mkCmd)
+import Gargantext.Database.Prelude (mkCmd, DBCmd)
 import Prelude
 
 
@@ -33,7 +33,7 @@ queryContextNodeNgrams2Table :: Query ContextNodeNgrams2Read
 queryContextNodeNgrams2Table = selectTable contextNodeNgrams2Table
 
 -- | Insert utils
-insertContextNodeNgrams2 :: [ContextNodeNgrams2] -> Cmd err Int
+insertContextNodeNgrams2 :: [ContextNodeNgrams2] -> DBCmd err Int
 insertContextNodeNgrams2 = insertContextNodeNgrams2W
                      . map (\(ContextNodeNgrams2 n1 n2 w) ->
                               ContextNodeNgrams2 (pgNodeId n1)
@@ -41,7 +41,7 @@ insertContextNodeNgrams2 = insertContextNodeNgrams2W
                                                  (sqlDouble w)
                            )
 
-insertContextNodeNgrams2W :: [ContextNodeNgrams2Write] -> Cmd err Int
+insertContextNodeNgrams2W :: [ContextNodeNgrams2Write] -> DBCmd err Int
 insertContextNodeNgrams2W nnnw =
   mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
     where

src/Gargantext/Database/Query/Table/Ngrams.hs

@@ -28,7 +28,7 @@ import Data.HashMap.Strict (HashMap)
 import Data.Map.Strict (Map)
 import Data.Text (Text)
 import Gargantext.Core.Types
-import Gargantext.Database.Prelude (runOpaQuery, Cmd, formatPGSQuery, runPGSQuery)
+import Gargantext.Database.Prelude (runOpaQuery, Cmd, formatPGSQuery, runPGSQuery, DBCmd)
 import Gargantext.Database.Query.Join (leftJoin3)
 import Gargantext.Database.Query.Table.ContextNodeNgrams2
 import Gargantext.Database.Query.Table.NodeNgrams (queryNodeNgramsTable)
@@ -73,14 +73,14 @@ _dbGetNgramsDb = runOpaQuery queryNgramsTable
 
 
 -- TODO-ACCESS: access must not be checked here but when insertNgrams is called.
-insertNgrams :: [Ngrams] -> Cmd err (HashMap Text NgramsId)
+insertNgrams :: [Ngrams] -> DBCmd err (HashMap Text NgramsId)
 insertNgrams ns =
   if List.null ns
      then pure HashMap.empty
      else HashMap.fromList <$> map (\(Indexed i t) -> (t, i)) <$> (insertNgrams' ns)
 
 -- TODO-ACCESS: access must not be checked here but when insertNgrams' is called.
-insertNgrams' :: [Ngrams] -> Cmd err [Indexed Int Text]
+insertNgrams' :: [Ngrams] -> DBCmd err [Indexed Int Text]
 insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
   where
     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]

src/Gargantext/Database/Query/Table/NgramsPostag.hs

@@ -24,7 +24,7 @@ import Data.Hashable (Hashable)
 import Data.Text (Text)
 import Gargantext.Core
 import Gargantext.Core.Types
-import Gargantext.Database.Prelude (Cmd, runPGSQuery, runPGSQuery_)
+import Gargantext.Database.Prelude (Cmd, runPGSQuery, runPGSQuery_, DBCmd)
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Prelude
 import Gargantext.Database.Query.Table.Ngrams
@@ -65,7 +65,7 @@ toInsert (NgramsPostag l a p form lem) =
   , view ngramsSize  lem
   )
 
-insertNgramsPostag :: [NgramsPostag] -> Cmd err (HashMap Text NgramsId)
+insertNgramsPostag :: [NgramsPostag] -> DBCmd err (HashMap Text NgramsId)
 insertNgramsPostag xs =
   if List.null xs
      then pure HashMap.empty
@@ -86,7 +86,7 @@ insertNgramsPostag xs =
        pure $ HashMap.union ns' nps'
 
 
-insertNgramsPostag' :: [NgramsPostagInsert] -> Cmd err [Indexed Text Int]
+insertNgramsPostag' :: [NgramsPostagInsert] -> DBCmd err [Indexed Text Int]
 insertNgramsPostag' ns = runPGSQuery queryInsertNgramsPostag (PGS.Only $ Values fields ns)
   where
 

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

@@ -171,7 +171,7 @@ getClosestParentIdByType' nId nType = do
 getChildrenByType :: HasDBid NodeType
                   => NodeId
                   -> NodeType
-                  -> Cmd err [NodeId]
+                  -> DBCmd err [NodeId]
 getChildrenByType nId nType = do
   result <- runPGSQuery query (PGS.Only nId)
   children_lst <- mapM (\(id, _) -> getChildrenByType id nType) result
@@ -260,7 +260,7 @@ getNode nId = do
     Just  r -> pure r
 
 getNodeWith :: (HasNodeError err, JSONB a)
-            => NodeId -> proxy a -> Cmd err (Node a)
+            => NodeId -> proxy a -> DBCmd err (Node a)
 getNodeWith nId _ = do
   maybeNode <- headMay <$> runOpaQuery (selectNode (pgNodeId nId))
   case maybeNode of
@@ -275,7 +275,7 @@ insertDefaultNode :: HasDBid NodeType
 insertDefaultNode nt p u = insertNode nt Nothing Nothing p u
 
 insertDefaultNodeIfNotExists :: HasDBid NodeType
-                             => NodeType -> ParentId -> UserId -> Cmd err [NodeId]
+                             => NodeType -> ParentId -> UserId -> DBCmd err [NodeId]
 insertDefaultNodeIfNotExists nt p u = do
   children <- getChildrenByType p nt
   case children of
@@ -399,19 +399,19 @@ instance MkCorpus HyperdataAnnuaire
 getOrMkList :: (HasNodeError err, HasDBid NodeType)
             => ParentId
             -> UserId
-            -> Cmd err ListId
+            -> DBCmd err ListId
 getOrMkList pId uId =
   maybe (mkList' pId uId) (pure . view node_id) . headMay =<< getListsWithParentId pId
     where
       mkList' pId' uId' = maybe (nodeError MkNode) pure . headMay =<< insertDefaultNode NodeList pId' uId'
 
 -- | TODO remove defaultList
-defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err ListId
+defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> DBCmd err ListId
 defaultList cId =
   maybe (nodeError (NoListFound cId)) (pure . view node_id) . headMay =<< getListsWithParentId cId
 
 defaultListMaybe :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err (Maybe NodeId)
 defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId cId
 
-getListsWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataList]
+getListsWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)

src/Gargantext/Database/Query/Table/Node/Document/Add.hs

@@ -28,12 +28,12 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..))
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import GHC.Generics (Generic)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, runPGSQuery, formatPGSQuery)
+import Gargantext.Database.Prelude (Cmd, runPGSQuery, formatPGSQuery, DBCmd)
 import Gargantext.Prelude
 
 ---------------------------------------------------------------------------
 
-add :: CorpusId -> [ContextId] -> Cmd err [Only Int]
+add :: CorpusId -> [ContextId] -> DBCmd err [Only Int]
 add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)
   where
     fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes

src/Gargantext/Database/Query/Table/Node/Document/Insert.hs

@@ -73,7 +73,7 @@ import GHC.Generics (Generic)
 import Gargantext.Core (HasDBid(toDBid))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, runPGSQuery{-, formatPGSQuery-})
+import Gargantext.Database.Prelude (runPGSQuery, DBCmd{-, formatPGSQuery-})
 import Gargantext.Database.Schema.Node (NodePoly(..))
 import qualified Gargantext.Defaults as Defaults
 import Gargantext.Prelude
@@ -93,7 +93,7 @@ import Database.PostgreSQL.Simple (formatQuery)
 -- ParentId : folder ID which is parent of the inserted documents
 -- Administrator of the database has to create a uniq index as following SQL command:
 -- `create unique index on contexts table (typename, parent_id, (hyperdata ->> 'uniqId'));`
-insertDb :: (InsertDb a, HasDBid NodeType) => UserId -> Maybe ParentId -> [a] -> Cmd err [ReturnId]
+insertDb :: (InsertDb a, HasDBid NodeType) => UserId -> Maybe ParentId -> [a] -> DBCmd err [ReturnId]
 insertDb u p = runPGSQuery queryInsert . Only . Values fields . map (insertDb' u p)
       where
         fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes

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

@@ -14,17 +14,19 @@ import Control.Lens (Prism', (#), (^?))
 import Control.Monad.Except (MonadError(..))
 import Data.Aeson
 import Data.Text (Text, pack)
+import qualified Data.Text as T
 
 import Prelude hiding (null, id, map, sum)
 
 import Gargantext.Database.Admin.Types.Node (ListId, NodeId(..))
 import Gargantext.Prelude hiding (sum, head)
+import Gargantext.Core.Types.Individu
 
 ------------------------------------------------------------------------
 data NodeError = NoListFound { listId :: ListId }
                | NoRootFound
                | NoCorpusFound
-               | NoUserFound
+               | NoUserFound User
                | MkNode
                | UserNoParent
                | HasParent
@@ -35,13 +37,14 @@ data NodeError = NoListFound { listId :: ListId }
                | DoesNotExist NodeId
                | NeedsConfiguration
                | NodeError Text
+               | QueryNoParse Text
 
 instance Show NodeError
   where
     show (NoListFound {})   = "No list   found"
     show NoRootFound   = "No Root   found"
     show NoCorpusFound = "No Corpus found"
-    show NoUserFound   = "No user   found"
+    show (NoUserFound ur) = "User(" <> T.unpack (renderUser ur) <> ") not found"
 
     show MkNode        = "Cannot make node"
     show NegativeId    = "Node with negative Id"
@@ -53,6 +56,7 @@ instance Show NodeError
     show (DoesNotExist n)   = "Node does not exist (" <> show n <> ")"
     show NeedsConfiguration = "Needs configuration"
     show (NodeError e)      = "NodeError: " <> cs e
+    show (QueryNoParse err) = "QueryNoParse: " <> T.unpack err
 
 instance ToJSON NodeError where
   toJSON (NoListFound { listId = NodeId listId }) =

src/Gargantext/Database/Query/Table/NodeNgrams.hs

@@ -67,7 +67,7 @@ listInsertDb :: Show a => ListId
              -> (ListId -> a -> [NodeNgramsW])
              -> a
              -- -> Cmd err [Returning]
-             -> Cmd err (Map NgramsType (Map Text Int))
+             -> DBCmd err (Map NgramsType (Map Text Int))
 listInsertDb l f ngs = Map.map Map.fromList
                     <$> Map.fromListWith (<>)
                     <$> List.map (\(Returning t tx id) -> (fromJust t, [(tx, id)]))
@@ -75,7 +75,7 @@ listInsertDb l f ngs = Map.map Map.fromList
                     <$> insertNodeNgrams (f l ngs)
 
 -- TODO optimize with size of ngrams
-insertNodeNgrams :: [NodeNgramsW] -> Cmd err [Returning]
+insertNodeNgrams :: [NodeNgramsW] -> DBCmd err [Returning]
 insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
   where
     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"

stack.yaml

@@ -44,8 +44,8 @@ extra-deps:
 - git: https://github.com/alpmestan/ekg-json.git
   commit: fd7e5d7325939103cd87d0dc592faf644160341c
   # Databases libs
-- git: https://github.com/garganscript/haskell-opaleye.git
-  commit: a5693a2010e6d13f51cdc576fa1dc9985e79ee0e
+- git: https://github.com/adinapoli/haskell-opaleye.git
+  commit: e9a29582ac66198dd2c2fdc3f8c8a4b1e6fbe004
 - git: https://github.com/robstewart57/rdf4h.git
   commit: 4fd2edf30c141600ffad6d730cc4c1c08a6dbce4
   # External Data API connectors
@@ -98,12 +98,14 @@ extra-deps:
   commit: b9fca8beee0f23c17a6b2001ec834d071709e6e7
   subdirs:
     - packages/base
+  # Temporary fork of boolexpr
+- git: https://github.com/adinapoli/boolexpr.git
+  commit: 91928b5d7f9342e9865dde0d94862792d2b88779
   # Others dependencies (using stack resolver)
 - HSvm-0.1.1.3.22
 - KMP-0.2.0.0@sha256:6dfbac03ef00ebd9347234732cb86a40f62ab5a80c0cc6bedb8eb51766f7df28,2562
 - MissingH-1.4.3.0@sha256:32f9892ec98cd21df4f4d3ed8d95a3831ae74287ea0641d6f09b2dc6ef061d39,4859
 - Unique-0.4.7.8@sha256:9661f45aa31dde119a2114566166ea38b011a45653337045ee4ced75636533c0,2067
-- boolexpr-0.2
 - constraints-extras-0.3.1.0@sha256:12016ebb91ad5ed2c82bf7e48c6bd6947d164d33c9dca5ac3965de1bb6c780c0,1777
 - context-0.2.0.0@sha256:6b643adb4a64fe521873d08df0497f71f88e18b9ecff4b68b4eef938e446cfc9,1886
 - dependent-sum-0.7.1.0@sha256:0e419237f5b86da3659772afff9cab355c0f8d5b3fdb15a5b30e673d8dc83941,2147

test-data/docker-compose.yml

+version: '3'
+
+services:
+  corenlp:
+    image: 'cgenie/corenlp-garg:4.5.4'
+    ports:
+      - 9000:9000

test-data/test_config.ini

@@ -16,3 +16,8 @@ MAX_DOCS_SCRAPERS = 10000
 JS_JOB_TIMEOUT = 1800
 JS_ID_TIMEOUT = 1800
 PUBMED_API_KEY = "no_key"
+
+[nlp]
+EN = corenlp://localhost:9000
+FR = spacy://localhost:8001
+All = corenlp://localhost:9000

test/Core/Text/Corpus/Query.hs

@@ -42,6 +42,10 @@ tests = withResource pubmedSettings (const (pure ())) $ \getPubmedKey ->
   , testProperty "Parses 'A AND B -C'   (left associative)" testParse05
   , testProperty "Parses 'A AND (B -C)' (right associative)" testParse05_01
   , testProperty "Parses (A OR B OR NOT C) AND (D OR E OR F) -(G OR H OR I)" testParse06
+  , testProperty "It supports '\"Haskell\" AND \"Idris\"'" testParse07
+  , testProperty "It supports 'Haskell AND Idris'" testParse07_01
+  , testProperty "It supports 'Raphael'" testParse07_02
+  , testProperty "It supports 'Niki', 'Ajeje' and 'Orf'" testParse07_03
   , testCase     "Parses words into a single constant" testWordsIntoConst
   , testGroup "Arxiv expression converter" [
       testCase "It supports 'A AND B'"     testArxiv01_01
@@ -124,6 +128,27 @@ testParse06 =
       )
     )
 
+testParse07 :: Property
+testParse07 =
+  translatesInto "\"Haskell\" AND \"Agda\""
+    ((BConst (Positive  "Haskell") `BAnd` (BConst (Positive  "Agda"))))
+
+testParse07_01 :: Property
+testParse07_01 =
+  translatesInto "Haskell AND Agda"
+    ((BConst (Positive  "Haskell") `BAnd` (BConst (Positive  "Agda"))))
+
+testParse07_02 :: Property
+testParse07_02 =
+  translatesInto "Raphael"
+    ((BConst (Positive  "Raphael")))
+
+testParse07_03 :: Property
+testParse07_03 =
+  translatesInto "Niki" ((BConst (Positive "Niki"))) .&&.
+  translatesInto "Ajeje" ((BConst (Positive "Ajeje"))) .&&.
+  translatesInto "Orf" ((BConst (Positive "Orf")))
+
 testWordsIntoConst :: Assertion
 testWordsIntoConst =
   let (expected :: BoolExpr Term) =

test/Database/Operations.hs

@@ -3,33 +3,32 @@
 {-# LANGUAGE TypeApplications     #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans      #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Database.Operations (
    tests
   ) where
 
 import Control.Exception hiding (assert)
-import Control.Lens hiding (elements)
 import Control.Monad.Except
 import Control.Monad.Reader
-import Control.Monad.Trans.Control
-import Data.IORef
 import Data.Pool hiding (withResource)
 import Data.String
 import Database.PostgreSQL.Simple
+import Gargantext.API.Node.Corpus.Update
+import Gargantext.Core
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.User
 import Gargantext.Database.Action.User.New
-import Gargantext.Database.Prelude
-import Gargantext.Database.Query.Table.Node.Error
+import Gargantext.Database.Admin.Types.Hyperdata.Corpus
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Table.Node (mk, getCorporaWithParentId, getOrMkList)
+import Gargantext.Database.Query.Tree.Root (getRootId)
+import Gargantext.Database.Schema.Node (NodePoly(..))
 import Gargantext.Prelude
 import Gargantext.Prelude.Config
 import Prelude
 import Shelly hiding (FilePath, run)
-import Test.QuickCheck.Monadic
-import Test.Hspec
-import Test.Tasty.HUnit hiding (assert)
-import Test.Tasty.QuickCheck
 import qualified Data.Pool as Pool
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
@@ -38,7 +37,16 @@ import qualified Database.PostgreSQL.Simple.Options as Client
 import qualified Database.Postgres.Temp as Tmp
 import qualified Shelly as SH
 
+import Database.Operations.Types
+import Database.Operations.DocumentSearch
 import Paths_gargantext
+import Test.Hspec
+import Test.QuickCheck.Monadic
+import Test.Tasty.HUnit hiding (assert)
+import Test.Tasty.QuickCheck
+import Gargantext.Database.Admin.Trigger.Init
+import Gargantext.Database.Action.Flow
+import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 
 -- | Keeps a log of usernames we have already generated, so that our
 -- roundtrip tests won't fail.
@@ -57,45 +65,6 @@ dbUser = "gargantua"
 dbPassword = "gargantua_test"
 dbName = "gargandb_test"
 
-newtype Counter = Counter { _Counter :: IORef Int }
-  deriving Eq
-
-instance Show Counter where
-  show (Counter _) = "Counter"
-
-emptyCounter :: IO Counter
-emptyCounter = Counter <$> newIORef 0
-
-nextCounter :: Counter -> IO Int
-nextCounter (Counter ref) = atomicModifyIORef' ref (\old -> (succ old, old))
-
-data TestEnv = TestEnv {
-    test_db          :: !DBHandle
-  , test_config      :: !GargConfig
-  , test_usernameGen :: !Counter
-  }
-
-newtype TestMonad a = TestMonad { runTestMonad :: ReaderT TestEnv IO a }
-  deriving ( Functor, Applicative, Monad
-           , MonadReader TestEnv, MonadError IOException
-           , MonadBase IO
-           , MonadBaseControl IO
-           )
-
-data DBHandle = DBHandle {
-    _DBHandle :: Pool PG.Connection
-  , _DBTmp    :: Tmp.DB
-  }
-
-instance HasNodeError IOException where
-  _NodeError = prism' (userError . show) (const Nothing)
-
-instance HasConnectionPool TestEnv where
-  connPool = to (_DBHandle . test_db)
-
-instance HasConfig TestEnv where
-  hasConfig = to test_config
-
 fakeIniPath :: IO FilePath
 fakeIniPath = getDataFileName "test-data/test_config.ini"
 
@@ -144,11 +113,22 @@ withTestDB = bracket setup teardown
 
 tests :: Spec
 tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
-  describe "Read/Writes" $
+  describe "Prelude" $ do
+    it "setup DB triggers" setupEnvironment
+  describe "Read/Writes" $ do
     describe "User creation" $ do
       it "Simple write/read" writeRead01
       it "Simple duplicate"  mkUserDup
       it "Read/Write roundtrip" prop_userCreationRoundtrip
+    describe "Corpus creation" $ do
+      it "Simple write/read" corpusReadWrite01
+      it "Can add language to Corpus" corpusAddLanguage
+      it "Can add documents to a Corpus" corpusAddDocuments
+    describe "Corpus search" $ do
+      it "Can stem query terms" stemmingTest
+      it "Can perform a simple search inside documents" corpusSearch01
+      it "Can perform search by author in documents" corpusSearch02
+      it "Can perform more complex searches using the boolean API" corpusSearch03
 
 data ExpectedActual a =
     Expected a
@@ -160,6 +140,16 @@ instance Eq a => Eq (ExpectedActual a) where
   (Actual a)   == (Expected b) = a == b
   _ == _ = False
 
+setupEnvironment :: TestEnv -> IO ()
+setupEnvironment env = flip runReaderT env $ runTestMonad $ do
+  void $ initFirstTriggers "secret_key"
+  void $ new_user $ mkNewUser (userMaster <> "@cnrs.com") (GargPassword "secret_key")
+  (masterUserId, _masterRootId, masterCorpusId)
+              <- getOrMk_RootWithCorpus (UserName userMaster)
+                                        (Left corpusMasterName)
+                                        (Nothing :: Maybe HyperdataCorpus)
+  masterListId <- getOrMkList masterCorpusId masterUserId
+  void $ initLastTriggers masterListId
 
 writeRead01 :: TestEnv -> Assertion
 writeRead01 env = do
@@ -170,14 +160,14 @@ writeRead01 env = do
     uid1 <- new_user nur1
     uid2 <- new_user nur2
 
-    liftBase $ uid1 `shouldBe` 1
-    liftBase $ uid2 `shouldBe` 2
+    liftBase $ uid1 `shouldBe` 2
+    liftBase $ uid2 `shouldBe` 3
 
     -- Getting the users by username returns the expected IDs
     uid1' <- getUserId (UserName "alfredo")
     uid2' <- getUserId (UserName "paul")
-    liftBase $ uid1' `shouldBe` 1
-    liftBase $ uid2' `shouldBe` 2
+    liftBase $ uid1' `shouldBe` 2
+    liftBase $ uid2' `shouldBe` 3
 
 mkUserDup :: TestEnv -> Assertion
 mkUserDup env = do
@@ -206,3 +196,26 @@ prop_userCreationRoundtrip env = monadicIO $ do
   uid <- runEnv env (new_user nur)
   ur' <- runEnv env (getUserId (UserName $ _nu_username nur))
   run (Expected uid `shouldBe` Actual ur')
+
+-- | We test that we can create and later read-back a 'Corpus'.
+corpusReadWrite01 :: TestEnv -> Assertion
+corpusReadWrite01 env = do
+  flip runReaderT env $ runTestMonad $ do
+    uid      <- getUserId (UserName "alfredo")
+    parentId <- getRootId (UserName "alfredo")
+    [corpusId] <- mk (Just "Test_Corpus") (Nothing :: Maybe HyperdataCorpus) parentId uid
+    liftIO $ corpusId `shouldBe` NodeId 416
+    -- Retrieve the corpus by Id
+    [corpus] <- getCorporaWithParentId parentId
+    liftIO $ corpusId `shouldBe` (_node_id corpus)
+
+-- | We test that we can update the existing language for a 'Corpus'.
+corpusAddLanguage :: TestEnv -> Assertion
+corpusAddLanguage env = do
+  flip runReaderT env $ runTestMonad $ do
+    parentId <- getRootId (UserName "alfredo")
+    [corpus] <- getCorporaWithParentId parentId
+    liftIO $ (_hc_lang . _node_hyperdata $ corpus) `shouldBe` Just EN -- defaults to English
+    addLanguageToCorpus (_node_id corpus) IT
+    [corpus'] <- getCorporaWithParentId parentId
+    liftIO $ (_hc_lang . _node_hyperdata $ corpus') `shouldBe` Just IT

test/Database/Operations/DocumentSearch.hs

+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+module Database.Operations.DocumentSearch where
+
+import Prelude
+
+import Control.Monad.Reader
+import Data.Aeson.QQ.Simple
+import Data.Aeson.Types
+import Data.Maybe
+import Gargantext.Core
+import Gargantext.Core.Types.Individu
+import Gargantext.Database.Action.Flow
+import Gargantext.Database.Action.Search
+import Gargantext.Database.Admin.Types.Hyperdata.Document
+import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Query.Tree.Root
+import Gargantext.Database.Schema.Node (NodePoly(..))
+import Network.URI (parseURI)
+
+import Database.Operations.Types
+import Test.Hspec.Expectations
+import Test.Tasty.HUnit
+import Gargantext.Core.Text.Terms.Mono.Stem.En
+import Gargantext.Database.Admin.Config (userMaster)
+import qualified Data.Text as T
+import qualified Gargantext.Core.Text.Corpus.Query as API
+import Gargantext.Database.Query.Facet
+
+
+exampleDocument_01 :: HyperdataDocument
+exampleDocument_01 = either error id $ parseEither parseJSON $ [aesonQQ|
+  { "doi":"01"
+  , "publication_day":6
+  , "language_iso2":"EN"
+  , "publication_minute":0
+  , "publication_month":7
+  , "language_iso3":"eng"
+  , "publication_second":0
+  , "authors":"Nils Hovdenak, Kjell Haram"
+  , "publication_year":2012
+  , "publication_date":"2012-07-06 00:00:00+00:00"
+  , "language_name":"English"
+  , "realdate_full_":"2012 01 12"
+  , "source":"European journal of obstetrics, gynecology, and reproductive biology Institute"
+  , "abstract":"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome."
+  , "title":"Influence of mineral and vitamin supplements on pregnancy outcome."
+  , "publication_hour":0
+  }
+|]
+
+exampleDocument_02 :: HyperdataDocument
+exampleDocument_02 = either error id $ parseEither parseJSON $ [aesonQQ|
+  { "doi":""
+  , "uniqId": "1405.3072v3"
+  , "bdd": "Arxiv"
+  , "publication_day":6
+  , "language_iso2":"EN"
+  , "publication_second":0
+  , "authors":"Ajeje Brazorf, Manuel Agnelli"
+  , "publication_year":2012
+  , "publication_date":"2012-07-06 00:00:00+00:00"
+  , "language_name":"English"
+  , "realdate_full_":"2012 01 12"
+  , "source":"Malagrotta Institute of Technology"
+  , "abstract":"We present PyPlasm, an innovative approach to computational graphics"
+  , "title":"PyPlasm: computational geometry made easy"
+  , "publication_hour":0
+  }
+|]
+
+exampleDocument_03 :: HyperdataDocument
+exampleDocument_03 = either error id $ parseEither parseJSON $ [aesonQQ|
+{
+    "bdd": "Arxiv"
+  , "doi": ""
+  , "url": "http://arxiv.org/pdf/1405.3072v2"
+  , "title": "Haskell for OCaml programmers"
+  , "source": ""
+  , "uniqId": "1405.3072v2"
+  , "authors": "Raphael Poss, Herbert Ballerina"
+  , "abstract": "  This introduction to Haskell is written to optimize learning by programmers who already know OCaml. "
+  , "institutes": ""
+  , "language_iso2": "EN"
+  , "publication_date": "2014-05-13T09:10:32Z"
+  , "publication_year": 2014
+}
+|]
+
+exampleDocument_04 :: HyperdataDocument
+exampleDocument_04 = either error id $ parseEither parseJSON $ [aesonQQ|
+{
+    "bdd": "Arxiv"
+  , "doi": ""
+  , "url": "http://arxiv.org/pdf/1407.5670v1"
+  , "title": "Rust for functional programmers"
+  , "source": ""
+  , "uniqId": "1407.5670v1"
+  , "authors": "Raphael Poss"
+  , "abstract": "  This article provides an introduction to Rust , a systems language by Mozilla , to programmers already familiar with Haskell , OCaml or other functional languages. " , "institutes": ""
+  , "language_iso2": "EN"
+  , "publication_date": "2014-07-21T21:20:31Z"
+  , "publication_year": 2014
+}
+|]
+
+nlpServerConfig :: NLPServerConfig
+nlpServerConfig =
+  let uri = parseURI "http://localhost:9000"
+  in NLPServerConfig CoreNLP (fromMaybe (error "parseURI for nlpServerConfig failed") uri)
+
+corpusAddDocuments :: TestEnv -> Assertion
+corpusAddDocuments env = do
+  flip runReaderT env $ runTestMonad $ do
+    -- NOTE(adn) We need to create user 'gargantua'(!!) in order
+    -- for 'addDocumentsToHyperCorpus' to work.
+    parentId <- getRootId (UserName userMaster)
+    [corpus] <- getCorporaWithParentId parentId
+    let corpusId = _node_id corpus
+
+    ids <- addDocumentsToHyperCorpus nlpServerConfig
+                                     (Just $ _node_hyperdata $ corpus)
+                                     (Multi EN)
+                                     corpusId
+                                     [exampleDocument_01, exampleDocument_02, exampleDocument_03, exampleDocument_04]
+    liftIO $ length ids `shouldBe` 4
+
+stemmingTest :: TestEnv -> Assertion
+stemmingTest _env = do
+  stemIt "Ajeje"    `shouldBe` "Ajeje"
+  stemIt "PyPlasm:" `shouldBe` "PyPlasm:"
+
+mkQ :: T.Text -> API.Query
+mkQ txt = either (\e -> error $ "(query) = " <> T.unpack txt <> ": " <> e) id . API.parseQuery . API.RawQuery $ txt
+
+corpusSearch01 :: TestEnv -> Assertion
+corpusSearch01 env = do
+  flip runReaderT env $ runTestMonad $ do
+
+    parentId <- getRootId (UserName userMaster)
+    [corpus] <- getCorporaWithParentId parentId
+
+    results1 <- searchInCorpus (_node_id corpus) False (mkQ "mineral") Nothing Nothing Nothing
+    results2 <- searchInCorpus (_node_id corpus) False (mkQ "computational") Nothing Nothing Nothing
+
+    liftIO $ length results1 `shouldBe` 1
+    liftIO $ length results2 `shouldBe` 1
+
+-- | Check that we support more complex queries
+corpusSearch02 :: TestEnv -> Assertion
+corpusSearch02 env = do
+  flip runReaderT env $ runTestMonad $ do
+
+    parentId <- getRootId (UserName userMaster)
+    [corpus] <- getCorporaWithParentId parentId
+
+    results1 <- searchInCorpus (_node_id corpus) False (mkQ "Raphael") Nothing Nothing Nothing
+    results2 <- searchInCorpus (_node_id corpus) False (mkQ "Raphael Poss") Nothing Nothing Nothing
+
+    liftIO $ do
+      length results1 `shouldBe` 2 -- Haskell & Rust
+      map facetDoc_title results2 `shouldBe` ["Haskell for OCaml programmers", "Rust for functional programmers"]
+
+-- | Check that we support more complex queries via the bool API
+corpusSearch03 :: TestEnv -> Assertion
+corpusSearch03 env = do
+  flip runReaderT env $ runTestMonad $ do
+
+    parentId <- getRootId (UserName userMaster)
+    [corpus] <- getCorporaWithParentId parentId
+
+    results1 <- searchInCorpus (_node_id corpus) False (mkQ "\"Manuel Agnelli\"") Nothing Nothing Nothing
+    results2 <- searchInCorpus (_node_id corpus) False (mkQ "Raphael AND -Rust") Nothing Nothing Nothing
+    results3 <- searchInCorpus (_node_id corpus) False (mkQ "(Raphael AND (NOT Rust)) OR PyPlasm") Nothing Nothing Nothing
+
+    liftIO $ do
+      length results1 `shouldBe` 1
+      map facetDoc_title results2 `shouldBe` ["Haskell for OCaml programmers"]
+      map facetDoc_title results3 `shouldBe` ["PyPlasm: computational geometry made easy", "Haskell for OCaml programmers"]

test/Database/Operations/Types.hs

+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-orphans      #-}
+
+module Database.Operations.Types where
+
+import Control.Exception
+import Control.Lens
+import Control.Monad.Except
+import Control.Monad.Reader
+import Control.Monad.Trans.Control
+import Data.IORef
+import Data.Pool
+import Gargantext
+import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.API.Prelude
+import Gargantext.Database.Query.Table.Node.Error
+import Gargantext.Prelude.Config
+import Gargantext.Utils.Jobs
+import Prelude
+import qualified Database.PostgreSQL.Simple as PG
+import qualified Database.Postgres.Temp as Tmp
+import qualified Gargantext.API.Admin.EnvTypes as EnvTypes
+
+newtype Counter = Counter { _Counter :: IORef Int }
+  deriving Eq
+
+instance Show Counter where
+  show (Counter _) = "Counter"
+
+emptyCounter :: IO Counter
+emptyCounter = Counter <$> newIORef 0
+
+nextCounter :: Counter -> IO Int
+nextCounter (Counter ref) = atomicModifyIORef' ref (\old -> (succ old, old))
+
+data TestEnv = TestEnv {
+    test_db                  :: !DBHandle
+  , test_config              :: !GargConfig
+  , test_usernameGen         :: !Counter
+  }
+
+newtype TestMonad a = TestMonad { runTestMonad :: ReaderT TestEnv IO a }
+  deriving ( Functor, Applicative, Monad
+           , MonadReader TestEnv, MonadError IOException
+           , MonadBase IO
+           , MonadBaseControl IO
+           , MonadFail
+           , MonadIO
+           )
+
+instance MonadJobStatus TestMonad where
+  type JobHandle      TestMonad = EnvTypes.ConcreteJobHandle GargError
+  type JobType        TestMonad = GargJob
+  type JobOutputType  TestMonad = JobLog
+  type JobEventType   TestMonad = JobLog
+
+  getLatestJobStatus _  = TestMonad (pure noJobLog)
+  withTracer _ jh n     = n jh
+  markStarted _ _       = TestMonad $ pure ()
+  markProgress _ _      = TestMonad $ pure ()
+  markFailure _ _ _     = TestMonad $ pure ()
+  markComplete _        = TestMonad $ pure ()
+  markFailed _ _        = TestMonad $ pure ()
+  addMoreSteps _ _      = TestMonad $ pure ()
+
+data DBHandle = DBHandle {
+    _DBHandle :: Pool PG.Connection
+  , _DBTmp    :: Tmp.DB
+  }
+
+instance HasNodeError IOException where
+  _NodeError = prism' (userError . show) (const Nothing)
+
+instance HasConnectionPool TestEnv where
+  connPool = to (_DBHandle . test_db)
+
+instance HasConfig TestEnv where
+  hasConfig = to test_config
+

test/hspec/Main.hs

@@ -3,10 +3,29 @@ module Main where
 
 import Gargantext.Prelude
 
+import Control.Exception
+import Shelly hiding (FilePath)
+import System.Process
+import System.IO
 import qualified Database.Operations     as DB
 
 import Test.Hspec
 
+startCoreNLPServer :: IO ProcessHandle
+startCoreNLPServer = do
+  devNull <- openFile "/dev/null" WriteMode
+  let p = proc "./startServer.sh" []
+  (_, _, _, hdl) <- createProcess $ p { cwd = Just "devops/coreNLP/stanford-corenlp-current"
+                    , delegate_ctlc = True
+                    , create_group = True
+                    , std_out = UseHandle devNull
+                    , std_err = UseHandle devNull
+                    }
+  pure hdl
+
+stopCoreNLPServer :: ProcessHandle -> IO ()
+stopCoreNLPServer = interruptProcessGroupOf
+
 -- It's especially important to use Hspec for DB tests, because,
 -- unlike 'tasty', 'Hspec' has explicit control over parallelism,
 -- and it's important that DB tests are run according to a very
@@ -14,5 +33,11 @@ import Test.Hspec
 -- Unfortunately it's not possibly to use the 'tasty-hspec' adapter
 -- because by the time we get a 'TestTree' out of the adapter library,
 -- the information about parallelism is lost.
+--
+-- /IMPORTANT/: For these tests to run correctly, you have to run
+-- ./devops/coreNLP/build.sh first. You have to run it only /once/,
+-- and then you are good to go for the time being.
 main :: IO ()
-main = hspec DB.tests
+main = do
+  hSetBuffering stdout NoBuffering
+  bracket startCoreNLPServer stopCoreNLPServer (const (hspec DB.tests))

test/tasty/Main.hs

@@ -14,7 +14,6 @@ import Gargantext.Prelude
 
 import qualified Core.Text.Corpus.Query  as CorpusQuery
 import qualified Core.Utils              as Utils
-import qualified Database.Operations     as DB
 import qualified Graph.Clustering        as Graph
 import qualified Ngrams.NLP              as NLP
 import qualified Ngrams.Query            as NgramsQuery