Merge remote-tracking branch 'origin/551-dev-graphql-contexts-ngrams' into dev-merge

src/Gargantext/API/GraphQL.hs

@@ -31,6 +31,7 @@ import Data.Morpheus.Types
   , Undefined(..)
   )
 import Data.Proxy
+import Data.Text (Text)
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
 import Gargantext.API.Prelude (HasJobEnv')
@@ -68,6 +69,7 @@ import Gargantext.API.Admin.Types (HasSettings)
 data Query m
   = Query
     { annuaire_contacts   :: GQLA.AnnuaireContactArgs -> m [GQLA.AnnuaireContact]
+    , context_ngrams      :: GQLCTX.ContextNgramsArgs -> m [Text]
     , contexts            :: GQLCTX.NodeContextArgs -> m [GQLCTX.NodeContextGQL]
     , contexts_for_ngrams :: GQLCTX.ContextsForNgramsArgs -> m [GQLCTX.ContextGQL]
     , imt_schools         :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
@@ -112,6 +114,7 @@ rootResolver
 rootResolver =
   RootResolver
     { queryResolver = Query { annuaire_contacts   = GQLA.resolveAnnuaireContacts
+                            , context_ngrams      = GQLCTX.resolveContextNgrams
                             , contexts            = GQLCTX.resolveNodeContext
                             , contexts_for_ngrams = GQLCTX.resolveContextsForNgrams
                             , imt_schools         = GQLIMT.resolveSchools

src/Gargantext/API/GraphQL/Context.hs

@@ -20,7 +20,7 @@ import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument)
 import Gargantext.Database.Admin.Types.Node (ContextTitle, NodeId(..), NodeTypeId, UserId, unNodeId)
 import Gargantext.Database.Prelude (CmdCommon)
-import Gargantext.Database.Query.Table.NodeContext (getNodeContext, getContextsForNgramsTerms, ContextForNgramsTerms(..))
+import Gargantext.Database.Query.Table.NodeContext (getNodeContext, getContextsForNgramsTerms, ContextForNgramsTerms(..), {- getContextNgrams, -} getContextNgramsMatchingFTS)
 import qualified Gargantext.Database.Query.Table.NodeContext as DNC
 import Gargantext.Database.Schema.NodeContext (NodeContext, NodeContextPoly(..))
 import Gargantext.Prelude
@@ -94,6 +94,12 @@ data NodeContextCategoryMArgs = NodeContextCategoryMArgs
   , category   :: Int
   } deriving (Generic, GQLType)
 
+data ContextNgramsArgs
+  = ContextNgramsArgs
+    { context_id  :: Int
+    , list_id     :: Int }
+    deriving (Generic, GQLType)
+
 type GqlM e env = Resolver QUERY e (GargM env GargError)
 type GqlM' e env a = ResolverM e (GargM env GargError) a
 
@@ -112,6 +118,12 @@ resolveContextsForNgrams
 resolveContextsForNgrams ContextsForNgramsArgs { corpus_id, ngrams_terms } =
   dbContextForNgrams corpus_id ngrams_terms
 
+resolveContextNgrams
+  :: (CmdCommon env)
+  => ContextNgramsArgs -> GqlM e env [Text]
+resolveContextNgrams ContextNgramsArgs { context_id, list_id } =
+  dbContextNgrams context_id list_id
+
 -- DB
 
 -- | Inner function to fetch the node context DB.
@@ -134,6 +146,12 @@ dbContextForNgrams node_id ngrams_terms = do
   --lift $ printDebug "[dbContextForNgrams] contextsForNgramsTerms" contextsForNgramsTerms
   pure $ toContextGQL <$> contextsForNgramsTerms
 
+dbContextNgrams
+  :: (CmdCommon env)
+  => Int -> Int -> GqlM e env [Text]
+dbContextNgrams context_id list_id = do
+  lift $ getContextNgramsMatchingFTS (NodeId context_id) (NodeId list_id)
+
 -- Conversion functions
 
 toNodeContextGQL :: NodeContext -> NodeContextGQL

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

@@ -33,6 +33,8 @@ module Gargantext.Database.Query.Table.NodeContext
   , getContextsForNgrams
   , ContextForNgrams(..)
   , getContextsForNgramsTerms
+  , getContextNgrams
+  , getContextNgramsMatchingFTS
   , ContextForNgramsTerms(..)
   , insertNodeContext
   , deleteNodeContext
@@ -188,6 +190,52 @@ getContextsForNgramsTerms cId ngramsTerms = do
                      AND ngrams.terms IN ?) t
                    ORDER BY t.doc_count DESC |]
 
+
+
+-- | Query the `context_node_ngrams` table and return ngrams for given
+-- `context_id` and `list_id`.
+-- WARNING: `context_node_ngrams` can be outdated.
+getContextNgrams :: HasNodeError err
+                 => NodeId
+                 -> NodeId
+                 -> Cmd err [Text]
+getContextNgrams contextId listId = do
+  res <- runPGSQuery query (contextId, listId)
+  pure $ (\(PGS.Only term) -> term) <$> res
+
+  where
+    query :: PGS.Query
+    query = [sql| SELECT ngrams.terms
+                FROM context_node_ngrams
+                JOIN ngrams ON ngrams.id = ngrams_id
+                WHERE context_id = ?
+                AND node_id = ? |]
+
+
+-- | Query the `contexts` table and return ngrams for given context_id
+-- and list_id that match the search tsvector.
+-- NOTE This is poor man's tokenization that is used as a hint for the
+-- frontend highlighter.
+-- NOTE We prefer `plainto_tsquery` over `phraseto_tsquery` as it is
+-- more permissive (i.e. ignores word ordering). See
+-- https://www.peterullrich.com/complete-guide-to-full-text-search-with-postgres-and-ecto
+getContextNgramsMatchingFTS :: HasNodeError err
+                            => NodeId
+                            -> NodeId
+                            -> Cmd err [Text]
+getContextNgramsMatchingFTS contextId listId = do
+  res <- runPGSQuery query (contextId, listId)
+  pure $ (\(PGS.Only term) -> term) <$> res
+
+  where
+    query :: PGS.Query
+    query = [sql| SELECT ngrams.terms
+                FROM ngrams
+                JOIN node_ngrams ON node_ngrams.ngrams_id = ngrams.id
+                CROSS JOIN contexts
+                WHERE contexts.id = ?
+                AND node_ngrams.node_id = ?
+                AND contexts.search @@ plainto_tsquery(ngrams.terms) |]
 ------------------------------------------------------------------------
 insertNodeContext :: [NodeContext] -> Cmd err Int
 insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn