Skip to content

Commit 9fcc04c

Browse files
author
Serhii Khoma
authored
Implement typed errors for Json (#73)
Implement typed errors for Json
1 parent 2ad2147 commit 9fcc04c

File tree

6 files changed

+241
-190
lines changed

6 files changed

+241
-190
lines changed

‎bower.json

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@
2323
"license": "MIT",
2424
"dependencies": {
2525
"purescript-argonaut-core": "^5.0.0",
26+
"purescript-generics-rep": "^6.1.1",
2627
"purescript-integers": "^4.0.0",
2728
"purescript-maybe": "^4.0.0",
2829
"purescript-ordered-collections": "^1.0.0",

‎src/Data/Argonaut/Decode/Class.purs

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,12 @@
11
module Data.Argonaut.Decode.Class where
22

3-
import Prelude (class Ord, Unit, Void, bind, ($), (<<<), (<>))
3+
import Prelude (class Ord, Unit, Void, bind, ($), (<<<))
44

55
import Data.Argonaut.Core (Json, toObject)
6+
import Data.Argonaut.Decode.Errors (JsonDecodeError(..))
67
import Data.Array.NonEmpty (NonEmptyArray)
78
import Data.Either (Either(..))
9+
import Data.Bifunctor (lmap)
810
import Data.Identity (Identity)
911
import Data.List (List)
1012
import Data.List.NonEmpty (NonEmptyList)
@@ -23,7 +25,7 @@ import Type.Data.RowList (RLProxy(..))
2325
import Data.Argonaut.Decode.Decoders
2426

2527
class DecodeJson a where
26-
decodeJson :: Json -> Either String a
28+
decodeJson :: Json -> Either JsonDecodeError a
2729

2830
instance decodeIdentity :: DecodeJson a => DecodeJson (Identity a) where
2931
decodeJson = decodeIdentity decodeJson
@@ -96,10 +98,10 @@ instance decodeRecord
9698
decodeJson json =
9799
case toObject json of
98100
Just object -> gDecodeJson object (RLProxy :: RLProxy list)
99-
Nothing -> Left "Could not convert JSON to object"
101+
Nothing -> Left $ TypeMismatch "Object"
100102

101103
class GDecodeJson (row :: # Type) (list :: RL.RowList) | list -> row where
102-
gDecodeJson :: FO.Object Json -> RLProxy list -> Either String (Record row)
104+
gDecodeJson :: FO.Object Json -> RLProxy list -> Either JsonDecodeError (Record row)
103105

104106
instance gDecodeJsonNil :: GDecodeJson () RL.Nil where
105107
gDecodeJson _ _ = Right {}
@@ -120,11 +122,11 @@ instance gDecodeJsonCons
120122
fieldName = reflectSymbol sProxy
121123
in case FO.lookup fieldName object of
122124
Just jsonVal -> do
123-
val <- elaborateFailure fieldName <<< decodeJson $ jsonVal
125+
val <- lmap (AtKey fieldName) <<< decodeJson $ jsonVal
124126

125127
rest <- gDecodeJson object (RLProxy :: RLProxy tail)
126128

127129
Right $ Record.insert sProxy val rest
128130

129131
Nothing ->
130-
Left $ "JSON was missing expected field: " <> fieldName
132+
Left $ AtKey fieldName MissingValue

‎src/Data/Argonaut/Decode/Combinators.purs

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module Data.Argonaut.Decode.Combinators
1818
import Prelude ((<$>))
1919

2020
import Data.Argonaut.Core (Json)
21+
import Data.Argonaut.Decode.Errors (JsonDecodeError)
2122
import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson)
2223
import Data.Either (Either)
2324
import Data.Maybe (Maybe, fromMaybe)
@@ -29,7 +30,7 @@ import Data.Argonaut.Decode.Decoders as Decoders
2930
-- |
3031
-- | Use this accessor if the key and value *must* be present in your object.
3132
-- | If the key and value are optional, use `getFieldOptional'` (`.:?`) instead.
32-
getField :: forall a. DecodeJson a => FO.Object Json -> String -> Either String a
33+
getField :: forall a. DecodeJson a => FO.Object Json -> String -> Either JsonDecodeError a
3334
getField = Decoders.getField decodeJson
3435

3536
infix 7 getField as .:
@@ -39,7 +40,7 @@ getFieldDeprecated
3940
=> DecodeJson a
4041
=> FO.Object Json
4142
-> String
42-
-> Either String a
43+
-> Either JsonDecodeError a
4344
getFieldDeprecated = getField
4445

4546
infix 7 getFieldDeprecated as .?
@@ -51,7 +52,7 @@ infix 7 getFieldDeprecated as .?
5152
-- |
5253
-- | Use this accessor if the key and value are optional in your object.
5354
-- | If the key and value are mandatory, use `getField` (`.:`) instead.
54-
getFieldOptional' :: forall a. DecodeJson a => FO.Object Json -> String -> Either String (Maybe a)
55+
getFieldOptional' :: forall a. DecodeJson a => FO.Object Json -> String -> Either JsonDecodeError (Maybe a)
5556
getFieldOptional' = Decoders.getFieldOptional' decodeJson
5657

5758
infix 7 getFieldOptional' as .:?
@@ -64,7 +65,7 @@ infix 7 getFieldOptional' as .:?
6465
-- | This function will treat `null` as a value and attempt to decode it into your desired type.
6566
-- | If you would like to treat `null` values the same as absent values, use
6667
-- | `getFieldOptional'` (`.:?`) instead.
67-
getFieldOptional :: forall a. DecodeJson a => FO.Object Json -> String -> Either String (Maybe a)
68+
getFieldOptional :: forall a. DecodeJson a => FO.Object Json -> String -> Either JsonDecodeError (Maybe a)
6869
getFieldOptional = Decoders.getFieldOptional decodeJson
6970

7071
infix 7 getFieldOptional as .:!
@@ -74,7 +75,7 @@ getFieldOptionalDeprecated
7475
=> DecodeJson a
7576
=> FO.Object Json
7677
-> String
77-
-> Either String (Maybe a)
78+
-> Either JsonDecodeError (Maybe a)
7879
getFieldOptionalDeprecated = Decoders.getFieldOptional decodeJson
7980

8081
infix 7 getFieldOptionalDeprecated as .??
@@ -98,14 +99,14 @@ infix 7 getFieldOptionalDeprecated as .??
9899
-- | baz <- x .:? "baz" .!= false -- optional field with default value of `false`
99100
-- | pure $ MyType { foo, bar, baz }
100101
-- | ```
101-
defaultField :: forall a. Either String (Maybe a) -> a -> Either String a
102+
defaultField :: forall a. Either JsonDecodeError (Maybe a) -> a -> Either JsonDecodeError a
102103
defaultField parser default = fromMaybe default <$> parser
103104

104105
infix 6 defaultField as .!=
105106

106107
defaultFieldDeprecated
107108
:: forall a. Warn ( Text "`.?=` is deprecated, use `.!=` instead" )
108-
=> Either String (Maybe a) -> a -> Either String a
109+
=> Either JsonDecodeError (Maybe a) -> a -> Either JsonDecodeError a
109110
defaultFieldDeprecated = defaultField
110111

111112
infix 6 defaultFieldDeprecated as .?=

‎src/Data/Argonaut/Decode/Decoders.purs

Lines changed: 58 additions & 63 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,8 @@ module Data.Argonaut.Decode.Decoders where
22

33
import Prelude
44

5-
import Data.Argonaut.Core (Json, caseJsonBoolean, caseJsonNull, caseJsonNumber, caseJsonString, isNull, stringify, toArray, toObject, toString)
5+
import Data.Argonaut.Core (Json, caseJsonBoolean, caseJsonNull, caseJsonNumber, caseJsonString, isNull, toArray, toObject, toString, fromString)
6+
import Data.Argonaut.Decode.Errors (JsonDecodeError(..))
67
import Data.Array as Arr
78
import Data.Array.NonEmpty (NonEmptyArray)
89
import Data.Array.NonEmpty as NEA
@@ -24,125 +25,125 @@ import Data.TraversableWithIndex (traverseWithIndex)
2425
import Data.Tuple (Tuple(..))
2526
import Foreign.Object as FO
2627

27-
decodeIdentity :: ∀ a . (Json -> Either String a) -> Json -> Either String (Identity a)
28+
decodeIdentity :: ∀ a . (Json -> Either JsonDecodeError a) -> Json -> Either JsonDecodeError (Identity a)
2829
decodeIdentity decoder j = Identity <$> decoder j
2930

30-
decodeMaybe :: ∀ a . (Json -> Either String a) -> Json -> Either String (Maybe a)
31+
decodeMaybe :: ∀ a . (Json -> Either JsonDecodeError a) -> Json -> Either JsonDecodeError (Maybe a)
3132
decodeMaybe decoder j
3233
| isNull j = pure Nothing
3334
| otherwise = Just <$> decoder j
3435

35-
decodeTuple :: ∀ a b . (Json -> Either String a) -> (Json -> Either String b) -> Json -> Either String (Tuple a b)
36+
decodeTuple :: ∀ a b . (Json -> Either JsonDecodeError a) -> (Json -> Either JsonDecodeError b) -> Json -> Either JsonDecodeError (Tuple a b)
3637
decodeTuple decoderA decoderB j = decodeArray Right j >>= f
3738
where
38-
f :: Array Json -> Either String (Tuple a b)
39+
f :: Array Json -> Either JsonDecodeError (Tuple a b)
3940
f [a, b] = Tuple <$> decoderA a <*> decoderB b
40-
f _ = Left "Couldn't decode Tuple"
41+
f _ = Left $ TypeMismatch "Tuple"
4142

42-
decodeEither :: ∀ a b . (Json -> Either String a) -> (Json -> Either String b) -> Json -> Either String (Either a b)
43+
decodeEither :: ∀ a b . (Json -> Either JsonDecodeError a) -> (Json -> Either JsonDecodeError b) -> Json -> Either JsonDecodeError (Either a b)
4344
decodeEither decoderA decoderB j =
44-
lmap ("Couldn't decode Either: " <> _) $
45+
lmap (Named "Either") $
4546
decodeJObject j >>= \obj -> do
46-
tag <- maybe (Left "Expected field 'tag'") Right $ FO.lookup "tag" obj
47-
val <- maybe (Left "Expected field 'value'") Right $ FO.lookup "value" obj
47+
tag <- maybe (Left $ AtKey "tag" MissingValue) Right $ FO.lookup "tag" obj
48+
val <- maybe (Left $ AtKey "value" MissingValue) Right $ FO.lookup "value" obj
4849
case toString tag of
4950
Just "Right" -> Right <$> decoderB val
5051
Just "Left" -> Left <$> decoderA val
51-
_ -> Left "'tag' field was not \"Left\" or \"Right\""
52+
_ -> Left $ AtKey "tag" (UnexpectedValue tag)
5253

53-
decodeNull :: Json -> Either String Unit
54-
decodeNull = caseJsonNull (Left "Value is not a null") (const $ Right unit)
54+
decodeNull :: Json -> Either JsonDecodeError Unit
55+
decodeNull = caseJsonNull (Left $ TypeMismatch "null") (const $ Right unit)
5556

56-
decodeBoolean :: Json -> Either String Boolean
57-
decodeBoolean = caseJsonBoolean (Left "Value is not a Boolean") Right
57+
decodeBoolean :: Json -> Either JsonDecodeError Boolean
58+
decodeBoolean = caseJsonBoolean (Left $ TypeMismatch "Boolean") Right
5859

59-
decodeNumber :: Json -> Either String Number
60-
decodeNumber = caseJsonNumber (Left "Value is not a Number") Right
60+
decodeNumber :: Json -> Either JsonDecodeError Number
61+
decodeNumber = caseJsonNumber (Left $ TypeMismatch "Number") Right
6162

62-
decodeInt :: Json -> Either String Int
63+
decodeInt :: Json -> Either JsonDecodeError Int
6364
decodeInt =
64-
maybe (Left "Value is not an Integer") Right
65+
maybe (Left $ TypeMismatch "Integer") Right
6566
<<< fromNumber
6667
<=< decodeNumber
6768

68-
decodeString :: Json -> Either String String
69-
decodeString = caseJsonString (Left "Value is not a String") Right
69+
decodeString :: Json -> Either JsonDecodeError String
70+
decodeString = caseJsonString (Left $ TypeMismatch "String") Right
7071

71-
decodeNonEmpty_Array :: ∀ a . (Json -> Either String a) -> Json -> Either String (NonEmpty Array a)
72+
decodeNonEmpty_Array :: ∀ a . (Json -> Either JsonDecodeError a) -> Json -> Either JsonDecodeError (NonEmpty Array a)
7273
decodeNonEmpty_Array decoder =
73-
lmap ("Couldn't decode NonEmpty Array: " <> _)
74-
<<< (traverse decoder <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< Arr.uncons) <=< decodeJArray)
74+
lmap (Named "NonEmpty Array")
75+
<<< (traverse decoder <=< (rmap (\x -> x.head :| x.tail) <<< note (TypeMismatch "NonEmpty Array") <<< Arr.uncons) <=< decodeJArray)
7576

76-
decodeNonEmptyArray :: ∀ a . (Json -> Either String a) -> Json -> Either String (NonEmptyArray a)
77+
decodeNonEmptyArray :: ∀ a . (Json -> Either JsonDecodeError a) -> Json -> Either JsonDecodeError (NonEmptyArray a)
7778
decodeNonEmptyArray decoder =
78-
lmap ("Couldn't decode NonEmptyArray: " <> _)
79-
<<< (traverse decoder <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> NEA.cons' x.head x.tail) <<< note " is empty" <<< Arr.uncons) <=< decodeJArray)
79+
lmap (Named "NonEmptyArray")
80+
<<< (traverse decoder <=< (rmap (\x -> NEA.cons' x.head x.tail) <<< note (TypeMismatch "NonEmptyArray") <<< Arr.uncons) <=< decodeJArray)
8081

81-
decodeNonEmpty_List :: ∀ a . (Json -> Either String a) -> Json -> Either String (NonEmpty List a)
82+
decodeNonEmpty_List :: ∀ a . (Json -> Either JsonDecodeError a) -> Json -> Either JsonDecodeError (NonEmpty List a)
8283
decodeNonEmpty_List decoder =
83-
lmap ("Couldn't decode NonEmpty List: " <> _)
84-
<<< (traverse decoder <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
84+
lmap (Named "NonEmpty List")
85+
<<< (traverse decoder <=< (rmap (\x -> x.head :| x.tail) <<< note (TypeMismatch "NonEmpty List") <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
8586

86-
decodeNonEmptyList :: ∀ a . (Json -> Either String a) -> Json -> Either String (NonEmptyList a)
87+
decodeNonEmptyList :: ∀ a . (Json -> Either JsonDecodeError a) -> Json -> Either JsonDecodeError (NonEmptyList a)
8788
decodeNonEmptyList decoder =
88-
lmap ("Couldn't decode NonEmptyList: " <> _)
89-
<<< (traverse decoder <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> NEL.cons' x.head x.tail) <<< note " is empty" <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
89+
lmap (Named "NonEmptyList")
90+
<<< (traverse decoder <=< (rmap (\x -> NEL.cons' x.head x.tail) <<< note (TypeMismatch "NonEmptyList") <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
9091

91-
decodeCodePoint :: Json -> Either String CodePoint
92+
decodeCodePoint :: Json -> Either JsonDecodeError CodePoint
9293
decodeCodePoint j =
93-
maybe (Left $ "Expected character but found: " <> stringify j) Right
94+
maybe (Left $ Named "CodePoint" $ UnexpectedValue j) Right
9495
=<< codePointAt 0 <$> decodeString j
9596

96-
decodeForeignObject :: ∀ a . (Json -> Either String a) -> Json -> Either String (FO.Object a)
97+
decodeForeignObject :: ∀ a . (Json -> Either JsonDecodeError a) -> Json -> Either JsonDecodeError (FO.Object a)
9798
decodeForeignObject decoder =
98-
lmap ("Couldn't decode ForeignObject: " <> _)
99+
lmap (Named "ForeignObject")
99100
<<< (traverse decoder <=< decodeJObject)
100101

101-
decodeArray :: ∀ a . (Json -> Either String a) -> Json -> Either String (Array a)
102+
decodeArray :: ∀ a . (Json -> Either JsonDecodeError a) -> Json -> Either JsonDecodeError (Array a)
102103
decodeArray decoder =
103-
lmap ("Couldn't decode Array (" <> _)
104+
lmap (Named "Array")
104105
<<< (traverseWithIndex f <=< decodeJArray)
105106
where
106-
msg i m = "Failed at index " <> show i <> "): " <> m
107+
msg i m = AtIndex i m
107108
f i = lmap (msg i) <<< decoder
108109

109-
decodeList :: ∀ a . (Json -> Either String a) -> Json -> Either String (List a)
110+
decodeList :: ∀ a . (Json -> Either JsonDecodeError a) -> Json -> Either JsonDecodeError (List a)
110111
decodeList decoder =
111-
lmap ("Couldn't decode List: " <> _)
112+
lmap (Named "List")
112113
<<< (traverse decoder <=< map (map fromFoldable) decodeJArray)
113114

114-
decodeSet :: ∀ a . Ord a => (Json -> Either String a) -> Json -> Either String (S.Set a)
115+
decodeSet :: ∀ a . Ord a => (Json -> Either JsonDecodeError a) -> Json -> Either JsonDecodeError (S.Set a)
115116
decodeSet decoder = map (S.fromFoldable :: List a -> S.Set a) <<< decodeList decoder
116117

117-
decodeMap :: ∀ a b . Ord a => (Json -> Either String a) -> (Json -> Either String b) -> Json -> Either String (M.Map a b)
118+
decodeMap :: ∀ a b . Ord a => (Json -> Either JsonDecodeError a) -> (Json -> Either JsonDecodeError b) -> Json -> Either JsonDecodeError (M.Map a b)
118119
decodeMap decoderA decoderB = map (M.fromFoldable :: List (Tuple a b) -> M.Map a b) <<< decodeList (decodeTuple decoderA decoderB)
119120

120-
decodeVoid :: Json -> Either String Void
121-
decodeVoid _ = Left "Value cannot be Void"
121+
decodeVoid :: Json -> Either JsonDecodeError Void
122+
decodeVoid _ = Left $ UnexpectedValue $ fromString "Value cannot be Void"
122123

123-
decodeJArray :: Json -> Either String (Array Json)
124-
decodeJArray = maybe (Left "Value is not an Array") Right <<< toArray
124+
decodeJArray :: Json -> Either JsonDecodeError (Array Json)
125+
decodeJArray = maybe (Left $ TypeMismatch "Array") Right <<< toArray
125126

126-
decodeJObject :: Json -> Either String (FO.Object Json)
127-
decodeJObject = maybe (Left "Value is not an Object") Right <<< toObject
127+
decodeJObject :: Json -> Either JsonDecodeError (FO.Object Json)
128+
decodeJObject = maybe (Left $ TypeMismatch "Object") Right <<< toObject
128129

129-
getField :: forall a. (Json -> Either String a) -> FO.Object Json -> String -> Either String a
130+
getField :: forall a. (Json -> Either JsonDecodeError a) -> FO.Object Json -> String -> Either JsonDecodeError a
130131
getField decoder o s =
131132
maybe
132-
(Left $ "Expected field " <> show s)
133-
(elaborateFailure s <<< decoder)
133+
(Left $ AtKey s MissingValue)
134+
(lmap (AtKey s) <<< decoder)
134135
(FO.lookup s o)
135136

136-
getFieldOptional :: forall a. (Json -> Either String a) -> FO.Object Json -> String -> Either String (Maybe a)
137+
getFieldOptional :: forall a. (Json -> Either JsonDecodeError a) -> FO.Object Json -> String -> Either JsonDecodeError (Maybe a)
137138
getFieldOptional decoder o s =
138139
maybe
139140
(pure Nothing)
140141
decode
141142
(FO.lookup s o)
142143
where
143-
decode json = Just <$> (elaborateFailure s <<< decoder) json
144+
decode json = Just <$> (lmap (AtKey s) <<< decoder) json
144145

145-
getFieldOptional' :: forall a. (Json -> Either String a) -> FO.Object Json -> String -> Either String (Maybe a)
146+
getFieldOptional' :: forall a. (Json -> Either JsonDecodeError a) -> FO.Object Json -> String -> Either JsonDecodeError (Maybe a)
146147
getFieldOptional' decoder o s =
147148
maybe
148149
(pure Nothing)
@@ -152,10 +153,4 @@ getFieldOptional' decoder o s =
152153
decode json =
153154
if isNull json
154155
then pure Nothing
155-
else Just <$> (elaborateFailure s <<< decoder) json
156-
157-
elaborateFailure :: ∀ a. String -> Either String a -> Either String a
158-
elaborateFailure s e =
159-
lmap msg e
160-
where
161-
msg m = "Failed to decode key '" <> s <> "': " <> m
156+
else Just <$> (lmap (AtKey s) <<< decoder) json

‎src/Data/Argonaut/Decode/Errors.purs

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
-- | Originally implemented in:
2+
-- | https://github.com/garyb/purescript-codec-argonaut
3+
module Data.Argonaut.Decode.Errors where
4+
5+
import Prelude
6+
7+
import Data.Argonaut.Core (Json, stringify)
8+
import Data.Generic.Rep (class Generic)
9+
10+
-- | Error type for failures while decoding.
11+
data JsonDecodeError
12+
= TypeMismatch String
13+
| UnexpectedValue Json
14+
| AtIndex Int JsonDecodeError
15+
| AtKey String JsonDecodeError
16+
| Named String JsonDecodeError
17+
| MissingValue
18+
19+
derive instance eqJsonDecodeError :: Eq JsonDecodeError
20+
derive instance ordJsonDecodeError :: Ord JsonDecodeError
21+
derive instance genericJsonDecodeError :: Generic JsonDecodeError _
22+
23+
instance showJsonDecodeError :: Show JsonDecodeError where
24+
show = case _ of
25+
TypeMismatch s -> "(TypeMismatch " <> show s <> ")"
26+
UnexpectedValue j -> "(UnexpectedValue " <> stringify j <> ")"
27+
AtIndex i e -> "(AtIndex " <> show i <> " " <> show e <> ")"
28+
AtKey k e -> "(AtKey " <> show k <> " " <> show e <> ")"
29+
Named s e -> "(Named " <> show s <> " " <> show e <> ")"
30+
MissingValue -> "MissingValue"
31+
32+
-- | Prints a `JsonDecodeError` as a readable error message.
33+
printJsonDecodeError :: JsonDecodeError -> String
34+
printJsonDecodeError err =
35+
"An error occurred while decoding a JSON value:\n" <> go err
36+
where
37+
go = case _ of
38+
TypeMismatch ty -> " Expected value of type '" <> ty <> "'."
39+
UnexpectedValue val -> " Unexpected value " <> stringify val <> "."
40+
AtIndex ix inner -> " At array index " <> show ix <> ":\n" <> go inner
41+
AtKey key inner -> " At object key \'" <> key <> "\':\n" <> go inner
42+
Named name inner -> " Under '" <> name <> "':\n" <> go inner
43+
MissingValue -> " No value was found."

0 commit comments

Comments
 (0)