Commit 80ffec62 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/adinapoli/fix-phylo-types' into dev-merge

parents 8e353331 69fa22f7
...@@ -26,6 +26,8 @@ data-files: ...@@ -26,6 +26,8 @@ data-files:
ekg-assets/chart_line_add.png ekg-assets/chart_line_add.png
ekg-assets/cross.png ekg-assets/cross.png
test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
test-data/phylo/bpa_phylo_test.json
test-data/phylo/open_science.json
library library
exposed-modules: exposed-modules:
...@@ -81,6 +83,7 @@ library ...@@ -81,6 +83,7 @@ library
Gargantext.Core.Types.Individu Gargantext.Core.Types.Individu
Gargantext.Core.Types.Main Gargantext.Core.Types.Main
Gargantext.Core.Types.Query Gargantext.Core.Types.Query
Gargantext.Core.Types.Phylo
Gargantext.Core.Utils Gargantext.Core.Utils
Gargantext.Core.Utils.Prefix Gargantext.Core.Utils.Prefix
Gargantext.Core.Viz.Graph Gargantext.Core.Viz.Graph
...@@ -235,7 +238,6 @@ library ...@@ -235,7 +238,6 @@ library
Gargantext.Core.Text.Terms.Multi.PosTagging Gargantext.Core.Text.Terms.Multi.PosTagging
Gargantext.Core.Text.Terms.Multi.PosTagging.Types Gargantext.Core.Text.Terms.Multi.PosTagging.Types
Gargantext.Core.Text.Upload Gargantext.Core.Text.Upload
Gargantext.Core.Types.Phylo
Gargantext.Core.Types.Search Gargantext.Core.Types.Search
Gargantext.Core.Utils.DateUtils Gargantext.Core.Utils.DateUtils
Gargantext.Core.Viz Gargantext.Core.Viz
......
...@@ -45,6 +45,8 @@ data-files: ...@@ -45,6 +45,8 @@ data-files:
- ekg-assets/chart_line_add.png - ekg-assets/chart_line_add.png
- ekg-assets/cross.png - ekg-assets/cross.png
- test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json - test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
- test-data/phylo/bpa_phylo_test.json
- test-data/phylo/open_science.json
library: library:
source-dirs: src source-dirs: src
ghc-options: ghc-options:
...@@ -109,6 +111,7 @@ library: ...@@ -109,6 +111,7 @@ library:
- Gargantext.Core.Types.Individu - Gargantext.Core.Types.Individu
- Gargantext.Core.Types.Main - Gargantext.Core.Types.Main
- Gargantext.Core.Types.Query - Gargantext.Core.Types.Query
- Gargantext.Core.Types.Phylo
- Gargantext.Core.Utils - Gargantext.Core.Utils
- Gargantext.Core.Utils.Prefix - Gargantext.Core.Utils.Prefix
- Gargantext.Core.Viz.Graph - Gargantext.Core.Viz.Graph
......
...@@ -9,16 +9,21 @@ import Data.Aeson ...@@ -9,16 +9,21 @@ import Data.Aeson
import Data.Either import Data.Either
import Gargantext.API.Node.Corpus.New import Gargantext.API.Node.Corpus.New
import Gargantext.API.Node.Corpus.Types import Gargantext.API.Node.Corpus.Types
import Gargantext.Core.Types.Phylo
import Gargantext.Core.Viz.Phylo.API import Gargantext.Core.Viz.Phylo.API
import Prelude import Prelude
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Test.Tasty.QuickCheck import Test.Tasty.QuickCheck
import Text.RawString.QQ import Text.RawString.QQ
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as C8 import qualified Data.ByteString.Lazy.Char8 as C8
import Paths_gargantext
jsonRoundtrip :: (Show a, FromJSON a, ToJSON a, Eq a) => a -> Property jsonRoundtrip :: (Show a, FromJSON a, ToJSON a, Eq a) => a -> Property
jsonRoundtrip a = eitherDecode (encode a) === Right a jsonRoundtrip a =
counterexample ("Parsed JSON: " <> C8.unpack (encode a)) $ eitherDecode (encode a) === Right a
tests :: TestTree tests :: TestTree
tests = testGroup "JSON" [ tests = testGroup "JSON" [
...@@ -26,7 +31,14 @@ tests = testGroup "JSON" [ ...@@ -26,7 +31,14 @@ tests = testGroup "JSON" [
, testProperty "WithQuery roundtrips" (jsonRoundtrip @WithQuery) , testProperty "WithQuery roundtrips" (jsonRoundtrip @WithQuery)
, testCase "WithQuery frontend compliance" testWithQueryFrontend , testCase "WithQuery frontend compliance" testWithQueryFrontend
, testGroup "Phylo" [ , testGroup "Phylo" [
testProperty "PhyloData" (jsonRoundtrip @PhyloData) testProperty "PeriodToNode" (jsonRoundtrip @PeriodToNodeData)
, testProperty "GraphData" (jsonRoundtrip @GraphData)
, testProperty "GraphDataData" (jsonRoundtrip @GraphDataData)
, testProperty "ObjectData" (jsonRoundtrip @ObjectData)
, testProperty "PhyloData" (jsonRoundtrip @PhyloData)
, testProperty "LayerData" (jsonRoundtrip @LayerData)
, testCase "can parse bpa_phylo_test.json" testParseBpaPhylo
, testCase "can parse open_science.json" testOpenSciencePhylo
] ]
] ]
...@@ -40,3 +52,19 @@ testWithQueryFrontend = do ...@@ -40,3 +52,19 @@ testWithQueryFrontend = do
-- instances, this test would fail, and we will be notified. -- instances, this test would fail, and we will be notified.
cannedWithQueryPayload :: String cannedWithQueryPayload :: String
cannedWithQueryPayload = [r| {"query":"Haskell","node_id":138,"lang":"EN","flowListWith":{"type":"MyListsFirst"},"datafield":"External Arxiv","databases":"Arxiv"} |] cannedWithQueryPayload = [r| {"query":"Haskell","node_id":138,"lang":"EN","flowListWith":{"type":"MyListsFirst"},"datafield":"External Arxiv","databases":"Arxiv"} |]
testParseBpaPhylo :: Assertion
testParseBpaPhylo = do
pth <- getDataFileName "test-data/phylo/bpa_phylo_test.json"
jsonBlob <- B.readFile pth
case eitherDecodeStrict' @GraphData jsonBlob of
Left err -> error err
Right _ -> pure ()
testOpenSciencePhylo :: Assertion
testOpenSciencePhylo = do
pth <- getDataFileName "test-data/phylo/open_science.json"
jsonBlob <- B.readFile pth
case eitherDecodeStrict' @PhyloData jsonBlob of
Left err -> error err
Right _ -> pure ()
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
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