diff --git a/gargantext.cabal b/gargantext.cabal index bf90196ff017d9b2d82c7d4e05c127ae39420a44..6e3c798e434939e51e10bf2e5689b5a94351c4ca 100644 --- a/gargantext.cabal +++ b/gargantext.cabal @@ -901,12 +901,14 @@ test-suite garg-test , gargantext-prelude , hspec , parsec + , patches-class , quickcheck-instances , tasty , tasty-hunit , text , time , unordered-containers + , validity default-language: Haskell2010 test-suite jobqueue-test diff --git a/package.yaml b/package.yaml index 8057e2a24a7a4de3dbf0a705e04f7a7cf0129ea9..f9b9ea9d767680fbd1ba4a7e5f03c514c61f241f 100644 --- a/package.yaml +++ b/package.yaml @@ -520,11 +520,13 @@ tests: - quickcheck-instances - time - parsec + - patches-class - duckling - tasty - tasty-hunit - text - unordered-containers + - validity jobqueue-test: main: Main.hs source-dirs: tests/queue diff --git a/src-test/Ngrams/Query.hs b/src-test/Ngrams/Query.hs index 75d842f83cb652dafd5088526768f1ce38060520..8079fc6ea5dd67c9f99c3691e23d2fc0e520628f 100644 --- a/src-test/Ngrams/Query.hs +++ b/src-test/Ngrams/Query.hs @@ -3,16 +3,19 @@ module Ngrams.Query where import Control.Monad -import Gargantext.Prelude -import Gargantext.API.Ngrams -import Gargantext.API.Ngrams.Types import Data.Coerce -import Data.Monoid -import qualified Data.Text as T -import qualified Data.Map.Strict as Map import Data.Map.Strict (Map) -import Gargantext.Core.Types.Query +import Data.Monoid +import Gargantext.API.Ngrams.Types (mSetFromList) +import Gargantext.API.Ngrams +import Gargantext.API.Ngrams.Types import Gargantext.Core.Types.Main +import Gargantext.Core.Types.Query +import Gargantext.Prelude +import qualified Data.Map.Strict as Map +import qualified Data.Patch.Class as Patch +import qualified Data.Validity as Validity +import qualified Data.Text as T import Ngrams.Query.PaginationCorpus import Test.Tasty @@ -61,6 +64,8 @@ unitTests = testGroup "Query tests" , testCase "Simple pagination on CandidateTerm (limit < total terms)" test_pagination04 , testCase "paginating QuantumComputing corpus works (MapTerms)" test_paginationQuantum , testCase "paginating QuantumComputing corpus works (CandidateTerm)" test_paginationQuantum_02 + -- -- Patching + , testCase "I can apply a patch to term mapTerms to stopTerms (issue #217)" test_217 ] -- Let's test that if we request elements sorted in @@ -297,3 +302,32 @@ test_paginationQuantum_02 = do , _nsq_orderBy = Nothing , _nsq_searchQuery = mockQueryFn Nothing } + +issue217Corpus :: NgramsTableMap +issue217Corpus = Map.fromList [ + ( "advantages", NgramsRepoElement 1 MapTerm Nothing Nothing (mSetFromList ["advantage"])) + , ( "advantage" , NgramsRepoElement 1 MapTerm (Just "advantages") (Just "advantages") mempty) + ] + +patched217Corpus :: NgramsTableMap +patched217Corpus = Map.fromList [ + ( "advantages", NgramsRepoElement 1 StopTerm Nothing Nothing (mSetFromList ["advantage"])) + , ( "advantage" , NgramsRepoElement 1 StopTerm (Just "advantages") (Just "advantages") mempty) + ] + +-- In this patch we simulate turning the subtree composed by 'advantages' and 'advantage' +-- from map terms to stop terms. +patch217 :: NgramsTablePatch +patch217 = mkNgramsTablePatch $ Map.fromList [ + (NgramsTerm "advantages", NgramsPatch + { _patch_children = mempty + , _patch_list = Patch.Replace MapTerm StopTerm + } + ) + ] + +test_217 :: Assertion +test_217 = do + -- Check the patch is applicable + Validity.validationIsValid (Patch.applicable patch217 (Just issue217Corpus)) @?= True + Patch.act patch217 (Just issue217Corpus) @?= Just patched217Corpus diff --git a/src/Gargantext/API/Ngrams/Types.hs b/src/Gargantext/API/Ngrams/Types.hs index 7543b3e19b2fb056b7a02d961b84d6b1f6e84871..25cdc8c3a6eaeb8bd50fb4f34a8963e976a2ae24 100644 --- a/src/Gargantext/API/Ngrams/Types.hs +++ b/src/Gargantext/API/Ngrams/Types.hs @@ -555,6 +555,9 @@ instance Action NgramsPatch (Maybe NgramsRepoElement) where newtype NgramsTablePatch = NgramsTablePatch (PatchMap NgramsTerm NgramsPatch) deriving (Eq, Show, Generic, ToJSON, FromJSON, Semigroup, Monoid, Validity, Transformable) +mkNgramsTablePatch :: Map NgramsTerm NgramsPatch -> NgramsTablePatch +mkNgramsTablePatch = NgramsTablePatch . PM.fromMap + instance Serialise NgramsTablePatch instance Serialise (PatchMap NgramsTerm NgramsPatch)