b6b2a53 · rowtype-yoga/purescript-yoga-json

git.iko.soy/rowtype-yoga/purescript-yoga-json

on main help sign in

Improve error handling

b6b2a53Mark Eibes4 years ago

src/Yoga/JSON.purs+44−12

compare with main

unifiedsplit

@@ -41,13 +41,14 @@ import Data.Array.NonEmpty (NonEmptyArray, fromArray, toArray)

41import Data.Bifunctor (lmap)

42import Data.BigInt (BigInt)

43import Data.BigInt as BigInt

44−import Data.DateTime (DateTime(..))

44+import Data.DateTime (DateTime)

45−import Data.DateTime as DateTime

46−import Data.Either (Either(..), either, hush, note)

45+import Data.Either (Either(..), hush, note)

46+import Data.Foldable (class Foldable, foldl)

47import Data.FoldableWithIndex (foldrWithIndex)

48+import Data.FunctorWithIndex (mapWithIndex)

48import Data.Identity (Identity(..))

49import Data.Identity (Identity(..))

49import Data.Int as Int

50import Data.Int as Int

50−import Data.JSDate (JSDate, toISOString)

51+import Data.JSDate (JSDate)

51import Data.JSDate as JSDate

52import Data.JSDate as JSDate

52import Data.List.NonEmpty (NonEmptyList, singleton)

53import Data.List.NonEmpty (NonEmptyList, singleton)

53import Data.Map (Map)

54import Data.Map (Map)

@@ -57,8 +58,7 @@ import Data.Newtype (class Newtype)

57import Data.Nullable (Nullable, toMaybe, toNullable)

58import Data.Nullable (Nullable, toMaybe, toNullable)

58import Data.Number as Number

59import Data.Number as Number

59import Data.Symbol (class IsSymbol, reflectSymbol)

60import Data.Symbol (class IsSymbol, reflectSymbol)

60−import Data.Traversable (sequence, traverse)

61+import Data.Traversable (traverse)

61−import Data.TraversableWithIndex (traverseWithIndex)

62import Data.Tuple (Tuple(..))

63import Data.Variant (Variant, inj, on)

64import Effect.Exception (message, try)

@@ -216,7 +216,7 @@ instance ReadForeign Boolean where

216 readImpl = readBoolean

217

218instance ReadForeign a ⇒ ReadForeign (Array a) where

219− readImpl = traverseWithIndex readAtIdx <=< readArray

219+ readImpl = sequenceCombining <<< mapWithIndex readAtIdx <=< readArray

220

221instance ReadForeign a ⇒ ReadForeign (Maybe a) where

222 readImpl = readNullOrUndefined readImpl

@@ -242,8 +242,21 @@ instance (ReadForeign a, ReadForeign b) ⇒ ReadForeign (Either a b) where

242 _ -> except $ Left (pure $ ForeignError $ "Invalid Either tag " <> tpe)

243

244instance ReadForeign a ⇒ ReadForeign (Object.Object a) where

245− readImpl = sequence <<< Object.mapWithKey readProp <=< readObject'

245+ readImpl = gatherErrors <<< Object.mapWithKey readProp <=< readObject'

246 where

247+ gatherErrors :: Object (F a) -> F (Object a)

248+ gatherErrors = Object.toUnfoldable

249+ >>> Array.foldl fn (Right (Object.empty))

250+ >>> except

251+ where

252+ fn :: _ -> _ -> (Either MultipleErrors (Object a))

253+ fn acc (Tuple k v) = do

254+ case acc, runExcept v of

255+ Left errs, Left errsNew -> Left (errs <> errsNew)

256+ Left errs, Right _ -> Left errs

257+ Right obj, Right value -> Right (Object.insert k value obj)

258+ Right _, Left errs -> Left errs

259+

247 readProp key value = except $ lmap (map (ErrorAtProperty key))

260 readProp key value = except $ lmap (map (ErrorAtProperty key))

248 (readImpl value # runExcept)

261 (readImpl value # runExcept)

249

262

@@ -321,16 +334,20 @@ instance

321 , Row.Cons name ty from' to

334 , Row.Cons name ty from' to

322 ) ⇒

335 ) ⇒

323 ReadForeignFields (Cons name ty tail) from to where

336 ReadForeignFields (Cons name ty tail) from to where

324− getFields _ obj = do

337+ getFields _ obj = except

325− compose <$> first <*> rest

338+ case runExcept first, runExcept rest of

339+ Right f, Right r -> Right (f <<< r)

340+ Left e1, Left e2 -> Left (e1 <> e2)

341+ Right _, Left es -> Left es

342+ Left es, Right _ -> Left es

326 where

343 where

327− value = withExcept' (readImpl =<< readProp name obj)

344+ value = enrichErrorWithPropName (readImpl =<< readProp name obj)

328 first = Builder.insert nameP <$> value

345 first = Builder.insert nameP <$> value

329 rest = getFields tailP obj

346 rest = getFields tailP obj

330 nameP = Proxy ∷ Proxy name

347 nameP = Proxy ∷ Proxy name

331 tailP = Proxy ∷ Proxy tail

