Merge branch 'generic-sum-argonaut' of...

Merge branch 'generic-sum-argonaut' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev

src/Gargantext/Utils/Argonaut.purs

+module Gargantext.Utils.Argonaut where
+
+import Prelude
+
+import Control.Alt ((<|>))
+import Data.Argonaut (Json)
+import Data.Argonaut as Argonaut
+import Data.Either (Either)
+import Data.Generic.Rep as GR
+import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
+
+-- | Provide a generic sum JSON decoding for sum types deriving Generic
+genericSumDecodeJson
+  :: forall a rep
+   . GR.Generic a rep
+  => GenericSumDecodeJsonRep rep
+  => Json
+  -> Either String a
+genericSumDecodeJson f =
+  GR.to <$> genericSumDecodeJsonRep f
+
+-- | Provide a generic sum JSON encoding for sum types deriving Generic
+genericSumEncodeJson
+  :: forall a rep
+   . GR.Generic a rep
+  => GenericSumEncodeJsonRep rep
+  => a
+  -> Json
+genericSumEncodeJson f =
+  genericSumEncodeJsonRep $ GR.from f
+
+class GenericSumDecodeJsonRep rep where
+  genericSumDecodeJsonRep :: Json -> Either String rep
+
+class GenericSumEncodeJsonRep rep where
+  genericSumEncodeJsonRep :: rep -> Json
+
+instance genericSumDecodeJsonRepSum ::
+  ( GenericSumDecodeJsonRep a
+  , GenericSumDecodeJsonRep b
+  ) => GenericSumDecodeJsonRep (GR.Sum a b) where
+  genericSumDecodeJsonRep f
+      = GR.Inl <$> genericSumDecodeJsonRep f
+    <|> GR.Inr <$> genericSumDecodeJsonRep f
+
+instance genericSumDecodeJsonRepConstructor ::
+  ( GenericSumDecodeJsonRep a
+  , IsSymbol name
+  ) => GenericSumDecodeJsonRep (GR.Constructor name a) where
+  genericSumDecodeJsonRep f = do
+    -- here we attempt to read the following json:
+    -- { "ConstructorName": argument }
+    let name = reflectSymbol (SProxy :: _ name)
+    obj <- Argonaut.decodeJson f
+    inner <- Argonaut.getField obj name
+    argument <- genericSumDecodeJsonRep inner
+    pure $ GR.Constructor argument
+
+instance genericSumDecodeJsonRepArgument ::
+  ( Argonaut.DecodeJson a
+  ) => GenericSumDecodeJsonRep (GR.Argument a) where
+  genericSumDecodeJsonRep f = GR.Argument <$> Argonaut.decodeJson f
+
+instance genericSumEncodeJsonRepSum ::
+  ( GenericSumEncodeJsonRep a
+  , GenericSumEncodeJsonRep b
+  ) => GenericSumEncodeJsonRep (GR.Sum a b) where
+  genericSumEncodeJsonRep (GR.Inl f) = genericSumEncodeJsonRep f
+  genericSumEncodeJsonRep (GR.Inr f) = genericSumEncodeJsonRep f
+
+instance genericSumEncodeJsonRepConstructor ::
+  ( GenericSumEncodeJsonRep a
+  , IsSymbol name
+  ) => GenericSumEncodeJsonRep (GR.Constructor name a) where
+  genericSumEncodeJsonRep (GR.Constructor inner) = do
+    -- here we attempt to write the following json:
+    -- { "ConstructorName": argument }
+    let name = reflectSymbol (SProxy :: _ name)
+    let argument = genericSumEncodeJsonRep inner
+    Argonaut.jsonSingletonObject name argument
+
+instance genericSumEncodeJsonRepArgument ::
+  ( Argonaut.EncodeJson a
+  ) => GenericSumEncodeJsonRep (GR.Argument a) where
+  genericSumEncodeJsonRep (GR.Argument f) = Argonaut.encodeJson f

test/Gargantext/Utils/Spec.purs

 module Gargantext.Utils.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 Data.Argonaut as Argonaut
+import Data.Either (Either(..), isLeft)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
 import Gargantext.Utils as GU
+import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
 import Gargantext.Utils.Crypto as GUC
 import Gargantext.Utils.Math as GUM
--- import Test.QuickCheck ((===), (/==), (<?>), Result(..))
 import Test.Spec (Spec, describe, it)
 import Test.Spec.Assertions (shouldEqual)
-import Test.Spec.QuickCheck (quickCheck')
+
+data Fruit
+  = Boat { hi :: Int }
+  | Gravy String
+  | Pork Int
+
+derive instance eqFruit :: Eq Fruit
+derive instance genericFruit :: Generic Fruit _
+instance showFruit :: Show Fruit where
+  show = genericShow
+instance decodeJsonFruit :: Argonaut.DecodeJson Fruit where
+  decodeJson = genericSumDecodeJson
+instance encodeJsonFruit :: Argonaut.EncodeJson Fruit where
+  encodeJson = genericSumEncodeJson
 
 spec :: Spec Unit
 spec =
@@ -40,3 +53,26 @@ spec =
       let text = "The quick brown fox jumps over the lazy dog"
       let textMd5 = "9e107d9d372bb6826bd81d3542a419d6"
       GUC.md5 text `shouldEqual` textMd5
+
+    it "genericSumDecodeJson works" do
+      let result1 = Argonaut.decodeJson =<< Argonaut.jsonParser """{"Boat":{"hi":1}}"""
+      result1 `shouldEqual` Right (Boat { hi: 1 })
+
+      let result2 = Argonaut.decodeJson =<< Argonaut.jsonParser """{"Gravy":"hi"}"""
+      result2 `shouldEqual` Right (Gravy "hi")
+
+      let result3 = Argonaut.decodeJson =<< Argonaut.jsonParser """{"Boat":123}"""
+      isLeft (result3 :: Either String Fruit) `shouldEqual` true
+
+    it "genericSumEncodeJson works and loops back with decode" do
+      let input1 = Boat { hi: 1 }
+      let result1 = Argonaut.encodeJson input1
+      let result1' = Argonaut.decodeJson result1
+      Argonaut.stringify result1 `shouldEqual` """{"Boat":{"hi":1}}"""
+      result1' `shouldEqual` Right input1
+
+      let input2 = Gravy "hi"
+      let result2 = Argonaut.encodeJson input2
+      let result2' = Argonaut.decodeJson result2
+      Argonaut.stringify result2 `shouldEqual` """{"Gravy":"hi"}"""
+      result2' `shouldEqual` Right input2