Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
120
Issues
120
List
Board
Labels
Milestones
Merge Requests
7
Merge Requests
7
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
5fbdc1ed
Commit
5fbdc1ed
authored
Jun 19, 2023
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add JSON roundtrip tests for Datafield and WithQuery
parent
24ef381d
Pipeline
#4230
passed with stages
in 109 minutes and 22 seconds
Changes
9
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
114 additions
and
30 deletions
+114
-30
gargantext.cabal
gargantext.cabal
+4
-2
package.yaml
package.yaml
+3
-0
Main.hs
src-test/Main.hs
+2
-0
JSON.hs
src-test/Offline/JSON.hs
+38
-0
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+9
-1
Types.hs
src/Gargantext/API/Node/Corpus/Types.hs
+27
-18
Core.hs
src/Gargantext/Core.hs
+5
-1
Query.hs
src/Gargantext/Core/Text/Corpus/Query.hs
+4
-0
Social.hs
src/Gargantext/Core/Text/List/Social.hs
+22
-8
No files found.
gargantext.cabal
View file @
5fbdc1ed
...
@@ -43,6 +43,8 @@ library
...
@@ -43,6 +43,8 @@ library
Gargantext.API.Ngrams.Tools
Gargantext.API.Ngrams.Tools
Gargantext.API.Ngrams.Types
Gargantext.API.Ngrams.Types
Gargantext.API.Node
Gargantext.API.Node
Gargantext.API.Node.Corpus.New
Gargantext.API.Node.Corpus.Types
Gargantext.API.Node.File
Gargantext.API.Node.File
Gargantext.API.Node.Share
Gargantext.API.Node.Share
Gargantext.API.Prelude
Gargantext.API.Prelude
...
@@ -149,11 +151,9 @@ library
...
@@ -149,11 +151,9 @@ library
Gargantext.API.Node.Corpus.Annuaire
Gargantext.API.Node.Corpus.Annuaire
Gargantext.API.Node.Corpus.Export
Gargantext.API.Node.Corpus.Export
Gargantext.API.Node.Corpus.Export.Types
Gargantext.API.Node.Corpus.Export.Types
Gargantext.API.Node.Corpus.New
Gargantext.API.Node.Corpus.New.File
Gargantext.API.Node.Corpus.New.File
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.Searx
Gargantext.API.Node.Corpus.Searx
Gargantext.API.Node.Corpus.Types
Gargantext.API.Node.Document.Export
Gargantext.API.Node.Document.Export
Gargantext.API.Node.Document.Export.Types
Gargantext.API.Node.Document.Export.Types
Gargantext.API.Node.DocumentsFromWriteNodes
Gargantext.API.Node.DocumentsFromWriteNodes
...
@@ -863,6 +863,7 @@ test-suite garg-test
...
@@ -863,6 +863,7 @@ test-suite garg-test
Ngrams.NLP
Ngrams.NLP
Ngrams.Query
Ngrams.Query
Ngrams.Query.PaginationCorpus
Ngrams.Query.PaginationCorpus
Offline.JSON
Parsers.Date
Parsers.Date
Parsers.Types
Parsers.Types
Parsers.WOS
Parsers.WOS
...
@@ -917,6 +918,7 @@ test-suite garg-test
...
@@ -917,6 +918,7 @@ test-suite garg-test
, patches-class
, patches-class
, patches-map
, patches-map
, quickcheck-instances
, quickcheck-instances
, raw-strings-qq
, servant-job
, servant-job
, stm
, stm
, tasty
, tasty
...
...
package.yaml
View file @
5fbdc1ed
...
@@ -71,6 +71,8 @@ library:
...
@@ -71,6 +71,8 @@ library:
-
Gargantext.API.Ngrams.Tools
-
Gargantext.API.Ngrams.Tools
-
Gargantext.API.Ngrams.Types
-
Gargantext.API.Ngrams.Types
-
Gargantext.API.Node
-
Gargantext.API.Node
-
Gargantext.API.Node.Corpus.New
-
Gargantext.API.Node.Corpus.Types
-
Gargantext.API.Node.File
-
Gargantext.API.Node.File
-
Gargantext.API.Node.Share
-
Gargantext.API.Node.Share
-
Gargantext.API.Prelude
-
Gargantext.API.Prelude
...
@@ -536,6 +538,7 @@ tests:
...
@@ -536,6 +538,7 @@ tests:
-
patches-map
-
patches-map
-
duckling
-
duckling
-
quickcheck-instances
-
quickcheck-instances
-
raw-strings-qq
-
servant-job
-
servant-job
-
stm
-
stm
-
tasty
-
tasty
...
...
src-test/Main.hs
View file @
5fbdc1ed
...
@@ -22,6 +22,7 @@ import qualified Parsers.Date as PD
...
@@ -22,6 +22,7 @@ import qualified Parsers.Date as PD
import
qualified
Graph.Clustering
as
Graph
import
qualified
Graph.Clustering
as
Graph
import
qualified
Utils.Crypto
as
Crypto
import
qualified
Utils.Crypto
as
Crypto
import
qualified
Utils.Jobs
as
Jobs
import
qualified
Utils.Jobs
as
Jobs
import
qualified
Offline.JSON
as
JSON
import
Test.Tasty
import
Test.Tasty
import
Test.Tasty.Hspec
import
Test.Tasty.Hspec
...
@@ -44,6 +45,7 @@ main = do
...
@@ -44,6 +45,7 @@ main = do
,
jobsSpec
,
jobsSpec
,
NgramsQuery
.
tests
,
NgramsQuery
.
tests
,
CorpusQuery
.
tests
,
CorpusQuery
.
tests
,
JSON
.
tests
]
]
-- Occ.parsersTest
-- Occ.parsersTest
-- Lang.ngramsExtractionTest FR
-- Lang.ngramsExtractionTest FR
...
...
src-test/Offline/JSON.hs
0 → 100644
View file @
5fbdc1ed
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE QuasiQuotes #-}
module
Offline.JSON
(
tests
)
where
import
Data.Aeson
import
Data.Either
import
Gargantext.API.Node.Corpus.New
import
Gargantext.API.Node.Corpus.Types
import
Prelude
import
Test.Tasty
import
Test.Tasty.HUnit
import
Test.Tasty.QuickCheck
import
Text.RawString.QQ
import
qualified
Data.ByteString.Lazy.Char8
as
C8
jsonRoundtrip
::
(
Show
a
,
FromJSON
a
,
ToJSON
a
,
Eq
a
)
=>
a
->
Property
jsonRoundtrip
a
=
eitherDecode
(
encode
a
)
===
Right
a
tests
::
TestTree
tests
=
testGroup
"JSON"
[
testProperty
"Datafield roundtrips"
(
jsonRoundtrip
@
Datafield
)
,
testProperty
"WithQuery roundtrips"
(
jsonRoundtrip
@
WithQuery
)
,
testCase
"WithQuery frontend compliance"
testWithQueryFrontend
]
testWithQueryFrontend
::
Assertion
testWithQueryFrontend
=
do
assertBool
"JSON instance will break frontend!"
(
isRight
$
eitherDecode
@
WithQuery
(
C8
.
pack
cannedWithQueryPayload
))
-- The aim of this type is to catch regressions in the frontend serialisation; this
-- is what the frontend currently expects, and therefore if we were to change the JSON
-- instances, this test would fail, and we will be notified.
cannedWithQueryPayload
::
String
cannedWithQueryPayload
=
[
r
|
{"query":"Haskell","node_id":138,"lang":"EN","flowListWith":{"type":"MyListsFirst"},"datafield":"External Arxiv","databases":"Arxiv"}
|]
src/Gargantext/API/Node/Corpus/New.hs
View file @
5fbdc1ed
...
@@ -144,7 +144,7 @@ data WithQuery = WithQuery
...
@@ -144,7 +144,7 @@ data WithQuery = WithQuery
,
_wq_node_id
::
!
Int
,
_wq_node_id
::
!
Int
,
_wq_flowListWith
::
!
FlowSocialListWith
,
_wq_flowListWith
::
!
FlowSocialListWith
}
}
deriving
Generic
deriving
(
Show
,
Eq
,
Generic
)
makeLenses
''
W
ithQuery
makeLenses
''
W
ithQuery
instance
FromJSON
WithQuery
where
instance
FromJSON
WithQuery
where
...
@@ -154,6 +154,14 @@ instance ToJSON WithQuery where
...
@@ -154,6 +154,14 @@ instance ToJSON WithQuery where
instance
ToSchema
WithQuery
where
instance
ToSchema
WithQuery
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_wq_"
)
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_wq_"
)
instance
Arbitrary
WithQuery
where
arbitrary
=
WithQuery
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
------------------------------------------------------------------------
------------------------------------------------------------------------
type
AddWithQuery
=
Summary
"Add with Query to corpus endpoint"
type
AddWithQuery
=
Summary
"Add with Query to corpus endpoint"
...
...
src/Gargantext/API/Node/Corpus/Types.hs
View file @
5fbdc1ed
...
@@ -3,11 +3,14 @@
...
@@ -3,11 +3,14 @@
module
Gargantext.API.Node.Corpus.Types
where
module
Gargantext.API.Node.Corpus.Types
where
import
Control.Lens
hiding
(
elements
,
Empty
)
import
Control.Lens
hiding
(
elements
,
Empty
)
import
Control.Monad.Fail
(
fail
)
import
Data.Aeson
import
Data.Aeson
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Monoid
(
mempty
)
import
Data.Monoid
(
mempty
)
import
Data.Swagger
import
Data.Swagger
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Test.QuickCheck
import
qualified
Data.Text
as
T
import
Gargantext.Prelude
import
Gargantext.Prelude
...
@@ -23,6 +26,9 @@ data Database = Empty
...
@@ -23,6 +26,9 @@ data Database = Empty
|
Isidore
|
Isidore
deriving
(
Eq
,
Show
,
Generic
,
Enum
,
Bounded
)
deriving
(
Eq
,
Show
,
Generic
,
Enum
,
Bounded
)
instance
Arbitrary
Database
where
arbitrary
=
arbitraryBoundedEnum
deriveJSON
(
unPrefix
""
)
''
D
atabase
deriveJSON
(
unPrefix
""
)
''
D
atabase
instance
ToSchema
Database
where
instance
ToSchema
Database
where
declareNamedSchema
=
genericDeclareNamedSchemaUnrestricted
defaultSchemaOptions
declareNamedSchema
=
genericDeclareNamedSchemaUnrestricted
defaultSchemaOptions
...
@@ -42,24 +48,27 @@ data Datafield = Gargantext
...
@@ -42,24 +48,27 @@ data Datafield = Gargantext
|
Files
|
Files
deriving
(
Eq
,
Show
,
Generic
)
deriving
(
Eq
,
Show
,
Generic
)
instance
FromJSON
Datafield
instance
FromJSON
Datafield
where
instance
ToJSON
Datafield
parseJSON
=
withText
"Datafield"
$
\
text
->
-- instance FromJSON Datafield where
case
text
of
-- parseJSON = withText "Datafield" $ \text ->
"Gargantext"
-- case text of
->
pure
Gargantext
-- "Gargantext" -> pure Gargantext
"Web"
-- "Web" -> pure Web
->
pure
Web
-- "Files" -> pure Files
"Files"
-- v ->
->
pure
Files
-- let (preExternal, _, postExternal) = v =~ ("External " :: Text) :: (Text, Text, Text)
v
->
case
T
.
breakOnEnd
" "
v
of
-- in
(
"External "
,
dbName
)
-- if preExternal == "" then do
->
External
<$>
parseJSON
(
String
dbName
)
-- db <- parseJSON $ String postExternal
_
->
fail
$
"Cannot match patterh 'External <db>' for string "
<>
T
.
unpack
v
-- pure $ External db
-- else fail $ "Cannot match patterh 'External <db>' for string " ++ (T.unpack v)
instance
ToJSON
Datafield
where
-- instance ToJSON Datafield where
toJSON
(
External
db
)
=
toJSON
$
"External "
<>
show
db
-- toJSON (External db) = toJSON $ "External " ++ (show db)
toJSON
s
=
toJSON
$
show
s
-- toJSON s = toJSON $ show s
instance
Arbitrary
Datafield
where
arbitrary
=
oneof
[
pure
Gargantext
,
pure
Web
,
pure
Files
,
External
<$>
arbitrary
]
instance
ToSchema
Datafield
where
instance
ToSchema
Datafield
where
declareNamedSchema
_
=
do
declareNamedSchema
_
=
do
return
$
NamedSchema
(
Just
"Datafield"
)
$
mempty
return
$
NamedSchema
(
Just
"Datafield"
)
$
mempty
...
...
src/Gargantext/Core.hs
View file @
5fbdc1ed
...
@@ -24,6 +24,7 @@ import Data.Tuple.Extra (swap)
...
@@ -24,6 +24,7 @@ import Data.Tuple.Extra (swap)
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Servant.API
import
Servant.API
import
Test.QuickCheck
import
qualified
Data.Map
as
Map
import
qualified
Data.Map
as
Map
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -80,8 +81,11 @@ instance ToHttpApiData Lang where
...
@@ -80,8 +81,11 @@ instance ToHttpApiData Lang where
toUrlPiece
=
pack
.
show
toUrlPiece
=
pack
.
show
instance
Hashable
Lang
instance
Hashable
Lang
instance
Arbitrary
Lang
where
arbitrary
=
arbitraryBoundedEnum
allLangs
::
[
Lang
]
allLangs
::
[
Lang
]
allLangs
=
[
minBound
..
]
allLangs
=
[
minBound
..
maxBound
]
class
HasDBid
a
where
class
HasDBid
a
where
toDBid
::
a
->
Int
toDBid
::
a
->
Int
...
...
src/Gargantext/Core/Text/Corpus/Query.hs
View file @
5fbdc1ed
...
@@ -21,6 +21,7 @@ import Gargantext.API.Admin.Orchestrator.Types
...
@@ -21,6 +21,7 @@ import Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Prelude
import
Prelude
import
Text.ParserCombinators.Parsec
import
Text.ParserCombinators.Parsec
import
Test.QuickCheck
import
qualified
Data.Aeson
as
Aeson
import
qualified
Data.Aeson
as
Aeson
import
Data.BoolExpr
as
BoolExpr
import
Data.BoolExpr
as
BoolExpr
import
Data.BoolExpr.Parser
as
BoolExpr
import
Data.BoolExpr.Parser
as
BoolExpr
...
@@ -37,6 +38,9 @@ newtype RawQuery = RawQuery { getRawQuery :: T.Text }
...
@@ -37,6 +38,9 @@ newtype RawQuery = RawQuery { getRawQuery :: T.Text }
,
Aeson
.
FromJSON
,
Aeson
.
ToJSON
,
Aeson
.
FromJSON
,
Aeson
.
ToJSON
,
Swagger
.
ToParamSchema
,
Swagger
.
ToSchema
)
,
Swagger
.
ToParamSchema
,
Swagger
.
ToSchema
)
instance
Arbitrary
RawQuery
where
arbitrary
=
RawQuery
<$>
arbitrary
-- | A limit to the number of results we want to retrieve.
-- | A limit to the number of results we want to retrieve.
newtype
Limit
=
Limit
{
getLimit
::
Int
}
newtype
Limit
=
Limit
{
getLimit
::
Int
}
deriving
newtype
(
Show
,
Eq
,
Num
deriving
newtype
(
Show
,
Eq
,
Num
...
...
src/Gargantext/Core/Text/List/Social.hs
View file @
5fbdc1ed
...
@@ -34,13 +34,12 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
...
@@ -34,13 +34,12 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import
Gargantext.Database.Query.Tree
(
NodeMode
(
Private
),
HasTreeError
)
import
Gargantext.Database.Query.Tree
(
NodeMode
(
Private
),
HasTreeError
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Test.QuickCheck
import
Web.Internal.HttpApiData
(
ToHttpApiData
,
FromHttpApiData
,
parseUrlPiece
,
toUrlPiece
)
import
Web.Internal.HttpApiData
(
ToHttpApiData
,
FromHttpApiData
,
parseUrlPiece
,
toUrlPiece
)
import
qualified
Data.List
as
List
import
qualified
Data.List
as
List
import
qualified
Data.Map.Strict
as
Map
import
qualified
Data.Map.Strict
as
Map
import
qualified
Data.Scientific
as
Scientific
import
qualified
Data.Text
as
T
import
qualified
Data.Text
as
T
import
qualified
Data.Vector
as
V
import
qualified
Data.Vector
as
V
import
qualified
Prelude
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Main parameters
-- | Main parameters
...
@@ -61,16 +60,28 @@ instance FromJSON FlowSocialListWith where
...
@@ -61,16 +60,28 @@ instance FromJSON FlowSocialListWith where
case
typ
of
case
typ
of
"MyListsFirst"
->
pure
$
FlowSocialListWithPriority
{
fslw_priority
=
MySelfFirst
}
"MyListsFirst"
->
pure
$
FlowSocialListWithPriority
{
fslw_priority
=
MySelfFirst
}
"OtherListsFirst"
->
pure
$
FlowSocialListWithPriority
{
fslw_priority
=
OthersFirst
}
"OtherListsFirst"
->
pure
$
FlowSocialListWithPriority
{
fslw_priority
=
OthersFirst
}
"OthersFirst"
->
pure
$
FlowSocialListWithPriority
{
fslw_priority
=
OthersFirst
}
"SelectedLists"
->
pure
$
FlowSocialListWithLists
{
fslw_lists
=
value
}
"SelectedLists"
->
pure
$
FlowSocialListWithLists
{
fslw_lists
=
value
}
"NoList"
->
pure
$
NoList
True
"NoList"
->
do
mkList
<-
v
.:
"makeList"
pure
$
NoList
mkList
_
->
pure
$
FlowSocialListWithPriority
{
fslw_priority
=
MySelfFirst
}
_
->
pure
$
FlowSocialListWithPriority
{
fslw_priority
=
MySelfFirst
}
parseJSON
_
=
mzero
parseJSON
_
=
mzero
instance
ToJSON
FlowSocialListWith
where
instance
ToJSON
FlowSocialListWith
where
toJSON
(
FlowSocialListWithPriority
{
fslw_priority
=
MySelfFirst
})
=
object
[
(
"type"
,
String
"MyListsFirst"
)
]
toJSON
(
FlowSocialListWithPriority
{
fslw_priority
=
MySelfFirst
})
=
object
[
(
"type"
,
String
"MyListsFirst"
)
]
toJSON
(
FlowSocialListWithPriority
{
fslw_priority
=
OthersFirst
})
=
object
[
(
"type"
,
String
"ListsFirst"
)
]
toJSON
(
FlowSocialListWithPriority
{
fslw_priority
=
OthersFirst
})
=
object
[
(
"type"
,
String
"OthersFirst"
)
]
toJSON
(
NoList
_
)
=
object
[
(
"type"
,
String
"NoList"
)
]
toJSON
(
NoList
v
)
=
object
[
(
"type"
,
String
"NoList"
),
(
"makeList"
,
toJSON
v
)
]
toJSON
(
FlowSocialListWithLists
{
fslw_lists
=
ids
})
=
object
[
(
"type"
,
String
"SelectedLists"
)
toJSON
(
FlowSocialListWithLists
{
fslw_lists
=
ids
})
=
,
(
"value"
,
Array
$
V
.
fromList
$
(
map
(
\
(
NodeId
id
)
->
Number
$
Scientific
.
scientific
(
Prelude
.
toInteger
id
)
1
)
ids
))
]
object
[
(
"type"
,
String
"SelectedLists"
)
,
(
"value"
,
Array
$
V
.
fromList
(
map
(
\
(
NodeId
id
)
->
toJSON
id
)
ids
))
]
instance
Arbitrary
FlowSocialListWith
where
arbitrary
=
oneof
[
FlowSocialListWithPriority
<$>
arbitrary
,
FlowSocialListWithLists
<$>
arbitrary
,
NoList
<$>
arbitrary
]
instance
ToSchema
FlowSocialListWith
where
instance
ToSchema
FlowSocialListWith
where
declareNamedSchema
=
genericDeclareNamedSchema
defaultSchemaOptions
declareNamedSchema
=
genericDeclareNamedSchema
defaultSchemaOptions
instance
FromHttpApiData
FlowSocialListWith
instance
FromHttpApiData
FlowSocialListWith
...
@@ -87,10 +98,13 @@ instance ToHttpApiData FlowSocialListWith where
...
@@ -87,10 +98,13 @@ instance ToHttpApiData FlowSocialListWith where
toUrlPiece
(
FlowSocialListWithLists
_
)
=
panic
"[G.C.T.L.Social] TODO ToHttpApiData FlowSocialListWith"
toUrlPiece
(
FlowSocialListWithLists
_
)
=
panic
"[G.C.T.L.Social] TODO ToHttpApiData FlowSocialListWith"
data
FlowSocialListPriority
=
MySelfFirst
|
OthersFirst
data
FlowSocialListPriority
=
MySelfFirst
|
OthersFirst
deriving
(
Eq
,
Show
,
Generic
)
deriving
(
Eq
,
Show
,
Generic
,
Enum
,
Bounded
)
instance
ToSchema
FlowSocialListPriority
where
instance
ToSchema
FlowSocialListPriority
where
declareNamedSchema
=
genericDeclareNamedSchema
defaultSchemaOptions
declareNamedSchema
=
genericDeclareNamedSchema
defaultSchemaOptions
instance
Arbitrary
FlowSocialListPriority
where
arbitrary
=
arbitraryBoundedEnum
flowSocialListPriority
::
FlowSocialListPriority
->
[
NodeMode
]
flowSocialListPriority
::
FlowSocialListPriority
->
[
NodeMode
]
flowSocialListPriority
MySelfFirst
=
[
Private
{-, Shared, Public -}
]
flowSocialListPriority
MySelfFirst
=
[
Private
{-, Shared, Public -}
]
flowSocialListPriority
OthersFirst
=
reverse
$
flowSocialListPriority
MySelfFirst
flowSocialListPriority
OthersFirst
=
reverse
$
flowSocialListPriority
MySelfFirst
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment