Fix bug in selectCountDocs

The refactored DB API now has a separate building block to create an Opaleye query that
counts the number of returned results; we do that via `countRows`, exactly like the previous version.

However, I have discovered a small footgun in the Opaleye API -- if you have
two `Select` statements both calling countRows in a chain, that will always yield a value of 1,
because the inner `countRows` will give you the actual number of results by returning
a single row with an integer inside (i.e. the count).

However, the subsequent (outer) call to `countRows` will return the number of rows
of the previous step .. which is always going to be one!

The bug was that I had left somewhere the spurious `countRows` in the query which
would return the number of documents needed for the TFICF field, triggering the bug
(because then we had `it` ALWAYS equal to 1.0).

In the new API, while we cannot prevent the bug at the type level we can
easily do an audit by grepping for `countRows`, making sure we have exactly one instance,
i.e. inside `mkOpaCountQuery`.

gargantext.cabal

@@ -304,12 +304,14 @@ library
       Gargantext.Database.Query.Table.Node.Error
       Gargantext.Database.Query.Table.Node.UpdateOpaleye
       Gargantext.Database.Query.Table.Node.User
+      Gargantext.Database.Query.Table.NodeContext
       Gargantext.Database.Query.Table.NodeNode
       Gargantext.Database.Query.Table.User
       Gargantext.Database.Query.Tree.Root
       Gargantext.Database.Schema.Context
       Gargantext.Database.Schema.Ngrams
       Gargantext.Database.Schema.Node
+      Gargantext.Database.Schema.Prelude
       Gargantext.Database.Schema.User
       Gargantext.Database.Transactional
       Gargantext.Database.Transactional.Example
@@ -480,7 +482,6 @@ library
       Gargantext.Database.Query.Table.Node.Document.Insert
       Gargantext.Database.Query.Table.Node.Select
       Gargantext.Database.Query.Table.Node.Update
-      Gargantext.Database.Query.Table.NodeContext
       Gargantext.Database.Query.Table.NodeContext_NodeContext
       Gargantext.Database.Query.Table.NodeNgrams
       Gargantext.Database.Query.Tree
@@ -491,7 +492,6 @@ library
       Gargantext.Database.Schema.NodeContext_NodeContext
       Gargantext.Database.Schema.NodeNgrams
       Gargantext.Database.Schema.NodeNode
-      Gargantext.Database.Schema.Prelude
       Gargantext.Database.Types
       Gargantext.Utils.Aeson
       Gargantext.Utils.Servant
@@ -758,11 +758,13 @@ common commonTestDependencies
     , monad-control >= 1.0.3 && < 1.1
     , mtl >= 2.2.2 && < 2.4
     , network-uri
+    , opaleye
     , parsec ^>= 3.1.16.1
     , patches-class ^>= 0.1.0.1
     , patches-map ^>= 0.1.0.1
     , postgres-options >= 0.2 && < 0.3
     , postgresql-simple >= 0.6.4 && <= 0.7.0.0
+    , product-profunctors
     , quickcheck-instances ^>= 0.3.25.2
     , random
     , raw-strings-qq

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

@@ -369,7 +369,7 @@ nodeContextsScore inputData = map (\(PGS.Only a) -> a)
 --     and nc.category >= 1
 --     and c.typename = 4
 selectCountDocs :: HasDBid NodeType => CorpusId -> DBQuery err x Int
-selectCountDocs cId = mkOpaCountQuery (countRows $ queryCountDocs cId)
+selectCountDocs cId = mkOpaCountQuery (queryCountDocs cId)
   where
     queryCountDocs cId' = proc () -> do
       (c, nc) <- joinInCorpus -< ()

test/Test/Database/Operations.hs

