[tests] fix hspec test compilation issue

Also, use genericArbitrary in Instances, this simplifies things
parent a250518a
Pipeline #6990 passed with stages
in 72 minutes and 47 seconds
...@@ -738,6 +738,7 @@ common testDependencies ...@@ -738,6 +738,7 @@ common testDependencies
, fmt , fmt
, gargantext , gargantext
, gargantext-prelude , gargantext-prelude
, generic-arbitrary >= 1.0.1 && < 2
, graphviz ^>= 2999.20.1.0 , graphviz ^>= 2999.20.1.0
, haskell-bee , haskell-bee
, hspec ^>= 2.11.1 , hspec ^>= 2.11.1
......
...@@ -207,7 +207,7 @@ data PhyloSubConfigAPI = ...@@ -207,7 +207,7 @@ data PhyloSubConfigAPI =
, _sc_clique :: Cluster , _sc_clique :: Cluster
, _sc_exportFilter :: Double , _sc_exportFilter :: Double
, _sc_defaultMode :: Bool , _sc_defaultMode :: Bool
} deriving (Show,Generic,Eq) } deriving (Show, Generic, Eq)
subConfigAPI2config :: PhyloSubConfigAPI -> PhyloConfig subConfigAPI2config :: PhyloSubConfigAPI -> PhyloConfig
......
...@@ -25,7 +25,7 @@ import Control.Monad.STM (atomically) ...@@ -25,7 +25,7 @@ import Control.Monad.STM (atomically)
import Data.Aeson qualified as Aeson import Data.Aeson qualified as Aeson
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Gargantext.Core.Notifications.Dispatcher.Types qualified as DT import Gargantext.Core.Notifications.Dispatcher.Types qualified as DT
import Gargantext.Core.Worker.Jobs (sendJobCfg) import Gargantext.Core.Worker.Jobs (sendJobWithCfg)
import Gargantext.Core.Worker.Jobs.Types (Job(Ping)) import Gargantext.Core.Worker.Jobs.Types (Job(Ping))
import Network.WebSockets qualified as WS import Network.WebSockets qualified as WS
import Prelude import Prelude
...@@ -61,7 +61,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -61,7 +61,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
-- wait a bit to connect -- wait a bit to connect
threadDelay (500 * millisecond) threadDelay (500 * millisecond)
_ <- sendJobCfg cfg Ping _ <- sendJobWithCfg cfg Ping
mTimeout <- Timeout.timeout (5 * 1000000) $ do mTimeout <- Timeout.timeout (5 * 1000000) $ do
md <- atomically $ readTChan tchan md <- atomically $ readTChan tchan
......
...@@ -9,6 +9,7 @@ Portability : POSIX ...@@ -9,6 +9,7 @@ Portability : POSIX
-} -}
{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
...@@ -21,26 +22,27 @@ import Data.Patch.Class (Replace, replace) ...@@ -21,26 +22,27 @@ import Data.Patch.Class (Replace, replace)
import Data.Text qualified as T import Data.Text qualified as T
import Data.Validity (Validation(..), ValidationChain (..), prettyValidation) import Data.Validity (Validation(..), ValidationChain (..), prettyValidation)
import EPO.API.Client.Types qualified as EPO import EPO.API.Client.Types qualified as EPO
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..), ForgotPasswordAsyncParams(..)) import Gargantext.API.Admin.Auth.Types (AuthenticatedUser, ForgotPasswordAsyncParams)
import Gargantext.API.Errors.Types qualified as Errors import Gargantext.API.Errors.Types qualified as Errors
import Gargantext.API.Ngrams.Types qualified as Ngrams import Gargantext.API.Ngrams.Types qualified as Ngrams
import Gargantext.API.Node.Contact.Types (AddContactParams(..)) import Gargantext.API.Node.Contact.Types (AddContactParams)
import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm(..)) import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm)
import Gargantext.API.Node.Corpus.New (ApiInfo(..)) import Gargantext.API.Node.Corpus.New (ApiInfo)
import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..)) import Gargantext.API.Node.Corpus.New.Types (FileFormat, FileType)
import Gargantext.API.Node.Corpus.Types (Datafield(..), Database(..)) import Gargantext.API.Node.Corpus.Types (Datafield, Database)
import Gargantext.API.Node.DocumentsFromWriteNodes.Types qualified as DFWN import Gargantext.API.Node.DocumentsFromWriteNodes.Types qualified as DFWN
import Gargantext.API.Node.DocumentUpload.Types (DocumentUpload(..)) import Gargantext.API.Node.DocumentUpload.Types (DocumentUpload)
import Gargantext.API.Node.FrameCalcUpload.Types qualified as FCU import Gargantext.API.Node.FrameCalcUpload.Types qualified as FCU
import Gargantext.API.Node.Get (GetNodeParams(..)) import Gargantext.API.Node.Get (GetNodeParams)
import Gargantext.API.Node.New.Types (PostNode(..)) import Gargantext.API.Node.New.Types (PostNode(..))
import Gargantext.API.Node.Share.Types (ShareNodeParams(..)) import Gargantext.API.Node.Share.Types (ShareNodeParams(..))
import Gargantext.API.Node.Update.Types qualified as NU import Gargantext.API.Node.Update.Types qualified as NU
import Gargantext.API.Node.Types (NewWithForm(..), RenameNode(..), WithQuery(..)) import Gargantext.API.Node.Types (NewWithForm, RenameNode(..), WithQuery)
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
import Gargantext.Core.Notifications.Dispatcher.Types qualified as DET import Gargantext.Core.Notifications.Dispatcher.Types qualified as DET
import Gargantext.Core.Types.Individu qualified as Individu import Gargantext.Core.Types.Individu qualified as Individu
import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm)) import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm))
import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI)
import Gargantext.Core.Worker.Jobs.Types (Job(..)) import Gargantext.Core.Worker.Jobs.Types (Job(..))
import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata
import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId(..), NodeType(..)) import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId(..), NodeType(..))
...@@ -50,17 +52,16 @@ import Servant.Job.Types qualified as SJ ...@@ -50,17 +52,16 @@ import Servant.Job.Types qualified as SJ
import Text.Parsec.Error (ParseError, Message(..), newErrorMessage) import Text.Parsec.Error (ParseError, Message(..), newErrorMessage)
import Text.Parsec.Pos import Text.Parsec.Pos
import Test.QuickCheck import Test.QuickCheck
import Test.QuickCheck.Arbitrary.Generic
instance Arbitrary AuthenticatedUser where instance Arbitrary AuthenticatedUser where arbitrary = genericArbitrary
arbitrary = AuthenticatedUser <$> arbitrary -- _auth_node_id
<*> arbitrary -- _auth_user_id
instance Arbitrary Message where instance Arbitrary Message where
arbitrary = do arbitrary = do
msgContent <- arbitrary msgContent <- arbitrary
oneof $ return <$> [SysUnExpect msgContent oneof $ return <$> [ SysUnExpect msgContent
, UnExpect msgContent , UnExpect msgContent
, Expect msgContent , Expect msgContent
, Message msgContent , Message msgContent
...@@ -94,14 +95,7 @@ alphanum :: [Char] ...@@ -94,14 +95,7 @@ alphanum :: [Char]
alphanum = smallLetter <> largeLetter <> digit alphanum = smallLetter <> largeLetter <> digit
instance Arbitrary Individu.User where instance Arbitrary Individu.User where arbitrary = genericArbitrary
arbitrary = do
userId <- arbitrary
userName <- arbitrary
nodeId <- arbitrary
oneof [ pure $ Individu.UserDBId userId
, pure $ Individu.UserName userName
, pure $ Individu.RootId nodeId ]
instance Arbitrary EPO.AuthKey where instance Arbitrary EPO.AuthKey where
...@@ -117,57 +111,29 @@ instance Arbitrary EPO.Token where ...@@ -117,57 +111,29 @@ instance Arbitrary EPO.Token where
arbitrary = EPO.Token <$> arbitrary arbitrary = EPO.Token <$> arbitrary
instance Arbitrary ApiInfo where instance Arbitrary ApiInfo where arbitrary = genericArbitrary
arbitrary = ApiInfo <$> arbitrary
instance Arbitrary FileFormat where instance Arbitrary FileFormat where arbitrary = genericArbitrary
arbitrary = elements [ Plain, ZIP ] instance Arbitrary FileType where arbitrary = genericArbitrary
instance Arbitrary FileType where
arbitrary = elements [TSV, PresseRIS]
instance Arbitrary Database where instance Arbitrary Database where arbitrary = arbitraryBoundedEnum
arbitrary = arbitraryBoundedEnum instance Arbitrary Datafield where arbitrary = genericArbitrary
instance Arbitrary Datafield where
arbitrary = oneof [pure Gargantext, pure Web, pure Files, External <$> arbitrary]
instance Arbitrary WithQuery where instance Arbitrary WithQuery where arbitrary = genericArbitrary
arbitrary = do
_wq_query <- arbitrary
_wq_databases <- arbitrary
_wq_datafield <- arbitrary
_wq_lang <- arbitrary
_wq_node_id <- arbitrary
_wq_flowListWith <- arbitrary
_wq_pubmedAPIKey <- arbitrary
_wq_epoAPIUser <- arbitrary
_wq_epoAPIToken <- arbitrary
pure $ WithQuery { .. }
-- The endpoint does nothing currently, but if it will, we need to provide some valid _wf_data -- The endpoint does nothing currently, but if it will, we need to provide some valid _wf_data
instance Arbitrary AnnuaireWithForm where instance Arbitrary AnnuaireWithForm where arbitrary = genericArbitrary
arbitrary = AnnuaireWithForm <$> arbitrary -- _wf_filetype
<*> arbitrary -- _wf_data
<*> arbitrary -- _wf_lang
instance Arbitrary AddContactParams where instance Arbitrary AddContactParams where arbitrary = genericArbitrary
arbitrary = elements [ AddContactParams "Pierre" "Dupont" ]
instance Arbitrary DFWN.Params where instance Arbitrary DFWN.Params where arbitrary = genericArbitrary
arbitrary = DFWN.Params <$> arbitrary -- id
<*> arbitrary -- paragraphs
<*> arbitrary -- lang
<*> arbitrary -- selection
instance Arbitrary ForgotPasswordAsyncParams where instance Arbitrary ForgotPasswordAsyncParams where arbitrary = genericArbitrary
arbitrary = ForgotPasswordAsyncParams <$> arbitrary -- TODO fix proper email
instance Arbitrary FCU.FrameCalcUpload where instance Arbitrary FCU.FrameCalcUpload where arbitrary = genericArbitrary
arbitrary = FCU.FrameCalcUpload <$> arbitrary -- _wf_lang
<*> arbitrary -- _wf_selection
instance Arbitrary GetNodeParams where instance Arbitrary GetNodeParams where arbitrary = genericArbitrary
arbitrary = GetNodeParams <$> arbitrary <*> arbitrary
instance Arbitrary PostNode where instance Arbitrary PostNode where
arbitrary = elements [PostNode "Node test" NodeCorpus] arbitrary = elements [PostNode "Node test" NodeCorpus]
...@@ -177,55 +143,21 @@ instance Arbitrary ShareNodeParams where ...@@ -177,55 +143,21 @@ instance Arbitrary ShareNodeParams where
, SharePublicParams (UnsafeMkNodeId 1) , SharePublicParams (UnsafeMkNodeId 1)
] ]
instance Arbitrary NU.UpdateNodeParams where instance Arbitrary PhyloSubConfigAPI where arbitrary = genericArbitrary
arbitrary = do instance Arbitrary NU.UpdateNodeParams where arbitrary = genericArbitrary
l <- NU.UpdateNodeParamsList <$> arbitrary instance Arbitrary NU.Method where arbitrary = arbitraryBoundedEnum
g <- NU.UpdateNodeParamsGraph <$> arbitrary instance Arbitrary NU.Granularity where arbitrary = arbitraryBoundedEnum
t <- NU.UpdateNodeParamsTexts <$> arbitrary instance Arbitrary NU.Charts where arbitrary = arbitraryBoundedEnum
b <- NU.UpdateNodeParamsBoard <$> arbitrary instance Arbitrary NU.UpdateNodeConfigGraph where arbitrary = genericArbitrary
elements [l,g,t,b]
instance Arbitrary NU.Method where instance Arbitrary Ngrams.UpdateTableNgramsCharts where arbitrary = genericArbitrary
arbitrary = elements [ minBound .. maxBound ]
instance Arbitrary NU.Granularity where -- TODO _du_date isn't arbitrary
arbitrary = elements [ minBound .. maxBound ] instance Arbitrary DocumentUpload where arbitrary = genericArbitrary
instance Arbitrary NU.Charts where
arbitrary = elements [ minBound .. maxBound ]
instance Arbitrary NU.UpdateNodeConfigGraph where
arbitrary = do
methodGraphMetric <- arbitrary
methodGraphClustering <- arbitrary
methodGraphBridgeness <- arbitrary
methodGraphEdgesStrength <- arbitrary
methodGraphNodeType1 <- arbitrary
methodGraphNodeType2 <- arbitrary
return $ NU.UpdateNodeConfigGraph methodGraphMetric
methodGraphClustering
methodGraphBridgeness
methodGraphEdgesStrength
methodGraphNodeType1
methodGraphNodeType2
instance Arbitrary Ngrams.UpdateTableNgramsCharts where
arbitrary = Ngrams.UpdateTableNgramsCharts <$> arbitrary -- _utn_tab_type
<*> arbitrary -- _utn_list_id
instance Arbitrary DocumentUpload where
arbitrary = DocumentUpload <$> arbitrary -- _du_abstract
<*> arbitrary -- _du_authors
<*> arbitrary -- _du_sources
<*> arbitrary -- _du_title
<*> arbitrary -- _du_date -- TODO This isn't arbitrary
<*> arbitrary -- _du_language
-- Hyperdata -- Hyperdata
instance Arbitrary Hyperdata.HyperdataUser where instance Arbitrary Hyperdata.HyperdataUser where arbitrary = genericArbitrary
arbitrary = Hyperdata.HyperdataUser <$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary Hyperdata.HyperdataPrivate where instance Arbitrary Hyperdata.HyperdataPrivate where
arbitrary = pure Hyperdata.defaultHyperdataPrivate arbitrary = pure Hyperdata.defaultHyperdataPrivate
...@@ -234,36 +166,21 @@ instance Arbitrary Hyperdata.HyperdataPublic where ...@@ -234,36 +166,21 @@ instance Arbitrary Hyperdata.HyperdataPublic where
arbitrary = pure Hyperdata.defaultHyperdataPublic arbitrary = pure Hyperdata.defaultHyperdataPublic
-- Servant job
instance Arbitrary a => Arbitrary (SJ.JobOutput a) where
arbitrary = SJ.JobOutput <$> arbitrary
-- instance Arbitrary NewWithFile where -- instance Arbitrary NewWithFile where
-- arbitrary = NewWithFile <$> arbitrary -- _wfi_b64_data -- arbitrary = NewWithFile <$> arbitrary -- _wfi_b64_data
-- <*> arbitrary -- _wf_lang -- <*> arbitrary -- _wf_lang
-- <*> arbitrary -- _wf_name -- <*> arbitrary -- _wf_name
instance Arbitrary NewWithForm where instance Arbitrary NewWithForm where arbitrary = genericArbitrary
arbitrary = NewWithForm <$> arbitrary -- _wf_filetype
<*> arbitrary -- _wf_fileformat
<*> arbitrary -- _wf_data
<*> arbitrary -- _wf_lang
<*> arbitrary -- _wf_name
<*> arbitrary -- _wf_selection
instance Arbitrary RenameNode where instance Arbitrary RenameNode where
arbitrary = elements [RenameNode "test"] arbitrary = elements [RenameNode "test"]
instance Arbitrary SJ.States where
arbitrary = oneof $ pure <$> [ SJ.IsPending
, SJ.IsReceived
, SJ.IsStarted
, SJ.IsRunning
, SJ.IsKilled
, SJ.IsFailure
, SJ.IsFinished ]
-- Servant job
instance Arbitrary a => Arbitrary (SJ.JobOutput a) where
arbitrary = SJ.JobOutput <$> arbitrary
instance Arbitrary SJ.States where arbitrary = genericArbitrary
instance Arbitrary (SJ.ID 'SJ.Safe k) where instance Arbitrary (SJ.ID 'SJ.Safe k) where
arbitrary = do arbitrary = do
_id_type <- arbitrary _id_type <- arbitrary
...@@ -271,7 +188,6 @@ instance Arbitrary (SJ.ID 'SJ.Safe k) where ...@@ -271,7 +188,6 @@ instance Arbitrary (SJ.ID 'SJ.Safe k) where
_id_time <- arbitrary _id_time <- arbitrary
_id_token <- arbitrary _id_token <- arbitrary
pure $ SJ.PrivateID { .. } pure $ SJ.PrivateID { .. }
instance Arbitrary a => Arbitrary (SJ.JobStatus 'SJ.Safe a) where instance Arbitrary a => Arbitrary (SJ.JobStatus 'SJ.Safe a) where
arbitrary = do arbitrary = do
_job_id <- arbitrary _job_id <- arbitrary
...@@ -313,14 +229,12 @@ instance Arbitrary Ngrams.NgramsTerm where ...@@ -313,14 +229,12 @@ instance Arbitrary Ngrams.NgramsTerm where
arbitrary = Ngrams.NgramsTerm <$> arbitrary = Ngrams.NgramsTerm <$>
-- we take into accoutn the fact, that tojsonkey strips the text -- we take into accoutn the fact, that tojsonkey strips the text
(arbitrary `suchThat` (\t -> t == T.strip t)) (arbitrary `suchThat` (\t -> t == T.strip t))
instance Arbitrary Ngrams.TabType where instance Arbitrary Ngrams.TabType where arbitrary = arbitraryBoundedEnum
arbitrary = elements [minBound .. maxBound]
instance Arbitrary Ngrams.NgramsElement where instance Arbitrary Ngrams.NgramsElement where
arbitrary = elements [Ngrams.newNgramsElement Nothing "sport"] arbitrary = elements [Ngrams.newNgramsElement Nothing "sport"]
instance Arbitrary Ngrams.NgramsTable where instance Arbitrary Ngrams.NgramsTable where
arbitrary = pure ngramsMockTable arbitrary = pure ngramsMockTable
instance Arbitrary Ngrams.OrderBy where instance Arbitrary Ngrams.OrderBy where arbitrary = arbitraryBoundedEnum
arbitrary = elements [minBound..maxBound]
instance (Ord a, Arbitrary a) => Arbitrary (Ngrams.PatchMSet a) where instance (Ord a, Arbitrary a) => Arbitrary (Ngrams.PatchMSet a) where
arbitrary = (Ngrams.PatchMSet . PM.fromMap) <$> arbitrary arbitrary = (Ngrams.PatchMSet . PM.fromMap) <$> arbitrary
instance (Eq a, Arbitrary a) => Arbitrary (Replace a) where instance (Eq a, Arbitrary a) => Arbitrary (Replace a) where
...@@ -374,8 +288,7 @@ ngramsMockTable = Ngrams.NgramsTable ...@@ -374,8 +288,7 @@ ngramsMockTable = Ngrams.NgramsTable
instance Arbitrary Errors.BackendErrorCode where instance Arbitrary Errors.BackendErrorCode where arbitrary = arbitraryBoundedEnum
arbitrary = arbitraryBoundedEnum
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
-- Arbitrary instances and test data generation -- Arbitrary instances and test data generation
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
......
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