Merge pull request #11 from hdgarrood/fix-either

Fix either

Author: garyb

src/Data/Argonaut/Decode.purs

@@ -77,7 +77,23 @@ instance decodeJsonTuple :: (DecodeJson a, DecodeJson b) => DecodeJson (Tuple a
     f _ = Left "Couldn't decode Tuple"
 
 instance decodeJsonEither :: (DecodeJson a, DecodeJson b) => DecodeJson (Either a b) where
-  decodeJson j = (Left <$> decodeJson j) <|> (Right <$> decodeJson j)
+  decodeJson j =
+    case toObject j of
+      Just obj -> do
+        tag <- just (M.lookup "tag" obj)
+        val <- just (M.lookup "value" obj)
+        case toString tag of
+          Just "Right" ->
+            Right <$> decodeJson val
+          Just "Left" ->
+            Left <$> decodeJson val
+          _ ->
+            Left "Couldn't decode Either"
+      _ ->
+        Left "Couldn't decode Either"
+    where
+    just (Just x) = Right x
+    just Nothing  = Left "Couldn't decode Either"
 
 instance decodeJsonNull :: DecodeJson Unit where
   decodeJson = foldJsonNull (Left "Not null") (const $ Right unit)

src/Data/Argonaut/Encode.purs

@@ -8,11 +8,11 @@ module Data.Argonaut.Encode
 import Prelude
 
 import Data.Argonaut.Core (Json(), jsonNull, fromBoolean, fromNumber, fromString, fromArray, fromObject)
-import Data.Either (Either(..))
+import Data.Either (Either(..), either)
 import Data.Foldable (foldr)
 import Data.Generic (Generic, GenericSpine(..), toSpine)
 import Data.Int (toNumber)
-import Data.List (List(), fromList)
+import Data.List (List(..), fromList)
 import Data.Map as M
 import Data.Maybe (Maybe(..))
 import Data.String (fromChar)
@@ -50,8 +50,12 @@ instance encodeJsonTuple :: (EncodeJson a, EncodeJson b) => EncodeJson (Tuple a
   encodeJson (Tuple a b) = encodeJson [encodeJson a, encodeJson b]
 
 instance encodeJsonEither :: (EncodeJson a, EncodeJson b) => EncodeJson (Either a b) where
-  encodeJson (Left a) = encodeJson a
-  encodeJson (Right b) = encodeJson b
+  encodeJson = either (obj "Left") (obj "Right")
+    where
+    obj :: forall c. (EncodeJson c) => String -> c -> Json
+    obj tag x =
+      fromObject $ SM.fromList $
+        Cons (Tuple "tag" (fromString tag)) (Cons (Tuple "value" (encodeJson x)) Nil)
 
 instance encodeJsonUnit :: EncodeJson Unit where
   encodeJson = const jsonNull

test/Test/Main.purs

@@ -183,7 +183,18 @@ genericsCheck = do
                                                              }]}
 
 
+eitherCheck = do
+  log "Test EncodeJson/DecodeJson Either instance"
+  quickCheck \(x :: Either String String) ->
+    case decodeJson (encodeJson x) of
+      Right decoded ->
+        decoded == x
+          <?> ("x = " <> show x <> ", decoded = " <> show decoded)
+      Left err ->
+        false <?> err
+
 main = do
+  eitherCheck
   encodeDecodeCheck
   combinatorsCheck
   genericsCheck