@@ -68,6 +68,7 @@ tests = parallel $ around withTestDB $ beforeWith (\ctx -> setupEnvironment ctx
           it "Can add documents to a Corpus" corpusAddDocuments
           describe "Corpus search" $ do
             it "Can stem query terms" stemmingTest
+            it "Can return the number of docs in a corpus" corpusReturnCount
             it "Can perform a simple search inside documents" corpusSearch01
             it "Can perform search by author in documents" corpusSearch02
             it "Can perform more complex searches using the boolean API" corpusSearch03

test/Test/Database/Operations/DocumentSearch.hs

@@ -33,8 +33,8 @@ import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Error (errorWith)
 import Gargantext.Database.Query.Tree.Root
+import Gargantext.Database.Query.Table.NodeContext (selectCountDocs)
 import Gargantext.Database.Schema.Node (NodePoly(..))
-import Gargantext.Prelude.Error (panicTrace)
 import Prelude
 import Test.Database.Types
 import Test.Hspec.Expectations
@@ -142,12 +142,9 @@ corpusAddDocuments env = runTestMonad env $ do
 
   cnt <- runDBQuery $ do
     parentId <- getRootId (UserName userMaster)
-    xs <- getCorporaWithParentId parentId
-    case xs of
-      [corpus] -> do
-        let corpusId = _node_id corpus
-        searchCountInCorpus corpusId False Nothing
-      _ -> panicTrace $ "corpusAddDocuments, impossible: " <> T.pack (show xs)
+    corpus <- getCorporaWithParentIdOrFail parentId
+    let corpusId = _node_id corpus
+    searchCountInCorpus corpusId False Nothing
 
   liftIO $ cnt `shouldBe` 4
 
@@ -248,3 +245,12 @@ corpusSearchDB01 env = do
 
     liftIO $ do
       length results `shouldBe` 0 -- doesn't exist, we just check that proper to_tsquery is called
+
+corpusReturnCount :: TestEnv -> Assertion
+corpusReturnCount env = do
+  runTestMonad env $ do
+    count <- runDBQuery $ do
+      parentId <- getRootId (UserName userMaster)
+      corpus   <- getCorporaWithParentIdOrFail parentId
+      selectCountDocs (_node_id corpus)
+    liftIO $ count @?= 4

test/Test/Database/Transactions.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE TupleSections        #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 {-| Tests for the transactional DB API -}
 
@@ -16,6 +17,7 @@ import Control.Exception.Safe qualified as Safe
 import Control.Monad.Reader
 import Control.Monad.Trans.Control
 import Data.Pool
+import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Data.String
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
@@ -27,8 +29,12 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.ToField
 import Database.Postgres.Temp qualified as Tmp
 import Gargantext.API.Errors.Types (BackendInternalError)
+import Gargantext.Database.Query.Table.Node.Error (errorWith)
+import Gargantext.Database.Schema.Prelude (Table (..))
 import Gargantext.Database.Transactional
 import Gargantext.Prelude
+import Opaleye (selectTable, requiredTableField, SqlInt4)
+import Opaleye qualified as O
 import Prelude qualified
 import Shelly as SH
 import System.Random.Stateful
@@ -36,7 +42,6 @@ import Test.Database.Types hiding (Counter)
 import Test.Hspec
 import Test.Tasty.HUnit hiding (assert)
 import Text.RawString.QQ
-import Gargantext.Database.Query.Table.Node.Error (errorWith)
 
 --
 -- For these tests we do not want to test the normal GGTX database queries, but rather
@@ -49,6 +54,31 @@ import Gargantext.Database.Query.Table.Node.Error (errorWith)
 -- | 2  | ...
 --
 
+newtype CounterId = CounterId { _CounterId :: Int }
+  deriving (Show, Eq, ToField, FromField)
+
+data Counter' id value = Counter
+  { counterId    :: !id
+  , counterValue :: value
+  }
+  deriving (Show, Eq)
+
+type Counter = Counter' CounterId Int
+
+$(makeAdaptorAndInstance "pCounter" ''Counter')
+
+type CounterOpa = Counter' (O.Field SqlInt4) (O.Field SqlInt4)
+
+countersTable :: Table CounterOpa CounterOpa
+countersTable  =
+  Table "ggtx_test_counter_table"
+         ( pCounter
+           Counter { counterId = requiredTableField "id"
+                   , counterValue = requiredTableField "counter_value"
+                   }
+         )
+
+
 newtype TestDBTxMonad a = TestDBTxMonad { _TestDBTxMonad :: TestMonadM DBHandle BackendInternalError a }
   deriving ( Functor, Applicative, Monad
            , MonadReader DBHandle, MonadError BackendInternalError
@@ -130,15 +160,6 @@ teardown test_db = do
 -- Helpers and transactions to work with counters
 --
 
-newtype CounterId = CounterId { _CounterId :: Int }
-  deriving (Show, Eq, ToField, FromField)
-
-data Counter = Counter
-  { counterId    :: !CounterId
-  , counterValue :: Int
-  }
-  deriving (Show, Eq)
-
 instance PG.FromRow Counter where
   fromRow = Counter <$> field <*> field
 
@@ -170,6 +191,8 @@ stepCounter cid = do
 tests :: Spec
 tests = parallel $ around withTestCounterDB $
   describe "Database Transactions" $ do
+    describe "Opaleye count queries" $ do
+      it "Supports counting rows" opaCountQueries
     describe "Pure PG Queries" $ do
       it "Simple query works" simplePGQueryWorks
     describe "Pure PG Inserts" $ do
@@ -243,3 +266,14 @@ testConsistency env = do
 
   -- Each actor should observe a consistent state.
   liftIO $ results `shouldBe` map (Counter (CounterId 2)) [ 1 .. competing_actors ]
+
+opaCountQueries :: DBHandle -> Assertion
+opaCountQueries env = runTestDBTxMonad env $ do
+  num0 <- runDBTx $ mkOpaCountQuery (selectTable countersTable)
+  liftIO $ num0 @?= 1 -- Returns the master counter created alongside the schema.
+
+  num <- runDBTx $ do
+    _ <- insertCounter
+    _ <- insertCounter
+    mkOpaCountQuery (selectTable countersTable)
+  liftIO $ num @?= 3