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:
ekg-assets/chart_line_add.png
ekg-assets/cross.png
test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
test-data/phylo/bpa_phylo_test.json
test-data/phylo/open_science.json
library
exposed-modules:
......@@ -81,6 +83,7 @@ library
Gargantext.Core.Types.Individu
Gargantext.Core.Types.Main
Gargantext.Core.Types.Query
Gargantext.Core.Types.Phylo
Gargantext.Core.Utils
Gargantext.Core.Utils.Prefix
Gargantext.Core.Viz.Graph
......@@ -235,7 +238,6 @@ library
Gargantext.Core.Text.Terms.Multi.PosTagging
Gargantext.Core.Text.Terms.Multi.PosTagging.Types
Gargantext.Core.Text.Upload
Gargantext.Core.Types.Phylo
Gargantext.Core.Types.Search
Gargantext.Core.Utils.DateUtils
Gargantext.Core.Viz
......
......@@ -45,6 +45,8 @@ data-files:
- ekg-assets/chart_line_add.png
- ekg-assets/cross.png
- test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
- test-data/phylo/bpa_phylo_test.json
- test-data/phylo/open_science.json
library:
source-dirs: src
ghc-options:
......@@ -109,6 +111,7 @@ library:
- Gargantext.Core.Types.Individu
- Gargantext.Core.Types.Main
- Gargantext.Core.Types.Query
- Gargantext.Core.Types.Phylo
- Gargantext.Core.Utils
- Gargantext.Core.Utils.Prefix
- Gargantext.Core.Viz.Graph
......
......@@ -9,16 +9,21 @@ import Data.Aeson
import Data.Either
import Gargantext.API.Node.Corpus.New
import Gargantext.API.Node.Corpus.Types
import Gargantext.Core.Types.Phylo
import Gargantext.Core.Viz.Phylo.API
import Prelude
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Text.RawString.QQ
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as C8
import Paths_gargantext
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 = testGroup "JSON" [
......@@ -26,7 +31,14 @@ tests = testGroup "JSON" [
, testProperty "WithQuery roundtrips" (jsonRoundtrip @WithQuery)
, testCase "WithQuery frontend compliance" testWithQueryFrontend
, 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
-- 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"} |]
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