Add instances for Map and Maps with Newtype keys (#4)

Author: i-am-the-slime

spago.dhall

@@ -12,16 +12,19 @@
   , "foreign"
   , "foreign-object"
   , "identity"
+  , "integers"
   , "lists"
   , "maybe"
   , "newtype"
   , "nullable"
+  , "ordered-collections"
   , "partial"
   , "prelude"
   , "record"
   , "transformers"
   , "tuples"
   , "typelevel-prelude"
+  , "unsafe-coerce"
   , "variant"
   ]
 , packages = ./packages.dhall

src/Yoga/JSON.purs

@@ -40,9 +40,14 @@ import Data.Array as Array
 import Data.Array.NonEmpty (NonEmptyArray, fromArray, toArray)
 import Data.Bifunctor (lmap)
 import Data.Either (Either, hush, note)
+import Data.FoldableWithIndex (foldrWithIndex)
 import Data.Identity (Identity(..))
+import Data.Int as Int
 import Data.List.NonEmpty (singleton)
-import Data.Maybe (Maybe(..), fromMaybe, maybe)
+import Data.Map (Map)
+import Data.Map as Map
+import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', maybe)
+import Data.Newtype (class Newtype)
 import Data.Nullable (Nullable, toMaybe, toNullable)
 import Data.Symbol (class IsSymbol, reflectSymbol)
 import Data.Traversable (sequence, traverse)
@@ -63,6 +68,7 @@ import Record (get)
 import Record.Builder (Builder)
 import Record.Builder as Builder
 import Type.Prelude (Proxy(..))
+import Unsafe.Coerce (unsafeCoerce)
 
 -- | An alias for the Either result of decoding
 type E a = Either MultipleErrors a
@@ -455,4 +461,27 @@ instance ReadForeign a ⇒ ReadForeign (NonEmptyArray a) where
       $ fromArray raw
 
 instance writeForeignNEArray ∷ WriteForeign a ⇒ WriteForeign (NonEmptyArray a) where
-  writeImpl a = writeImpl <<< toArray $ a
+  writeImpl a = writeImpl <<< toArray $ a
+
+-- Map instances
+instance (WriteForeign a) => WriteForeign (Map String a) where
+  writeImpl = foldrWithIndex Object.insert Object.empty >>> writeImpl
+else
+instance (WriteForeign a) => WriteForeign (Map Int a) where
+  writeImpl = foldrWithIndex (show >>> Object.insert) Object.empty >>> writeImpl
+else
+instance (Newtype nt key, WriteForeign (Map key value)) => WriteForeign (Map nt value) where
+  writeImpl = (unsafeCoerce :: (_ -> Map key value )) >>> writeImpl
+
+instance (ReadForeign a) => ReadForeign (Map String a) where
+  readImpl = (readImpl :: (_ -> _ (Object a))) >>> map (foldrWithIndex Map.insert Map.empty)
+else
+instance (ReadForeign a) => ReadForeign (Map Int a) where
+  readImpl = (readImpl :: (_ -> _ (Object a))) >>> map (foldrWithIndex (unsafeStringToInt >>> Map.insert) Map.empty)
+else
+instance (Newtype nt key, ReadForeign (Map key value)) => ReadForeign (Map nt value) where
+  readImpl = (readImpl :: (_ -> _ (Map key value))) >>> map (unsafeCoerce :: (Map key value -> Map nt value))
+
+unsafeStringToInt :: String → Int
+unsafeStringToInt = Int.fromString >>>
+  (fromMaybe' \_ -> unsafeCrashWith "impossible")

test.dhall

@@ -6,8 +6,6 @@ in      conf
               conf.dependencies
             # [ "spec"
               , "spec-discovery"
-              , "console"
-              , "nonempty"
               , "aff"
               , "strings-extra"
               , "newtype"

test/BasicsSpec.purs

@@ -7,19 +7,19 @@ import Data.Either (Either(..))
 import Data.Foldable (traverse_)
 import Data.List as List
 import Data.List.Lazy as LazyList
+import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype, un)
 import Data.Nullable as Nullable
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
 import Data.Variant (Variant, inj)
-import Debug (spy)
 import Foreign.Object as Object
