git.iko.soy/rowtype-yoga/purescript-yoga-json
on main help sign in
Add instances for Map and Maps with Newtype keys (#4)
commit0ff9e606d80ecbf8054851e3d6cbe471de237a0c authorMark Eibes <mark.eibes@gmail.com> dateThu 16 Jun 2022, 21:28 (4 years ago) parentce23de7
6 files changed+56−11
spago.dhall+3 src/Yoga/JSON.purs+31−2 test.dhall−2 test/BasicsSpec.purs+21−4 test/ErrorsSpec.purs−2 test/GenericsSpec.purs+1−1
spago.dhall+3
@@ -12,16 +12,19 @@
1212 , "foreign"
1313 , "foreign-object"
1414 , "identity"
15+ , "integers"
1516 , "lists"
1617 , "maybe"
1718 , "newtype"
1819 , "nullable"
20+ , "ordered-collections"
1921 , "partial"
2022 , "prelude"
2123 , "record"
2224 , "transformers"
2325 , "tuples"
2426 , "typelevel-prelude"
27+ , "unsafe-coerce"
2528 , "variant"
2629 ]
2730, packages = ./packages.dhall
src/Yoga/JSON.purs+31−2
@@ -40,9 +40,14 @@ import Data.Array as Array
4040import Data.Array.NonEmpty (NonEmptyArray, fromArray, toArray)
4141import Data.Bifunctor (lmap)
4242import Data.Either (Either, hush, note)
43+import Data.FoldableWithIndex (foldrWithIndex)
4344import Data.Identity (Identity(..))
45+import Data.Int as Int
4446import Data.List.NonEmpty (singleton)
45−import Data.Maybe (Maybe(..), fromMaybe, maybe)
47+import Data.Map (Map)
48+import Data.Map as Map
49+import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', maybe)
50+import Data.Newtype (class Newtype)
4651import Data.Nullable (Nullable, toMaybe, toNullable)
4752import Data.Symbol (class IsSymbol, reflectSymbol)
4853import Data.Traversable (sequence, traverse)
@@ -63,6 +68,7 @@ import Record (get)
6368import Record.Builder (Builder)
6469import Record.Builder as Builder
6570import Type.Prelude (Proxy(..))
71+import Unsafe.Coerce (unsafeCoerce)
6672
6773-- | An alias for the Either result of decoding
6874type E a = Either MultipleErrors a
@@ -455,4 +461,27 @@ instance ReadForeign a ⇒ ReadForeign (NonEmptyArray a) where
455461 $ fromArray raw
456462
457463instance writeForeignNEArray ∷ WriteForeign a ⇒ WriteForeign (NonEmptyArray a) where
458− writeImpl a = writeImpl <<< toArray $ a
464+ writeImpl a = writeImpl <<< toArray $ a
465+
466+-- Map instances
467+instance (WriteForeign a) => WriteForeign (Map String a) where
468+ writeImpl = foldrWithIndex Object.insert Object.empty >>> writeImpl
469+else
470+instance (WriteForeign a) => WriteForeign (Map Int a) where
471+ writeImpl = foldrWithIndex (show >>> Object.insert) Object.empty >>> writeImpl
472+else
473+instance (Newtype nt key, WriteForeign (Map key value)) => WriteForeign (Map nt value) where
474+ writeImpl = (unsafeCoerce :: (_ -> Map key value )) >>> writeImpl
475+
476+instance (ReadForeign a) => ReadForeign (Map String a) where
477+ readImpl = (readImpl :: (_ -> _ (Object a))) >>> map (foldrWithIndex Map.insert Map.empty)
478+else
479+instance (ReadForeign a) => ReadForeign (Map Int a) where
480+ readImpl = (readImpl :: (_ -> _ (Object a))) >>> map (foldrWithIndex (unsafeStringToInt >>> Map.insert) Map.empty)
481+else
482+instance (Newtype nt key, ReadForeign (Map key value)) => ReadForeign (Map nt value) where
483+ readImpl = (readImpl :: (_ -> _ (Map key value))) >>> map (unsafeCoerce :: (Map key value -> Map nt value))
484+
485+unsafeStringToInt :: String → Int
486+unsafeStringToInt = Int.fromString >>>
487+ (fromMaybe' \_ -> unsafeCrashWith "impossible")
test.dhall−2
@@ -6,8 +6,6 @@ in conf
66 conf.dependencies
77 # [ "spec"
88 , "spec-discovery"
9− , "console"
10− , "nonempty"
119 , "aff"
1210 , "strings-extra"
1311 , "newtype"
test/BasicsSpec.purs+21−4
@@ -7,19 +7,19 @@ import Data.Either (Either(..))
77import Data.Foldable (traverse_)
88import Data.List as List
99import Data.List.Lazy as LazyList
10+import Data.Map as Map
1011import Data.Maybe (Maybe(..))
1112import Data.Newtype (class Newtype, un)
1213import Data.Nullable as Nullable
1314import Data.Tuple (Tuple(..))
1415import Data.Tuple.Nested ((/\))
1516import Data.Variant (Variant, inj)
16−import Debug (spy)
1717import Foreign.Object as Object
18−import Test.Spec (Spec, describe, it, itOnly)
18+import Test.Spec (Spec, describe, it)
1919import Test.Spec.Assertions (shouldEqual)
2020import Test.Util (roundtrips)
2121import Type.Proxy (Proxy(..))
22−import Yoga.JSON (class ReadForeign, class WriteForeign, readJSON, readJSON_, writeJSON)
22+import Yoga.JSON (class ReadForeign, class WriteForeign, readJSON, writeJSON)
2323import Yoga.JSON.Variant (TaggedVariant(..), UntaggedVariant(..))
2424
2525spec :: Spec Unit
@@ -45,6 +45,12 @@ spec = describe "En- and decoding" $ do
4545 it "roundtrips List" $ traverse_ roundtrips (List.fromFoldable [["A", "B"],[]])
4646 it "roundtrips NonEmptyArray" $ roundtrips (NEA.cons' "A" ["B"])
4747 it "roundtrips Object" $ roundtrips (Object.fromHomogeneous { a: 12, b: 54 })
48+ it "roundtrips String Map" $ roundtrips (Map.fromFoldable [("A" /\ 8),("C" /\ 7)])
49+ it "roundtrips Int Map" $ roundtrips (Map.fromFoldable [(4 /\ "B"),(8 /\ "D")])
50+ it "roundtrips Map with String newtype keys"
51+ $ roundtrips (Map.fromFoldable [(Stringy "A" /\ "B"),(Stringy "C" /\ "D")])
52+ it "roundtrips Map with Int newtype keys"
53+ $ roundtrips (Map.fromFoldable [(Inty 4 /\ "B"),(Inty 8 /\ "D")])
4854
4955 describe "works on record types" do
5056 it "roundtrips" do
@@ -86,6 +92,8 @@ spec = describe "En- and decoding" $ do
8692
8793type ExampleVariant = ("erwin" :: String, "jackie" :: Int)
8894type ExampleTaggedVariant t v = TaggedVariant t v ExampleVariant
95+
96+erwin ∷ ∀ a r. a → Variant ( erwin ∷ a | r )
8997erwin = inj (Proxy :: Proxy "erwin")
9098type Erwin r = (erwin :: String | r)
9199
@@ -93,5 +101,14 @@ newtype Stringy = Stringy String
93101derive instance Newtype Stringy _
94102derive newtype instance Show Stringy
95103derive newtype instance Eq Stringy
104+derive newtype instance Ord Stringy
96105derive newtype instance WriteForeign Stringy
97−derive newtype instance ReadForeign Stringy
106+derive newtype instance ReadForeign Stringy
107+
108+newtype Inty = Inty Int
109+derive instance Newtype Inty _
110+derive newtype instance Show Inty
111+derive newtype instance Eq Inty
112+derive newtype instance Ord Inty
113+derive newtype instance WriteForeign Inty
114+derive newtype instance ReadForeign Inty
test/ErrorsSpec.purs−2
@@ -5,7 +5,6 @@ import Prelude
55import Data.Array as Array
66import Data.Either (blush)
77import Data.Maybe (Maybe(..))
8−import Debug (spy)
98import Test.Spec (Spec, describe, it)
109import Test.Spec.Assertions (shouldEqual)
1110import Type.Proxy (Proxy(..))
@@ -34,5 +33,4 @@ spec = describe "Errors" do
3433getErrorPath ∷ ∀ a. ReadForeign a ⇒ Proxy a → String → Maybe (Array String)
3534getErrorPath _ x = do
3635 let e = (readJSON x ∷ _ a) # blush
37− let _ = spy "e" e
3836 (e <#> map toJSONPath <#> Array.fromFoldable)
test/GenericsSpec.purs+1−1
@@ -65,6 +65,7 @@ instance ReadForeign HalfEnum where readImpl = genericReadForeignTaggedSum halfE
6565instance WriteForeign HalfEnum where writeImpl = genericWriteForeignTaggedSum halfEnumOptions
6666
6767data MyEnum = Enum1 | Enum2 | Enum3
68+
6869derive instance Generic MyEnum _
6970derive instance Eq MyEnum
7071instance Show MyEnum where show = genericShow
@@ -72,7 +73,6 @@ instance ReadForeign MyEnum where readImpl = genericReadForeignEnum
7273instance WriteForeign MyEnum where writeImpl = genericWriteForeignEnum
7374
7475data IntOrString = AnInt Int | AString String
75−
7676derive instance Generic IntOrString _
7777derive instance Eq IntOrString
7878instance Show IntOrString where show = genericShow