@@ -67,7 +67,7 @@ instance decodeJsonNumber :: DecodeJson Number where
67
67
decodeJson = caseJsonNumber (Left " Value is not a Number" ) Right
68
68
69
69
instance decodeJsonInt :: DecodeJson Int where
70
- decodeJson =
70
+ decodeJson =
71
71
maybe (Left " Value is not an integer" ) Right
72
72
<<< fromNumber
73
73
<=< decodeJson
@@ -79,22 +79,22 @@ instance decodeJsonJson :: DecodeJson Json where
79
79
decodeJson = Right
80
80
81
81
instance decodeJsonNonEmpty_Array :: (DecodeJson a ) => DecodeJson (NonEmpty Array a ) where
82
- decodeJson =
82
+ decodeJson =
83
83
lmap (" Couldn't decode NonEmpty Array: " <> _)
84
84
<<< (traverse decodeJson <=< (lmap (" JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< Arr .uncons) <=< decodeJArray)
85
85
86
86
instance decodeJsonNonEmptyArray :: (DecodeJson a ) => DecodeJson (NonEmptyArray a ) where
87
- decodeJson =
87
+ decodeJson =
88
88
lmap (" Couldn't decode NonEmptyArray: " <> _)
89
89
<<< (traverse decodeJson <=< (lmap (" JSON Array" <> _) <<< rmap (\x -> NEA .cons' x.head x.tail) <<< note " is empty" <<< Arr .uncons) <=< decodeJArray)
90
90
91
91
instance decodeJsonNonEmpty_List :: (DecodeJson a ) => DecodeJson (NonEmpty List a ) where
92
- decodeJson =
92
+ decodeJson =
93
93
lmap (" Couldn't decode NonEmpty List: " <> _)
94
94
<<< (traverse decodeJson <=< (lmap (" JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< L .uncons) <=< map (map fromFoldable) decodeJArray)
95
95
96
96
instance decodeJsonNonEmptyList :: (DecodeJson a ) => DecodeJson (NonEmptyList a ) where
97
- decodeJson =
97
+ decodeJson =
98
98
lmap (" Couldn't decode NonEmptyList: " <> _)
99
99
<<< (traverse decodeJson <=< (lmap (" JSON Array" <> _) <<< rmap (\x -> NEL .cons' x.head x.tail) <<< note " is empty" <<< L .uncons) <=< map (map fromFoldable) decodeJArray)
100
100
@@ -104,20 +104,20 @@ instance decodeJsonChar :: DecodeJson CodePoint where
104
104
=<< codePointAt 0 <$> decodeJson j
105
105
106
106
instance decodeForeignObject :: DecodeJson a => DecodeJson (FO.Object a ) where
107
- decodeJson =
107
+ decodeJson =
108
108
lmap (" Couldn't decode ForeignObject: " <> _)
109
109
<<< (traverse decodeJson <=< decodeJObject)
110
110
111
111
instance decodeArray :: DecodeJson a => DecodeJson (Array a ) where
112
- decodeJson =
113
- lmap (" Couldn't decode Array (" <> _)
112
+ decodeJson =
113
+ lmap (" Couldn't decode Array (" <> _)
114
114
<<< (traverseWithIndex f <=< decodeJArray)
115
115
where
116
116
msg i m = " Failed at index " <> show i <> " ): " <> m
117
117
f i = lmap (msg i) <<< decodeJson
118
118
119
119
instance decodeList :: DecodeJson a => DecodeJson (List a ) where
120
- decodeJson =
120
+ decodeJson =
121
121
lmap (" Couldn't decode List: " <> _)
122
122
<<< (traverse decodeJson <=< map (map fromFoldable) decodeJArray)
123
123
@@ -160,19 +160,25 @@ instance gDecodeJsonCons
160
160
, Row.Lacks field rowTail
161
161
)
162
162
=> GDecodeJson row (RL.Cons field value tail ) where
163
- gDecodeJson object _ = do
164
- let
163
+ gDecodeJson object _ =
164
+ let
165
165
sProxy :: SProxy field
166
166
sProxy = SProxy
167
167
168
168
fieldName = reflectSymbol sProxy
169
+ in case FO .lookup fieldName object of
170
+ Just jsonVal -> do
171
+ val <- elaborateFailure fieldName <<< decodeJson $ jsonVal
169
172
170
- rest <- gDecodeJson object (RLProxy :: RLProxy tail )
173
+ rest <- gDecodeJson object (RLProxy :: RLProxy tail )
171
174
172
- case FO .lookup fieldName object of
173
- Just jsonVal -> do
174
- val <- decodeJson jsonVal
175
175
Right $ Record .insert sProxy val rest
176
176
177
177
Nothing ->
178
178
Left $ " JSON was missing expected field: " <> fieldName
179
+
180
+ elaborateFailure :: ∀ a . String -> Either String a -> Either String a
181
+ elaborateFailure s e =
182
+ lmap msg e
183
+ where
184
+ msg m = " Failed to decode key '" <> s <> " ': " <> m
0 commit comments