[BREAKING, phylo] one more breaking TimeUnit JSON modification

Also, added tests to make sure (de)serialization is correct

spago.lock

@@ -414,6 +414,7 @@
         },
         "test": {
           "dependencies": [
+            "quickcheck",
             "spec",
             "spec-discovery",
             "spec-quickcheck"

spago.yaml

@@ -161,6 +161,7 @@ package:
   test:
     main: Test.Main
     dependencies:
+      - quickcheck
       - spec
       - spec-discovery
       - spec-quickcheck

src/Gargantext/Components/PhyloExplorer/API.purs

@@ -21,6 +21,7 @@ import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype)
 import Data.Show.Generic (genericShow)
+import Foreign as Foreign
 import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.PhyloExplorer.JSON (PhyloJSON)
 import Gargantext.Components.PhyloExplorer.Types (PhyloSet, parseToPhyloSet)
@@ -103,54 +104,36 @@ instance Show TimeUnit where
   show = genericShow
 
 instance JSON.ReadForeign TimeUnit where
-  readImpl = JSONG.untaggedSumRep
+  readImpl f = do
+    { tag, time_unit_criteria: tuc } <-
+      JSON.readImpl f
+        :: Foreign.F
+             { tag :: String
+             , time_unit_criteria :: TimeUnitCriteria
+             }
+    case tag of
+      "Epoch" -> pure $ Epoch tuc
+      "Year" -> pure $ Year tuc
+      "Month" -> pure $ Month tuc
+      "Day" -> pure $ Day tuc
+      "Hour" -> pure $ Hour tuc
+      "Minute" -> pure $ Minute tuc
+      "Second" -> pure $ Second tuc
+      _ ->
+        Foreign.fail $ Foreign.ForeignError $ "deserialization for tag '" <> tag <> "' not implemented"
 
 instance JSON.WriteForeign TimeUnit where
   writeImpl = case _ of
-    Epoch (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseEpoch) o
-    Year (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseYear) o
-    Month (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseMonth) o
-    Week (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseWeek) o
-    Day (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseDay) o
-    Hour (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseHour) o
-    Minute (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseMinute) o
-    Second (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseSecond) o
+    Epoch tuc -> (JSON.writeImpl <<< mkRecord "Epoch") tuc
+    Year tuc -> (JSON.writeImpl <<< mkRecord "Year") tuc
+    Month tuc -> (JSON.writeImpl <<< mkRecord "Month") tuc
+    Week tuc -> (JSON.writeImpl <<< mkRecord "Week") tuc
+    Day tuc -> (JSON.writeImpl <<< mkRecord "Day") tuc
+    Hour tuc -> (JSON.writeImpl <<< mkRecord "Hour") tuc
+    Minute tuc -> (JSON.writeImpl <<< mkRecord "Minute") tuc
+    Second tuc -> (JSON.writeImpl <<< mkRecord "Second") tuc
     where
-    -- TODO It would be nice to refactor these functions, however it's
-    -- not that trivial, because we would have to combine `Symbol`s at
-    -- the type level25
-    parseEpoch =
-      Record.insert
-        (Proxy :: Proxy "tag")
-        "Epoch"
-    parseYear =
-      Record.insert
-        (Proxy :: Proxy "tag")
-        "Year"
-    parseMonth =
-      Record.insert
-        (Proxy :: Proxy "tag")
-        "Month"
-    parseWeek =
-      Record.insert
-        (Proxy :: Proxy "tag")
-        "Week"
-    parseDay =
-      Record.insert
-        (Proxy :: Proxy "tag")
-        "Day"
-    parseHour =
-      Record.insert
-        (Proxy :: Proxy "tag")
-        "Hour"
-    parseMinute =
-      Record.insert
-        (Proxy :: Proxy "tag")
-        "Minute"
-    parseSecond =
-      Record.insert
-        (Proxy :: Proxy "tag")
-        "Second"
+    mkRecord name tuc = { "tag": name, "time_unit_criteria": tuc }
 
 data ReflexiveTimeUnit
   = Epoch_
@@ -193,6 +176,7 @@ instance Show TimeUnitCriteria where
   show = genericShow
 
 derive newtype instance JSON.ReadForeign TimeUnitCriteria
+derive newtype instance JSON.WriteForeign TimeUnitCriteria
 
 data Clique
   = FIS

test/Test/Gargantext/Data/Spec.purs

 module Test.Gargantext.Data.Spec where
 
 import Prelude
-import Data.Array (index)
-import Data.Foldable (all)
-import Data.Maybe (Maybe(..), isJust)
-import Data.String (drop, stripPrefix, Pattern(..))
-import Data.Tuple (Tuple(..))
 import Test.Spec (Spec, describe, it)
 import Test.Spec.Assertions (shouldEqual)
-import Test.Spec.QuickCheck (quickCheck')
 
 import Gargantext.Data.Array as GDA
 
 spec :: Spec Unit
 spec =
-  describe "G.D.Array" do
-    it "swap works" do
-      GDA.swap 1 0 [0, 1, 2] `shouldEqual` [1, 0, 2]
-      GDA.swap 1 2 [0, 1, 2] `shouldEqual` [0, 2, 1]
-    it "slidingWindow works" do
-      GDA.slidingWindow [1, 2, 3, 4, 5] 2 `shouldEqual` [[1, 2], [2, 3], [3, 4], [4, 5]]
+  describe "G.Data" do
+    describe "Array" $ do
+      it "swap works" do
+        GDA.swap 1 0 [0, 1, 2] `shouldEqual` [1, 0, 2]
+        GDA.swap 1 2 [0, 1, 2] `shouldEqual` [0, 2, 1]
+      it "slidingWindow works" do
+        GDA.slidingWindow [1, 2, 3, 4, 5] 2 `shouldEqual` [[1, 2], [2, 3], [3, 4], [4, 5]]
+

test/Test/Gargantext/JSON/Spec.purs

+module Test.Gargantext.JSON.Spec where
+
+import Prelude
+import Data.Array.NonEmpty as NEA
+import Data.Generic.Rep (class Generic)
+import Data.Maybe (Maybe(..), fromJust)
+import Partial.Unsafe (unsafePartial)
+import Simple.JSON as JSON
+import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary)
+import Test.QuickCheck.Gen (oneOf)
+import Test.Spec (Spec, describe, it)
+
+import Test.Spec.QuickCheck (quickCheck')
+
+import Gargantext.Components.PhyloExplorer.API (TimeUnitCriteria(..), TimeUnit(..))
+
+
+spec :: Spec Unit
+spec =
+  describe "G.JSON" do
+    describe "Phylo" $ do
+      it "TimeUnitCriteria (de)serialization works" do
+        quickCheck' 100 $
+          \(ATimeUnitCriteria tuc) ->
+            JSON.readJSON_ (JSON.writeJSON tuc) == Just tuc
+
+
+
+-- newtype wrappers so we don't declare Arbitrary in code
+newtype ATimeUnitCriteria = ATimeUnitCriteria TimeUnitCriteria
+derive instance Generic ATimeUnitCriteria _
+derive instance Eq ATimeUnitCriteria
+instance Arbitrary ATimeUnitCriteria where
+  arbitrary = do
+    period <- arbitrary
+    step <- arbitrary
+    matchingFrame <- arbitrary
+    pure $ ATimeUnitCriteria $ TimeUnitCriteria { period, step, matchingFrame }
+
+unATimeUnitCriteria :: ATimeUnitCriteria -> TimeUnitCriteria
+unATimeUnitCriteria (ATimeUnitCriteria tuc) = tuc
+
+
+newtype ATimeUnit = ATimeUnit TimeUnit
+derive instance Generic ATimeUnit _
+derive instance Eq ATimeUnit
+instance Arbitrary ATimeUnit where
+  arbitrary = do
+    oneOf $ unsafePartial fromJust $
+      NEA.fromArray [
+          (ATimeUnit <<< Epoch <<< unATimeUnitCriteria) <$> arbitrary
+        , (ATimeUnit <<< Year <<< unATimeUnitCriteria) <$> arbitrary
+        , (ATimeUnit <<< Month <<< unATimeUnitCriteria) <$> arbitrary
+        , (ATimeUnit <<< Week <<< unATimeUnitCriteria) <$> arbitrary
+        , (ATimeUnit <<< Day <<< unATimeUnitCriteria) <$> arbitrary
+        , (ATimeUnit <<< Hour <<< unATimeUnitCriteria) <$> arbitrary
+        , (ATimeUnit <<< Minute <<< unATimeUnitCriteria) <$> arbitrary
+        , (ATimeUnit <<< Second <<< unATimeUnitCriteria) <$> arbitrary
+        ]