Support for Tuple

src/Simple/JSON.purs

@@ -21,8 +21,9 @@ module Simple.JSON (
 import Prelude
 
 import Control.Monad.Except (runExcept, withExcept)
+import Data.Array (length, unsafeIndex)
 import Data.Either (Either)
-import Data.Foreign (F, Foreign, ForeignError(..), MultipleErrors, readArray, readBoolean, readChar, readInt, readNull, readNumber, readString, toForeign)
+import Data.Foreign (F, Foreign, ForeignError(..), MultipleErrors, fail, readArray, readBoolean, readChar, readInt, readNull, readNumber, readString, toForeign)
 import Data.Foreign.Index (readProp)
 import Data.Foreign.Internal (readStrMap)
 import Data.Foreign.JSON (parseJSON)
@@ -35,7 +36,9 @@ import Data.Record.Builder as Builder
 import Data.StrMap as StrMap
 import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
 import Data.Traversable (sequence, traverse)
+import Data.Tuple (Tuple(..))
 import Global.Unsafe (unsafeStringify)
+import Partial.Unsafe (unsafePartial)
 import Type.Row (class RowLacks, class RowToList, Cons, Nil, RLProxy(RLProxy), kind RowList)
 
 -- | Read a JSON string to a type `a` while returning a `MultipleErrors` if the
@@ -76,47 +79,58 @@ read = readImpl
 class ReadForeign a where
  readImpl :: Foreign -> F a
 
-instance readForeign :: ReadForeign Foreign where
+instance readForeignForeign :: ReadForeign Foreign where
  readImpl = pure
 
-instance readChar :: ReadForeign Char where
+instance readForeignChar :: ReadForeign Char where
  readImpl = readChar
 
-instance readNumber :: ReadForeign Number where
+instance readForeignNumber :: ReadForeign Number where
  readImpl = readNumber
 
-instance readInt :: ReadForeign Int where
+instance readForeignInt :: ReadForeign Int where
  readImpl = readInt
 
-instance readString :: ReadForeign String where
+instance readForeignString :: ReadForeign String where
  readImpl = readString
 
-instance readBoolean :: ReadForeign Boolean where
+instance readForeignBoolean :: ReadForeign Boolean where
  readImpl = readBoolean
 
-instance readArray :: ReadForeign a => ReadForeign (Array a) where
+instance readForeignArray :: ReadForeign a => ReadForeign (Array a) where
  readImpl = readElements <=< readArray
  where
  readElements xs = sequence $ readImpl <$> xs
 
-instance readNullOrUndefined :: ReadForeign a => ReadForeign (NullOrUndefined a) where
+instance readForeignNullOrUndefined :: ReadForeign a => ReadForeign (NullOrUndefined a) where
  readImpl = readNullOrUndefined readImpl
 
-instance readMaybe :: ReadForeign a => ReadForeign (Maybe a) where
+instance readForeignMaybe :: ReadForeign a => ReadForeign (Maybe a) where
  readImpl = map unNullOrUndefined <<< readImpl
 
-instance readNullable :: ReadForeign a => ReadForeign (Nullable a) where
+instance readForeignNullable :: ReadForeign a => ReadForeign (Nullable a) where
  readImpl o = withExcept (map reformat) $
  map toNullable <$> traverse readImpl =<< readNull o
  where
  reformat error = case error of
  TypeMismatch inner other -> TypeMismatch ("Nullable " <> inner) other
  _ -> error
 
-instance readStrMap :: ReadForeign a => ReadForeign (StrMap.StrMap a) where
+instance readForeignStrMap :: ReadForeign a => ReadForeign (StrMap.StrMap a) where
  readImpl = sequence <<< StrMap.mapWithKey (const readImpl) <=< readStrMap
 
-instance readRecord ::
+instance readForeignTuple :: (ReadForeign a, ReadForeign b) => ReadForeign (Tuple a b) where
+ readImpl = asTuple <=< readArray
+ where asTuple :: Array Foreign -> F (Tuple a b)
+ asTuple arr = case length arr of
+ 2 -> do
+ let get a i = unsafePartial $ unsafeIndex a i
+ a <- readImpl $ get arr 0
+ b <- readImpl $ get arr 1
+ pure $ Tuple a b
+ l -> fail $ TypeMismatch "2 values" (show l <> " values")
+
+instance readForeignRecord ::
  ( RowToList fields fieldList
  , ReadForeignFields fieldList () fields
  ) => ReadForeign (Record fields) where
@@ -133,7 +147,7 @@ class ReadForeignFields (xs :: RowList) (from :: # Type) (to :: # Type)
  -> Foreign
  -> F (Builder (Record from) (Record to))
 
-instance readFieldsCons ::
+instance readForeignFieldsCons ::
  ( IsSymbol name
  , ReadForeign ty
  , ReadForeignFields tail from from'
@@ -153,7 +167,7 @@ instance readFieldsCons ::
  name = reflectSymbol nameP
  withExcept' = withExcept <<< map $ ErrorAtProperty name
 
-instance readFieldsNil ::
+instance readForeignFieldsNil ::
  ReadForeignFields Nil () () where
  getFields _ _ =
  pure id
@@ -197,6 +211,9 @@ instance writeForeignNullable :: WriteForeign a => WriteForeign (Nullable a) whe
 instance writeForeignStrMap :: WriteForeign a => WriteForeign (StrMap.StrMap a) where
  writeImpl = toForeign <<< StrMap.mapWithKey (const writeImpl)
 
+instance writeForeignTuple :: (WriteForeign a, WriteForeign b) => WriteForeign (Tuple a b) where
+ writeImpl (Tuple a b) = writeImpl [toForeign a, toForeign b]
+
 instance recordWriteForeign ::
  ( RowToList row rl
  , WriteForeignFields rl row () to

test/Main.purs

@@ -4,7 +4,6 @@ import Prelude
 
 import Control.Monad.Aff (Aff)
 import Control.Monad.Eff (Eff)
-import Control.Monad.Except (runExcept)
 import Data.Argonaut.Core (Json)
 import Data.Argonaut.Parser (jsonParser)
 import Data.Either (Either(..), either, fromLeft, isRight)
@@ -16,6 +15,7 @@ import Data.Maybe (Maybe)
 import Data.NonEmpty (NonEmpty(..))
 import Data.Nullable (Nullable)
 import Data.StrMap (StrMap)
+import Data.Tuple (Tuple)
 import Partial.Unsafe (unsafePartial)
 import Simple.JSON (class ReadForeign, class WriteForeign, readJSON, writeJSON)
 import Test.Spec (describe, it)
@@ -50,6 +50,10 @@ type MyTestMaybe =
  { a :: Maybe String
  }
 
+type MyTestTuple =
+ { a :: Tuple Int String
+ }
+
 type MyTestManyMaybe =
  { a :: Maybe String
  , aNull :: Maybe String
@@ -106,6 +110,14 @@ main = run [consoleReporter] do
  (unsafePartial $ fromLeft result) `shouldEqual`
  (NonEmptyList (NonEmpty (ErrorAtProperty "b" (TypeMismatch "Nullable String" "Undefined")) Nil))
  isRight (result :: E MyTestNullable) `shouldEqual` false
+ it "fails with invalid Tuple" do
+ let result = readJSON """
+ { "a": [1, "foo", 4] }
+ """
+ (unsafePartial $ fromLeft result) `shouldEqual`
+ (NonEmptyList (NonEmpty (ErrorAtProperty "a" (TypeMismatch "2 values" "3 values")) Nil))
+ isRight (result :: E MyTestTuple) `shouldEqual` false
+
 
  describe "roundtrips" do
  it "works with proper JSON" $ roundtrips (Proxy :: Proxy MyTest) """
@@ -132,3 +144,6 @@ main = run [consoleReporter] do
  it "works with Nullable" $ roundtrips (Proxy :: Proxy MyTestNullable) """
  { "a": null, "b": "a" }
  """
+ it "works with Tuple" $ roundtrips (Proxy :: Proxy MyTestTuple) """
+ { "a": [1, "foo"] }
+ """