Commit 02f60d0d authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/169-dev-singulars-plurals' into dev

parents 5248845f 0f038a40
...@@ -15,22 +15,22 @@ Import a corpus binary. ...@@ -15,22 +15,22 @@ Import a corpus binary.
module Main where module Main where
import Data.Either import Data.Text qualified as Text
import qualified Data.Text as Text
import Gargantext.API.Dev (withDevEnv, runCmdGargDev)
import Gargantext.API.Admin.EnvTypes (DevEnv(..), DevJobHandle(..)) import Gargantext.API.Admin.EnvTypes (DevEnv(..), DevJobHandle(..))
import Gargantext.API.Errors.Types import Gargantext.API.Dev (withDevEnv, runCmdGargDev)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Node () -- instances import Gargantext.API.Node () -- instances
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..))
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Types.Query (Limit) import Gargantext.Core.Types.Query (Limit)
import Gargantext.Database.Action.Flow (flowCorpusFile, flowAnnuaire, TermType(..)) import Gargantext.Database.Action.Flow (flowCorpusFile, flowAnnuaire, TermType(..))
import Gargantext.Database.Action.Flow.Types (FlowCmdM) import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Node (CorpusId) import Gargantext.Database.Admin.Types.Node (CorpusId)
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusName))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..)) import Gargantext.Utils.Jobs.Monad ( MonadJobStatus, JobHandle )
import Gargantext.Utils.Jobs (MonadJobStatus, JobHandle)
main :: IO () main :: IO ()
main = do main = do
...@@ -46,13 +46,14 @@ main = do ...@@ -46,13 +46,14 @@ main = do
Nothing -> panicTrace $ "Cannot read limit: " <> (Text.pack limit) Nothing -> panicTrace $ "Cannot read limit: " <> (Text.pack limit)
Just l -> l Just l -> l
corpus :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId corpus :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
corpus = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) limit' tt format Plain corpusPath Nothing DevJobHandle mkCorpusUser = MkCorpusUserNormalCorpusName (UserName $ cs user) (cs name :: Text)
corpus = flowCorpusFile mkCorpusUser limit' tt format Plain corpusPath Nothing DevJobHandle
corpusCsvHal :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId corpusCsvHal :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
corpusCsvHal = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) limit' tt CsvHal Plain corpusPath Nothing DevJobHandle corpusCsvHal = flowCorpusFile mkCorpusUser limit' tt CsvHal Plain corpusPath Nothing DevJobHandle
annuaire :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId annuaire :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
annuaire = flowAnnuaire (UserName $ cs user) (Left "Annuaire") (Multi EN) corpusPath DevJobHandle annuaire = flowAnnuaire (MkCorpusUserNormalCorpusName (UserName $ cs user) "Annuaire") (Multi EN) corpusPath DevJobHandle
{- {-
let debatCorpus :: forall m. FlowCmdM DevEnv BackendInternalError m => m CorpusId let debatCorpus :: forall m. FlowCmdM DevEnv BackendInternalError m => m CorpusId
......
...@@ -15,21 +15,21 @@ Import a corpus binary. ...@@ -15,21 +15,21 @@ Import a corpus binary.
module Main where module Main where
import Data.List.NonEmpty qualified as NE
import Gargantext.API.Dev (withDevEnv, runCmdDev) import Gargantext.API.Dev (withDevEnv, runCmdDev)
import Gargantext.API.Errors.Types import Gargantext.API.Errors.Types
import Gargantext.API.Node () -- instances only import Gargantext.API.Node () -- instances only
import Gargantext.Core.Types.Individu (User(..), arbitraryNewUsers, NewUser(..), arbitraryUsername, GargPassword(..)) import Gargantext.Core.Types.Individu (User(..), arbitraryNewUsers, NewUser(..), arbitraryUsername, GargPassword(..))
import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMk_RootWithCorpus) import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers) import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, DBCmd) import Gargantext.Database.Prelude (Cmd, DBCmd)
import Gargantext.Database.Query.Table.Node (getOrMkList) import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Table.User (insertNewUsers, ) import Gargantext.Database.Query.Table.User (insertNewUsers, )
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserMaster))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Config (GargConfig(..), readConfig) import Gargantext.Prelude.Config (GargConfig(..), readConfig)
import qualified Data.List.NonEmpty as NE
main :: IO () main :: IO ()
...@@ -63,8 +63,7 @@ main = do ...@@ -63,8 +63,7 @@ main = do
initMaster :: Cmd BackendInternalError (UserId, RootId, CorpusId, ListId) initMaster :: Cmd BackendInternalError (UserId, RootId, CorpusId, ListId)
initMaster = do initMaster = do
(masterUserId, masterRootId, masterCorpusId) (masterUserId, masterRootId, masterCorpusId)
<- getOrMk_RootWithCorpus (UserName userMaster) <- getOrMkRootWithCorpus MkCorpusUserMaster
(Left corpusMasterName)
(Nothing :: Maybe HyperdataCorpus) (Nothing :: Maybe HyperdataCorpus)
masterListId <- getOrMkList masterCorpusId masterUserId masterListId <- getOrMkList masterCorpusId masterUserId
_triggers <- initLastTriggers masterListId _triggers <- initLastTriggers masterListId
......
...@@ -22,11 +22,7 @@ module Gargantext.API.Node.Contact ...@@ -22,11 +22,7 @@ module Gargantext.API.Node.Contact
import Conduit ( yield ) import Conduit ( yield )
import Data.Aeson import Data.Aeson
import Data.Either (Either(Right))
import Data.Maybe (Maybe(..))
import Data.Swagger ( ToSchema ) import Data.Swagger ( ToSchema )
import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser(AuthenticatedUser) ) import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser(AuthenticatedUser) )
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..)) import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs) import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
...@@ -42,12 +38,13 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM) ...@@ -42,12 +38,13 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact, hyperdataContact ) import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact, hyperdataContact )
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire(..) ) import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire(..) )
import Gargantext.Database.Admin.Types.Node ( CorpusId, NodeId ) import Gargantext.Database.Admin.Types.Node ( CorpusId, NodeId )
import Gargantext.Prelude (($), {-printDebug,-}) import Gargantext.Prelude (($), Generic, Maybe(..), Text)
import Gargantext.Utils.Aeson qualified as GUA import Gargantext.Utils.Aeson qualified as GUA
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..)) import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant import Servant
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) ) import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
------------------------------------------------------------------------ ------------------------------------------------------------------------
type API = "contact" :> Summary "Contact endpoint" type API = "contact" :> Summary "Contact endpoint"
...@@ -85,7 +82,7 @@ addContact :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m) ...@@ -85,7 +82,7 @@ addContact :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m)
addContact u nId (AddContactParams fn ln) jobHandle = do addContact u nId (AddContactParams fn ln) jobHandle = do
markStarted 2 jobHandle markStarted 2 jobHandle
_ <- flow (Nothing :: Maybe HyperdataAnnuaire) u (Right [nId]) (Multi EN) Nothing (1, yield $ hyperdataContact fn ln) jobHandle _ <- flow (Nothing :: Maybe HyperdataAnnuaire) (MkCorpusUserNormalCorpusIds u [nId]) (Multi EN) Nothing (1, yield $ hyperdataContact fn ln) jobHandle
markComplete jobHandle markComplete jobHandle
addContact _uId _nId _p jobHandle = do addContact _uId _nId _p jobHandle = do
......
...@@ -56,6 +56,7 @@ import Gargantext.Database.GargDB qualified as GargDB ...@@ -56,6 +56,7 @@ import Gargantext.Database.GargDB qualified as GargDB
import Gargantext.Database.Prelude (hasConfig) import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Database.Query.Table.Node (getNodeWith, getOrMkList) import Gargantext.Database.Query.Table.Node (getNodeWith, getOrMkList)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
import Gargantext.Database.Schema.Node (node_hyperdata) import Gargantext.Database.Schema.Node (node_hyperdata)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Config (gc_max_docs_parsers) import Gargantext.Prelude.Config (gc_max_docs_parsers)
...@@ -335,8 +336,7 @@ addToCorpusWithForm user cid nwf jobHandle = do ...@@ -335,8 +336,7 @@ addToCorpusWithForm user cid nwf jobHandle = do
-- TODO granularity of the logStatus -- TODO granularity of the logStatus
-- printDebug "flowCorpus with (corpus_id, lang)" (cid, l) -- printDebug "flowCorpus with (corpus_id, lang)" (cid, l)
_cid' <- flowCorpus user _cid' <- flowCorpus (MkCorpusUserNormalCorpusIds user [cid])
(Right [cid])
(Multi l) (Multi l)
(Just (nwf ^. wf_selection)) (Just (nwf ^. wf_selection))
--(Just $ fromIntegral $ length docs, docsC') --(Just $ fromIntegral $ length docs, docsC')
......
...@@ -35,7 +35,6 @@ import Gargantext.Core.Utils.Prefix (unPrefix) ...@@ -35,7 +35,6 @@ import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus) --, DataText(..)) import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus) --, DataText(..))
import Gargantext.Database.Action.Flow.List (flowList_DbRepo) import Gargantext.Database.Action.Flow.List (flowList_DbRepo)
import Gargantext.Database.Action.User (getUserId) import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus) import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..)) import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
import Gargantext.Database.Admin.Types.Node (CorpusId, ListId, NodeType(NodeTexts)) import Gargantext.Database.Admin.Types.Node (CorpusId, ListId, NodeType(NodeTexts))
...@@ -43,7 +42,7 @@ import Gargantext.Database.Prelude (hasConfig) ...@@ -43,7 +42,7 @@ import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Database.Query.Table.Node (getOrMkList, insertDefaultNodeIfNotExists) import Gargantext.Database.Query.Table.Node (getOrMkList, insertDefaultNodeIfNotExists)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Tree.Error (HasTreeError) import Gargantext.Database.Query.Tree.Error (HasTreeError)
import Gargantext.Database.Query.Tree.Root (getOrMk_RootWithCorpus) import Gargantext.Database.Query.Tree.Root (getOrMkRootWithCorpus, MkCorpusUser (MkCorpusUserMaster))
import Gargantext.Prelude hiding (All) import Gargantext.Prelude hiding (All)
import Gargantext.Prelude.Config import Gargantext.Prelude.Config
import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..)) import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..))
...@@ -148,7 +147,7 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) = ...@@ -148,7 +147,7 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
let mCorpus = Nothing :: Maybe HyperdataCorpus let mCorpus = Nothing :: Maybe HyperdataCorpus
void $ addDocumentsToHyperCorpus server mCorpus (Multi l) cId docs' void $ addDocumentsToHyperCorpus server mCorpus (Multi l) cId docs'
(_masterUserId, _masterRootId, masterCorpusId) (_masterUserId, _masterRootId, masterCorpusId)
<- getOrMk_RootWithCorpus (UserName userMaster) (Left "") mCorpus <- getOrMkRootWithCorpus MkCorpusUserMaster mCorpus
let gp = GroupWithPosTag l server HashMap.empty let gp = GroupWithPosTag l server HashMap.empty
-- gp = case l of -- gp = case l of
-- FR -> GroupWithPosTag l Spacy HashMap.empty -- FR -> GroupWithPosTag l Spacy HashMap.empty
......
This diff is collapsed.
...@@ -41,15 +41,15 @@ module Gargantext.Database.Query.Facet ...@@ -41,15 +41,15 @@ module Gargantext.Database.Query.Facet
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Control.Lens ((^.)) import Control.Lens ((^.))
import Data.Text qualified as T import Data.Text qualified as T
import Gargantext.Core import Gargantext.Core ( HasDBid(toDBid) )
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset, IsTrash) import Gargantext.Core.Types.Query (Limit, Offset, IsTrash)
import Gargantext.Database.Prelude (DBCmd, runCountOpaQuery, runOpaQuery) import Gargantext.Database.Prelude (DBCmd, runCountOpaQuery, runOpaQuery)
import Gargantext.Database.Query.Facet.Types import Gargantext.Database.Query.Facet.Types
import Gargantext.Database.Query.Filter import Gargantext.Database.Query.Filter ( limit', offset' )
import Gargantext.Database.Query.Table.Context import Gargantext.Database.Query.Table.Context ( queryContextSearchTable )
import Gargantext.Database.Query.Table.ContextNodeNgrams import Gargantext.Database.Query.Table.ContextNodeNgrams
import Gargantext.Database.Query.Table.Ngrams import Gargantext.Database.Query.Table.Ngrams ( NgramsRead, NgramsPoly(_ngrams_id), queryNgramsTable, ngrams_id )
import Gargantext.Database.Query.Table.Node (defaultList) import Gargantext.Database.Query.Table.Node (defaultList)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.NodeContext (queryNodeContextTable) import Gargantext.Database.Query.Table.NodeContext (queryNodeContextTable)
...@@ -58,7 +58,6 @@ import Gargantext.Database.Schema.Node ...@@ -58,7 +58,6 @@ import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeContext import Gargantext.Database.Schema.NodeContext
import Opaleye import Opaleye
import Opaleye.Aggregate qualified as OAgg import Opaleye.Aggregate qualified as OAgg
import Opaleye.Internal.Unpackspec ()
import Protolude hiding (null, map, sum, not) import Protolude hiding (null, map, sum, not)
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -5,18 +5,18 @@ module Gargantext.Database.Query.Facet.Types where ...@@ -5,18 +5,18 @@ module Gargantext.Database.Query.Facet.Types where
import Data.Aeson (FromJSON, ToJSON) import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.Swagger import Data.Swagger ( ToParamSchema, ToSchema(..), genericDeclareNamedSchema )
import qualified Data.Text as T import Data.Text qualified as T
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Data.Time.Segment (jour) import Data.Time.Segment (jour)
import Gargantext.Core.Types import Gargantext.Database.Admin.Types.Node ( NodeId )
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument, arbitraryHyperdataDocuments) import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, arbitraryHyperdataDocuments )
import Opaleye import Opaleye
import Protolude hiding (null, map, sum, not) import Protolude hiding (null, map, sum, not)
import Servant.API (FromHttpApiData(..), ToHttpApiData(..)) import Servant.API (FromHttpApiData(..), ToHttpApiData(..))
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
-- | DocFacet -- | DocFacet
......
...@@ -10,9 +10,6 @@ Portability : POSIX ...@@ -10,9 +10,6 @@ Portability : POSIX
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.Database.Query.Filter module Gargantext.Database.Query.Filter
......
...@@ -15,10 +15,7 @@ Multiple Join functions with Opaleye. ...@@ -15,10 +15,7 @@ Multiple Join functions with Opaleye.
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TemplateHaskell #-}
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -36,11 +33,10 @@ module Gargantext.Database.Query.Join ( leftJoin2 ...@@ -36,11 +33,10 @@ module Gargantext.Database.Query.Join ( leftJoin2
where where
import Control.Arrow ((>>>), returnA) import Control.Arrow ((>>>), returnA)
import Data.Profunctor.Product.Default import Data.Profunctor.Product.Default ( Default )
import Gargantext.Prelude import Gargantext.Prelude ( Applicative((<*>)), (<$>) )
import Opaleye hiding (keepWhen) import Opaleye hiding (keepWhen)
import Opaleye.Internal.Join (NullMaker(..)) import Opaleye.Internal.Join (NullMaker(..))
import qualified Opaleye.Internal.Unpackspec()
keepWhen :: (a -> Field SqlBool) -> SelectArr a a keepWhen :: (a -> Field SqlBool) -> SelectArr a a
......
...@@ -12,22 +12,20 @@ Portability : POSIX ...@@ -12,22 +12,20 @@ Portability : POSIX
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Gargantext.Database.Query.Table.Context module Gargantext.Database.Query.Table.Context
where where
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Gargantext.Core import Gargantext.Core ( HasDBid(toDBid) )
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset) import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata.Any ( HyperdataAny )
import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, HyperdataDocumentV3 )
import Gargantext.Database.Prelude (DBCmd, JSONB, runOpaQuery) import Gargantext.Database.Prelude (DBCmd, JSONB, runOpaQuery)
import Gargantext.Database.Query.Filter (limit', offset') import Gargantext.Database.Query.Filter (limit', offset')
import Gargantext.Database.Query.Table.Node.Error import Gargantext.Database.Query.Table.Node.Error ( HasNodeError, nodeError, NodeError(NoContextFound) )
import Gargantext.Database.Schema.Context import Gargantext.Database.Schema.Context
import Gargantext.Prelude hiding (sum, head) import Gargantext.Prelude hiding (sum, head)
import Opaleye hiding (FromField) import Opaleye hiding (FromField)
......
...@@ -11,9 +11,6 @@ Portability : POSIX ...@@ -11,9 +11,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.ContextNodeNgrams module Gargantext.Database.Query.Table.ContextNodeNgrams
( module Gargantext.Database.Schema.ContextNodeNgrams ( module Gargantext.Database.Schema.ContextNodeNgrams
......
...@@ -11,10 +11,6 @@ Portability : POSIX ...@@ -11,10 +11,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.ContextNodeNgrams2 module Gargantext.Database.Query.Table.ContextNodeNgrams2
( module Gargantext.Database.Schema.ContextNodeNgrams2 ( module Gargantext.Database.Schema.ContextNodeNgrams2
, insertContextNodeNgrams2 , insertContextNodeNgrams2
......
...@@ -30,7 +30,7 @@ import Data.List qualified as List ...@@ -30,7 +30,7 @@ import Data.List qualified as List
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
import Database.PostgreSQL.Simple qualified as PGS import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.Core.Text.Ngrams (Ngrams, NgramsType) import Gargantext.Core.Text.Ngrams (Ngrams, NgramsType)
import Gargantext.Core.Types import Gargantext.Database.Admin.Types.Node ( pgNodeId, CorpusId, ListId, DocId )
import Gargantext.Database.Prelude (runOpaQuery, formatPGSQuery, runPGSQuery, DBCmd) import Gargantext.Database.Prelude (runOpaQuery, formatPGSQuery, runPGSQuery, DBCmd)
import Gargantext.Database.Query.Join (leftJoin3) import Gargantext.Database.Query.Join (leftJoin3)
import Gargantext.Database.Query.Table.ContextNodeNgrams2 import Gargantext.Database.Query.Table.ContextNodeNgrams2
...@@ -38,7 +38,7 @@ import Gargantext.Database.Query.Table.NodeNgrams (queryNodeNgramsTable) ...@@ -38,7 +38,7 @@ import Gargantext.Database.Query.Table.NodeNgrams (queryNodeNgramsTable)
import Gargantext.Database.Schema.Ngrams import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.NodeNgrams import Gargantext.Database.Schema.NodeNgrams
import Gargantext.Database.Schema.Prelude import Gargantext.Database.Schema.Prelude
import Gargantext.Database.Types import Gargantext.Database.Types ( Indexed(Indexed) )
import Gargantext.Prelude import Gargantext.Prelude
queryNgramsTable :: Select NgramsRead queryNgramsTable :: Select NgramsRead
......
...@@ -24,7 +24,7 @@ import Data.HashMap.Strict qualified as HashMap ...@@ -24,7 +24,7 @@ import Data.HashMap.Strict qualified as HashMap
import Data.List qualified as List import Data.List qualified as List
import Database.PostgreSQL.Simple qualified as PGS import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.Core import Gargantext.Core
import Gargantext.Core.Text.Ngrams (Ngrams, ngramsSize, ngramsTerms) import Gargantext.Core.Text.Ngrams (Ngrams(..), ngramsSize, ngramsTerms)
import Gargantext.Core.Types ( POS ) import Gargantext.Core.Types ( POS )
import Gargantext.Database.Prelude (runPGSQuery, runPGSQuery_, DBCmd) import Gargantext.Database.Prelude (runPGSQuery, runPGSQuery_, DBCmd)
import Gargantext.Database.Query.Table.Ngrams ( NgramsId, insertNgrams ) import Gargantext.Database.Query.Table.Ngrams ( NgramsId, insertNgrams )
...@@ -154,14 +154,40 @@ SELECT terms,id FROM ins_form_ret ...@@ -154,14 +154,40 @@ SELECT terms,id FROM ins_form_ret
-- TODO add lang and postag algo -- TODO add lang and postag algo
-- TODO remove when form == lem in insert -- TODO remove when form == lem in insert
selectLems :: Lang -> NLPServerConfig -> [Ngrams] -> DBCmd err [(Form, Lem)] selectLems :: Lang -> NLPServerConfig -> [Ngrams] -> DBCmd err [(Form, Lem)]
selectLems l (NLPServerConfig { server }) ns = runPGSQuery querySelectLems (PGS.Only $ Values fields datas) selectLems l (NLPServerConfig { server }) ns = runPGSQuery querySelectLems (PGS.In (map _ngramsTerms ns), toDBid l, toDBid server)
----------------------
querySelectLems :: PGS.Query
querySelectLems = [sql|
WITH
trms
AS (SELECT id, terms, n
FROM ngrams
WHERE terms IN ?)
, input_rows(lang_id, algo_id, terms,n)
AS (SELECT ? as lang_id, ? as algo_id, terms, n, id
FROM trms)
, lems AS ( select ir.terms as t1, n2.terms as t2, sum(np.score) as score from input_rows ir
JOIN ngrams_postag np ON np.ngrams_id = ir.id
JOIN ngrams n2 ON n2.id = np.lemm_id
WHERE np.lang_id = ir.lang_id
AND np.algo_id = ir.algo_id
GROUP BY ir.terms, n2.terms
ORDER BY score DESC
)
SELECT t1,t2 from lems
|]
-- | This is the same as 'selectLems', but slower.
selectLems' :: Lang -> NLPServerConfig -> [Ngrams] -> DBCmd err [(Form, Lem)]
selectLems' l (NLPServerConfig { server }) ns = runPGSQuery querySelectLems' (PGS.Only $ Values fields datas)
where where
fields = map (QualifiedIdentifier Nothing) ["int4","int4","text", "int4"] fields = map (QualifiedIdentifier Nothing) ["int4","int4","text", "int4"]
datas = map (\d -> [toField $ toDBid l, toField $ toDBid server] <> toRow d) ns datas = map (\d -> [toField $ toDBid l, toField $ toDBid server] <> toRow d) ns
----------------------
querySelectLems :: PGS.Query querySelectLems' :: PGS.Query
querySelectLems = [sql| querySelectLems' = [sql|
WITH input_rows(lang_id, algo_id, terms,n) WITH input_rows(lang_id, algo_id, terms,n)
AS (?) -- ((VALUES ('automata' :: "text"))) AS (?) -- ((VALUES ('automata' :: "text")))
, lems AS ( select n1.terms as t1 ,n2.terms as t2 ,sum(np.score) as score from input_rows ir , lems AS ( select n1.terms as t1 ,n2.terms as t2 ,sum(np.score) as score from input_rows ir
......
...@@ -14,7 +14,6 @@ Portability : POSIX ...@@ -14,7 +14,6 @@ Portability : POSIX
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
...@@ -23,14 +22,19 @@ module Gargantext.Database.Query.Table.Node ...@@ -23,14 +22,19 @@ module Gargantext.Database.Query.Table.Node
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Control.Lens (set, view) import Control.Lens (set, view)
import Data.Aeson import Data.Aeson ( encode, Value, ToJSON )
import Database.PostgreSQL.Simple qualified as PGS import Database.PostgreSQL.Simple qualified as PGS
import Database.PostgreSQL.Simple.SqlQQ (sql) import Database.PostgreSQL.Simple.SqlQQ (sql)
import Gargantext.Core import Gargantext.Core ( HasDBid(toDBid) )
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset) import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata.Any ( HyperdataAny )
import Gargantext.Database.Admin.Types.Hyperdata.Default import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus )
import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, HyperdataDocumentV3 )
import Gargantext.Database.Admin.Types.Hyperdata.List ( HyperdataList )
import Gargantext.Database.Admin.Types.Hyperdata.Model ( HyperdataModel )
import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( Hyperdata )
import Gargantext.Database.Admin.Types.Hyperdata.Default ( defaultHyperdata, DefaultHyperdata(..) )
import Gargantext.Database.Prelude (DBCmd, JSONB, mkCmd, runPGSQuery, runOpaQuery) import Gargantext.Database.Prelude (DBCmd, JSONB, mkCmd, runPGSQuery, runOpaQuery)
import Gargantext.Database.Query.Filter (limit', offset') import Gargantext.Database.Query.Filter (limit', offset')
import Gargantext.Database.Query.Table.Node.Error import Gargantext.Database.Query.Table.Node.Error
......
...@@ -10,23 +10,22 @@ Portability : POSIX ...@@ -10,23 +10,22 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
module Gargantext.Database.Query.Table.Node.Children module Gargantext.Database.Query.Table.Node.Children
where where
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Data.Proxy import Gargantext.Core ( HasDBid(toDBid) )
import Gargantext.Core
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset) import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument, HyperdataContact) import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact )
import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument )
import Gargantext.Database.Prelude (DBCmd, JSONB, runCountOpaQuery, runOpaQuery) import Gargantext.Database.Prelude (DBCmd, JSONB, runCountOpaQuery, runOpaQuery)
import Gargantext.Database.Query.Filter import Gargantext.Database.Query.Filter ( limit', offset' )
import Gargantext.Database.Query.Table.NodeContext import Gargantext.Database.Query.Table.NodeContext ( NodeContextPoly(NodeContext), queryNodeContextTable )
import Gargantext.Database.Schema.Context import Gargantext.Database.Schema.Context
import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.Node ( NodeRead, NodePoly(Node, _node_id), queryNodeTable )
import Gargantext.Prelude import Gargantext.Prelude
import Opaleye import Opaleye
......
...@@ -13,7 +13,7 @@ module Gargantext.Database.Query.Table.Node.Contact ...@@ -13,7 +13,7 @@ module Gargantext.Database.Query.Table.Node.Contact
where where
import Gargantext.Database.Admin.Types.Node ( Node) import Gargantext.Database.Admin.Types.Node ( Node)
import Gargantext.Database.Admin.Types.Hyperdata.Contact import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact )
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -20,11 +20,11 @@ module Gargantext.Database.Query.Table.Node.Document.Add ...@@ -20,11 +20,11 @@ module Gargantext.Database.Query.Table.Node.Document.Add
where where
import Database.PostgreSQL.Simple (Query, Only(..)) import Database.PostgreSQL.Simple (Query, Only(..))
import Database.PostgreSQL.Simple.SqlQQ import Database.PostgreSQL.Simple.SqlQQ ( sql )
import Database.PostgreSQL.Simple.ToField (toField) import Database.PostgreSQL.Simple.ToField (toField)
import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import Database.PostgreSQL.Simple.ToRow (ToRow(..))
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node ( CorpusId, ContextId, NodeId, ParentId )
import Gargantext.Database.Prelude (runPGSQuery, formatPGSQuery, DBCmd) import Gargantext.Database.Prelude (runPGSQuery, formatPGSQuery, DBCmd)
import Gargantext.Prelude import Gargantext.Prelude
......
...@@ -66,7 +66,8 @@ import Database.PostgreSQL.Simple.SqlQQ ( sql ) ...@@ -66,7 +66,8 @@ import Database.PostgreSQL.Simple.SqlQQ ( sql )
import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-}) import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-})
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Gargantext.Core (HasDBid(toDBid)) import Gargantext.Core (HasDBid(toDBid))
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact )
import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument(..) )
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (runPGSQuery, DBCmd{-, formatPGSQuery-}) import Gargantext.Database.Prelude (runPGSQuery, DBCmd{-, formatPGSQuery-})
import Gargantext.Database.Schema.Node (NodePoly(..)) import Gargantext.Database.Schema.Node (NodePoly(..))
......
...@@ -27,9 +27,9 @@ module Gargantext.Database.Query.Table.Node.Error ( ...@@ -27,9 +27,9 @@ module Gargantext.Database.Query.Table.Node.Error (
) where ) where
import Control.Lens (Prism', (#), (^?)) import Control.Lens (Prism', (#), (^?))
import Data.Aeson import Data.Aeson ( object, ToJSON(toJSON) )
import Data.Text qualified as T import Data.Text qualified as T
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu ( renderUser, User, Username )
import Gargantext.Database.Admin.Types.Node (ListId, NodeId(..), ContextId, UserId, ParentId) import Gargantext.Database.Admin.Types.Node (ListId, NodeId(..), ContextId, UserId, ParentId)
import Gargantext.Prelude hiding (sum, head) import Gargantext.Prelude hiding (sum, head)
import Prelude hiding (null, id, map, sum, show) import Prelude hiding (null, id, map, sum, show)
......
...@@ -16,12 +16,12 @@ module Gargantext.Database.Query.Table.Node.Select ...@@ -16,12 +16,12 @@ module Gargantext.Database.Query.Table.Node.Select
where where
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Gargantext.Core import Gargantext.Core ( HasDBid(toDBid) )
import Gargantext.Core.Types import Gargantext.Database.Admin.Types.Node ( NodeType, NodeId )
import Gargantext.Core.Types.Individu (Username) import Gargantext.Core.Types.Individu (Username)
import Gargantext.Database.Prelude (DBCmd, runOpaQuery) import Gargantext.Database.Prelude (DBCmd, runOpaQuery)
import Gargantext.Database.Query.Table.User import Gargantext.Database.Query.Table.User ( UserPoly(user_username, user_id), queryUserTable )
import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.Node ( NodePoly(_node_id, _node_user_id, _node_typename), queryNodeTable )
import Opaleye import Opaleye
import Protolude import Protolude
......
...@@ -9,18 +9,15 @@ Portability : POSIX ...@@ -9,18 +9,15 @@ Portability : POSIX
-} -}
{-# LANGUAGE QuasiQuotes #-}
module Gargantext.Database.Query.Table.Node.Update (Update(..), update) module Gargantext.Database.Query.Table.Node.Update (Update(..), update)
where where
import qualified Data.Text as DT import Data.Text qualified as DT
import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple ( Only(Only) )
import Gargantext.Prelude
import Gargantext.Core.Types (Name) import Gargantext.Core.Types (Name)
import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
import Gargantext.Database.Admin.Types.Node (NodeId, ParentId) import Gargantext.Database.Admin.Types.Node (NodeId, ParentId)
import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
import Gargantext.Prelude
-- import Data.ByteString -- import Data.ByteString
--rename :: NodeId -> Text -> IO ByteString --rename :: NodeId -> Text -> IO ByteString
......
...@@ -9,19 +9,16 @@ Portability : POSIX ...@@ -9,19 +9,16 @@ Portability : POSIX
-} -}
{-# LANGUAGE QuasiQuotes #-}
module Gargantext.Database.Query.Table.Node.UpdateOpaleye module Gargantext.Database.Query.Table.Node.UpdateOpaleye
where where
import Data.Aeson (encode) import Data.Aeson (encode)
import Gargantext.Core import Gargantext.Core ( HasDBid )
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( HyperdataC )
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node (NodeType, pgNodeId, NodeId)
import Gargantext.Database.Prelude (mkCmd, DBCmd) import Gargantext.Database.Prelude (mkCmd, DBCmd)
import Gargantext.Database.Query.Table.Node import Gargantext.Database.Query.Table.Node ( getNodeWithType, getNodesIdWithType, getNodesWithType )
import Gargantext.Database.Query.Table.Node.Error import Gargantext.Database.Query.Table.Node.Error ( HasNodeError )
import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.Node
import Gargantext.Prelude import Gargantext.Prelude
import Opaleye import Opaleye
......
...@@ -12,13 +12,13 @@ Portability : POSIX ...@@ -12,13 +12,13 @@ Portability : POSIX
module Gargantext.Database.Query.Table.Node.User module Gargantext.Database.Query.Table.Node.User
where where
import Gargantext.Core import Gargantext.Core ( HasDBid )
import Gargantext.Core.Types (Name) import Gargantext.Core.Types (Name)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..), defaultHyperdataUser) import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser(..), defaultHyperdataUser )
import Gargantext.Database.Admin.Types.Node (Node, NodeId(..), UserId, NodeType(..), pgNodeId) import Gargantext.Database.Admin.Types.Node (Node, NodeId(..), UserId, NodeType(..), pgNodeId)
import Gargantext.Database.Prelude (DBCmd, runOpaQuery) import Gargantext.Database.Prelude (DBCmd, runOpaQuery)
import Gargantext.Database.Query.Table.Node import Gargantext.Database.Query.Table.Node ( node, selectNode )
import Gargantext.Database.Schema.Node -- (Node(..)) import Gargantext.Database.Schema.Node ( NodeWrite ) -- (Node(..))
import Gargantext.Prelude import Gargantext.Prelude
import Opaleye (limit) import Opaleye (limit)
......
...@@ -10,7 +10,6 @@ Portability : POSIX ...@@ -10,7 +10,6 @@ Portability : POSIX
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodeContext_NodeContext module Gargantext.Database.Query.Table.NodeContext_NodeContext
( module Gargantext.Database.Schema.NodeContext_NodeContext ( module Gargantext.Database.Schema.NodeContext_NodeContext
...@@ -20,10 +19,10 @@ module Gargantext.Database.Query.Table.NodeContext_NodeContext ...@@ -20,10 +19,10 @@ module Gargantext.Database.Query.Table.NodeContext_NodeContext
where where
import Database.PostgreSQL.Simple qualified as PGS import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.Core.Types import Gargantext.Database.Admin.Types.Node ( ContactId, CorpusId, AnnuaireId, DocId )
import Gargantext.Database.Prelude (DBCmd, runPGSQuery) import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
import Gargantext.Database.Schema.NodeContext_NodeContext import Gargantext.Database.Schema.NodeContext_NodeContext
import Gargantext.Database.Schema.Prelude hiding (sum) import Gargantext.Database.Schema.Prelude ( QualifiedIdentifier(QualifiedIdentifier), Values(Values), sql )
import Gargantext.Prelude import Gargantext.Prelude
{- {-
......
...@@ -30,9 +30,9 @@ import Data.List.Extra (nubOrd) ...@@ -30,9 +30,9 @@ import Data.List.Extra (nubOrd)
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Database.PostgreSQL.Simple qualified as PGS (Query, Only(..)) import Database.PostgreSQL.Simple qualified as PGS (Query, Only(..))
import Gargantext.Core import Gargantext.Core ( HasDBid(toDBid) )
import Gargantext.Core.Text.Ngrams (NgramsType) import Gargantext.Core.Text.Ngrams (NgramsType)
import Gargantext.Core.Types import Gargantext.Database.Admin.Types.Node ( ListId )
import Gargantext.Database.Prelude (DBCmd, runPGSQuery) import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
import Gargantext.Database.Schema.Ngrams (fromNgramsTypeId) import Gargantext.Database.Schema.Ngrams (fromNgramsTypeId)
import Gargantext.Database.Schema.NodeNgrams import Gargantext.Database.Schema.NodeNgrams
......
...@@ -16,7 +16,6 @@ commentary with @some markup@. ...@@ -16,7 +16,6 @@ commentary with @some markup@.
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodeNode module Gargantext.Database.Query.Table.NodeNode
( module Gargantext.Database.Schema.NodeNode ( module Gargantext.Database.Schema.NodeNode
......
...@@ -11,10 +11,6 @@ Portability : POSIX ...@@ -11,10 +11,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodeNodeNgrams module Gargantext.Database.Query.Table.NodeNodeNgrams
( module Gargantext.Database.Schema.NodeNodeNgrams ( module Gargantext.Database.Schema.NodeNodeNgrams
, queryNodeNodeNgramsTable , queryNodeNodeNgramsTable
......
...@@ -23,11 +23,6 @@ Next Step benchmark: ...@@ -23,11 +23,6 @@ Next Step benchmark:
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams module Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
where where
......
...@@ -11,11 +11,6 @@ Portability : POSIX ...@@ -11,11 +11,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodesNgramsRepo module Gargantext.Database.Query.Table.NodesNgramsRepo
where where
......
...@@ -15,9 +15,6 @@ Functions to deal with users, database side. ...@@ -15,9 +15,6 @@ Functions to deal with users, database side.
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
module Gargantext.Database.Query.Table.User module Gargantext.Database.Query.Table.User
...@@ -53,16 +50,14 @@ module Gargantext.Database.Query.Table.User ...@@ -53,16 +50,14 @@ module Gargantext.Database.Query.Table.User
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Control.Lens ((^.), (?~)) import Control.Lens ((^.), (?~))
import Data.List.NonEmpty qualified as NE import Data.List.NonEmpty qualified as NE
import Data.Proxy
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Data.UUID qualified as UUID import Data.UUID qualified as UUID
import Gargantext.Core (HasDBid, toDBid) import Gargantext.Core (HasDBid, toDBid)
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Database.Admin.Config () import Gargantext.Database.Admin.Config ()
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..), hu_pubmed_api_key, hu_epo_api_user, hu_epo_api_token) import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser(..), hu_pubmed_api_key, hu_epo_api_user, hu_epo_api_token )
import Gargantext.Database.Admin.Types.Node (NodeType(NodeUser), Node, NodeId(..), pgNodeId) import Gargantext.Database.Admin.Types.Node (NodeType(NodeUser), Node, NodeId(..), UserId(..), pgNodeId)
import Gargantext.Database.Admin.Types.Node (UserId(..)) import Gargantext.Database.Prelude ( DBCmd, runOpaQuery, mkCmd )
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateNodeWithType) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateNodeWithType)
import Gargantext.Database.Schema.Node (NodeRead, node_hyperdata, queryNodeTable, node_id, node_user_id, node_typename) import Gargantext.Database.Schema.Node (NodeRead, node_hyperdata, queryNodeTable, node_id, node_user_id, node_typename)
......
...@@ -9,17 +9,15 @@ Portability : POSIX ...@@ -9,17 +9,15 @@ Portability : POSIX
-} -}
{-# LANGUAGE QuasiQuotes #-}
module Gargantext.Database.Query.Tree.Error module Gargantext.Database.Query.Tree.Error
where where
import Control.Lens (Prism', (#)) import Control.Lens (Prism', (#))
import Gargantext.Core.Types import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Gargantext.Database.Admin.Types.Node ( NodeId )
import Gargantext.Prelude import Gargantext.Prelude
import Prelude qualified import Prelude qualified
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
------------------------------------------------------------------------ ------------------------------------------------------------------------
data TreeError = NoRoot data TreeError = NoRoot
......
...@@ -14,20 +14,19 @@ module Gargantext.Database.Query.Tree.Root ...@@ -14,20 +14,19 @@ module Gargantext.Database.Query.Tree.Root
where where
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Gargantext.Core import Gargantext.Core (HasDBid(..))
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Types.Main (CorpusName) import Gargantext.Core.Types.Main (CorpusName)
import Gargantext.Database.Action.Node import Gargantext.Database.Action.Node ( mkNodeWithParent )
import Gargantext.Database.Action.User (getUserId, getUsername) import Gargantext.Database.Action.User (getUserId, getUsername)
import Gargantext.Database.Admin.Config import Gargantext.Database.Admin.Config ( corpusMasterName, userMaster )
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser) import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (runOpaQuery, DBCmd) import Gargantext.Database.Prelude (runOpaQuery, DBCmd)
import Gargantext.Database.Query.Table.Node import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..)) import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead) import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead, queryNodeTable)
import Gargantext.Database.Schema.Node (queryNodeTable)
import Gargantext.Prelude import Gargantext.Prelude
import Opaleye (restrict, (.==), Select) import Opaleye (restrict, (.==), Select)
import Opaleye.SqlTypes (sqlStrictText, sqlInt4) import Opaleye.SqlTypes (sqlStrictText, sqlInt4)
...@@ -61,30 +60,62 @@ getOrMkRoot user = do ...@@ -61,30 +60,62 @@ getOrMkRoot user = do
pure (userId, rootId) pure (userId, rootId)
getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a) -- | Datatype for the `getOrMkRootWithCorpus`.
=> User -- There are only 3 possibilities:
-> Either CorpusName [CorpusId] -- - User is userMaster and then there is no corpus name
-- - User is a normal user and then we pass corpus name
-- - User is a normal user and then we pass corpus ids
data MkCorpusUser =
MkCorpusUserMaster
| MkCorpusUserNormalCorpusName User CorpusName
| MkCorpusUserNormalCorpusIds User [CorpusId]
deriving (Eq, Show)
userFromMkCorpusUser :: MkCorpusUser -> User
userFromMkCorpusUser MkCorpusUserMaster = UserName userMaster
userFromMkCorpusUser (MkCorpusUserNormalCorpusIds u _cids) = u
userFromMkCorpusUser (MkCorpusUserNormalCorpusName u _cname) = u
getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a)
=> MkCorpusUser
-> Maybe a -> Maybe a
-> DBCmd err (UserId, RootId, CorpusId) -> DBCmd err (UserId, RootId, CorpusId)
getOrMk_RootWithCorpus user cName c = do getOrMkRootWithCorpus MkCorpusUserMaster c = do
(userId, rootId) <- getOrMkRoot (UserName userMaster)
corpusId'' <- do
ns <- getCorporaWithParentId rootId
pure $ map _node_id ns
case corpusId'' of
[] -> mkCorpus corpusMasterName c rootId userId
cIds -> do
corpusId <- maybe (nodeError NoCorpusFound) pure (head cIds)
pure (userId, rootId, corpusId)
getOrMkRootWithCorpus (MkCorpusUserNormalCorpusName user cName) c = do
(userId, rootId) <- getOrMkRoot user
mkCorpus cName c rootId userId
getOrMkRootWithCorpus (MkCorpusUserNormalCorpusIds user []) c = do
getOrMkRootWithCorpus (MkCorpusUserNormalCorpusName user "Default") c
getOrMkRootWithCorpus (MkCorpusUserNormalCorpusIds user cIds) _c = do
(userId, rootId) <- getOrMkRoot user (userId, rootId) <- getOrMkRoot user
corpusId'' <- if user == UserName userMaster corpusId <- maybe (nodeError NoCorpusFound) pure (head cIds)
then do pure (userId, rootId, corpusId)
ns <- getCorporaWithParentId rootId
pure $ map _node_id ns
else -- | Helper function for `getOrMkRootWithCorpus`.
pure $ fromRight [] cName mkCorpus :: (HasNodeError err, MkCorpus a)
=> CorpusName
corpusId' <- if corpusId'' /= [] -> Maybe a
then pure corpusId'' -> RootId
else do -> UserId
c' <- mk (Just $ fromLeft "Default" cName) c rootId userId -> DBCmd err (UserId, RootId, CorpusId)
_tId <- case head c' of mkCorpus cName c rootId userId = do
Nothing -> errorWith "[G.D.Q.T.Root.getOrMk...] mk Corpus failed" c' <- mk (Just cName) c rootId userId
Just c'' -> insertDefaultNode NodeTexts c'' userId _tId <- case head c' of
pure c' Nothing -> errorWith "[G.D.Q.T.Root.getOrMk...] mk Corpus failed"
Just c'' -> insertDefaultNode NodeTexts c'' userId
corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId')
corpusId <- maybe (nodeError NoCorpusFound) pure (head c')
pure (userId, rootId, corpusId) pure (userId, rootId, corpusId)
...@@ -118,20 +149,20 @@ selectRoot :: User -> Select NodeRead ...@@ -118,20 +149,20 @@ selectRoot :: User -> Select NodeRead
selectRoot (UserName username) = proc () -> do selectRoot (UserName username) = proc () -> do
row <- queryNodeTable -< () row <- queryNodeTable -< ()
users <- queryUserTable -< () users <- queryUserTable -< ()
restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser) restrict -< _node_typename row .== sqlInt4 (toDBid NodeUser)
restrict -< user_username users .== (sqlStrictText username) restrict -< user_username users .== sqlStrictText username
restrict -< _node_user_id row .== (user_id users) restrict -< _node_user_id row .== user_id users
returnA -< row returnA -< row
selectRoot (UserDBId uid) = proc () -> do selectRoot (UserDBId uid) = proc () -> do
row <- queryNodeTable -< () row <- queryNodeTable -< ()
restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser) restrict -< _node_typename row .== sqlInt4 (toDBid NodeUser)
restrict -< _node_user_id row .== (sqlInt4 $ _UserId uid) restrict -< _node_user_id row .== sqlInt4 (_UserId uid)
returnA -< row returnA -< row
selectRoot (RootId nid) = selectRoot (RootId nid) =
proc () -> do proc () -> do
row <- queryNodeTable -< () row <- queryNodeTable -< ()
restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser) restrict -< _node_typename row .== sqlInt4 (toDBid NodeUser)
restrict -< _node_id row .== (pgNodeId nid) restrict -< _node_id row .== pgNodeId nid
returnA -< row returnA -< row
...@@ -3,6 +3,7 @@ ...@@ -3,6 +3,7 @@
module Test.API.Setup where module Test.API.Setup where
-- import Gargantext.Prelude (printDebug)
import Control.Lens import Control.Lens
import Control.Monad.Reader import Control.Monad.Reader
import Gargantext.API (makeApp) import Gargantext.API (makeApp)
...@@ -21,24 +22,24 @@ import Gargantext.Database.Admin.Trigger.Init ...@@ -21,24 +22,24 @@ import Gargantext.Database.Admin.Trigger.Init
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node (getOrMkList) import Gargantext.Database.Query.Table.Node (getOrMkList)
-- import Gargantext.Prelude (printDebug) import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..))
import Gargantext.Prelude.Config import Gargantext.Prelude.Config
import Gargantext.Prelude.Mail qualified as Mail
import Gargantext.Prelude.NLP qualified as NLP
import Gargantext.System.Logging import Gargantext.System.Logging
import Gargantext.Utils.Jobs qualified as Jobs
import Gargantext.Utils.Jobs.Monad qualified as Jobs
import Gargantext.Utils.Jobs.Queue qualified as Jobs
import Gargantext.Utils.Jobs.Settings qualified as Jobs
import Network.HTTP.Client.TLS (newTlsManager) import Network.HTTP.Client.TLS (newTlsManager)
import Network.Wai (Application) import Network.Wai (Application)
import Network.Wai.Handler.Warp qualified as Warp
import Prelude import Prelude
import Servant.Auth.Client () import Servant.Auth.Client ()
import Servant.Client import Servant.Client
import Servant.Job.Async qualified as ServantAsync
import Test.Database.Setup (withTestDB, fakeIniPath, testEnvToPgConnectionInfo) import Test.Database.Setup (withTestDB, fakeIniPath, testEnvToPgConnectionInfo)
import Test.Database.Types import Test.Database.Types
import qualified Gargantext.Prelude.Mail as Mail
import qualified Gargantext.Prelude.NLP as NLP
import qualified Gargantext.Utils.Jobs as Jobs
import qualified Gargantext.Utils.Jobs.Monad as Jobs
import qualified Gargantext.Utils.Jobs.Queue as Jobs
import qualified Gargantext.Utils.Jobs.Settings as Jobs
import qualified Network.Wai.Handler.Warp as Warp
import qualified Servant.Job.Async as ServantAsync
newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env
...@@ -97,9 +98,7 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do ...@@ -97,9 +98,7 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do
void $ initFirstTriggers "secret_key" void $ initFirstTriggers "secret_key"
void $ new_user $ mkNewUser (userMaster <> "@cnrs.com") (GargPassword "secret_key") void $ new_user $ mkNewUser (userMaster <> "@cnrs.com") (GargPassword "secret_key")
(masterUserId, _masterRootId, masterCorpusId) (masterUserId, _masterRootId, masterCorpusId)
<- getOrMk_RootWithCorpus (UserName userMaster) <- getOrMkRootWithCorpus MkCorpusUserMaster (Nothing :: Maybe HyperdataCorpus)
(Left corpusMasterName)
(Nothing :: Maybe HyperdataCorpus)
masterListId <- getOrMkList masterCorpusId masterUserId masterListId <- getOrMkList masterCorpusId masterUserId
-- printDebug "[setupEnvironment] masterListId: " masterListId -- printDebug "[setupEnvironment] masterListId: " masterListId
void $ initLastTriggers masterListId void $ initLastTriggers masterListId
......
...@@ -36,7 +36,7 @@ mockFlatCorpus = Versioned 0 $ Map.fromList [ ...@@ -36,7 +36,7 @@ mockFlatCorpus = Versioned 0 $ Map.fromList [
mockQueryFn :: Maybe T.Text -> NgramsTerm -> Bool mockQueryFn :: Maybe T.Text -> NgramsTerm -> Bool
mockQueryFn searchQuery (NgramsTerm nt) = mockQueryFn searchQuery (NgramsTerm nt) =
maybe (const True) T.isInfixOf (T.toLower <$> searchQuery) (T.toLower nt) maybe (const True) (T.isInfixOf . T.toLower) searchQuery (T.toLower nt)
unitTests :: TestTree unitTests :: TestTree
unitTests = testGroup "Query tests" unitTests = testGroup "Query tests"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment