Merge branch 'dev' into 471-dev-node-multiterms

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

@@ -14,8 +14,8 @@ import Data.Aeson.Encode.Pretty
 import Data.ByteString qualified as B
 import Data.ByteString.Lazy qualified as BL
 import Gargantext.API.Routes.Named
+import Gargantext.Prelude
 import Options.Applicative
-import Prelude
 import Servant.API
 import Servant.API.Routes
 import Servant.API.WebSocket qualified as WS (WebSocketPending)
@@ -52,6 +52,6 @@ instance HasRoutes Raw where
 routesCLI :: CLIRoutes -> IO ()
 routesCLI = \case
   CLIR_list
-    -> printRoutes @(NamedRoutes API)
+    -> printRoutesSorted @(NamedRoutes API)
   (CLIR_export filePath)
     -> B.writeFile filePath . BL.toStrict $ encodePretty (getRoutes @(NamedRoutes API))

bin/update-project-dependencies

@@ -16,8 +16,8 @@ fi
 # with the `sha256sum` result calculated on the `cabal.project` and
 # `cabal.project.freeze`. This ensures the files stay deterministic so that CI
 # cache can kick in.
-expected_cabal_project_hash="7d021a8e3d0b68421e26bdfe4e1da82f6ea26b6c420fc984b3c30c14bc5fea98"
-expected_cabal_project_freeze_hash="553b98aadb35506a305bd740cdd71f5fadc1e6d55d10f91cf39daa6735a63d78"
+expected_cabal_project_hash="c7e0466c8d4c1ca88b4f3d62d022bd29329d44afc48fffbcfacf0f65293acba8"
+expected_cabal_project_freeze_hash="553b98aadb35506a305bd740cdd71f5fadc1e6d55d10f91cf39daa6735a63d78" 
 
 
 cabal --store-dir=$STORE_DIR v2-build --dry-run

cabal.project

@@ -146,7 +146,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/fpringle/servant-routes.git
-    tag: 7694f62af6bc1596d754b42af16da131ac403b3a
+    tag: c3c558d9278ef239a474f1e1b69afc461be60d01
 
 source-repository-package
     type: git

gargantext.cabal

@@ -120,7 +120,6 @@ library
       Gargantext.API.Admin.Orchestrator.Types
       Gargantext.API.Admin.Settings
       Gargantext.API.Auth.PolicyCheck
-      Gargantext.API.Count.Types
       Gargantext.API.Dev
       Gargantext.API.Errors
       Gargantext.API.Errors.Class
@@ -166,7 +165,6 @@ library
       Gargantext.API.Routes.Named.Contact
       Gargantext.API.Routes.Named.Context
       Gargantext.API.Routes.Named.Corpus
-      Gargantext.API.Routes.Named.Count
       Gargantext.API.Routes.Named.Document
       Gargantext.API.Routes.Named.EKG
       Gargantext.API.Routes.Named.File
@@ -335,7 +333,6 @@ library
       Gargantext.API.Admin.Auth
       Gargantext.API.Admin.FrontEnd
       Gargantext.API.Context
-      Gargantext.API.Count
       Gargantext.API.EKG
       Gargantext.API.GraphQL
       Gargantext.API.GraphQL.Annuaire

src/Gargantext/API/Count.hs

