Add docNgrams test

gargantext.cabal

@@ -861,6 +861,7 @@ test-suite garg-test-tasty
       Test.Ngrams.Terms
       Test.Offline.Errors
       Test.Offline.JSON
+      Test.Offline.Ngrams
       Test.Offline.Phylo
       Test.Offline.Stemming.Lancaster
       Test.Parsers.Date

src/Gargantext/Database/Schema/Context.hs

@@ -61,6 +61,9 @@ data ContextPolyOnlyId id hyperdata =
                 , _context_oid_hyperdata :: !hyperdata }
   deriving (Show, Generic)
 
+instance (Arbitrary id, Arbitrary hyperdata) => Arbitrary (ContextPolyOnlyId id hyperdata) where
+  arbitrary = ContextOnlyId <$> arbitrary <*> arbitrary
+
 ------------------------------------------------------------------------
 -- Automatic instances derivation
 $(deriveJSON (unPrefix "_context_oid_") ''ContextPolyOnlyId)

test/Test/Offline/Ngrams.hs

+module Test.Offline.Ngrams (tests) where
+
+import Prelude
+
+import Data.Text qualified as T
+import Gargantext.API.Ngrams.Types qualified as NT
+import Gargantext.Core
+import Gargantext.Core.Types
+import Gargantext.Database.Action.Flow.Utils (docNgrams)
+import Gargantext.Database.Admin.Types.Hyperdata
+import Test.Instances ()
+import Test.QuickCheck
+import Test.Tasty
+import Test.Tasty.QuickCheck (testProperty)
+
+-- In order to test the behaviour of 'docNgrams' we create wrappers around 'NgramsTerm' to have two
+-- different 'Arbitrary' flavours, one that always produces non-empty 'Text' fragments, and one that
+-- /might/ occasionally generate empty text fragments.
+newtype NgramsTermNonEmpty = NgramsTermNonEmpty { unNgramsTermNonEmpty :: T.Text }
+  deriving (Eq, Show)
+
+instance Arbitrary NgramsTermNonEmpty where
+  arbitrary = do
+    singleChar <- arbitrary `suchThat` ((/=) ' ')
+    txt        <- arbitrary
+    pure $ NgramsTermNonEmpty $ (T.singleton singleChar <> txt)
+
+tests :: TestTree
+tests = testGroup "Ngrams" [
+    testGroup "docNgrams" [
+     testProperty "return results for non-empty input ngrams" testDocNgramsWithTerms
+    ]
+  ]
+
+testDocNgramsWithTerms :: Lang -> NonEmptyList NgramsTermNonEmpty -> ContextOnlyId HyperdataDocument -> Property
+testDocNgramsWithTerms lang ts doc =
+  let ts' = map (NT.NgramsTerm . unNgramsTermNonEmpty) $ getNonEmpty ts
+  in counterexample "docNgrams returned no results" $ length (docNgrams lang ts' doc) > 0

test/drivers/tasty/Main.hs

@@ -27,6 +27,7 @@ import qualified Test.Ngrams.Query               as NgramsQuery
 import qualified Test.Ngrams.Terms               as NgramsTerms
 import qualified Test.Offline.Errors             as Errors
 import qualified Test.Offline.JSON               as JSON
+import qualified Test.Offline.Ngrams             as Ngrams
 import qualified Test.Offline.Phylo              as Phylo
 import qualified Test.Offline.Stemming.Lancaster as Lancaster
 import qualified Test.Parsers.Date               as PD
@@ -70,6 +71,7 @@ main = do
     , CorpusQuery.tests
     , TSVParser.tests
     , JSON.tests
+    , Ngrams.tests
     , Errors.tests
     , similaritySpec
     , Phylo.tests