@@ -130,15 +130,15 @@ json' = value'
130130
131131-- Open recursion: object_, object_', array_, array_' are parameterized by the
132132-- toplevel Value parser to be called recursively, to keep the parameter
133−-- hFromList outside of the recursive loop for proper inlining.
133+-- mkObject outside of the recursive loop for proper inlining.
134134
135−object_ :: HFromList -> Parser Value -> Parser Value
136−object_ hFromList val = {-# SCC "object_" #-} Object <$> objectValues hFromList jstring val
135+object_ :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value
136+object_ mkObject val = {-# SCC "object_" #-} Object <$> objectValues mkObject jstring val
137137{-# INLINE object_ #-}
138138
139−object_' :: HFromList -> Parser Value -> Parser Value
140−object_' hFromList val' = {-# SCC "object_'" #-} do
141− !vals <- objectValues hFromList jstring' val'
139+object_' :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value
140+object_' mkObject val' = {-# SCC "object_'" #-} do
141+ !vals <- objectValues mkObject jstring' val'
142142 return (Object vals)
143143 where
144144 jstring' = do
@@ -146,12 +146,9 @@ object_' hFromList val' = {-# SCC "object_'" #-} do
146146 return s
147147{-# INLINE object_' #-}
148148
149−-- The object parser 'objectValues' is parameterized by the object constructor.
150−-- See also 'jsonWith'.
151−type HFromList = [(Text, Value)] -> Parser Object
152−
153−objectValues :: HFromList -> Parser Text -> Parser Value -> Parser (H.HashMap Text Value)
154−objectValues hFromList str val = do
149+objectValues :: ([(Text, Value)] -> Either String Object)
150+ -> Parser Text -> Parser Value -> Parser (H.HashMap Text Value)
151+objectValues mkObject str val = do
155152 skipSpace
156153 w <- A.peekWord8'
157154 if w == CLOSE_CURLY
@@ -167,7 +164,9 @@ objectValues hFromList str val = do
167164 let acc' = (k, v) : acc
168165 if ch == COMMA
169166 then skipSpace >> loop acc'
170− else hFromList acc'
167+ else case mkObject acc' of
168+ Left err -> fail err
169+ Right obj -> pure obj
171170{-# INLINE objectValues #-}
172171
173172array_ :: Parser Value -> Parser Value
@@ -211,21 +210,21 @@ value = jsonWith (pure . H.fromList)
211210-- 'json' keeps only the first occurence of each key, using 'HashMap.Lazy.fromList'.
212211--
213212-- @
214−-- 'json' = 'jsonWith' ('pure' '.' 'H.fromList')
213+-- 'json' = 'jsonWith' ('Right' '.' 'H.fromList')
215214-- @
216215--
217216-- 'jsonLast' keeps the last occurence of each key, using
218217-- @'HashMap.Lazy.fromListWith' ('const' 'id')@.
219218--
220219-- @
221−-- 'jsonLast' = 'jsonWith' ('pure' '.' 'HashMap.Lazy.fromListWith' ('const' 'id'))
220+-- 'jsonLast' = 'jsonWith' ('Right' '.' 'HashMap.Lazy.fromListWith' ('const' 'id'))
222221-- @
223222--
224223-- 'jsonAccum' keeps wraps all values in arrays to keep duplicates, using
225224-- 'fromListAccum'.
226225--
227226-- @
228−-- 'jsonAccum' = 'jsonWith' ('pure' . 'fromListAccum')
227+-- 'jsonAccum' = 'jsonWith' ('Right' . 'fromListAccum')
229228-- @
230229--
231230-- 'jsonNoDup' fails if any object contains duplicate keys, using 'parseListNoDup'.
@@ -233,13 +232,13 @@ value = jsonWith (pure . H.fromList)
233232-- @
234233-- 'jsonNoDup' = 'jsonWith' 'parseListNoDup'
235234-- @
236−jsonWith :: ([(Text, Value)] -> Parser Object) -> Parser Value
237−jsonWith hFromList = fix $ \value_ -> do
235+jsonWith :: ([(Text, Value)] -> Either String Object) -> Parser Value
236+jsonWith mkObject = fix $ \value_ -> do
238237 skipSpace
239238 w <- A.peekWord8'
240239 case w of
241240 DOUBLE_QUOTE -> A.anyWord8 *> (String <$> jstring_)
242− OPEN_CURLY -> A.anyWord8 *> object_ hFromList value_
241+ OPEN_CURLY -> A.anyWord8 *> object_ mkObject value_
243242 OPEN_SQUARE -> A.anyWord8 *> array_ value_
244243 C_f -> string "false" $> Bool False
245244 C_t -> string "true" $> Bool True
@@ -251,12 +250,12 @@ jsonWith hFromList = fix $ \value_ -> do
251250
252251-- | Variant of 'json' which keeps only the last occurence of every key.
253252jsonLast :: Parser Value
254−jsonLast = jsonWith (pure . H.fromListWith (const id))
253+jsonLast = jsonWith (Right . H.fromListWith (const id))
255254
256255-- | Variant of 'json' wrapping all object mappings in 'Array' to preserve
257256-- key-value pairs with the same keys.
258257jsonAccum :: Parser Value
259−jsonAccum = jsonWith (pure . fromListAccum)
258+jsonAccum = jsonWith (Right . fromListAccum)
260259
261260-- | Variant of 'json' which fails if any object contains duplicate keys.
262261jsonNoDup :: Parser Value
@@ -272,27 +271,27 @@ fromListAccum =
272271 fmap (Array . Vector.fromList . ($ [])) . H.fromListWith (.) . (fmap . fmap) (:)
273272
274273-- | @'fromListNoDup' kvs@ fails if @kvs@ contains duplicate keys.
275−parseListNoDup :: [(Text, Value)] -> Parser Object
274+parseListNoDup :: [(Text, Value)] -> Either String Object
276275parseListNoDup =
277276 H.traverseWithKey unwrap . H.fromListWith (\_ _ -> Nothing) . (fmap . fmap) Just
278277 where
279− unwrap k Nothing = fail $ "found duplicate key: " ++ show k
280− unwrap _ (Just v) = pure v
278+ unwrap k Nothing = Left $ "found duplicate key: " ++ show k
279+ unwrap _ (Just v) = Right v
281280
282281-- | Strict version of 'value'. Synonym of 'json''.
283282value' :: Parser Value
284283value' = jsonWith' (pure . H.fromList)
285284
286285-- | Strict version of 'jsonWith'.
287−jsonWith' :: ([(Text, Value)] -> Parser Object) -> Parser Value
288−jsonWith' hFromList = fix $ \value_ -> do
286+jsonWith' :: ([(Text, Value)] -> Either String Object) -> Parser Value
287+jsonWith' mkObject = fix $ \value_ -> do
289288 skipSpace
290289 w <- A.peekWord8'
291290 case w of
292291 DOUBLE_QUOTE -> do
293292 !s <- A.anyWord8 *> jstring_
294293 return (String s)
295− OPEN_CURLY -> A.anyWord8 *> object_' hFromList value_
294+ OPEN_CURLY -> A.anyWord8 *> object_' mkObject value_
296295 OPEN_SQUARE -> A.anyWord8 *> array_' value_
297296 C_f -> string "false" $> Bool False
298297 C_t -> string "true" $> Bool True