src-test/Offline/JSON.hs

   1
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE TypeApplications #-}
   4 {-# LANGUAGE QuasiQuotes #-}
   5
   6 module Offline.JSON (tests) where
   7
   8 import Data.Aeson
   9 import Data.Either
  10 import Gargantext.API.Node.Corpus.New
  11 import Gargantext.API.Node.Corpus.Types
  12 import Gargantext.Core.Types.Phylo
  13 import Gargantext.Core.Viz.Phylo.API
  14 import Prelude
  15 import Test.Tasty
  16 import Test.Tasty.HUnit
  17 import Test.Tasty.QuickCheck
  18 import Text.RawString.QQ
  19 import qualified Data.ByteString as B
  20 import qualified Data.ByteString.Lazy.Char8 as C8
  21
  22 import Paths_gargantext
  23
  24 jsonRoundtrip :: (Show a, FromJSON a, ToJSON a, Eq a) => a -> Property
  25 jsonRoundtrip a =
  26   counterexample ("Parsed JSON: " <> C8.unpack (encode a)) $ eitherDecode (encode a) === Right a
  27
  28 tests :: TestTree
  29 tests = testGroup "JSON" [
  30     testProperty "Datafield roundtrips" (jsonRoundtrip @Datafield)
  31   , testProperty "WithQuery roundtrips" (jsonRoundtrip @WithQuery)
  32   , testCase "WithQuery frontend compliance" testWithQueryFrontend
  33   , testGroup "Phylo" [
  34     testProperty "PeriodToNode"  (jsonRoundtrip @PeriodToNodeData)
  35   , testProperty "GraphData"     (jsonRoundtrip @GraphData)
  36   , testProperty "GraphDataData" (jsonRoundtrip @GraphDataData)
  37   , testProperty "ObjectData"    (jsonRoundtrip @ObjectData)
  38   , testProperty "PhyloData"     (jsonRoundtrip @PhyloData)
  39   , testProperty "LayerData"     (jsonRoundtrip @LayerData)
  40   , testCase "can parse bpa_phylo_test.json" testParseBpaPhylo
  41   , testCase "can parse open_science.json" testOpenSciencePhylo
  42   ]
  43   ]
  44
  45 testWithQueryFrontend :: Assertion
  46 testWithQueryFrontend = do
  47   assertBool "JSON instance will break frontend!"
  48     (isRight $ eitherDecode @WithQuery (C8.pack cannedWithQueryPayload))
  49
  50 -- The aim of this type is to catch regressions in the frontend serialisation; this
  51 -- is what the frontend currently expects, and therefore if we were to change the JSON
  52 -- instances, this test would fail, and we will be notified.
  53 cannedWithQueryPayload :: String
  54 cannedWithQueryPayload = [r| {"query":"Haskell","node_id":138,"lang":"EN","flowListWith":{"type":"MyListsFirst"},"datafield":"External Arxiv","databases":"Arxiv"} |]
  55
  56 testParseBpaPhylo :: Assertion
  57 testParseBpaPhylo = do
  58   pth      <- getDataFileName "test-data/phylo/bpa_phylo_test.json"
  59   jsonBlob <- B.readFile pth
  60   case eitherDecodeStrict' @GraphData jsonBlob of
  61     Left err    -> error err
  62     Right _     -> pure ()
  63
  64 testOpenSciencePhylo :: Assertion
  65 testOpenSciencePhylo = do
  66   pth      <- getDataFileName "test-data/phylo/open_science.json"
  67   jsonBlob <- B.readFile pth
  68   case eitherDecodeStrict' @PhyloData jsonBlob of
  69     Left err    -> error err
  70     Right _     -> pure ()