348 tailP = Proxy ∷ Proxy tail

332 name = reflectSymbol nameP

349 name = reflectSymbol nameP

333− withExcept' = (withExcept <<< map) (ErrorAtProperty name)

350+ enrichErrorWithPropName = (withExcept <<< map) (ErrorAtProperty name)

334

351

335readAtIdx ∷ ∀ a. ReadForeign a ⇒ Int → Foreign → F a

352readAtIdx ∷ ∀ a. ReadForeign a ⇒ Int → Foreign → F a

336readAtIdx i f = withExcept (map (ErrorAtIndex i)) (readImpl f)

353readAtIdx i f = withExcept (map (ErrorAtIndex i)) (readImpl f)

@@ -552,3 +569,18 @@ instance ReadForeign DateTime where

552unsafeStringToInt :: String → Int

569unsafeStringToInt :: String → Int

553unsafeStringToInt = Int.fromString >>>

570unsafeStringToInt = Int.fromString >>>

554 (fromMaybe' \_ -> unsafeCrashWith "impossible")

571 (fromMaybe' \_ -> unsafeCrashWith "impossible")

572+

573+sequenceCombining :: forall f a.

574+ Monoid (f a) =>

575+ Foldable f =>

576+ Applicative f =>

577+ f (F a) -> F (f a)

578+sequenceCombining = foldl fn (Right mempty) >>> except

579+ where

580+ fn :: _ -> _ -> (Either MultipleErrors (f a))

581+ fn acc elem = do

582+ case acc, runExcept elem of

583+ Left errs, Left errsNew -> Left (errs <> errsNew)

584+ Left errs, Right _ -> Left errs

585+ Right values, Right value -> Right (values <> pure value)

586+ Right _, Left errs -> Left errs

src/Yoga/JSON/Error.purs+33

@@ -14,3 +14,36 @@ toJSONPath fe = "$" <> path

14 ErrorAtIndex i e -> "[" <> show i <> "]" <> go e

15 ErrorAtProperty _ (TypeMismatch _ "undefined") -> ""

16 ErrorAtProperty prop e -> "." <> prop <> go e

17+

18+renderHumanError :: ForeignError -> String

19+renderHumanError = errorToJSON >>> toHuman

20+ where

21+ toHuman { message, path } = message <> " at " <> path

22+

23+errorToJSON ∷

24+ ForeignError →

25+ { message ∷ String

26+ , path ∷ String

27+ }

28+errorToJSON err = go err

29+ where

30+ path = toJSONPath err

31+ go = case _ of

32+ ForeignError s →

33+ { path

34+ , message: s

35+ }

36+ TypeMismatch exp "Undefined" →

37+ { path

38+ , message: "Must provide a value of type '" <> exp <> "'"

39+ }

40+ TypeMismatch exp "undefined" →

41+ { path

42+ , message: "Must provide a value of type '" <> exp <> "'"

43+ }

44+ TypeMismatch exp act →

45+ { path

46+ , message: "Must provide a value of type '" <> exp <> "' instead of '" <> act <> "'"

47+ }

48+ ErrorAtIndex _ e → go e

49+ ErrorAtProperty _ e → go e

test/BasicsSpec.purs+2−2

@@ -17,9 +17,9 @@ import Data.Tuple (Tuple(..))

17import Data.Tuple.Nested ((/\))

18import Data.Variant (Variant, inj)

19import Effect.Class (liftEffect)

20−import Effect.Now (nowDate, nowDateTime)

20+import Effect.Now (nowDateTime)

21import Foreign.Object as Object

22−import Partial.Unsafe (unsafeCrashWith, unsafePartial)

22+import Partial.Unsafe (unsafeCrashWith)

23import Test.Spec (Spec, describe, it)

24import Test.Spec.Assertions (shouldEqual)

25import Test.Util (roundtrips)

test/ErrorsSpec.purs+53−4

@@ -3,16 +3,65 @@ module Test.ErrorsSpec where

3import Prelude

5import Data.Array as Array

6−import Data.Either (blush)

6+import Data.Array.NonEmpty as NEA

7+import Data.Bifunctor (lmap)

8+import Data.Either (Either(..), blush, either)

7import Data.Maybe (Maybe(..))

9import Data.Maybe (Maybe(..))

10+import Foreign (ForeignError(..))

11+import Foreign.Object (Object)

12+import Foreign.Object as Object

8import Test.Spec (Spec, describe, it)

13import Test.Spec (Spec, describe, it)

9import Test.Spec.Assertions (shouldEqual)

14import Test.Spec.Assertions (shouldEqual)

10import Type.Proxy (Proxy(..))

15import Type.Proxy (Proxy(..))

11−import Yoga.JSON (class ReadForeign, readJSON)

16+import Yoga.JSON (class ReadForeign, E, readJSON)

12−import Yoga.JSON.Error (toJSONPath)

17+import Yoga.JSON as JSON

18+import Yoga.JSON.Error (errorToJSON, renderHumanError, toJSONPath)

14spec ∷ Spec Unit

20spec ∷ Spec Unit

15spec = describe "Errors" do

21spec = describe "Errors" do

22+ describe "are returned at once" do

23+ it "returns multiple errors for object" do

24+ let

25+ res :: E (Object Int)

26+ res = JSON.readJSON """{ "something": "no", "else": true }"""

27+ e1 = ErrorAtProperty "something" (TypeMismatch "Int" "String")

28+ e2 = ErrorAtProperty "else" (TypeMismatch "Int" "Boolean")

29+ res `shouldEqual` (Left (pure e1 <> pure e2))

30+

31+ it "returns multiple errors for record" do

32+ let

33+ res :: E { a :: Int, b :: String }

34+ res = JSON.readJSON """{ "b": true }"""

35+ e1 = ErrorAtProperty "a" (TypeMismatch "Int" "Undefined")

36+ e2 = ErrorAtProperty "b" (TypeMismatch "String" "Boolean")

37+ res `shouldEqual` (Left (pure e1 <> pure e2))

38+

39+ it "returns multiple errors for array" do

40+ let

41+ res :: E (Array Int)

42+ res = JSON.readJSON """[1,"a",2,true]"""

43+ e1 = ErrorAtIndex 1 (TypeMismatch "Int" "String")

44+ e2 = ErrorAtIndex 3 (TypeMismatch "Int" "Boolean")

45+ res `shouldEqual` (Left (pure e1 <> pure e2))

46+

47+ describe "produces human-friendly errors" do

48+ it "For some object" do

49+ let

50+ res :: E (Object Int)

51+ res = JSON.readJSON """{ "something": "no", "else": true }"""

52+ e1 = "Must provide a value of type 'Int' instead of 'String' at $.something"

53+ e2 = "Must provide a value of type 'Int' instead of 'Boolean' at $.else"

54+ (res # lmap (map renderHumanError >>> Array.fromFoldable))

55+ `shouldEqual` (Left [e1, e2])

56+

57+ it "For deeply nested keys" do

58+ let

59+ res :: E { a :: { b :: { c :: { d :: String }}}}

60+ res = JSON.readJSON """{ "a": { "b": { "c": { }}}}"""

61+ e = "Must provide a value of type 'String' at $.a.b.c.d"

62+ (res # lmap (map renderHumanError >>> Array.fromFoldable))

63+ `shouldEqual` (Left [e])

64+

16 describe "have the correct JSON path" do

65 describe "have the correct JSON path" do

17 it "empty json" do

66 it "empty json" do

18 (getErrorPath (Proxy ∷ _ {}) "") `shouldEqual` Just [ "$" ]

67 (getErrorPath (Proxy ∷ _ {}) "") `shouldEqual` Just [ "$" ]

@@ -33,4 +82,4 @@ spec = describe "Errors" do

33getErrorPath ∷ ∀ a. ReadForeign a ⇒ Proxy a → String → Maybe (Array String)

82getErrorPath ∷ ∀ a. ReadForeign a ⇒ Proxy a → String → Maybe (Array String)

34getErrorPath _ x = do

83getErrorPath _ x = do

35 let e = (readJSON x ∷ _ a) # blush

84 let e = (readJSON x ∷ _ a) # blush

36− (e <#> map toJSONPath <#> Array.fromFoldable)

85+ (e <#> map toJSONPath <#> Array.fromFoldable)

test/Util.purs+5−5

@@ -5,11 +5,11 @@ import Prelude

5import Data.Either (Either(..))

6import Data.Semigroup.Foldable (intercalateMap)

7import Effect.Aff (Aff)

8−import Foreign (Foreign, renderForeignError)

8+import Foreign (Foreign)

9import Test.Spec.Assertions (fail)

10import Type.Proxy (Proxy(..))

11import Yoga.JSON (class ReadForeign, class WriteForeign, read, readJSON, write, writeJSON)

12−import Yoga.JSON.Error (toJSONPath)

12+import Yoga.JSON.Error (renderHumanError, toJSONPath)

14roundtrips ∷ ∀ a. Show a ⇒ Eq a ⇒ ReadForeign a ⇒ WriteForeign a ⇒ a → Aff Unit

15roundtrips x = do

@@ -18,10 +18,10 @@ roundtrips x = do

19shouldRead ∷ ∀ a. ReadForeign a ⇒ Proxy a → Foreign → Aff Unit

20shouldRead _ = read >>> case _ of

21− Left e → fail (intercalateMap "\n" renderForeignError e <> "\n" <> intercalateMap "\n" toJSONPath e)

21+ Left e → fail (intercalateMap "\n" renderHumanError e <> "\n" <> intercalateMap "\n" toJSONPath e)

22 Right (_ ∷ a) → pure unit

24shouldReadJSON ∷ ∀ a. ReadForeign a ⇒ Proxy a → String → Aff Unit

25shouldReadJSON _ = readJSON >>> case _ of

26− Left e → fail (intercalateMap "\n" renderForeignError e <> "\n" <> intercalateMap "\n" toJSONPath e)

26+ Left e → fail (intercalateMap "\n" renderHumanError e <> "\n" <> intercalateMap "\n" toJSONPath e)

27− Right (_ ∷ a) → pure unit

27+ Right (_ ∷ a) → pure unit