Add Phylo golden tests

gargantext.cabal

@@ -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:

package.yaml

@@ -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:

src-test/Offline/JSON.hs

@@ -16,8 +16,11 @@ 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 =
   counterexample ("Parsed JSON: " <> C8.unpack (encode a)) $ eitherDecode (encode a) === Right a
@@ -33,6 +36,9 @@ tests = testGroup "JSON" [
   , 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
   ]
   ]
 
@@ -46,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 ()

src/Gargantext/Core/Types/Phylo.hs

@@ -33,6 +33,7 @@ import Control.Applicative ((<|>))
 import Data.Aeson
 import Data.Aeson.Types
 import Data.Aeson.TH (deriveJSON)
+import Data.Maybe
 import Data.Monoid
 import Data.Swagger
 import Data.Text    (Text)
@@ -395,7 +396,7 @@ instance ToJSON LayerData where
 
 instance FromJSON LayerData where
   parseJSON = withObject "LayerData" $ \o -> do
-    _ld_nodes <- o .: "nodes"
+    _ld_nodes <- fromMaybe mempty <$> (o .:? "nodes")
     pure $ LayerData{..}
 
 data NodeCommonData =
@@ -447,6 +448,7 @@ data EdgeData
   = GroupToAncestor !GvId !EdgeCommonData !GroupToAncestorData
   | GroupToGroup    !GvId !EdgeCommonData !GroupToGroupData
   | BranchToGroup   !GvId !EdgeCommonData !BranchToGroupData
+  | PeriodToPeriod  !GvId !EdgeCommonData
   deriving (Show, Eq, Generic)
 
 data GroupToAncestorData
@@ -516,13 +518,15 @@ instance FromJSON GvId where
 instance ToJSON EdgeData where
   toJSON = \case
     GroupToAncestor gvid commonData edgeTypeData
-      -> mkEdge "ancestorLink" gvid commonData edgeTypeData
+      -> mkEdge (Just "ancestorLink") gvid commonData edgeTypeData
     GroupToGroup gvid commonData edgeTypeData
-      -> mkEdge "link" gvid commonData edgeTypeData
+      -> mkEdge (Just "link") gvid commonData edgeTypeData
     BranchToGroup gvid commonData edgeTypeData
-      -> mkEdge "branchLink" gvid commonData edgeTypeData
+      -> mkEdge (Just "branchLink") gvid commonData edgeTypeData
+    PeriodToPeriod gvid commonData
+      -> mkEdge Nothing gvid commonData (Object mempty)
 
-mkEdge :: ToJSON a => Text -> GvId -> EdgeCommonData -> a -> Value
+mkEdge :: ToJSON a => Maybe Text -> GvId -> EdgeCommonData -> a -> Value
 mkEdge edgeType gvid commonData edgeTypeData =
   let commonDataJSON   = toJSON commonData
       edgeTypeDataJSON = toJSON edgeTypeData
@@ -537,18 +541,19 @@ mkEdge edgeType gvid commonData edgeTypeData =
 
 instance FromJSON EdgeData where
   parseJSON = withObject "EdgeData" $ \o -> do
-    edgeType  <- o .: "edgeType"
+    edgeType  <- o .:? "edgeType"
     gvid      <- o .: "_gvid"
     _ed_color <- o .: "color"
     _ed_head  <- o .: "head"
     _ed_pos   <- o .: "pos"
     _ed_tail  <- o .: "tail"
     _ed_width <- o .: "width"
-    case (edgeType :: Text) of
-      "ancestorLink" -> GroupToAncestor <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
-      "link"         -> GroupToGroup    <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
-      "branchLink"   -> BranchToGroup   <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
-      _              -> fail $ "EdgeData: unrecognised edgeType for Phylo graph: " <> T.unpack edgeType
+    case (edgeType :: Maybe Text) of
+      Just "ancestorLink" -> GroupToAncestor <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
+      Just "link"         -> GroupToGroup    <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
+      Just "branchLink"   -> BranchToGroup   <$> pure gvid <*> pure EdgeCommonData{..} <*> parseJSON (Object o)
+      Just unknownEdgeType -> fail $ "EdgeData: unrecognised edgeType for Phylo graph: " <> T.unpack unknownEdgeType
+      Nothing             -> pure $ PeriodToPeriod gvid EdgeCommonData{..}
 
 instance ToJSON EdgeCommonData where
   toJSON EdgeCommonData{..} = object