-{-|
-Module      : Gargantext.API.Count
-Description : Server API
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
-Count API part of Gargantext.
--}
-
-{-# OPTIONS_GHC -fno-warn-deprecations #-}
-
-{-# LANGUAGE TemplateHaskell    #-}
-{-# LANGUAGE TypeOperators      #-}
-{-# LANGUAGE DeriveAnyClass     #-}
-
-module Gargantext.API.Count (
-    countAPI
-  ) where
-
-import Gargantext.API.Count.Types
-import Gargantext.API.Routes.Named.Count qualified as Named
-import Gargantext.Prelude
-import Servant.Server.Generic (AsServerT)
-
------------------------------------------------------------------------
--- TODO-ACCESS: CanCount
--- TODO-EVENTS: No events as this is a read only query.
------------------------------------------------------------------------
-countAPI :: Query -> Named.CountAPI (AsServerT m)
-countAPI _ = Named.CountAPI undefined

src/Gargantext/API/Count/Types.hs

-{-|
-Module      : Gargantext.API.Count.Types
-Description : 
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
--}
-
-{-# LANGUAGE TemplateHaskell    #-}
-
-module Gargantext.API.Count.Types (
-    Scraper(..)
-  , QueryBool(..)
-  , Query(..)
-  , Message(..)
-  , Code
-  , Error
-  , Errors
-  , Counts(..)
-  , Count(..)
-
-  -- * functions
-  , scrapers
-  ) where
-
-import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema )
-import Data.Text (pack)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Prelude
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary(..))
-
------------------------------------------------------------------------
-data Scraper = Pubmed | Hal | IsTex | Isidore
-  deriving (Eq, Show, Generic, Enum, Bounded)
-
-scrapers :: [Scraper]
-scrapers = [minBound..maxBound]
-
-instance FromJSON Scraper
-instance ToJSON   Scraper
-
-instance Arbitrary Scraper where
-    arbitrary = elements scrapers
-
-instance ToSchema Scraper
-
------------------------------------------------------------------------
-data QueryBool = QueryBool Text
-        deriving (Eq, Show, Generic)
-
-queries :: [QueryBool]
-queries =  [QueryBool (pack "(X OR X') AND (Y OR Y') NOT (Z OR Z')")]
---queries =  [QueryBool (pack "(X + X') * (Y + Y') - (Z + Z')")]
-
-instance Arbitrary QueryBool where
-    arbitrary = elements queries
-
-instance FromJSON QueryBool
-instance ToJSON   QueryBool
-
-instance ToSchema QueryBool
------------------------------------------------------------------------
-
-data Query = Query { query_query :: QueryBool
-                   , query_name  :: Maybe [Scraper]
-                   }
-                   deriving (Eq, Show, Generic)
-instance FromJSON Query
-instance ToJSON   Query
-
-instance Arbitrary Query where
-    arbitrary = elements [ Query q (Just n) 
-                         | q <- queries
-                         , n <- take 10 $ permutations scrapers
-                         ]
-
-instance ToSchema Query where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
-
------------------------------------------------------------------------
-type Code = Integer
-type Error  = Text
-type Errors = [Error]
-
------------------------------------------------------------------------
-data Message = Message Code Errors
-        deriving (Eq, Show, Generic)
-
-toMessage :: [(Code, Errors)] -> [Message]
-toMessage = map (\(c,err) -> Message c err)
-
-messages :: [Message]
-messages =  toMessage $ [ (400, ["Ill formed query             "])
-                        , (300, ["API connexion error          "])
-                        , (300, ["Internal Gargantext Error    "])
-                        ] <> take 10 ( repeat (200, [""]))
-
-instance Arbitrary Message where
-    arbitrary = elements messages
-
-instance ToSchema Message
------------------------------------------------------------------------
-data Counts = Counts { results :: [Either Message Count]
-                     } deriving (Eq, Show, Generic)
-
-
-instance Arbitrary Counts where
-    arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
-                                 , Right (Count IsTex  (Just 150))
-                                 , Right (Count Hal    (Just 150))
-                                 ]
-                         ]
-
-instance ToSchema Counts
-
------------------------------------------------------------------------
-data Count = Count { count_name    :: Scraper
-                   , count_count   :: Maybe Int
-                   }
-                   deriving (Eq, Show, Generic)
-
-instance ToSchema Count where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
---instance Arbitrary Count where
---    arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
-
---
--- JSON instances
---
-
-instance FromJSON Message
-instance ToJSON   Message
-
-$(deriveJSON (unPrefix "count_") ''Count)
-
-instance FromJSON Counts
-instance ToJSON   Counts
-

src/Gargantext/API/GraphQL.hs

@@ -15,7 +15,6 @@ Portability : POSIX
 {-# LANGUAGE KindSignatures #-}  -- for use of Endpoint (name :: Symbol)
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PartialTypeSignatures #-}  -- to automatically use suggested type hole signatures during compilation
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
 module Gargantext.API.GraphQL where

src/Gargantext/API/GraphQL/Context.hs

@@ -22,8 +22,7 @@ import Data.Morpheus.Types
   , ResolverM
   , QUERY
   )
-import Data.Text (pack, unpack)
-import Data.Text qualified as Text
+import Data.Text (pack)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser )
 import Gargantext.API.Auth.PolicyCheck ( nodeWriteChecks, AccessPolicyManager )
@@ -97,7 +96,7 @@ data ContextsForNgramsArgs
   = ContextsForNgramsArgs
     { corpus_id    :: Int
     , ngrams_terms :: [Text]
-    , and_logic    :: Text
+    , and_logic    :: Bool
     } deriving (Generic, GQLType)
 
 data NodeContextCategoryMArgs = NodeContextCategoryMArgs
@@ -153,9 +152,10 @@ dbNodeContext context_id node_id = do
 -- | Returns list of `ContextGQL` for given ngrams in given corpus id.
 dbContextForNgrams
   :: (IsDBEnvExtra env)
-  => Int -> [Text] -> Text -> GqlM e env [ContextGQL]
+  => Int -> [Text] -> Bool -> GqlM e env [ContextGQL]
 dbContextForNgrams node_id ngrams_terms and_logic = do
