Skip to content

haskell-gargantext
haskell-gargantext
Commit 4d32941d authored by Alfredo Di Napoli's avatar Alfredo Di Napoli
Browse files
Options

Port all the tasty specs to hspec

parent d362b468
Pipeline #7708 passed with stages
          in 46 minutes and 11 seconds
          Hide whitespace changes
          Inline Side-by-side
          Showing with 394 additions and 473 deletions
          gargantext.cabal
          View file @ 4d32941d
          ...@@ -728,12 +728,19 @@ common commonTestDependencies ...@@ -728,12 +728,19 @@ common commonTestDependencies
          build-depends: build-depends:
          base >=4.7 && <5 base >=4.7 && <5
          , QuickCheck ^>= 2.14.2 , QuickCheck ^>= 2.14.2
          , accelerate >= 1.3.0.0
          , aeson ^>= 2.1.2.1 , aeson ^>= 2.1.2.1
          , aeson-pretty ^>= 0.8.9
          , aeson-qq , aeson-qq
          , async ^>= 2.2.4 , async ^>= 2.2.4
          , boolexpr ^>= 0.3
          , bytestring ^>= 0.11.5.3 , bytestring ^>= 0.11.5.3
          , cache >= 0.1.3.0 , cache >= 0.1.3.0
          , conduit ^>= 1.3.4.2
          , containers ^>= 0.6.7 , containers ^>= 0.6.7
          , crawlerArxiv
          , cryptohash
          , directory ^>= 1.3.7.1
          , epo-api-client , epo-api-client
          , fast-logger ^>= 3.2.2 , fast-logger ^>= 3.2.2
          , filepath ^>= 1.4.2.2 , filepath ^>= 1.4.2.2
          ...@@ -741,16 +748,20 @@ common commonTestDependencies ...@@ -741,16 +748,20 @@ common commonTestDependencies
          , gargantext , gargantext
          , gargantext-prelude , gargantext-prelude
          , generic-arbitrary >= 1.0.1 && < 2 , generic-arbitrary >= 1.0.1 && < 2
          , graphviz ^>= 2999.20.1.0
          , haskell-bee , haskell-bee
          , hspec ^>= 2.11.1 , hspec ^>= 2.11.1
          , hspec-expectations >= 0.8 && < 0.9 , hspec-expectations >= 0.8 && < 0.9
          , hspec-expectations-lifted < 0.11 , hspec-expectations-lifted < 0.11
          , hspec-golden
          , hspec-wai , hspec-wai
          , hspec-wai-json , hspec-wai-json
          , http-client ^>= 0.7.14 , http-client ^>= 0.7.14
          , http-client-tls >= 0.3.6.1 && < 0.4 , http-client-tls >= 0.3.6.1 && < 0.4
          , http-types , http-types
          , HUnit
          , lens >= 5.2.2 && < 5.3 , lens >= 5.2.2 && < 5.3
          , massiv < 1.1
          , monad-control >= 1.0.3 && < 1.1 , monad-control >= 1.0.3 && < 1.1
          , mtl >= 2.2.2 && < 2.4 , mtl >= 2.2.2 && < 2.4
          , network-uri , network-uri
          ...@@ -760,71 +771,79 @@ common commonTestDependencies ...@@ -760,71 +771,79 @@ common commonTestDependencies
          , patches-map ^>= 0.1.0.1 , patches-map ^>= 0.1.0.1
          , postgres-options >= 0.2 && < 0.3 , postgres-options >= 0.2 && < 0.3
          , postgresql-simple >= 0.6.4 && <= 0.7.0.0 , postgresql-simple >= 0.6.4 && <= 0.7.0.0
          , process ^>= 1.6.18.0
          , product-profunctors , product-profunctors
          , quickcheck-instances ^>= 0.3.25.2 , quickcheck-instances ^>= 0.3.25.2
          , random , random
          , raw-strings-qq , raw-strings-qq
          , resource-pool >= 0.4.0.0 && < 0.5 , resource-pool >= 0.4.0.0 && < 0.5
          , safe-exceptions >= 0.1.7.4 && < 0.2 , safe-exceptions >= 0.1.7.4 && < 0.2
          , scientific < 0.4
          , servant >= 0.20.1 && < 0.21
          , servant-auth-client , servant-auth-client
          , servant-client >= 0.20 && < 0.21 , servant-client >= 0.20 && < 0.21
          , servant-client-core >= 0.20 && < 0.21 , servant-client-core >= 0.20 && < 0.21
          , servant-conduit >= 0.15 && < 0.17 , servant-conduit >= 0.15 && < 0.17
          , servant-server >= 0.20.1 && < 0.21 , servant-server >= 0.20.1 && < 0.21
          , shelly >= 1.9 && < 2 , shelly >= 1.9 && < 2
          , split
          , sqlite-simple >= 0.4.19 && < 0.5
          , stm >= 2.5.1.0 && < 2.6 , stm >= 2.5.1.0 && < 2.6
          , streaming-commons , streaming-commons
          , tasty-hunit
          , tasty-quickcheck
          , text ^>= 2.0.2 , text ^>= 2.0.2
          , time ^>= 1.12.2
          , tmp-postgres >= 1.34.1 && < 1.35 , tmp-postgres >= 1.34.1 && < 1.35
          , tree-diff , tree-diff
          , unicode-collation >= 0.1.3.5
          , unix >= 2.7.3 && < 2.9
          , unliftio , unliftio
          , unordered-containers ^>= 0.2.16.0
          , utf8-string ^>= 1.0.2
          , validity ^>= 0.12.0.2 , validity ^>= 0.12.0.2
          , vector >= 0.12.3.0 && <= 0.13.1.0
          , wai , wai
          , wai-extra , wai-extra
          , warp , warp
          , websockets , websockets
          test-suite garg-test-tasty test-suite garg-test
          import: import:
          defaults defaults
          , commonTestDependencies , commonTestDependencies
          type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
          main-is: drivers/tasty/Main.hs main-is: Main.hs
          build-depends: build-depends:
          aeson-pretty ^>= 0.8.9
          , accelerate >= 1.3.0.0
          , boolexpr ^>= 0.3
          , conduit ^>= 1.3.4.2
          , crawlerArxiv
          , cryptohash
          , directory ^>= 1.3.7.1
          , graphviz ^>= 2999.20.1.0
          , massiv < 1.1
          , scientific < 0.4
          , split
          , tasty >= 1.4.3 && < 1.6
          , tasty-golden
          , tasty-hspec
          , time ^>= 1.12.2
          , unicode-collation >= 0.1.3.5
          , unordered-containers ^>= 0.2.16.0
          , utf8-string ^>= 1.0.2
          , vector >= 0.12.3.0 && <= 0.13.1.0
          other-modules: other-modules:
          CLI.Phylo.Common CLI.Phylo.Common
          Paths_gargantext Paths_gargantext
          Paths_gargantext
          Test.API
          Test.API.Authentication
          Test.API.Authentication
          Test.API.Errors
          Test.API.Export
          Test.API.GraphQL
          Test.API.Notifications
          Test.API.Prelude
          Test.API.Prelude
          Test.API.Private
          Test.API.Private.List
          Test.API.Private.List Test.API.Private.List
          Test.API.Private.Move Test.API.Private.Move
          Test.API.Private.Move
          Test.API.Private.Remote
          Test.API.Private.Remote Test.API.Private.Remote
          Test.API.Private.Share Test.API.Private.Share
          Test.API.Private.Share
          Test.API.Private.Table
          Test.API.Private.Table Test.API.Private.Table
          Test.API.Authentication Test.API.Routes
          Test.API.Routes Test.API.Routes
          Test.API.Setup Test.API.Setup
          Test.API.Prelude Test.API.Setup
          Test.API.UpdateList
          Test.API.UpdateList Test.API.UpdateList
          Test.API.Worker
          Test.Core.LinearAlgebra Test.Core.LinearAlgebra
          Test.Core.Notifications Test.Core.Notifications
          Test.Core.Orchestrator Test.Core.Orchestrator
          ...@@ -837,15 +856,23 @@ test-suite garg-test-tasty ...@@ -837,15 +856,23 @@ test-suite garg-test-tasty
          Test.Core.Utils Test.Core.Utils
          Test.Core.Worker Test.Core.Worker
          Test.Database.Operations Test.Database.Operations
          Test.Database.Operations
          Test.Database.Operations.DocumentSearch
          Test.Database.Operations.DocumentSearch Test.Database.Operations.DocumentSearch
          Test.Database.Operations.NodeStory Test.Database.Operations.NodeStory
          Test.Database.Operations.NodeStory
          Test.Database.Operations.PublishNode
          Test.Database.Operations.PublishNode Test.Database.Operations.PublishNode
          Test.Database.Setup Test.Database.Setup
          Test.Database.Setup
          Test.Database.Transactions
          Test.Database.Transactions Test.Database.Transactions
          Test.Database.Types Test.Database.Types
          Test.Database.Types
          Test.Graph.Clustering Test.Graph.Clustering
          Test.Graph.Distance Test.Graph.Distance
          Test.Instances Test.Instances
          Test.Instances
          Test.Ngrams.Lang Test.Ngrams.Lang
          Test.Ngrams.Lang.En Test.Ngrams.Lang.En
          Test.Ngrams.Lang.Fr Test.Ngrams.Lang.Fr
          ...@@ -864,62 +891,20 @@ test-suite garg-test-tasty ...@@ -864,62 +891,20 @@ test-suite garg-test-tasty
          Test.Parsers.Types Test.Parsers.Types
          Test.Parsers.WOS Test.Parsers.WOS
          Test.Server.ReverseProxy Test.Server.ReverseProxy
          Test.Server.ReverseProxy
          Test.Types Test.Types
          Test.Types
          Test.Utils
          Test.Utils Test.Utils
          Test.Utils.Crypto Test.Utils.Crypto
          Test.Utils.Db Test.Utils.Db
          Test.Utils.Db
          Test.Utils.Jobs Test.Utils.Jobs
          Test.Utils.Jobs.Types Test.Utils.Jobs.Types
          Test.Utils.Notifications Test.Utils.Notifications
          hs-source-dirs:
          test bin/gargantext-cli
          ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N
          test-suite garg-test-hspec
          import:
          defaults
          , commonTestDependencies
          type: exitcode-stdio-1.0
          main-is: drivers/hspec/Main.hs
          build-depends:
          process ^>= 1.6.18.0
          , servant >= 0.20.1 && < 0.21
          , sqlite-simple >= 0.4.19 && < 0.5
          , unix >= 2.7.3 && < 2.9
          other-modules:
          Paths_gargantext
          Test.API
          Test.API.Authentication
          Test.API.Errors
          Test.API.Export
          Test.API.GraphQL
          Test.API.Notifications
          Test.API.Private
          Test.API.Private.List
          Test.API.Private.Move
          Test.API.Private.Remote
          Test.API.Private.Share
          Test.API.Private.Table
          Test.API.Routes
          Test.API.Setup
          Test.API.Prelude
          Test.API.UpdateList
          Test.API.Worker
          Test.Database.Operations
          Test.Database.Operations.DocumentSearch
          Test.Database.Operations.NodeStory
          Test.Database.Operations.PublishNode
          Test.Database.Setup
          Test.Database.Transactions
          Test.Database.Types
          Test.Instances
          Test.Server.ReverseProxy
          Test.Types
          Test.Utils
          Test.Utils.Db
          Test.Utils.Notifications Test.Utils.Notifications
          hs-source-dirs: hs-source-dirs:
          test test bin/gargantext-cli
          ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N
          benchmark garg-bench benchmark garg-bench
          ......
          hie.yaml
          View file @ 4d32941d
          ...@@ -61,10 +61,13 @@ cradle: ...@@ -61,10 +61,13 @@ cradle:
          component: "gargantext:exe:gargantext" component: "gargantext:exe:gargantext"
          - path: "./test" - path: "./test"
          component: "gargantext:test:garg-test-tasty" component: "gargantext:test:garg-test"
          - path: "./bin/gargantext-cli" - path: "./bin/gargantext-cli"
          component: "gargantext:test:garg-test-tasty" component: "gargantext:test:garg-test"
          - path: "./test" - path: "./bench/Main.hs"
          component: "gargantext:test:garg-test-hspec" component: "gargantext:bench:garg-bench"
          - path: "./bench/Paths_gargantext.hs"
          component: "gargantext:bench:garg-bench"
          test/drivers/hspec/Main.hs → test/Main.hs
          View file @ 4d32941d
          ...@@ -7,14 +7,24 @@ import Data.Text (isInfixOf) ...@@ -7,14 +7,24 @@ import Data.Text (isInfixOf)
          import Data.Text qualified as T import Data.Text qualified as T
          import Gargantext.Prelude hiding (isInfixOf) import Gargantext.Prelude hiding (isInfixOf)
          import System.IO import System.IO
          import System.Process
          import System.Posix.Process import System.Posix.Process
          import System.Posix.Signals import System.Posix.Signals
          import System.Process
          import Test.API qualified as API import Test.API qualified as API
          import Test.Database.Operations qualified as DB import Test.Database.Operations qualified as DB
          import Test.Database.Transactions qualified as DBT import Test.Database.Transactions qualified as DBT
          import Test.Hspec import Test.Hspec
          import Test.Server.ReverseProxy qualified as ReverseProxy import Test.Server.ReverseProxy qualified as ReverseProxy
          import Test.Core.Notifications qualified as Notifications
          import Test.Core.Similarity qualified as Similarity
          import Test.Core.Utils qualified as Utils
          import Test.Graph.Clustering qualified as Clustering
          import Test.Graph.Distance qualified as Distance
          import Test.Ngrams.Lang.Occurrences qualified as Occurrences
          import Test.Ngrams.NLP qualified as NLP
          import Test.Parsers.Date qualified as PD
          import Test.Utils.Crypto qualified as Crypto
          import Test.Utils.Jobs qualified as Jobs
          startCoreNLPServer :: IO ProcessHandle startCoreNLPServer :: IO ProcessHandle
          ...@@ -70,4 +80,13 @@ main = do ...@@ -70,4 +80,13 @@ main = do
          DB.tests DB.tests
          DBT.tests DBT.tests
          DB.nodeStoryTests DB.nodeStoryTests
          runIO $ putText "tests finished" describe "Utils" $ Utils.test
          describe "Graph Clustering" $ Clustering.test
          describe "Graph Distance" $ Distance.test
          describe "Date split" $ PD.testDateSplit
          describe "Crypto" $ Crypto.test
          describe "NLP" $ NLP.test
          describe "Jobs" $ Jobs.test
          describe "Similarity" $ Similarity.test
          describe "Notifications" $ Notifications.test
          describe "Occurrences" $ Occurrences.test
          test/Test/API/Prelude.hs
          View file @ 4d32941d
          ...@@ -38,7 +38,7 @@ import Gargantext.Prelude hiding (get) ...@@ -38,7 +38,7 @@ import Gargantext.Prelude hiding (get)
          import Prelude (fail) import Prelude (fail)
          import Servant.Client.Core import Servant.Client.Core
          import Test.Database.Types import Test.Database.Types
          import Test.Tasty.HUnit (Assertion, (@?=)) import Test.HUnit (Assertion, (@?=))
          checkEither :: (Show a, Monad m) => m (Either a b) -> m b checkEither :: (Show a, Monad m) => m (Either a b) -> m b
          checkEither = fmap (either (\x -> panicTrace $ "checkEither:" <> T.pack (show x)) identity) checkEither = fmap (either (\x -> panicTrace $ "checkEither:" <> T.pack (show x)) identity)
          ......
          test/Test/API/Private/Move.hs
          View file @ 4d32941d
          ...@@ -19,7 +19,7 @@ import Test.API.Setup ...@@ -19,7 +19,7 @@ import Test.API.Setup
          import Test.Hspec (Spec, it, aroundAll, describe, sequential) import Test.Hspec (Spec, it, aroundAll, describe, sequential)
          import Test.Hspec.Wai.Internal (withApplication) import Test.Hspec.Wai.Internal (withApplication)
          import Test.Hspec.Expectations.Lifted import Test.Hspec.Expectations.Lifted
          import Test.Tasty.HUnit (assertBool) import Test.HUnit (assertBool)
          import Test.Utils import Test.Utils
          tests :: Spec tests :: Spec
          ......
          test/Test/API/Worker.hs
          View file @ 4d32941d
          ...@@ -40,7 +40,7 @@ import Test.Utils.Notifications ...@@ -40,7 +40,7 @@ import Test.Utils.Notifications
          import Gargantext.System.Logging import Gargantext.System.Logging
          import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
          import qualified Data.ByteString as BL import qualified Data.ByteString as BL
          import Test.Tasty.HUnit (assertBool) import Test.HUnit (assertBool)
          ......
          test/Test/Core/LinearAlgebra.hs
          View file @ 4d32941d
          ...@@ -8,8 +8,8 @@ ...@@ -8,8 +8,8 @@
          module Test.Core.LinearAlgebra where module Test.Core.LinearAlgebra where
          import Data.Array.Accelerate hiding (Ord, Eq, map, (<=)) import Data.Array.Accelerate hiding (Ord, Eq, map, (<=))
          import Data.Array.Accelerate.Interpreter qualified as Naive
          import Data.Array.Accelerate qualified as A import Data.Array.Accelerate qualified as A
          import Data.Array.Accelerate.Interpreter qualified as Naive
          import Data.Massiv.Array qualified as Massiv import Data.Massiv.Array qualified as Massiv
          import Data.Proxy import Data.Proxy
          import Data.Scientific import Data.Scientific
          ...@@ -19,8 +19,9 @@ import Gargantext.Core.Methods.Matrix.Accelerate.Utils qualified as Legacy ...@@ -19,8 +19,9 @@ import Gargantext.Core.Methods.Matrix.Accelerate.Utils qualified as Legacy
          import Gargantext.Core.Methods.Similarities.Accelerate.Distributional qualified as Legacy import Gargantext.Core.Methods.Similarities.Accelerate.Distributional qualified as Legacy
          import Gargantext.Orphans.Accelerate (sliceArray) import Gargantext.Orphans.Accelerate (sliceArray)
          import Prelude hiding ((^)) import Prelude hiding ((^))
          import Test.Tasty import Test.Hspec
          import Test.Tasty.QuickCheck import Test.Hspec.QuickCheck
          import Test.QuickCheck
          -- --
          ...@@ -97,32 +98,29 @@ testMatrix_04 = SquareMatrix $ fromList (Z :. 8 :. 8) $ ...@@ -97,32 +98,29 @@ testMatrix_04 = SquareMatrix $ fromList (Z :. 8 :. 8) $
          -- Main test runner -- Main test runner
          -- --
          tests :: TestTree tests :: Spec
          tests = testGroup "LinearAlgebra" [ tests = describe "LinearAlgebra" $ do
          testProperty "termDivNan" compareTermDivNan prop "termDivNan" compareTermDivNan
          , testProperty "diag" compareDiag prop "diag" compareDiag
          , testProperty "sumRows" compareSumRows prop "sumRows" compareSumRows
          , testProperty "matMaxMini" compareMatMaxMini prop "matMaxMini" compareMatMaxMini
          , testProperty "sumM_go" compareSumM_go prop "sumM_go" compareSumM_go
          , testProperty "sumMin_go" compareSumMin_go prop "sumMin_go" compareSumMin_go
          , testProperty "matrixEye" compareMatrixEye prop "matrixEye" compareMatrixEye
          , testProperty "diagNull" compareDiagNull prop "diagNull" compareDiagNull
          , testGroup "distributional" [ describe "distributional" $ do
          testProperty "reference implementation roundtrips" compareDistributionalImplementations prop "reference implementation roundtrips" compareDistributionalImplementations
          , testProperty "2x2" (compareDistributional (Proxy @Double) twoByTwo) prop "2x2" (compareDistributional (Proxy @Double) twoByTwo)
          , testProperty "7x7" (compareDistributional (Proxy @Double) testMatrix_02) prop "7x7" (compareDistributional (Proxy @Double) testMatrix_02)
          , testProperty "14x14" (compareDistributional (Proxy @Double) testMatrix_01) prop "14x14" (compareDistributional (Proxy @Double) testMatrix_01)
          , testProperty "roundtrips" (compareDistributional (Proxy @Double)) prop "roundtrips" (compareDistributional (Proxy @Double))
          ] describe "logDistributional2" $ do
          , testGroup "logDistributional2" [ prop "2x2" (compareLogDistributional2 (Proxy @Double) twoByTwo)
          testProperty "2x2" (compareLogDistributional2 (Proxy @Double) twoByTwo) prop "7x7" (compareLogDistributional2 (Proxy @Double) testMatrix_02)
          , testProperty "7x7" (compareLogDistributional2 (Proxy @Double) testMatrix_02) prop "8x8" (compareLogDistributional2 (Proxy @Double) testMatrix_04)
          , testProperty "8x8" (compareLogDistributional2 (Proxy @Double) testMatrix_04) prop "11x11" (compareLogDistributional2 (Proxy @Double) testMatrix_03)
          , testProperty "11x11" (compareLogDistributional2 (Proxy @Double) testMatrix_03) prop "14x14" (compareLogDistributional2 (Proxy @Double) testMatrix_01)
          , testProperty "14x14" (compareLogDistributional2 (Proxy @Double) testMatrix_01) prop "roundtrips" (compareLogDistributional2 (Proxy @Double))
          ,testProperty "roundtrips" (compareLogDistributional2 (Proxy @Double))
          ]
          ]
          -- --
          -- Tests -- Tests
          ......
          test/Test/Core/Notifications.hs
          View file @ 4d32941d
          ...@@ -20,8 +20,7 @@ import Gargantext.Core.Notifications.Dispatcher.Types ...@@ -20,8 +20,7 @@ import Gargantext.Core.Notifications.Dispatcher.Types
          import Gargantext.Prelude import Gargantext.Prelude
          import Test.Hspec import Test.Hspec
          import Test.Instances () import Test.Instances ()
          import Test.Tasty import Test.Hspec.QuickCheck
          import Test.Tasty.QuickCheck qualified as QC
          test :: Spec test :: Spec
          ...@@ -31,9 +30,9 @@ test = do ...@@ -31,9 +30,9 @@ test = do
          let ce = UpdateTreeFirstLevel 15 let ce = UpdateTreeFirstLevel 15
          A.decode (A.encode ce) `shouldBe` (Just ce) A.decode (A.encode ce) `shouldBe` (Just ce)
          qcTests :: TestTree qcTests :: Spec
          qcTests = qcTests =
          testGroup "Notifications QuickCheck tests" $ do describe "Notifications QuickCheck tests" $ do
          [ QC.testProperty "CEMessage aeson encoding" $ \m -> A.decode (A.encode (m :: CEMessage)) == Just m prop "CEMessage aeson encoding" $ \m -> A.decode (A.encode (m :: CEMessage)) == Just m
          , QC.testProperty "Topic aeson encoding" $ \t -> A.decode (A.encode (t :: Topic)) == Just t prop "Topic aeson encoding" $ \t -> A.decode (A.encode (t :: Topic)) == Just t
          , QC.testProperty "WSRequest aeson encoding" $ \ws -> A.decode (A.encode (ws :: WSRequest)) == Just ws ] prop "WSRequest aeson encoding" $ \ws -> A.decode (A.encode (ws :: WSRequest)) == Just ws
          test/Test/Core/Orchestrator.hs
          View file @ 4d32941d
          ...@@ -17,11 +17,11 @@ import Data.Aeson qualified as A ...@@ -17,11 +17,11 @@ import Data.Aeson qualified as A
          import Gargantext.API.Admin.Orchestrator.Types import Gargantext.API.Admin.Orchestrator.Types
          import Gargantext.Prelude import Gargantext.Prelude
          import Test.Instances () import Test.Instances ()
          import Test.Tasty import Test.Hspec
          import Test.Tasty.QuickCheck qualified as QC import Test.Hspec.QuickCheck
          qcTests :: TestTree qcTests :: Spec
          qcTests = qcTests =
          testGroup "Orchestrator QuickCheck tests" $ do describe "Orchestrator QuickCheck tests" $ do
          [ QC.testProperty "ExternalAPIs aeson encoding" $ \m -> A.decode (A.encode (m :: ExternalAPIs)) == Just m ] prop "ExternalAPIs aeson encoding" $ \m -> A.decode (A.encode (m :: ExternalAPIs)) == Just m
          test/Test/Core/Text/Corpus/Query.hs
          View file @ 4d32941d
          ...@@ -16,9 +16,10 @@ import qualified Gargantext.Core.Text.Corpus.API.Arxiv as Arxiv ...@@ -16,9 +16,10 @@ import qualified Gargantext.Core.Text.Corpus.API.Arxiv as Arxiv
          import qualified Gargantext.Core.Text.Corpus.API.Pubmed as Pubmed import qualified Gargantext.Core.Text.Corpus.API.Pubmed as Pubmed
          import qualified Network.Api.Arxiv as Arxiv import qualified Network.Api.Arxiv as Arxiv
          import Test.Tasty import Test.HUnit
          import Test.Tasty.HUnit import Test.Hspec
          import Test.Tasty.QuickCheck hiding (Positive, Negative) import Test.Hspec.QuickCheck
          import Test.QuickCheck hiding (Positive, Negative)
          newtype PubmedApiKey newtype PubmedApiKey
          = PubmedApiKey { _PubmedApiKey :: T.Text } = PubmedApiKey { _PubmedApiKey :: T.Text }
          ...@@ -28,54 +29,50 @@ newtype PubmedApiKey ...@@ -28,54 +29,50 @@ newtype PubmedApiKey
          pubmedSettings :: IO (Maybe PubmedApiKey) pubmedSettings :: IO (Maybe PubmedApiKey)
          pubmedSettings = fmap fromString <$> lookupEnv "PUBMED_API_KEY" pubmedSettings = fmap fromString <$> lookupEnv "PUBMED_API_KEY"
          tests :: TestTree tests :: Spec
          tests = withResource pubmedSettings (const (pure ())) $ \getPubmedKey -> tests = do
          testGroup "Boolean Query Engine" [ describe "Boolean Query Engine" $ do
          testProperty "Parses 'A OR B'" testParse01 prop "Parses 'A OR B'" testParse01
          , testProperty "Parses 'A AND B'" testParse02 prop "Parses 'A AND B'" testParse02
          , testProperty "Parses '-A'" testParse03 prop "Parses '-A'" testParse03
          , testProperty "Parses 'NOT A'" testParse03_01 prop "Parses 'NOT A'" testParse03_01
          , testProperty "Parses 'A -B'" testParse04 prop "Parses 'A -B'" testParse04
          , testProperty "Parses 'A NOT -B'" testParse04_01 prop "Parses 'A NOT -B'" testParse04_01
          , testProperty "Parses 'A AND B -C' (left associative)" testParse05 prop "Parses 'A AND B -C' (left associative)" testParse05
          , testProperty "Parses 'A AND (B -C)' (right associative)" testParse05_01 prop "Parses 'A AND (B -C)' (right associative)" testParse05_01
          , testProperty "Parses (A OR B OR NOT C) AND (D OR E OR F) -(G OR H OR I)" testParse06 prop "Parses (A OR B OR NOT C) AND (D OR E OR F) -(G OR H OR I)" testParse06
          , testProperty "It supports '\"Haskell\" AND \"Idris\"'" testParse07 prop "It supports '\"Haskell\" AND \"Idris\"'" testParse07
          , testProperty "It supports 'Haskell AND Idris'" testParse07_01 prop "It supports 'Haskell AND Idris'" testParse07_01
          , testProperty "It supports 'Raphael'" testParse07_02 prop "It supports 'Raphael'" testParse07_02
          , testProperty "It supports 'Niki', 'Ajeje' and 'Orf'" testParse07_03 prop "It supports 'Niki', 'Ajeje' and 'Orf'" testParse07_03
          , testCase "Parses words into a single constant" testWordsIntoConst it "Parses words into a single constant" testWordsIntoConst
          , testGroup "Arxiv expression converter" [ describe "Arxiv expression converter" $ do
          testCase "It supports 'A AND B'" testArxiv01_01 it "It supports 'A AND B'" testArxiv01_01
          , testCase "It supports '\"Haskell\" AND \"Agda\"'" testArxiv01_02 it "It supports '\"Haskell\" AND \"Agda\"'" testArxiv01_02
          , testCase "It supports 'A OR B'" testArxiv02 it "It supports 'A OR B'" testArxiv02
          , testCase "It supports 'A AND NOT B'" testArxiv03_01 it "It supports 'A AND NOT B'" testArxiv03_01
          , testCase "It supports 'A AND -B'" testArxiv03_02 it "It supports 'A AND -B'" testArxiv03_02
          , testCase "It supports 'A AND -B'" testArxiv03_02 it "It supports 'A AND -B'" testArxiv03_02
          , testCase "It supports 'A AND NOT (NOT B)'" testArxiv04_01 it "It supports 'A AND NOT (NOT B)'" testArxiv04_01
          , testCase "It supports 'A AND NOT (NOT (NOT B))'" testArxiv04_02 it "It supports 'A AND NOT (NOT (NOT B))'" testArxiv04_02
          , testCase "It supports 'A OR NOT B'" testArxiv05 it "It supports 'A OR NOT B'" testArxiv05
          , testCase "It supports '-A'" testArxiv06 it "It supports '-A'" testArxiv06
          ] describe "PUBMED expression converter" $ do
          , testGroup "PUBMED expression converter" [ it "It supports 'A'" testPubMed01
          testCase "It supports 'A'" testPubMed01 it "It supports '-A'" testPubMed02_01
          , testCase "It supports '-A'" testPubMed02_01 it "It supports 'NOT A'" testPubMed02_02
          , testCase "It supports 'NOT A'" testPubMed02_02 it "It supports 'NOT (NOT A)'" testPubMed02_03
          , testCase "It supports 'NOT (NOT A)'" testPubMed02_03 it "It supports '\"Haskell\" AND \"Idris\"'" testPubMed03
          , testCase "It supports '\"Haskell\" AND \"Idris\"'" testPubMed03 it "It supports 'A OR B'" testPubMed04
          , testCase "It supports 'A OR B'" testPubMed04 beforeAll pubmedSettings $ do
          ] describe "PUBMED real queries (skipped if PUBMED_API_KEY env var not set)" $ do
          , testGroup "PUBMED real queries (skipped if PUBMED_API_KEY env var not set)" [ it "It searches for \"Covid\"" $ \key -> testPubMedCovid_01 key
          testCase "It searches for \"Covid\"" (testPubMedCovid_01 getPubmedKey) it "It searches for \"Covid\" AND \"Alzheimer\"" $ \key -> testPubMedCovid_02 key
          , testCase "It searches for \"Covid\" AND \"Alzheimer\"" (testPubMedCovid_02 getPubmedKey) -- We skip the Arxiv tests if the PUBMED_API_KEY is not set just for conveniency, to have
          ] -- only a single flow-control mechanism.
          -- We skip the Arxiv tests if the PUBMED_API_KEY is not set just for conveniency, to have describe "ARXIV real queries (skipped if PUBMED_API_KEY env var not set)" $ do
          -- only a single flow-control mechanism. it "It searches for \"Haskell\"" $ \key -> testArxivRealWorld_01 key
          , testGroup "ARXIV real queries (skipped if PUBMED_API_KEY env var not set)" [ it "It searches for \"Haskell\" AND \"Agda\"" $ \key -> testArxivRealWorld_02 key
          testCase "It searches for \"Haskell\"" (testArxivRealWorld_01 getPubmedKey)
          , testCase "It searches for \"Haskell\" AND \"Agda\"" (testArxivRealWorld_02 getPubmedKey)
          ]
          ]
          -- | Checks that the 'RawQuery' can be translated into the expected 'BoolExpr' form, -- | Checks that the 'RawQuery' can be translated into the expected 'BoolExpr' form,
          -- by also checking that both renders back to the initial 'RawQuery'. -- by also checking that both renders back to the initial 'RawQuery'.
          ...@@ -242,9 +239,8 @@ testPubMed04 :: Assertion ...@@ -242,9 +239,8 @@ testPubMed04 :: Assertion
          testPubMed04 = withValidQuery "A OR B" $ \q -> testPubMed04 = withValidQuery "A OR B" $ \q ->
          Pubmed.getESearch (Pubmed.convertQuery q) @?= "A+OR+B" Pubmed.getESearch (Pubmed.convertQuery q) @?= "A+OR+B"
          testPubMedCovid_01 :: IO (Maybe PubmedApiKey) -> Assertion testPubMedCovid_01 :: Maybe PubmedApiKey -> Assertion
          testPubMedCovid_01 getPubmedKey = do testPubMedCovid_01 mb_key = do
          mb_key <- getPubmedKey
          case mb_key of case mb_key of
          Nothing -> pure () Nothing -> pure ()
          Just k -> withValidQuery "\"Covid\"" $ \query -> do Just k -> withValidQuery "\"Covid\"" $ \query -> do
          ...@@ -257,9 +253,8 @@ testPubMedCovid_01 getPubmedKey = do ...@@ -257,9 +253,8 @@ testPubMedCovid_01 getPubmedKey = do
          [] -> fail "No documents found." [] -> fail "No documents found."
          (x:_) -> _hd_title x @?= Just "Being a Hospice Nurse in Times of the COVID-19 Pandemic: A Phenomenological Study of Providing End-of-Life Care." (x:_) -> _hd_title x @?= Just "Being a Hospice Nurse in Times of the COVID-19 Pandemic: A Phenomenological Study of Providing End-of-Life Care."
          testPubMedCovid_02 :: IO (Maybe PubmedApiKey) -> Assertion testPubMedCovid_02 :: Maybe PubmedApiKey -> Assertion
          testPubMedCovid_02 getPubmedKey = do testPubMedCovid_02 mb_key = do
          mb_key <- getPubmedKey
          case mb_key of case mb_key of
          Nothing -> pure () Nothing -> pure ()
          Just k -> withValidQuery "\"Covid\" AND \"Alzheimer\"" $ \query -> do Just k -> withValidQuery "\"Covid\" AND \"Alzheimer\"" $ \query -> do
          ...@@ -272,9 +267,8 @@ testPubMedCovid_02 getPubmedKey = do ...@@ -272,9 +267,8 @@ testPubMedCovid_02 getPubmedKey = do
          [] -> fail "No documents found." [] -> fail "No documents found."
          (x:_) -> _hd_title x @?= Just "Neurodegenerative and Neurodevelopmental Diseases and the Gut-Brain Axis: The Potential of Therapeutic Targeting of the Microbiome." (x:_) -> _hd_title x @?= Just "Neurodegenerative and Neurodevelopmental Diseases and the Gut-Brain Axis: The Potential of Therapeutic Targeting of the Microbiome."
          testArxivRealWorld_01 :: IO (Maybe PubmedApiKey) -> Assertion testArxivRealWorld_01 :: Maybe PubmedApiKey -> Assertion
          testArxivRealWorld_01 getPubmedKey = do testArxivRealWorld_01 mb_key = do
          mb_key <- getPubmedKey
          case mb_key of case mb_key of
          Nothing -> pure () Nothing -> pure ()
          Just _ -> withValidQuery "\"Haskell\"" $ \query -> do Just _ -> withValidQuery "\"Haskell\"" $ \query -> do
          ...@@ -284,9 +278,8 @@ testArxivRealWorld_01 getPubmedKey = do ...@@ -284,9 +278,8 @@ testArxivRealWorld_01 getPubmedKey = do
          [] -> fail "No documents found." [] -> fail "No documents found."
          (x:_) -> _hd_title x @?= Just "Haskell for OCaml programmers" (x:_) -> _hd_title x @?= Just "Haskell for OCaml programmers"
          testArxivRealWorld_02 :: IO (Maybe PubmedApiKey) -> Assertion testArxivRealWorld_02 :: Maybe PubmedApiKey -> Assertion
          testArxivRealWorld_02 getPubmedKey = do testArxivRealWorld_02 mb_key = do
          mb_key <- getPubmedKey
          case mb_key of case mb_key of
          Nothing -> pure () Nothing -> pure ()
          Just _ -> withValidQuery "\"Haskell\" AND \"Agda\"" $ \query -> do Just _ -> withValidQuery "\"Haskell\" AND \"Agda\"" $ \query -> do
          ......
          test/Test/Core/Text/Corpus/TSV.hs
          View file @ 4d32941d
          ...@@ -13,20 +13,18 @@ import Data.Text.Encoding as DT ...@@ -13,20 +13,18 @@ import Data.Text.Encoding as DT
          import Prelude import Prelude
          import Test.Tasty import Test.Hspec
          import Test.Tasty.QuickCheck hiding (Positive, Negative) import Test.Hspec.QuickCheck
          tests :: TestTree
          tests = testGroup "TSV Parser" [
          testProperty "Parses 'Valid Text'" testValidText
          , testProperty "Parses 'Valid Number'" testValidNumber
          , testProperty "Parses 'Error Per Line On A File'" testTestErrorPerLine
          , testProperty "Parses 'Correct File'" testTestCorrectFile
          , testProperty "Parses 'Correct File With New Line In Last Header'" testTestCorrectFileWithNewLine
          , testProperty "Parses 'Find Delimiter'" testFindDelimiter
          , testProperty "Parses 'Get Headers'" testGetHeader]
          tests :: Spec
          tests = describe "TSV Parser" $ do
          prop "Parses 'Valid Text'" testValidText
          prop "Parses 'Valid Number'" testValidNumber
          prop "Parses 'Error Per Line On A File'" testTestErrorPerLine
          prop "Parses 'Correct File'" testTestCorrectFile
          prop "Parses 'Correct File With New Line In Last Header'" testTestCorrectFileWithNewLine
          prop "Parses 'Find Delimiter'" testFindDelimiter
          prop "Parses 'Get Headers'" testGetHeader
          delimiterBS :: Delimiter -> BL.ByteString delimiterBS :: Delimiter -> BL.ByteString
          ...@@ -36,10 +34,10 @@ delimiterBS Line = BLU.fromString "\n" ...@@ -36,10 +34,10 @@ delimiterBS Line = BLU.fromString "\n"
          data File = File { fDelimiter :: Delimiter data File = File { fDelimiter :: Delimiter
          , allCorpus :: [RandomCorpus] , allCorpus :: [RandomCorpus]
          } }
          deriving (Show) deriving (Show)
          data RandomCorpus = data RandomCorpus =
          RandomCorpus { abstract :: Text RandomCorpus { abstract :: Text
          , title :: Text , title :: Text
          , authors :: Text , authors :: Text
          ...@@ -47,7 +45,7 @@ data RandomCorpus = ...@@ -47,7 +45,7 @@ data RandomCorpus =
          , day :: Int , day :: Int
          , month :: Int , month :: Int
          , years :: Int , years :: Int
          } }
          deriving (Show) deriving (Show)
          instance Arbitrary File where instance Arbitrary File where
          ...@@ -67,19 +65,19 @@ delimiterToText Line = DT.pack "\n" ...@@ -67,19 +65,19 @@ delimiterToText Line = DT.pack "\n"
          delimiterToString :: Delimiter -> Char delimiterToString :: Delimiter -> Char
          delimiterToString Tab = '\t' delimiterToString Tab = '\t'
          delimiterToString Comma = ',' delimiterToString Comma = ','
          delimiterToString Line = '\n' delimiterToString Line = '\n'
          textToBL :: Text -> BL.ByteString textToBL :: Text -> BL.ByteString
          textToBL b = BL.fromChunks . return . DT.encodeUtf8 $ b textToBL b = BL.fromChunks . return . DT.encodeUtf8 $ b
          generateRandomCorpus :: Gen RandomCorpus generateRandomCorpus :: Gen RandomCorpus
          generateRandomCorpus = RandomCorpus generateRandomCorpus = RandomCorpus
          <$> generateString <$> generateString
          <*> generateString
          <*> generateString <*> generateString
          <*> generateString <*> generateString
          <*> generateNumber <*> generateString
          <*> generateNumber <*> generateNumber
          <*> generateNumber
          <*> generateNumber <*> generateNumber
          generateFileDelimiter :: Gen File generateFileDelimiter :: Gen File
          ...@@ -99,7 +97,7 @@ generateNumber :: Gen Int ...@@ -99,7 +97,7 @@ generateNumber :: Gen Int
          generateNumber = arbitrary :: Gen Int generateNumber = arbitrary :: Gen Int
          randomHeaderList :: Gen [String] randomHeaderList :: Gen [String]
          randomHeaderList = frequency [ randomHeaderList = frequency [
          (1, return []) (1, return [])
          , (7, (:) <$> (elements ["Publication Day", "Publication Month", "Publication Year", "Authors", "Title", "Source", "Abstract"]) <*> randomHeaderList) , (7, (:) <$> (elements ["Publication Day", "Publication Month", "Publication Year", "Authors", "Title", "Source", "Abstract"]) <*> randomHeaderList)
          ] ]
          ...@@ -168,7 +166,7 @@ testValidNumber = forAll generateNumber (\s -> do ...@@ -168,7 +166,7 @@ testValidNumber = forAll generateNumber (\s -> do
          -- Test the 'validTextField' function (test if a field is good on garganText) -- Test the 'validTextField' function (test if a field is good on garganText)
          testValidText :: Property testValidText :: Property
          testValidText = forAll generateString (\s -> testValidText = forAll generateString (\s ->
          let bl = textToBL s in let bl = textToBL s in
          case validTextField bl s 1 of case validTextField bl s 1 of
          Right _ -> True Right _ -> True
          ...@@ -188,7 +186,7 @@ testTestErrorPerLine = forAll generateRandomCorpus (\tsv -> do ...@@ -188,7 +186,7 @@ testTestErrorPerLine = forAll generateRandomCorpus (\tsv -> do
          Right _ -> True Right _ -> True
          Left _ -> validRandomCorpus tsv del) Left _ -> validRandomCorpus tsv del)
          --check : --check :
          -- True Del -- True Del
          -- False Error -- False Error
          ...@@ -198,7 +196,7 @@ testTestCorrectFile = forAll generateFile (\file -> do ...@@ -198,7 +196,7 @@ testTestCorrectFile = forAll generateFile (\file -> do
          let tsv = createFile file let tsv = createFile file
          case testCorrectFile tsv of case testCorrectFile tsv of
          Right del -> del == fDelimiter file Right del -> del == fDelimiter file
          Left _ -> Prelude.all (\x -> do Left _ -> Prelude.all (\x -> do
          let del = fDelimiter file let del = fDelimiter file
          let headers = Prelude.map DT.pack ["Publication Day", "Publication Month", "Publication Year", "Authors", "Title", "Source", "Abstract"] let headers = Prelude.map DT.pack ["Publication Day", "Publication Month", "Publication Year", "Authors", "Title", "Source", "Abstract"]
          let splitLine = BL.splitWith (==delimiter del) $ createLineFromCorpus x del let splitLine = BL.splitWith (==delimiter del) $ createLineFromCorpus x del
          ...@@ -213,7 +211,7 @@ testTestCorrectFileWithNewLine = forAll generateFile (\file -> do ...@@ -213,7 +211,7 @@ testTestCorrectFileWithNewLine = forAll generateFile (\file -> do
          let tsv = createFileWithNewLine file let tsv = createFileWithNewLine file
          case testCorrectFile tsv of case testCorrectFile tsv of
          Right _ -> True Right _ -> True
          Left _ -> Prelude.all (\x -> do Left _ -> Prelude.all (\x -> do
          let del = fDelimiter file let del = fDelimiter file
          let headers = Prelude.map DT.pack ["Publication Day", "Publication Month", "Publication Year", "Authors", "Title", "Source", "Abstract"] let headers = Prelude.map DT.pack ["Publication Day", "Publication Month", "Publication Year", "Authors", "Title", "Source", "Abstract"]
          let splitLine = BL.splitWith (==delimiter del) $ createLineFromCorpus x del let splitLine = BL.splitWith (==delimiter del) $ createLineFromCorpus x del
          ......
          test/Test/Core/Worker.hs
          View file @ 4d32941d
          ...@@ -15,16 +15,15 @@ import Data.Aeson qualified as Aeson ...@@ -15,16 +15,15 @@ import Data.Aeson qualified as Aeson
          import Gargantext.Core.Worker.Jobs.Types (Job(..)) import Gargantext.Core.Worker.Jobs.Types (Job(..))
          import Gargantext.Prelude import Gargantext.Prelude
          import Test.Instances () import Test.Instances ()
          import Test.Tasty import Test.Hspec
          import Test.Tasty.QuickCheck hiding (Positive, Negative) import Test.Hspec.QuickCheck
          tests :: TestTree tests :: Spec
          tests = testGroup "worker unit tests" [ tests = describe "worker unit tests" $
          testProperty "Worker Job to/from JSON serialization is correct" $ prop "Worker Job to/from JSON serialization is correct" $
          \job -> Aeson.decode (Aeson.encode (job :: Job)) == Just job \job -> Aeson.decode (Aeson.encode (job :: Job)) == Just job
          -- , testProperty "JobInfo to/from JSON serialization is correct" $ -- , testProperty "JobInfo to/from JSON serialization is correct" $
          -- \ji -> Aeson.decode (Aeson.encode (ji :: JobInfo)) == Just ji -- \ji -> Aeson.decode (Aeson.encode (ji :: JobInfo)) == Just ji
          ]
          test/Test/Database/Operations.hs
          View file @ 4d32941d
          ...@@ -34,10 +34,10 @@ import Test.Database.Operations.NodeStory ...@@ -34,10 +34,10 @@ import Test.Database.Operations.NodeStory
          import Test.Database.Operations.PublishNode import Test.Database.Operations.PublishNode
          import Test.Database.Setup (withTestDB) import Test.Database.Setup (withTestDB)
          import Test.Database.Types import Test.Database.Types
          import Test.HUnit hiding (assert)
          import Test.Hspec import Test.Hspec
          import Test.QuickCheck
          import Test.QuickCheck.Monadic import Test.QuickCheck.Monadic
          import Test.Tasty.HUnit hiding (assert)
          import Test.Tasty.QuickCheck
          -- | Keeps a log of usernames we have already generated, so that our -- | Keeps a log of usernames we have already generated, so that our
          ......
          test/Test/Database/Operations/DocumentSearch.hs
          View file @ 4d32941d
          ...@@ -38,7 +38,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..)) ...@@ -38,7 +38,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..))
          import Prelude import Prelude
          import Test.Database.Types import Test.Database.Types
          import Test.Hspec.Expectations import Test.Hspec.Expectations
          import Test.Tasty.HUnit import Test.HUnit hiding (Node)
          exampleDocument_01 :: HyperdataDocument exampleDocument_01 :: HyperdataDocument
          ......
          test/Test/Database/Operations/NodeStory.hs
          View file @ 4d32941d
          ...@@ -39,7 +39,7 @@ import Gargantext.Prelude ...@@ -39,7 +39,7 @@ import Gargantext.Prelude
          import Test.Database.Operations.DocumentSearch (getCorporaWithParentIdOrFail) import Test.Database.Operations.DocumentSearch (getCorporaWithParentIdOrFail)
          import Test.Database.Types import Test.Database.Types
          import Test.Hspec.Expectations import Test.Hspec.Expectations
          import Test.Tasty.HUnit import Test.HUnit
          commonInitialization :: TestMonad ( UserId, NodeId, ListId, ArchiveList ) commonInitialization :: TestMonad ( UserId, NodeId, ListId, ArchiveList )
          ......
          test/Test/Database/Operations/PublishNode.hs
          View file @ 4d32941d
          ...@@ -23,7 +23,7 @@ import Gargantext.Database.Query.Table.NodeNode ...@@ -23,7 +23,7 @@ import Gargantext.Database.Query.Table.NodeNode
          import Gargantext.Database.Schema.Node (NodePoly(..)) import Gargantext.Database.Schema.Node (NodePoly(..))
          import Test.API.Prelude (newPrivateFolderForUser, newPublicFolderForUser, alice) import Test.API.Prelude (newPrivateFolderForUser, newPublicFolderForUser, alice)
          import Test.Database.Types import Test.Database.Types
          import Test.Tasty.HUnit import Test.HUnit
          publishStrict :: SourceId -> TargetId -> DBCmd err () publishStrict :: SourceId -> TargetId -> DBCmd err ()
          publishStrict sid = runDBTx . publishNode NPP_publish_no_edits_allowed sid publishStrict sid = runDBTx . publishNode NPP_publish_no_edits_allowed sid
          ......
          test/Test/Database/Transactions.hs
          View file @ 4d32941d
          ...@@ -40,7 +40,7 @@ import Shelly as SH ...@@ -40,7 +40,7 @@ import Shelly as SH
          import System.Random.Stateful import System.Random.Stateful
          import Test.Database.Types hiding (Counter) import Test.Database.Types hiding (Counter)
          import Test.Hspec import Test.Hspec
          import Test.Tasty.HUnit hiding (assert) import Test.HUnit hiding (assert)
          import Text.RawString.QQ import Text.RawString.QQ
          -- --
          ......
          test/Test/Ngrams/Query.hs
          View file @ 4d32941d
          ...@@ -16,13 +16,13 @@ import Gargantext.Core.Types.Main ...@@ -16,13 +16,13 @@ import Gargantext.Core.Types.Main
          import Gargantext.Core.Types.Query import Gargantext.Core.Types.Query
          import Gargantext.Prelude import Gargantext.Prelude
          import Test.Ngrams.Query.PaginationCorpus import Test.Ngrams.Query.PaginationCorpus
          import Test.Tasty import Test.HUnit
          import Test.Tasty.HUnit import Test.Hspec
          import Test.Utils ((@??=)) import Test.Utils ((@??=))
          tests :: TestTree tests :: Spec
          tests = testGroup "Ngrams" [unitTests] tests = describe "Ngrams" $ unitTests
          curryElem :: NgramsElement curryElem :: NgramsElement
          curryElem = mkMapTerm "curry" curryElem = mkMapTerm "curry"
          ...@@ -43,32 +43,31 @@ mockQueryFn :: Maybe T.Text -> NgramsTerm -> Bool ...@@ -43,32 +43,31 @@ mockQueryFn :: Maybe T.Text -> NgramsTerm -> Bool
          mockQueryFn searchQuery (NgramsTerm nt) = mockQueryFn searchQuery (NgramsTerm nt) =
          maybe (const True) (T.isInfixOf . T.toLower) searchQuery (T.toLower nt) maybe (const True) (T.isInfixOf . T.toLower) searchQuery (T.toLower nt)
          unitTests :: TestTree unitTests :: Spec
          unitTests = testGroup "Query tests" unitTests = describe "Query tests" $ do
          [ -- Sorting -- Sorting
          testCase "Simple query mockFlatCorpus" testFlat01 it "Simple query mockFlatCorpus" testFlat01
          , testCase "Simple query (desc sorting)" testFlat02 it "Simple query (desc sorting)" testFlat02
          , testCase "[#331] sorting via DUCET works" testSortDiacriticsDucet it "[#331] sorting via DUCET works" testSortDiacriticsDucet
          , testCase "[#331] Natural sort ascending works" testNaturalSortAsceding it "[#331] Natural sort ascending works" testNaturalSortAsceding
          , testCase "[#331] Natural sort descending works" testNaturalSortDescending it "[#331] Natural sort descending works" testNaturalSortDescending
          -- -- Filtering -- -- Filtering
          , testCase "Simple query (listType = MapTerm)" testFlat03 it "Simple query (listType = MapTerm)" testFlat03
          , testCase "Simple query (listType = StopTerm)" testFlat04 it "Simple query (listType = StopTerm)" testFlat04
          -- -- Full text search -- -- Full text search
          , testCase "Simple query (search with match)" testFlat05 it "Simple query (search with match)" testFlat05
          -- -- Pagination -- -- Pagination
          , testCase "Simple pagination on all terms" test_pagination_allTerms it "Simple pagination on all terms" test_pagination_allTerms
          , testCase "Simple pagination on MapTerm" test_pagination01 it "Simple pagination on MapTerm" test_pagination01
          , testCase "Simple pagination on MapTerm (limit < total terms)" test_pagination02 it "Simple pagination on MapTerm (limit < total terms)" test_pagination02
          , testCase "Simple pagination on MapTerm (offset works)" test_pagination02_offset it "Simple pagination on MapTerm (offset works)" test_pagination02_offset
          , testCase "Simple pagination on ListTerm (limit < total terms)" test_pagination03 it "Simple pagination on ListTerm (limit < total terms)" test_pagination03
          , testCase "Simple pagination on ListTerm (offset works)" test_pagination03_offset it "Simple pagination on ListTerm (offset works)" test_pagination03_offset
          , testCase "Simple pagination on CandidateTerm (limit < total terms)" test_pagination04 it "Simple pagination on CandidateTerm (limit < total terms)" test_pagination04
          , testCase "paginating QuantumComputing corpus works (MapTerms)" test_paginationQuantum it "paginating QuantumComputing corpus works (MapTerms)" test_paginationQuantum
          , testCase "paginating QuantumComputing corpus works (CandidateTerm)" test_paginationQuantum_02 it "paginating QuantumComputing corpus works (CandidateTerm)" test_paginationQuantum_02
          -- -- Patching -- -- Patching
          , testCase "I can apply a patch to term mapTerms to stopTerms (issue #217)" test_217 it "I can apply a patch to term mapTerms to stopTerms (issue #217)" test_217
          ]
          -- Let's test that if we request elements sorted in -- Let's test that if we request elements sorted in
          -- /ascending/ order, we get them. -- /ascending/ order, we get them.
          ......
          test/Test/Ngrams/Terms.hs
          View file @ 4d32941d
          ...@@ -15,31 +15,26 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument(.. ...@@ -15,31 +15,26 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument(..
          import Gargantext.Database.Admin.Types.Node (NodeId(..)) import Gargantext.Database.Admin.Types.Node (NodeId(..))
          import Gargantext.Database.Schema.Context ( ContextPolyOnlyId(..) ) import Gargantext.Database.Schema.Context ( ContextPolyOnlyId(..) )
          import Gargantext.Prelude import Gargantext.Prelude
          import Test.Tasty import Test.Hspec
          import Test.Tasty.HUnit import Test.HUnit
          tests :: TestTree tests :: Spec
          tests = testGroup "Ngrams" [unitTests] tests = describe "Ngrams" unitTests
          unitTests :: TestTree unitTests :: Spec
          unitTests = testGroup "Terms tests" unitTests = describe "Terms tests" $ do
          [ -- Sorting -- Sorting
          testCase "Build patterns works 01" testBuildPatterns01 it "Build patterns works 01" testBuildPatterns01
          , testCase "Build patterns works 02" testBuildPatterns02 it "Build patterns works 02" testBuildPatterns02
          it "termsInText works 01" testTermsInText01
          , testCase "termsInText works 01" testTermsInText01 it "termsInText works 02" testTermsInText02
          , testCase "termsInText works 02" testTermsInText02 it "termsInText works 03" testTermsInText03
          , testCase "termsInText works 03" testTermsInText03 it "termsInText works 04 (related to issue #221)" testTermsInText04
          , testCase "termsInText works 04 (related to issue #221)" testTermsInText04 it "extractTermsWithList' works 01" testExtractTermsWithList'01
          it "docNgrams works 01" testDocNgrams01
          , testCase "extractTermsWithList' works 01" testExtractTermsWithList'01 it "docNgrams works 02" testDocNgrams02
          it "ngramsByDoc works 01" testNgramsByDoc01
          , testCase "docNgrams works 01" testDocNgrams01
          , testCase "docNgrams works 02" testDocNgrams02
          , testCase "ngramsByDoc works 01" testNgramsByDoc01
          ]
          -- | Let's document how the `buildPatternsWith` function works. -- | Let's document how the `buildPatternsWith` function works.
          testBuildPatterns01 :: Assertion testBuildPatterns01 :: Assertion
          ......
          test/Test/Offline/Errors.hs
          View file @ 4d32941d
          ...@@ -9,14 +9,13 @@ import Gargantext.Core (fromDBid) ...@@ -9,14 +9,13 @@ import Gargantext.Core (fromDBid)
          import Gargantext.Database.Admin.Config () import Gargantext.Database.Admin.Config ()
          import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
          import Prelude import Prelude
          import Test.Tasty import Test.Hspec
          import Test.Tasty.HUnit import Test.HUnit
          tests :: TestTree tests :: Spec
          tests = testGroup "Errors" [ tests = describe "Errors" $
          testCase "fromDBid comes with a CallStack" fromDBid_cs it "fromDBid comes with a CallStack" fromDBid_cs
          ]
          fromDBid_cs :: Assertion fromDBid_cs :: Assertion
          fromDBid_cs = do fromDBid_cs = do
          ......
          test/Test/Offline/JSON.hs
          View file @ 4d32941d
          ...@@ -21,9 +21,9 @@ import Gargantext.Database.Admin.Types.Node ...@@ -21,9 +21,9 @@ import Gargantext.Database.Admin.Types.Node
          import Paths_gargantext import Paths_gargantext
          import Prelude import Prelude
          import Test.Instances (genFrontendErr) import Test.Instances (genFrontendErr)
          import Test.Tasty import Test.Hspec
          import Test.Tasty.HUnit import Test.HUnit
          import Test.Tasty.QuickCheck import Test.QuickCheck
          import Text.RawString.QQ import Text.RawString.QQ
          jsonRoundtrip :: (Show a, FromJSON a, ToJSON a, Eq a) => a -> Property jsonRoundtrip :: (Show a, FromJSON a, ToJSON a, Eq a) => a -> Property
          ...@@ -50,34 +50,32 @@ jsonFrontendErrorRoundtrip = conjoin $ map mk_prop [minBound .. maxBound] ...@@ -50,34 +50,32 @@ jsonFrontendErrorRoundtrip = conjoin $ map mk_prop [minBound .. maxBound]
          mk_prop code = forAll (genFrontendErr code) $ \a -> mk_prop code = forAll (genFrontendErr code) $ \a ->
          counterexample ("Parsed JSON: " <> C8.unpack (encode a)) $ eitherDecode (encode a) === Right a counterexample ("Parsed JSON: " <> C8.unpack (encode a)) $ eitherDecode (encode a) === Right a
          tests :: TestTree tests :: Spec
          tests = testGroup "JSON" [ tests = describe "JSON" $ do
          testProperty "NodeId roundtrips" (jsonRoundtrip @NodeId) it "NodeId roundtrips" (property $ jsonRoundtrip @NodeId)
          , testProperty "RootId roundtrips" (jsonRoundtrip @RootId) it "RootId roundtrips" (property $ jsonRoundtrip @RootId)
          , testProperty "Datafield roundtrips" (jsonRoundtrip @Datafield) it "Datafield roundtrips" (property $ jsonRoundtrip @Datafield)
          , testProperty "WithQuery roundtrips" (jsonRoundtrip @WithQuery) it "WithQuery roundtrips" (property $ jsonRoundtrip @WithQuery)
          , testProperty "PublishRequest roundtrips" (jsonRoundtrip @PublishRequest) it "PublishRequest roundtrips" (property $ jsonRoundtrip @PublishRequest)
          , testProperty "RemoteExportRequest roundtrips" (jsonRoundtrip @RemoteExportRequest) it "RemoteExportRequest roundtrips" (property $ jsonRoundtrip @RemoteExportRequest)
          , testProperty "FrontendError roundtrips" jsonFrontendErrorRoundtrip it "FrontendError roundtrips" jsonFrontendErrorRoundtrip
          , testProperty "BackendErrorCode roundtrips" (jsonEnumRoundtrip (Dict @_ @BackendErrorCode)) it "BackendErrorCode roundtrips" (jsonEnumRoundtrip (Dict @_ @BackendErrorCode))
          , testProperty "NodeType roundtrips" (jsonEnumRoundtrip (Dict @_ @NodeType)) it "NodeType roundtrips" (jsonEnumRoundtrip (Dict @_ @NodeType))
          , testProperty "NodePublishPolicy roundtrips" (jsonEnumRoundtrip (Dict @_ @NodePublishPolicy)) it "NodePublishPolicy roundtrips" (jsonEnumRoundtrip (Dict @_ @NodePublishPolicy))
          , testCase "WithQuery frontend compliance" testWithQueryFrontend it "WithQuery frontend compliance" testWithQueryFrontend
          , testCase "WithQuery frontend compliance (PubMed)" testWithQueryFrontendPubMed it "WithQuery frontend compliance (PubMed)" testWithQueryFrontendPubMed
          , testCase "WithQuery frontend compliance (EPO)" testWithQueryFrontendEPO it "WithQuery frontend compliance (EPO)" testWithQueryFrontendEPO
          , testGroup "Phylo" [ describe "Phylo" $ do
          testProperty "PeriodToNode" (jsonRoundtrip @PeriodToNodeData) it "PeriodToNode" (property $ jsonRoundtrip @PeriodToNodeData)
          , testProperty "GraphData" (jsonRoundtrip @GraphData) it "GraphData" (property $ jsonRoundtrip @GraphData)
          , testProperty "GraphDataData" (jsonRoundtrip @GraphDataData) it "GraphDataData" (property $ jsonRoundtrip @GraphDataData)
          , testProperty "ObjectData" (jsonRoundtrip @ObjectData) it "ObjectData" (property $ jsonRoundtrip @ObjectData)
          , testProperty "PhyloData" (jsonRoundtrip @PhyloData) it "PhyloData" (property $ jsonRoundtrip @PhyloData)
          , testProperty "ComputeTimeHistory" (jsonRoundtrip @VizPhylo.ComputeTimeHistory) it "ComputeTimeHistory" (property $ jsonRoundtrip @VizPhylo.ComputeTimeHistory)
          , testProperty "Phylo" (jsonRoundtrip @VizPhylo.Phylo) it "Phylo" (property $ jsonRoundtrip @VizPhylo.Phylo)
          , testProperty "LayerData" (jsonRoundtrip @LayerData) it "LayerData" (property $ jsonRoundtrip @LayerData)
          , testCase "can parse bpa_phylo_test.json" testParseBpaPhylo it "can parse bpa_phylo_test.json" testParseBpaPhylo
          , testCase "can parse open_science.json" testOpenSciencePhylo it "can parse open_science.json" testOpenSciencePhylo
          ]
          ]
          testWithQueryFrontend :: Assertion testWithQueryFrontend :: Assertion
          testWithQueryFrontend = do testWithQueryFrontend = do
          ......
          test/Test/Offline/Ngrams.hs
          View file @ 4d32941d
          ...@@ -13,8 +13,7 @@ import Gargantext.Database.Schema.Context ...@@ -13,8 +13,7 @@ import Gargantext.Database.Schema.Context
          import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
          import Test.Instances () import Test.Instances ()
          import Test.QuickCheck import Test.QuickCheck
          import Test.Tasty import Test.Hspec
          import Test.Tasty.QuickCheck (testProperty)
          import Control.Lens import Control.Lens
          import qualified Test.QuickCheck as QC import qualified Test.QuickCheck as QC
          import Gargantext.Core.Text.Terms.Mono (isSep) import Gargantext.Core.Text.Terms.Mono (isSep)
          ...@@ -82,18 +81,14 @@ instance Arbitrary DocumentWithMatches where ...@@ -82,18 +81,14 @@ instance Arbitrary DocumentWithMatches where
          pure $ DocumentWithMatches generatedTerms hyperDoc pure $ DocumentWithMatches generatedTerms hyperDoc
          tests :: TestTree tests :: Spec
          tests = testGroup "Ngrams" [ tests = describe "Ngrams" $ do
          testGroup "buildPatterns internal correctness" [ describe "buildPatterns internal correctness" $ do
          testProperty "patterns, no matter how simple, can be searched" prop_patterns_internal_consistency it "patterns, no matter how simple, can be searched" $ property prop_patterns_internal_consistency
          ] describe "buildPatternsWith" $ do
          , testGroup "buildPatternsWith" [ it "return results for non-empty input terms" $ property testBuildPatternsNonEmpty
          testProperty "return results for non-empty input terms" testBuildPatternsNonEmpty describe "docNgrams" $ do
          ] it "always matches if the input text contains any of the terms" $ property testDocNgramsOKMatch
          , testGroup "docNgrams" [
          testProperty "always matches if the input text contains any of the terms" testDocNgramsOKMatch
          ]
          ]
          testDocNgramsOKMatch :: Lang -> DocumentWithMatches -> Property testDocNgramsOKMatch :: Lang -> DocumentWithMatches -> Property
          testDocNgramsOKMatch lang (DocumentWithMatches ts doc) = testDocNgramsOKMatch lang (DocumentWithMatches ts doc) =
          ......
          test/Test/Offline/Phylo.hs
          View file @ 4d32941d
          ...@@ -7,8 +7,10 @@ module Test.Offline.Phylo (tests) where ...@@ -7,8 +7,10 @@ module Test.Offline.Phylo (tests) where
          import CLI.Phylo.Common import CLI.Phylo.Common
          import Data.Aeson as JSON import Data.Aeson as JSON
          import Data.Aeson.Types qualified as JSON
          import Data.Aeson.Encode.Pretty qualified as JSON import Data.Aeson.Encode.Pretty qualified as JSON
          import Data.Aeson.Types qualified as JSON
          import Data.ByteString.Char8 qualified as C8
          import Data.ByteString.Lazy qualified as BIO
          import Data.ByteString.Lazy qualified as BL import Data.ByteString.Lazy qualified as BL
          import Data.GraphViz.Attributes.Complete qualified as Graphviz import Data.GraphViz.Attributes.Complete qualified as Graphviz
          import Data.Text.Lazy as TL import Data.Text.Lazy as TL
          ...@@ -16,18 +18,17 @@ import Data.TreeDiff ...@@ -16,18 +18,17 @@ import Data.TreeDiff
          import Data.Vector qualified as V import Data.Vector qualified as V
          import Gargantext.Core.Text.List.Formats.TSV import Gargantext.Core.Text.List.Formats.TSV
          import Gargantext.Core.Types.Phylo hiding (Phylo(..)) import Gargantext.Core.Types.Phylo hiding (Phylo(..))
          import Gargantext.Core.Viz.Phylo hiding (EdgeType(..))
          import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo, phylo2dot2json) import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo, phylo2dot2json)
          import Gargantext.Core.Viz.Phylo.Example qualified as Cleopatre import Gargantext.Core.Viz.Phylo.Example qualified as Cleopatre
          import Gargantext.Core.Viz.Phylo hiding (EdgeType(..))
          import Gargantext.Core.Viz.Phylo.PhyloExport import Gargantext.Core.Viz.Phylo.PhyloExport
          import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink) import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink)
          import Gargantext.Core.Viz.Phylo.PhyloTools import Gargantext.Core.Viz.Phylo.PhyloTools
          import Paths_gargantext import Paths_gargantext
          import Prelude import Prelude
          import Test.Tasty import Test.HUnit
          import Test.Tasty.Golden (goldenVsStringDiff) import Test.Hspec
          import Test.Tasty.HUnit import Test.Hspec.Golden
          import qualified Test.Tasty.Golden.Advanced as Advanced
          phyloTestConfig :: PhyloConfig phyloTestConfig :: PhyloConfig
          phyloTestConfig = PhyloConfig { phyloTestConfig = PhyloConfig {
          ...@@ -53,21 +54,36 @@ phyloTestConfig = PhyloConfig { ...@@ -53,21 +54,36 @@ phyloTestConfig = PhyloConfig {
          , exportFilter = [ByBranchSize {_branch_size = 3.0}] , exportFilter = [ByBranchSize {_branch_size = 3.0}]
          } }
          phyloGolden :: TestName -> (FilePath, IO BL.ByteString) -> TestTree phyloGolden :: (FilePath, BL.ByteString) -> Golden BL.ByteString
          phyloGolden testName (fp, action) = phyloGolden (fp, actualOutput) =
          goldenVsStringDiff testName differ fp action Golden {
          where output = actualOutput
          differ ref new = [ "diff", "-u", "-w", "--color=always", ref, new] , encodePretty = C8.unpack . BIO.toStrict
          , writeToFile = \_ _ -> pure ()
          , readFromFile = BIO.readFile
          , goldenFile = fp
          , actualFile = Nothing
          , failFirstTime = True
          }
          -- | Use this variant for those tests which requires a more sophisticated way of -- | Use this variant for those tests which requires a more sophisticated way of
          -- comparing outputs directly on the GraphData -- comparing outputs directly on the GraphData
          phyloGoldenGraphData :: TestName -> (FilePath, IO GraphData) -> TestTree phyloGoldenGraphData :: (FilePath, GraphData) -> Golden GraphData
          phyloGoldenGraphData testName (goldenPath, getActual) = phyloGoldenGraphData (goldenPath, new) =
          Advanced.goldenTest testName getGolden getActual differ updateGolden Golden {
          output = new
          , encodePretty = differ
          , writeToFile = \_ new' -> updateGolden new'
          , readFromFile = const getGolden
          , goldenFile = goldenPath
          , actualFile = Nothing
          , failFirstTime = True
          }
          where where
          differ ref new = pure $ case compareGraphDataFuzzy ref new of differ :: GraphData -> String
          True -> Nothing differ ref = case compareGraphDataFuzzy ref new of
          False -> Just $ show (ansiWlEditExprCompact $ ediff ref new) True -> mempty
          False -> show (ansiWlEditExprCompact $ ediff ref new)
          updateGolden :: GraphData -> IO () updateGolden :: GraphData -> IO ()
          updateGolden gd = BL.writeFile goldenPath (JSON.encodePretty gd) updateGolden gd = BL.writeFile goldenPath (JSON.encodePretty gd)
          ...@@ -79,36 +95,34 @@ phyloGoldenGraphData testName (goldenPath, getActual) = ...@@ -79,36 +95,34 @@ phyloGoldenGraphData testName (goldenPath, getActual) =
          Left err -> fail err Left err -> fail err
          Right (expected :: GraphData) -> pure expected Right (expected :: GraphData) -> pure expected
          tests :: TestTree tests :: Spec
          tests = testGroup "Phylo" [ tests = describe "Phylo" $ do
          testGroup "Export" [ describe "Export" $ do
          testCase "ngramsToLabel respects encoding" test_ngramsToLabel_01 it "ngramsToLabel respects encoding" test_ngramsToLabel_01
          , testCase "ngramsToLabel is rendered correctly in CustomAttribute" test_ngramsToLabel_02 it "ngramsToLabel is rendered correctly in CustomAttribute" test_ngramsToLabel_02
          ] describe "toPhyloWithoutLink" $ do
          , testGroup "toPhyloWithoutLink" [ it "returns expected data" testSmallPhyloWithoutLinkExpectedOutput
          testCase "returns expected data" testSmallPhyloWithoutLinkExpectedOutput it "phyloCleopatre returns expected data" $ phyloGolden testCleopatreWithoutLinkExpectedOutput
          , phyloGolden "phyloCleopatre returns expected data" testCleopatreWithoutLinkExpectedOutput beforeAll testNadalWithoutLinkExpectedOutput $
          , phyloGolden "Nadal canned corpus returns expected data" testNadalWithoutLinkExpectedOutput it "Nadal canned corpus returns expected data" $ phyloGolden
          ] describe "phylo2dot2json" $ do
          , testGroup "phylo2dot2json" [ beforeAll testPhylo2dot2json $
          phyloGoldenGraphData "is deterministic" testPhylo2dot2json it "is deterministic" phyloGoldenGraphData
          ] describe "toPhylo" $ do
          , testGroup "toPhylo" [ beforeAll testToPhyloDeterminism $
          phyloGolden "is deterministic" testToPhyloDeterminism it "is deterministic" $ phyloGolden
          ] describe "relatedComponents" $ do
          , testGroup "relatedComponents" [ it "finds simple connection" testRelComp_Connected
          testCase "finds simple connection" testRelComp_Connected it "parses csv phylo" testCsvPhylo
          ]
          , testCase "parses csv phylo" testCsvPhylo
          ]
          testCleopatreWithoutLinkExpectedOutput :: (FilePath, IO BL.ByteString) testCleopatreWithoutLinkExpectedOutput :: (FilePath, BL.ByteString)
          testCleopatreWithoutLinkExpectedOutput = testCleopatreWithoutLinkExpectedOutput =
          let actual = toPhyloWithoutLink Cleopatre.docs Cleopatre.config let actual = toPhyloWithoutLink Cleopatre.docs Cleopatre.config
          in ("test-data/phylo/cleopatre.golden.json", pure $ JSON.encodePretty actual) in ("test-data/phylo/cleopatre.golden.json", JSON.encodePretty actual)
          testNadalWithoutLinkExpectedOutput :: IO (FilePath, BL.ByteString)
          testNadalWithoutLinkExpectedOutput = do
          testNadalWithoutLinkExpectedOutput :: (FilePath, IO BL.ByteString)
          testNadalWithoutLinkExpectedOutput = ("test-data/phylo/nadal.golden.json",) $ do
          corpusPath' <- getDataFileName "test-data/phylo/nadal_docslist.golden.tsv" corpusPath' <- getDataFileName "test-data/phylo/nadal_docslist.golden.tsv"
          listPath' <- getDataFileName "test-data/phylo/nadal_ngramslist.golden.tsv" listPath' <- getDataFileName "test-data/phylo/nadal_ngramslist.golden.tsv"
          let config = phyloTestConfig { corpusPath = corpusPath' let config = phyloTestConfig { corpusPath = corpusPath'
          ...@@ -120,7 +134,9 @@ testNadalWithoutLinkExpectedOutput = ("test-data/phylo/nadal.golden.json",) $ do ...@@ -120,7 +134,9 @@ testNadalWithoutLinkExpectedOutput = ("test-data/phylo/nadal.golden.json",) $ do
          (corpusPath config) (corpusPath config)
          [Year 3 1 5,Month 3 1 5,Week 4 2 5] [Year 3 1 5,Month 3 1 5,Week 4 2 5]
          mapList mapList
          pure $ JSON.encodePretty $ setConfig phyloTestConfig $ toPhyloWithoutLink corpus config pure ( "test-data/phylo/nadal.golden.json"
          , JSON.encodePretty $ setConfig phyloTestConfig $ toPhyloWithoutLink corpus config
          )
          testSmallPhyloWithoutLinkExpectedOutput :: Assertion testSmallPhyloWithoutLinkExpectedOutput :: Assertion
          testSmallPhyloWithoutLinkExpectedOutput = do testSmallPhyloWithoutLinkExpectedOutput = do
          ...@@ -139,12 +155,12 @@ testSmallPhyloWithoutLinkExpectedOutput = do ...@@ -139,12 +155,12 @@ testSmallPhyloWithoutLinkExpectedOutput = do
          expected <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/small-phylo.golden.json") expected <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/small-phylo.golden.json")
          assertBool (show $ ansiWlEditExprCompact $ ediff expected actual) (expected == actual) assertBool (show $ ansiWlEditExprCompact $ ediff expected actual) (expected == actual)
          testPhylo2dot2json :: (FilePath, IO GraphData) testPhylo2dot2json :: IO (FilePath, GraphData)
          testPhylo2dot2json = ("test-data/phylo/phylo2dot2json.golden.json",) $ do testPhylo2dot2json = do
          actual_e <- JSON.parseEither JSON.parseJSON <$> phylo2dot2json Cleopatre.phyloCleopatre actual_e <- JSON.parseEither JSON.parseJSON <$> phylo2dot2json Cleopatre.phyloCleopatre
          case actual_e of case actual_e of
          Left err -> fail err Left err -> fail err
          Right (actual :: GraphData) -> pure actual Right (actual :: GraphData) -> pure ("test-data/phylo/phylo2dot2json.golden.json", actual)
          compareGraphDataFuzzy :: GraphData -> GraphData -> Bool compareGraphDataFuzzy :: GraphData -> GraphData -> Bool
          compareGraphDataFuzzy gd1 gd2 = compareGraphDataFuzzy gd1 gd2 =
          ...@@ -255,8 +271,8 @@ testRelComp_Connected = do ...@@ -255,8 +271,8 @@ testRelComp_Connected = do
          (relatedComponents @Int) [[1,2], [3,5], [2,4],[9,5],[5,4]] @?= [[1,2,4,3,5,9]] (relatedComponents @Int) [[1,2], [3,5], [2,4],[9,5],[5,4]] @?= [[1,2,4,3,5,9]]
          (relatedComponents @Int) [[1,2,5], [4,5,9]] @?= [[1,2,5,4,9]] (relatedComponents @Int) [[1,2,5], [4,5,9]] @?= [[1,2,5,4,9]]
          testToPhyloDeterminism :: (FilePath, IO BL.ByteString) testToPhyloDeterminism :: IO (FilePath, BL.ByteString)
          testToPhyloDeterminism = ("test-data/phylo/187481.json",) $ do testToPhyloDeterminism = do
          corpusPath' <- getDataFileName "test-data/phylo/GarganText_DocsList-nodeId-187481.tsv" corpusPath' <- getDataFileName "test-data/phylo/GarganText_DocsList-nodeId-187481.tsv"
          listPath' <- getDataFileName "test-data/phylo/GarganText_NgramsList-187482.tsv" listPath' <- getDataFileName "test-data/phylo/GarganText_NgramsList-187482.tsv"
          let config = phyloTestConfig { corpusPath = corpusPath' let config = phyloTestConfig { corpusPath = corpusPath'
          ...@@ -269,7 +285,9 @@ testToPhyloDeterminism = ("test-data/phylo/187481.json",) $ do ...@@ -269,7 +285,9 @@ testToPhyloDeterminism = ("test-data/phylo/187481.json",) $ do
          [Year 3 1 5,Month 3 1 5,Week 4 2 5] [Year 3 1 5,Month 3 1 5,Week 4 2 5]
          mapList mapList
          let actual = setConfig phyloTestConfig $ toPhylo $ toPhyloWithoutLink corpus config let actual = setConfig phyloTestConfig $ toPhylo $ toPhyloWithoutLink corpus config
          pure $ JSON.encodePretty actual pure ( "test-data/phylo/187481.json"
          , JSON.encodePretty actual
          )
          testCsvPhylo :: Assertion testCsvPhylo :: Assertion
          testCsvPhylo = do testCsvPhylo = do
          ......
          test/Test/Offline/Stemming/Lancaster.hs
          View file @ 4d32941d
          ...@@ -4,19 +4,30 @@ module Test.Offline.Stemming.Lancaster where ...@@ -4,19 +4,30 @@ module Test.Offline.Stemming.Lancaster where
          import Prelude import Prelude
          import Data.ByteString.Char8 qualified as C8 import Data.ByteString.Char8 qualified as C8
          import Data.ByteString.Lazy qualified as BIO
          import Data.Text qualified as T import Data.Text qualified as T
          import Gargantext.Core.Text.Terms.Mono.Stem.Internal.Lancaster (stem) import Gargantext.Core.Text.Terms.Mono.Stem.Internal.Lancaster (stem)
          import Gargantext.Prelude (toS) import Gargantext.Prelude (toS)
          import Test.Tasty import Test.Hspec
          import Test.Tasty.Golden (goldenVsString) import Test.Hspec.Golden
          import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
          import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
          goldenBS :: BL.ByteString -> Golden BL.ByteString
          goldenBS actualOutput =
          Golden {
          output = actualOutput
          , encodePretty = C8.unpack . BIO.toStrict
          , writeToFile = \_ _ -> pure ()
          , readFromFile = BIO.readFile
          , goldenFile = "test-data/stemming/lancaster.txt"
          , actualFile = Nothing
          , failFirstTime = True
          }
          tests :: TestTree tests :: Spec
          tests = testGroup "Lancaster" [ tests = describe "Lancaster" $
          goldenVsString "test vector works" "test-data/stemming/lancaster.txt" mkTestVector it "test vector works" $ goldenBS mkTestVector
          ]
          -- | List un /unstemmed/ test words -- | List un /unstemmed/ test words
          testWords :: [(Int, T.Text)] testWords :: [(Int, T.Text)]
          ...@@ -126,5 +137,5 @@ testWords = [ ...@@ -126,5 +137,5 @@ testWords = [
          , (103, "corroborate") , (103, "corroborate")
          ] ]
          mkTestVector :: IO BL.ByteString mkTestVector :: BL.ByteString
          mkTestVector = pure $ toS $ C8.unlines (map (\(indx, w) -> (C8.pack $ show indx) <> "," <> TE.encodeUtf8 (stem w)) testWords) mkTestVector = toS $ C8.unlines (map (\(indx, w) -> (C8.pack $ show indx) <> "," <> TE.encodeUtf8 (stem w)) testWords)
          test/Test/Utils.hs
          View file @ 4d32941d
          ...@@ -73,7 +73,7 @@ import Test.Hspec.Expectations ...@@ -73,7 +73,7 @@ import Test.Hspec.Expectations
          import Test.Hspec.Wai.JSON (FromValue(..)) import Test.Hspec.Wai.JSON (FromValue(..))
          import Test.Hspec.Wai (MatchBody(..), WaiExpectation, WaiSession, request) import Test.Hspec.Wai (MatchBody(..), WaiExpectation, WaiSession, request)
          import Test.Hspec.Wai.Matcher (MatchHeader(..), ResponseMatcher(..), bodyEquals, formatHeader, match) import Test.Hspec.Wai.Matcher (MatchHeader(..), ResponseMatcher(..), bodyEquals, formatHeader, match)
          import Test.Tasty.HUnit (Assertion, assertBool) import Test.HUnit (Assertion, assertBool)
          import Test.Utils.Notifications (withWSConnection, millisecond) import Test.Utils.Notifications (withWSConnection, millisecond)
          ......
          test/drivers/tasty/Main.hs deleted 100644 → 0
          View file @ d362b468
          {--|
          Module : Main.hs
          Description : Main for Gargantext Tasty Tests
          Copyright : (c) CNRS, 2017-Present
          License : AGPL + CECILL v3
          Maintainer : team@gargantext.org
          Stability : experimental
          Portability : POSIX
          -}
          module Main where
          import Gargantext.Prelude
          import qualified Test.Core.LinearAlgebra as LinearAlgebra
          import qualified Test.Core.Notifications as Notifications
          import qualified Test.Core.Orchestrator as Orchestrator
          import qualified Test.Core.Similarity as Similarity
          import qualified Test.Core.Text.Corpus.Query as CorpusQuery
          import qualified Test.Core.Text.Corpus.TSV as TSVParser
          import qualified Test.Core.Utils as Utils
          import qualified Test.Core.Worker as Worker
          import qualified Test.Graph.Clustering as Clustering
          import qualified Test.Graph.Distance as Distance
          import qualified Test.Ngrams.Lang.Occurrences as Occurrences
          import qualified Test.Ngrams.NLP as NLP
          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
          import qualified Test.Utils.Crypto as Crypto
          import qualified Test.Utils.Jobs as Jobs
          import System.IO (hGetBuffering, hSetBuffering)
          import Test.Tasty
          import Test.Tasty.Hspec
          -- | https://mercurytechnologies.github.io/ghciwatch/integration/tasty.html
          protectStdoutBuffering :: IO a -> IO a
          protectStdoutBuffering action =
          bracket
          (hGetBuffering stdout)
          (\bufferMode -> hSetBuffering stdout bufferMode)
          (const action)
          main :: IO ()
          main = do
          utilSpec <- testSpec "Utils" Utils.test
          clusteringSpec <- testSpec "Graph Clustering" Clustering.test
          distanceSpec <- testSpec "Graph Distance" Distance.test
          dateSplitSpec <- testSpec "Date split" PD.testDateSplit
          cryptoSpec <- testSpec "Crypto" Crypto.test
          nlpSpec <- testSpec "NLP" NLP.test
          jobsSpec <- testSpec "Jobs" Jobs.test
          similaritySpec <- testSpec "Similarity" Similarity.test
          asyncUpdatesSpec <- testSpec "Notifications" Notifications.test
          occurrencesSpec <- testSpec "Occurrences" Occurrences.test
          protectStdoutBuffering $ defaultMain $ testGroup "Gargantext"
          [ utilSpec
          , clusteringSpec
          , distanceSpec
          , dateSplitSpec
          , cryptoSpec
          , nlpSpec
          , jobsSpec
          , occurrencesSpec
          , NgramsQuery.tests
          , occurrencesSpec
          , CorpusQuery.tests
          , TSVParser.tests
          , JSON.tests
          , Ngrams.tests
          , Errors.tests
          , similaritySpec
          , Phylo.tests
          , testGroup "Stemming" [ Lancaster.tests ]
          , Worker.tests
          , asyncUpdatesSpec
          , Notifications.qcTests
          , Orchestrator.qcTests
          , NgramsTerms.tests
          , LinearAlgebra.tests
          ]
          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