Skip to content

Commit 1e528c9

Browse files
authored
Eelaborate error in records derived by GDecodeJson (#72)
1 parent a092a0b commit 1e528c9

File tree

2 files changed

+22
-23
lines changed

2 files changed

+22
-23
lines changed

src/Data/Argonaut/Decode/Class.purs

+21-15
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ instance decodeJsonNumber :: DecodeJson Number where
6767
decodeJson = caseJsonNumber (Left "Value is not a Number") Right
6868

6969
instance decodeJsonInt :: DecodeJson Int where
70-
decodeJson =
70+
decodeJson =
7171
maybe (Left "Value is not an integer") Right
7272
<<< fromNumber
7373
<=< decodeJson
@@ -79,22 +79,22 @@ instance decodeJsonJson :: DecodeJson Json where
7979
decodeJson = Right
8080

8181
instance decodeJsonNonEmpty_Array :: (DecodeJson a) => DecodeJson (NonEmpty Array a) where
82-
decodeJson =
82+
decodeJson =
8383
lmap ("Couldn't decode NonEmpty Array: " <> _)
8484
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< Arr.uncons) <=< decodeJArray)
8585

8686
instance decodeJsonNonEmptyArray :: (DecodeJson a) => DecodeJson (NonEmptyArray a) where
87-
decodeJson =
87+
decodeJson =
8888
lmap ("Couldn't decode NonEmptyArray: " <> _)
8989
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> NEA.cons' x.head x.tail) <<< note " is empty" <<< Arr.uncons) <=< decodeJArray)
9090

9191
instance decodeJsonNonEmpty_List :: (DecodeJson a) => DecodeJson (NonEmpty List a) where
92-
decodeJson =
92+
decodeJson =
9393
lmap ("Couldn't decode NonEmpty List: " <> _)
9494
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> x.head :| x.tail) <<< note " is empty" <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
9595

9696
instance decodeJsonNonEmptyList :: (DecodeJson a) => DecodeJson (NonEmptyList a) where
97-
decodeJson =
97+
decodeJson =
9898
lmap ("Couldn't decode NonEmptyList: " <> _)
9999
<<< (traverse decodeJson <=< (lmap ("JSON Array" <> _) <<< rmap (\x -> NEL.cons' x.head x.tail) <<< note " is empty" <<< L.uncons) <=< map (map fromFoldable) decodeJArray)
100100

@@ -104,20 +104,20 @@ instance decodeJsonChar :: DecodeJson CodePoint where
104104
=<< codePointAt 0 <$> decodeJson j
105105

106106
instance decodeForeignObject :: DecodeJson a => DecodeJson (FO.Object a) where
107-
decodeJson =
107+
decodeJson =
108108
lmap ("Couldn't decode ForeignObject: " <> _)
109109
<<< (traverse decodeJson <=< decodeJObject)
110110

111111
instance decodeArray :: DecodeJson a => DecodeJson (Array a) where
112-
decodeJson =
113-
lmap ("Couldn't decode Array (" <> _)
112+
decodeJson =
113+
lmap ("Couldn't decode Array (" <> _)
114114
<<< (traverseWithIndex f <=< decodeJArray)
115115
where
116116
msg i m = "Failed at index " <> show i <> "): " <> m
117117
f i = lmap (msg i) <<< decodeJson
118118

119119
instance decodeList :: DecodeJson a => DecodeJson (List a) where
120-
decodeJson =
120+
decodeJson =
121121
lmap ("Couldn't decode List: " <> _)
122122
<<< (traverse decodeJson <=< map (map fromFoldable) decodeJArray)
123123

@@ -160,19 +160,25 @@ instance gDecodeJsonCons
160160
, Row.Lacks field rowTail
161161
)
162162
=> GDecodeJson row (RL.Cons field value tail) where
163-
gDecodeJson object _ = do
164-
let
163+
gDecodeJson object _ =
164+
let
165165
sProxy :: SProxy field
166166
sProxy = SProxy
167167

168168
fieldName = reflectSymbol sProxy
169+
in case FO.lookup fieldName object of
170+
Just jsonVal -> do
171+
val <- elaborateFailure fieldName <<< decodeJson $ jsonVal
169172

170-
rest <- gDecodeJson object (RLProxy :: RLProxy tail)
173+
rest <- gDecodeJson object (RLProxy :: RLProxy tail)
171174

172-
case FO.lookup fieldName object of
173-
Just jsonVal -> do
174-
val <- decodeJson jsonVal
175175
Right $ Record.insert sProxy val rest
176176

177177
Nothing ->
178178
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

src/Data/Argonaut/Decode/Combinators.purs

+1-8
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,7 @@ module Data.Argonaut.Decode.Combinators
1818
import Prelude
1919

2020
import Data.Argonaut.Core (Json, isNull)
21-
import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson)
22-
import Data.Bifunctor (lmap)
21+
import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson, elaborateFailure)
2322
import Data.Either (Either(..))
2423
import Data.Maybe (Maybe(..), fromMaybe, maybe)
2524
import Foreign.Object as FO
@@ -128,9 +127,3 @@ defaultFieldDeprecated
128127
defaultFieldDeprecated = defaultField
129128

130129
infix 6 defaultFieldDeprecated as .?=
131-
132-
elaborateFailure :: a. String -> Either String a -> Either String a
133-
elaborateFailure s e =
134-
lmap msg e
135-
where
136-
msg m = "Failed to decode key '" <> s <> "': " <> m

0 commit comments

Comments
 (0)