-  contextsForNgramsTerms <- lift $ runDBQuery $ getContextsForNgramsTerms (UnsafeMkNodeId node_id) ngrams_terms ( readMaybe $ unpack $ Text.toTitle and_logic )
+  contextsForNgramsTerms <- lift $ runDBQuery $
+    getContextsForNgramsTerms (UnsafeMkNodeId node_id) ngrams_terms and_logic
   --lift $ printDebug "[dbContextForNgrams] contextsForNgramsTerms" contextsForNgramsTerms
   pure $ toContextGQL <$> contextsForNgramsTerms
 

src/Gargantext/API/Ngrams/List.hs

@@ -61,10 +61,13 @@ import Servant.Server.Generic (AsServerT)
 
 
 getAPI :: Named.GETAPI (AsServerT (GargM Env BackendInternalError))
-getAPI = Named.GETAPI $ \listId -> Named.ListEndpoints
-  { listJSONEp    = getJson listId
-  , listJSONZipEp = getJsonZip listId
-  , listTSVEp     = getTsv listId
+getAPI = Named.GETAPI
+  {
+    getListEp = \listId -> Named.ListEndpoints
+                            { listJSONEp    = getJson listId
+                            , listJSONZipEp = getJsonZip listId
+                            , listTSVEp     = getTsv listId
+                            }
   }
 
 --

src/Gargantext/API/Node.hs

@@ -32,7 +32,7 @@ import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser (..), auth
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Auth.PolicyCheck ( nodeReadChecks, nodeWriteChecks, moveChecks, AccessPolicyManager, publishChecks )
 import Gargantext.API.Errors.Types (BackendInternalError)
-import Gargantext.API.Metrics
+import Gargantext.API.Metrics (chartApi, pieApi, scatterApi, treeApi, updateChart)
 import Gargantext.API.Ngrams.Types (TabType(..))
 import Gargantext.API.Node.DocumentUpload qualified as DocumentUpload
 import Gargantext.API.Node.DocumentsFromWriteNodes qualified as DFWN
@@ -40,7 +40,7 @@ import Gargantext.API.Node.File ( fileApi, fileAsyncApi )
 import Gargantext.API.Node.FrameCalcUpload qualified as FrameCalcUpload
 import Gargantext.API.Node.New ( postNode, postNodeAsyncAPI )
 import Gargantext.API.Node.Share qualified as Share
-import Gargantext.API.Node.Types
+import Gargantext.API.Node.Types (NodesToCategory(..), NodesToScore(..), RenameNode(..))
 import Gargantext.API.Node.Update qualified as Update
 import Gargantext.API.Prelude ( GargM, GargServer, IsGargServer )
 import Gargantext.API.Routes.Named.File qualified as Named
@@ -61,14 +61,14 @@ import Gargantext.Database.Action.Delete qualified as Action (deleteNode)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny, HyperdataCorpus, HyperdataAnnuaire)
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( HyperdataC )
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude
-import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Admin.Types.Node (CorpusId, NodeId, ParentId, RootId, UserId)
+import Gargantext.Database.Prelude (DBCmdExtra, JSONB, runDBTx, runDBQuery)
+import Gargantext.Database.Query.Table.Node (defaultList, deleteNodes, getNodeWith, getNodesWithParentId)
 import Gargantext.Database.Query.Table.Node.Children (getChildren)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
-import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
-import Gargantext.Database.Query.Table.Node.Update qualified as U (update, Update(..), publish)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
+import Gargantext.Database.Query.Table.Node.Update qualified as U (update, Update(..), publish)
+import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
 import Gargantext.Database.Query.Table.NodeContext (nodeContextsCategory, nodeContextsScore)
 import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Database.Query.Tree (tree, tree_flat, TreeMode(..))