-import Test.Spec (Spec, describe, it, itOnly)
+import Test.Spec (Spec, describe, it)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Util (roundtrips)
 import Type.Proxy (Proxy(..))
-import Yoga.JSON (class ReadForeign, class WriteForeign, readJSON, readJSON_, writeJSON)
+import Yoga.JSON (class ReadForeign, class WriteForeign, readJSON, writeJSON)
 import Yoga.JSON.Variant (TaggedVariant(..), UntaggedVariant(..))
 
 spec :: Spec Unit
@@ -45,6 +45,12 @@ spec = describe "En- and decoding" $ do
     it "roundtrips List" $ traverse_ roundtrips (List.fromFoldable [["A", "B"],[]])
     it "roundtrips NonEmptyArray" $ roundtrips (NEA.cons' "A" ["B"])
     it "roundtrips Object" $ roundtrips (Object.fromHomogeneous { a: 12, b: 54 })
+    it "roundtrips String Map" $ roundtrips (Map.fromFoldable [("A" /\ 8),("C" /\ 7)])
+    it "roundtrips Int Map" $ roundtrips (Map.fromFoldable [(4 /\ "B"),(8 /\ "D")])
+    it "roundtrips Map with String newtype keys"
+      $ roundtrips (Map.fromFoldable [(Stringy "A" /\ "B"),(Stringy "C" /\ "D")])
+    it "roundtrips Map with Int newtype keys"
+      $ roundtrips (Map.fromFoldable [(Inty 4 /\ "B"),(Inty 8 /\ "D")])
 
   describe "works on record types" do
     it "roundtrips" do
@@ -86,12 +92,23 @@ spec = describe "En- and decoding" $ do
 
 type ExampleVariant = ("erwin" :: String, "jackie" :: Int)
 type ExampleTaggedVariant t v = TaggedVariant t v ExampleVariant
+
+erwin ∷ ∀ a r. a → Variant ( erwin ∷ a | r )
 erwin = inj (Proxy :: Proxy "erwin")
 type Erwin r = (erwin :: String | r)
 
 newtype Stringy = Stringy String
 derive instance Newtype Stringy _
 derive newtype instance Show Stringy
 derive newtype instance Eq Stringy
+derive newtype instance Ord Stringy
 derive newtype instance WriteForeign Stringy
-derive newtype instance ReadForeign Stringy
+derive newtype instance ReadForeign Stringy
+
+newtype Inty = Inty Int
+derive instance Newtype Inty _
+derive newtype instance Show Inty
+derive newtype instance Eq Inty
+derive newtype instance Ord Inty
+derive newtype instance WriteForeign Inty
+derive newtype instance ReadForeign Inty

test/ErrorsSpec.purs

@@ -5,7 +5,6 @@ import Prelude
 import Data.Array as Array
 import Data.Either (blush)
 import Data.Maybe (Maybe(..))
-import Debug (spy)
 import Test.Spec (Spec, describe, it)
 import Test.Spec.Assertions (shouldEqual)
 import Type.Proxy (Proxy(..))
@@ -34,5 +33,4 @@ spec = describe "Errors" do
 getErrorPath ∷ ∀ a. ReadForeign a ⇒ Proxy a → String → Maybe (Array String)
 getErrorPath _ x = do
   let e = (readJSON x ∷ _ a) # blush
-  let _ = spy "e" e
   (e <#> map toJSONPath <#> Array.fromFoldable)

test/GenericsSpec.purs

@@ -65,14 +65,14 @@ instance ReadForeign HalfEnum where readImpl = genericReadForeignTaggedSum halfE
 instance WriteForeign HalfEnum where writeImpl = genericWriteForeignTaggedSum halfEnumOptions
 
 data MyEnum = Enum1 | Enum2 | Enum3
+
 derive instance Generic MyEnum _
 derive instance Eq MyEnum
 instance Show MyEnum where show = genericShow
 instance ReadForeign MyEnum where readImpl = genericReadForeignEnum
 instance WriteForeign MyEnum where writeImpl = genericWriteForeignEnum
 
 data IntOrString = AnInt Int | AString String
-
 derive instance Generic IntOrString _
 derive instance Eq IntOrString
 instance Show IntOrString where show = genericShow