[test] fix ngrams test by having a better non-empty terms generator

Ref #488
parent 9be580a4
Pipeline #7791 passed with stages
in 46 minutes and 4 seconds
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
module Test.Offline.Ngrams (tests) where module Test.Offline.Ngrams (tests) where
import Prelude import Prelude
import Control.Lens import Control.Lens
import Data.Char (isSpace)
import Data.Char qualified as Char
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
import Data.Text qualified as T import Data.Text qualified as T
import Data.Tree
import Gargantext.API.Ngrams (filterNgramsNodes, buildForest, destroyForest, pruneForest) import Gargantext.API.Ngrams (filterNgramsNodes, buildForest, destroyForest, pruneForest)
import Gargantext.API.Ngrams.Types import Gargantext.API.Ngrams.Types
import Gargantext.API.Ngrams.Types qualified as NT import Gargantext.API.Ngrams.Types qualified as NT
...@@ -20,15 +25,12 @@ import Gargantext.Database.Admin.Types.Hyperdata ...@@ -20,15 +25,12 @@ import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Schema.Context import Gargantext.Database.Schema.Context
import Test.HUnit import Test.HUnit
import Test.Hspec import Test.Hspec
import Test.Hspec.QuickCheck (prop)
import Test.Instances () import Test.Instances ()
import Test.Ngrams.Query (mkMapTerm) import Test.Ngrams.Query (mkMapTerm)
import Test.QuickCheck import Test.QuickCheck
import Test.QuickCheck qualified as QC import Test.QuickCheck qualified as QC
import Data.Tree
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
import Data.Char (isSpace)
import Data.Map.Strict (Map)
import Test.Hspec.QuickCheck (prop)
genScientificText :: Gen T.Text genScientificText :: Gen T.Text
...@@ -54,12 +56,12 @@ punctuation = ",.();:-" ...@@ -54,12 +56,12 @@ punctuation = ",.();:-"
genNgramsTermNonEmpty :: Gen NgramsTermNonEmpty genNgramsTermNonEmpty :: Gen NgramsTermNonEmpty
genNgramsTermNonEmpty = do genNgramsTermNonEmpty = do
singleChar <- arbitrary `suchThat` (\x -> x /= ' ' && isAllowed x) singleChar <- arbitrary `suchThat` isAllowed
txt <- filter isAllowed <$> listOf1 genScientificChar txt <- filter isAllowed <$> listOf1 genScientificChar
pure $ NgramsTermNonEmpty $ (T.pack $ singleChar : txt) pure $ NgramsTermNonEmpty $ (T.pack $ singleChar : txt)
where where
isAllowed :: Char -> Bool isAllowed :: Char -> Bool
isAllowed s = not (s `elem` punctuation) && not (s `elem` ws) && not (isSep s) isAllowed s = not (Char.isSpace s) && not (s `elem` punctuation) && not (s `elem` ws) && not (isSep s)
-- In order to test the behaviour of 'docNgrams' we create wrappers around 'NgramsTerm' to have two -- 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 -- different 'Arbitrary' flavours, one that always produces non-empty 'Text' fragments, and one that
......
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