@@ -249,11 +249,11 @@ genericNodeAPI' :: forall a proxy. ( HyperdataC a )
                 -> Named.NodeAPI a (AsServerT (GargM Env BackendInternalError))
 genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
   { nodeNodeAPI        = withNamedPolicyT authenticatedUser (nodeReadChecks targetNode) $
-                           Named.NodeNodeAPI $ runDBQuery (getNodeWith targetNode (Proxy :: Proxy a))
+                           Named.NodeNodeAPI { getNodeEp = runDBQuery $ getNodeWith targetNode (Proxy :: Proxy a) }
   , renameAPI          = withNamedPolicyT authenticatedUser (nodeWriteChecks targetNode) $
-                           Named.RenameAPI   $ rename loggedInUserId targetNode
+                           Named.RenameAPI { renameEp = rename loggedInUserId targetNode }
   , postNodeAPI        = withNamedPolicyT authenticatedUser (nodeWriteChecks targetNode) $
-                           Named.PostNodeAPI $ postNode authenticatedUser targetNode
+                           Named.PostNodeAPI { postWithParentEp = postNode authenticatedUser targetNode }
   , postNodeAsyncAPI   = withNamedPolicyT authenticatedUser (nodeWriteChecks targetNode) $
                            postNodeAsyncAPI authenticatedUser targetNode
   , frameCalcUploadAPI = FrameCalcUpload.api authenticatedUser targetNode
@@ -262,30 +262,29 @@ genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
                            Update.api targetNode
   , deleteEp           = withPolicy authenticatedUser (nodeWriteChecks targetNode) $
                            Action.deleteNode userRootId targetNode
-  , childrenAPI        = Named.ChildrenAPI $ \mb_nty mb_off mb_lim ->
-      runDBQuery $ getChildren targetNode (Proxy :: Proxy a) mb_nty mb_off mb_lim
+  , childrenAPI        = Named.ChildrenAPI { summaryChildrenEp = \nt o l -> runDBQuery $ getChildren targetNode (Proxy :: Proxy a) nt o l }
   , tableAPI           = tableApi targetNode
   , tableNgramsAPI     = apiNgramsTableCorpus targetNode
-  , catAPI             = Named.CatAPI $ catApi targetNode
-  , scoreAPI           = Named.ScoreAPI $ scoreApi targetNode
+  , catAPI             = Named.CatAPI { categoriseEp = catApi targetNode }
+  , scoreAPI           = Named.ScoreAPI { scoreNodesEp = scoreApi targetNode }
   , searchAPI          = Search.api targetNode
-  , shareAPI           = Named.ShareNode $ Share.api userRootId targetNode
+  , shareAPI           = Named.ShareNode { shareNodeEp = Share.api userRootId targetNode }
   , unshareEp          = Share.unShare targetNode
   , publishAPI         = withNamedPolicyT authenticatedUser (publishChecks targetNode) $
-                           Named.PublishAPI $ \Named.PublishRequest{pubrq_policy} -> runDBTx $ U.publish loggedInUserId targetNode pubrq_policy
+                           Named.PublishAPI { publishEp = \Named.PublishRequest{pubrq_policy} -> runDBTx $ U.publish loggedInUserId targetNode pubrq_policy }
   ---- Pairing utilities
   , pairWithEp         = pairWith targetNode
   , pairsEp            = pairs targetNode
-  , pairingEp          = Named.PairingAPI $ getPair targetNode
+  , pairingEp          = Named.PairingAPI { getPairingEp = getPair targetNode }
   ---- VIZ
   , scatterAPI         = scatterApi targetNode
   , chartAPI           = chartApi targetNode
   , pieAPI             = pieApi targetNode
   , treeAPI            = treeApi targetNode
   , phyloAPI           = phyloAPI targetNode
-  , moveAPI            = Named.MoveAPI $ \parentId ->
+  , moveAPI            = Named.MoveAPI { moveNodeEp = \parentId ->
                            withPolicy authenticatedUser (moveChecks (SourceId targetNode) (TargetId parentId)) $
-                             moveNode loggedInUserId targetNode parentId
+                             moveNode loggedInUserId targetNode parentId }
   , fileAPI            = Named.FileAPI { fileDownloadEp = fileApi targetNode }
   , fileAsyncAPI       = fileAsyncApi authenticatedUser targetNode
   , dfwnAPI            = DFWN.api authenticatedUser targetNode

src/Gargantext/API/Routes/Named/Corpus.hs

@@ -24,7 +24,7 @@ module Gargantext.API.Routes.Named.Corpus (
 import Data.Aeson.TH (deriveJSON)
 import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
 import Data.Text (Text)
-import GHC.Generics
+import GHC.Generics (Generic)
 import Gargantext.API.Node.Corpus.Export.Types (Corpus, CorpusSQLite)
 import Gargantext.API.Node.Types (NewWithForm, WithQuery)
 import Gargantext.API.Worker (WorkerAPI)

src/Gargantext/API/Routes/Named/Count.hs

-{-# LANGUAGE TypeOperators #-}
-
-module Gargantext.API.Routes.Named.Count (
-  -- * Routes types
-    CountAPI(..)
-
-  -- * Re-exports
-  , module X
-  ) where
-
-import GHC.Generics (Generic)
-import Gargantext.API.Count.Types as X
-import Servant
-
-
-newtype CountAPI mode = CountAPI
-  { postCountsEp :: mode :- Post '[JSON] X.Counts
-  } deriving Generic

src/Gargantext/API/Routes/Named/Private.hs

@@ -30,19 +30,18 @@ import Gargantext.API.Auth.PolicyCheck (PolicyChecked)
 import Gargantext.API.Routes.Named.Contact (ContactAPI)
 import Gargantext.API.Routes.Named.Context (ContextAPI)
 import Gargantext.API.Routes.Named.Corpus (AddWithTempFile, AddWithQuery, CorpusExportAPI, MakeSubcorpusAPI)
-import Gargantext.API.Routes.Named.Count (CountAPI, Query)
 import Gargantext.API.Routes.Named.Document (DocumentExportAPI)
 import Gargantext.API.Routes.Named.List (GETAPI, JSONAPI, TSVAPI)
-import Gargantext.API.Routes.Named.Node
-import Gargantext.API.Routes.Named.Remote
-import Gargantext.API.Routes.Named.Share
-import Gargantext.API.Routes.Named.Table
-import Gargantext.API.Routes.Named.Tree
-import Gargantext.API.Routes.Named.Viz
-import Gargantext.Database.Admin.Types.Hyperdata.Any
-import Gargantext.Database.Admin.Types.Hyperdata.Corpus
-import Gargantext.Database.Admin.Types.Node
-import GHC.Generics
+import Gargantext.API.Routes.Named.Node (NodeAPI, NodesAPI, NodeNodeAPI, Roots)
+import Gargantext.API.Routes.Named.Remote (RemoteImportAPI)
+import Gargantext.API.Routes.Named.Share (ShareURL)
+import Gargantext.API.Routes.Named.Table (TableNgramsAPI)
+import Gargantext.API.Routes.Named.Tree (NodeTreeAPI, TreeFlatAPI)
+import Gargantext.API.Routes.Named.Viz (GraphAPI, PhyloExportAPI)
+import Gargantext.Database.Admin.Types.Hyperdata.Any (HyperdataAny)
+import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataAnnuaire, HyperdataCorpus)
+import Gargantext.Database.Admin.Types.Node (ContextId, CorpusId, DocId, NodeId)
+import GHC.Generics (Generic)
 import Servant.API
 import Servant.Auth qualified as SA
 
@@ -81,9 +80,6 @@ data GargPrivateAPI' mode = GargPrivateAPI'
                                          :> NamedRoutes DocumentExportAPI
   , phyloExportAPI    :: mode :- "phylo" :> Capture "node_id" DocId
                                          :> NamedRoutes PhyloExportAPI
-  , countAPI :: mode :- "count" :> Summary "Count endpoint"
-                                :> ReqBody '[JSON] Query
-                                :> NamedRoutes CountAPI
   , graphAPI :: mode :- "graph" :> Summary "Graph endpoint"
                                 :> Capture "graph_id" NodeId
                                 :> NamedRoutes GraphAPI

src/Gargantext/API/Routes/Named/Remote.hs

+{-|
+Module      : Gargantext.API.Routes.Named.Remote
+Description : Server API
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
 
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE TypeOperators #-}
+
 module Gargantext.API.Routes.Named.Remote (
   -- * Routes types
     RemoteExportAPI(..)
@@ -13,16 +25,15 @@ import Conduit qualified as C
 import Data.Aeson as JSON
 import Data.ByteString.Lazy qualified as BL
 import Data.ByteString qualified as BS
-import Data.Proxy
-import Data.Swagger hiding (Http)
+import Data.Proxy (Proxy(Proxy))
+import Data.Swagger (NamedSchema(..), ToSchema, declareNamedSchema, binarySchema, sketchStrictSchema)
 import Gargantext.API.Admin.Auth.Types (Token)
 import Gargantext.API.Auth.PolicyCheck (PolicyChecked)
 import Gargantext.Database.Admin.Types.Node ( NodeId (..) )
-import GHC.Generics
+import GHC.Generics (Generic)
 import Prelude
 import Servant.API
-import Servant.Client.Core.BaseUrl
-import Test.QuickCheck
+import Servant.Client.Core.BaseUrl (BaseUrl(..), parseBaseUrl, Scheme(Http))
 
 
 data RemoteExportAPI mode = RemoteExportAPI
@@ -42,9 +53,6 @@ data RemoteExportRequest =
   , _rer_instance_auth :: Token
   } deriving (Show, Eq, Generic)
 
-instance Arbitrary RemoteExportRequest where
-  arbitrary = RemoteExportRequest <$> (pure (BaseUrl Http "dev.sub.gargantext.org" 8008 "")) <*> arbitrary
-
 instance ToJSON RemoteExportRequest where
   toJSON RemoteExportRequest{..}
     = JSON.object [ "instance_url"  .= toJSON _rer_instance_url

src/Gargantext/API/Routes/Named/Share.hs

@@ -17,7 +17,7 @@ import Data.Aeson (withText)
 import Data.Swagger (ToSchema, declareNamedSchema)
 import Data.Text qualified as T
 import Gargantext.API.Node.Share.Types ( ShareNodeParams (..) )
-import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
 import Gargantext.Prelude
 import Network.URI (parseURI)
 import Prelude (fail)

src/Gargantext/API/Search.hs

 {-|
-Module      : Gargantext.API.Count
+Module      : Gargantext.API.Search
 Description : Server API
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3

src/Gargantext/API/Server/Named/Private.hs

@@ -5,7 +5,6 @@ module Gargantext.API.Server.Named.Private where
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Context (contextAPI)
-import Gargantext.API.Count qualified as Count
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Members (members)
 import Gargantext.API.Ngrams.List qualified as List
@@ -54,7 +53,6 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
        , tableNgramsAPI    = apiNgramsTableDoc authenticatedUser
        , phyloExportAPI    = PhyloExport.api userNodeId
        , documentExportAPI = documentExportAPI userNodeId
-       , countAPI          = Count.countAPI
        , graphAPI          = Viz.graphAPI authenticatedUser userId
        , treeAPI           = Tree.treeAPI authenticatedUser
        , treeFlatAPI       = Tree.treeFlatAPI authenticatedUser

src/Gargantext/Core/Text/Terms.hs

@@ -116,11 +116,11 @@ data ExtractedNgrams = SimpleNgrams   { unSimpleNgrams   :: Ngrams       }
 instance Hashable ExtractedNgrams
 
 -- | A typeclass that represents extracting ngrams from an entity.
-class ExtractNgrams h where
+class Monad m => ExtractNgrams m h where
   extractNgrams :: NLPServerConfig
                 -> TermType Lang
                 -> h
-                -> DBCmd err (HashMap ExtractedNgrams (Map NgramsType TermsWeight, TermsCount))
+                -> m (HashMap ExtractedNgrams (Map NgramsType TermsWeight, TermsCount))
 
 ------------------------------------------------------------------------
 enrichedTerms :: Lang -> PosTagAlgo -> POS -> Terms -> NgramsPostag

src/Gargantext/Core/Text/Terms/Multi.hs

@@ -11,9 +11,19 @@ Multi-terms are ngrams where n > 1.
 
 -}
 
-module Gargantext.Core.Text.Terms.Multi (multiterms, Terms(..), tokenTag2terms, multiterms_rake, tokenTagsWith, tokenTags, cleanTextForNLP)
+module Gargantext.Core.Text.Terms.Multi (
+    multiterms
+  , Terms(..)
+  , MultitermsExtractionException(..)
+  , tokenTag2terms
+  , multiterms_rake
+  , tokenTagsWith
+  , tokenTags
+  , cleanTextForNLP
+  )
   where
 
+import Control.Exception.Safe qualified as Safe
 import Data.Attoparsec.Text as DAT (space, notChar, string )
 import Gargantext.Core (Lang(..), NLPServerConfig(..), PosTagAlgo(..))
 import Gargantext.Core.Text.Terms.Multi.Lang.En qualified as En
@@ -25,14 +35,23 @@ import Gargantext.Core.Types ( POS(NP), Terms(Terms), TermsWithCount, TokenTag(T
 import Gargantext.Core.Utils (groupWithCounts)
 import Gargantext.Prelude
 import Gargantext.Utils.SpacyNLP qualified as SpacyNLP
+import Network.HTTP.Client
 import Replace.Attoparsec.Text as RAT ( streamEdit )
 
 -------------------------------------------------------------------
 type NLP_API = Lang -> Text -> IO PosSentences
 
+data MultitermsExtractionException
+  = MEE_nlp_server_http_exception !NLPServerConfig !HttpException
+  deriving Show
+
+instance Exception MultitermsExtractionException
+
 -------------------------------------------------------------------
+-- | Extracts the terms from the input 'txt'. Throws a
+-- 'MultitermExtractionException' in case we fail.
 multiterms :: NLPServerConfig -> Lang -> Text -> IO [TermsWithCount]
-multiterms nsc l txt = do
+multiterms nsc l txt = handle (\ex -> Safe.throwIO $ MEE_nlp_server_http_exception nsc ex) $ do
   let txt' = cleanTextForNLP txt
   if txt' == ""
      then do

src/Gargantext/Database/Action/Flow.hs

@@ -56,7 +56,7 @@ module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
 
 import Conduit
 import Control.Lens ( to, view )
-import Control.Monad.Catch
+import Control.Exception.Safe (catch, MonadCatch)
 import Data.Conduit qualified as C
 import Data.Conduit.Internal (zipSources)
 import Data.Conduit.List qualified as CL
@@ -116,6 +116,7 @@ import Gargantext.Utils.Jobs.Monad ( JobHandle, MonadJobStatus(..) )
 ------------------------------------------------------------------------
 -- Imports for upgrade function
 import Gargantext.Database.Query.Tree.Error ( HasTreeError )
+import Gargantext.Core.Text.Terms.Multi (MultitermsExtractionException)
 
 ------------------------------------------------------------------------
 
@@ -256,9 +257,11 @@ flowCorpus :: ( IsDBCmd env err m
               , HasTreeError err
               , HasValidationError err
               , FlowCorpus a
+              , ExtractNgrams m a
               , MonadJobStatus m
               , MonadCatch m
-              , HasCentralExchangeNotification env, Show a )
+              , HasCentralExchangeNotification env
+              )
            => MkCorpusUser
            -> TermType Lang
            -> Maybe FlowSocialListWith
@@ -276,10 +279,11 @@ flow :: forall env err m a c.
         , HasTreeError err
         , HasValidationError err
         , FlowCorpus a
+        , ExtractNgrams m a
         , MkCorpus c
         , MonadJobStatus m
         , HasCentralExchangeNotification env
-        , MonadCatch m, Show a
+        , MonadCatch m
         )
         => Maybe c
         -> MkCorpusUser
@@ -317,9 +321,10 @@ addDocumentsToHyperCorpus :: ( IsDBCmd env err m
                              , HasNodeError err
                              , HasNLPServer env
                              , FlowCorpus document
+                             , ExtractNgrams m document
                              , MkCorpus corpus
                              , MonadLogger m
-                             , MonadCatch m, Show document
+                             , MonadCatch m
                              )
                              => Maybe corpus
                              -> TermType Lang
@@ -471,7 +476,7 @@ data InsertDocError
 
 extractNgramsFromDocument :: ( UniqParameters doc
                              , HasText doc
-                             , ExtractNgrams doc
+                             , ExtractNgrams m doc
                              , IsDBCmd err env m
                              , MonadLogger m
                              , MonadCatch m
@@ -487,7 +492,7 @@ extractNgramsFromDocument nlpServer lang doc =
   -- will still be added to the corpus and we can try to regen the ngrams at a later stage.
   UncommittedNgrams . Map.singleton docId <$>
     (documentIdWithNgrams (extractNgrams nlpServer $ withLang lang [doc]) (Indexed docId doc)
-     `catch` \(e :: SomeException) -> do
+     `catch` \(e :: MultitermsExtractionException) -> do
        $(logLocM) ERROR $ T.pack $ "Document with hash " <> show docId <> " failed ngrams extraction due to an exception: " <> displayException e
        pure $ DocumentIdWithNgrams (Indexed docId doc) mempty
     )
@@ -517,7 +522,7 @@ commitNgramsForDocument (UncommittedNgrams ng) (Indexed oldIx node) = do
 extractNgramsFromDocuments :: forall doc env err m.
                            ( HasText doc
                            , UniqParameters doc
-                           , ExtractNgrams doc
+                           , ExtractNgrams m doc
                            , IsDBCmd env err m
                            , MonadLogger m
                            , MonadCatch m
@@ -545,7 +550,7 @@ commitNgramsForDocuments ng nodes =
 insertMasterDocs :: ( HasNodeError err
                     , UniqParameters doc
                     , FlowCorpus doc
-                    , MkCorpus   c, Show doc
+                    , MkCorpus c
                     )
                  => GargConfig
                  -> UncommittedNgrams doc

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

@@ -13,6 +13,7 @@ Portability : POSIX
 
 {-# LANGUAGE InstanceSigs            #-}
 {-# LANGUAGE ScopedTypeVariables     #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 
 module Gargantext.Database.Action.Flow.Extract
@@ -30,7 +31,6 @@ import Gargantext.Core.Types (POS(NP), TermsCount, TermsWeight)
 import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact, cw_lastName, hc_who )
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, hd_authors, hd_bdd, hd_institutes, hd_source )
 import Gargantext.Database.Admin.Types.Node ( Node )
-import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.NgramsPostag (NgramsPostag)
 import Gargantext.Database.Schema.Ngrams ( text2ngrams )
 import Gargantext.Database.Schema.Node (NodePoly(..))
@@ -39,7 +39,7 @@ import Gargantext.Prelude
 
 
 ------------------------------------------------------------------------
-instance ExtractNgrams HyperdataContact where
+instance Monad m => ExtractNgrams m HyperdataContact where
   extractNgrams _ncs _l = pure . HashMap.mapKeys (cleanExtractedNgrams 255) . extract
     where
       extract :: HyperdataContact
@@ -55,15 +55,15 @@ instance ExtractNgrams HyperdataContact where
 -- | Main ngrams extraction functionality.
 --   For NgramsTerms, this calls NLP server under the hood.
 --   For Sources, Institutes, Authors, this uses simple split on " ".
-instance ExtractNgrams HyperdataDocument where
+instance (Monad m, MonadBase IO m) => ExtractNgrams m HyperdataDocument where
   extractNgrams :: NLPServerConfig
                 -> TermType Lang
                 -> HyperdataDocument
-                -> DBCmd err (HashMap.HashMap ExtractedNgrams (Map NgramsType TermsWeight, TermsCount))
+                -> m (HashMap.HashMap ExtractedNgrams (Map NgramsType TermsWeight, TermsCount))
   extractNgrams ncs lang hd = HashMap.mapKeys (cleanExtractedNgrams 255) <$> extractNgramsT' hd
     where
       extractNgramsT' :: HyperdataDocument
-                      -> DBCmd err (HashMap.HashMap ExtractedNgrams (Map NgramsType TermsWeight, TermsCount))
+                      -> m (HashMap.HashMap ExtractedNgrams (Map NgramsType TermsWeight, TermsCount))
       extractNgramsT' doc = do
         let source    = text2ngrams
                       $ maybe "Nothing" identity
@@ -87,7 +87,7 @@ instance ExtractNgrams HyperdataDocument where
              <> [(SimpleNgrams     a', (DM.singleton Authors     1, 1)) | a' <- authors    ]
              <> [(EnrichedNgrams   t', (DM.singleton NgramsTerms 1, cnt')) | (t', cnt') <- termsWithCounts' ]
 
-instance (ExtractNgrams a, HasText a) => ExtractNgrams (Node a)
+instance (ExtractNgrams m a, HasText a) => ExtractNgrams m (Node a)
   where
     extractNgrams ncs l (Node { _node_hyperdata = h }) = extractNgrams ncs l h
 

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

@@ -25,7 +25,6 @@ import Gargantext.Core.NodeStory.Types ( HasNodeStory )
 import Gargantext.Core.Text ( HasText )
 import Gargantext.API.Admin.Orchestrator.Types qualified as API
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
-import Gargantext.Core.Text.Terms ( ExtractNgrams )
 import Gargantext.Core.Types (HasValidationError, TermsCount, TermsWeight)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument )
@@ -51,11 +50,10 @@ type FlowCmdM env err m =
   )
 
 type FlowCorpus a = ( UniqParameters a
-                    , InsertDb       a
-                    , ExtractNgrams  a
-                    , HasText        a
-                    , ToNode         a
-                    , ToJSON         a
+                    , InsertDb         a
+                    , HasText          a
+                    , ToNode           a
+                    , ToJSON           a
                     )
 
 type FlowInsertDB a = ( AddUniqId a

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

@@ -151,9 +151,9 @@ data ContextForNgramsTerms =
 getContextsForNgramsTerms :: HasNodeError err
                           => NodeId
                           -> [Text]
-                          -> Maybe Bool
+                          -> Bool
                           -> DBQuery err x [ContextForNgramsTerms]
-getContextsForNgramsTerms cId ngramsTerms (Just True) = do
+getContextsForNgramsTerms cId ngramsTerms True = do
   let terms_length = length ngramsTerms
   res <- mkPGQuery query (cId, PGS.In ngramsTerms, terms_length)
   pure $ (\( _cfnt_nodeId

stack.yaml

@@ -134,7 +134,7 @@
   git: "https://github.com/delanoe/patches-map"
   subdirs:
   - .
-- commit: 7694f62af6bc1596d754b42af16da131ac403b3a
+- commit: c3c558d9278ef239a474f1e1b69afc461be60d01
   git: "https://github.com/fpringle/servant-routes.git"
   subdirs:
   - .

test/Test/Instances.hs

@@ -42,6 +42,7 @@ import Gargantext.API.Node.Update.Types qualified as NU
 import Gargantext.API.Node.Types (NewWithForm, NewWithTempFile(..), RenameNode(..), WithQuery)
 import Gargantext.API.Public.Types (PublicData(..))
 import Gargantext.API.Routes.Named.Publish (PublishRequest(..))
+import Gargantext.API.Routes.Named.Remote (RemoteExportRequest(..))
 import Gargantext.API.Search.Types (SearchQuery(..), SearchResult(..), SearchResultTypes(..), SearchType(..))
 import Gargantext.API.Table.Types (TableQuery(..))
 import Gargantext.API.Viz.Types (PhyloData)
@@ -58,6 +59,7 @@ import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata
 import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId(..), NodeType(..))
 import Gargantext.Database.Query.Facet (OrderBy(..))
 import Gargantext.Prelude hiding (replace, Location)
+import Servant.Client.Core.BaseUrl (BaseUrl(..), Scheme(Http))
 import Text.Parsec.Error (ParseError, Message(..), newErrorMessage)
 import Text.Parsec.Pos
 import Test.QuickCheck
@@ -155,6 +157,11 @@ defaultPublicData =
 instance Arbitrary PublishRequest where
   arbitrary = PublishRequest <$> arbitraryBoundedEnum
 
+
+instance Arbitrary RemoteExportRequest where
+  arbitrary = RemoteExportRequest <$> (pure (BaseUrl Http "dev.sub.gargantext.org" 8008 "")) <*> arbitrary
+
+
 instance Arbitrary SearchQuery where
   arbitrary = elements [SearchQuery (RawQuery "electrodes") SearchDoc]
   -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]