Merge pull request #2 from commercialhaskell/synonym2

Fix `...:` and `...:?` (do not smother fail message)

CHANGELOG.md

@@ -6,6 +6,11 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to the
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
+## 0.1.1 - 2023-12-07
+
+* `...:` and `...:?` no longer smother `fail` messages if a single key is
+  present in the object.
+
 ## 0.1.0 - 2023-07-08
 
 * Spin out module `Pantry.Internal.AesonExtended` from package `pantry-0.8.3`.

aeson-warning-parser.cabal

@@ -1,11 +1,11 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
 name:           aeson-warning-parser
-version:        0.1.0
+version:        0.1.1
 synopsis:       Library providing JSON parser that warns about unexpected fields in objects.
 description:    Please see the README on GitHub at <https://github.com/commercialhaskell/aeson-warning-parser#readme>
 category:       JSON

package.yaml

@@ -1,5 +1,5 @@
 name:        aeson-warning-parser
-version:     0.1.0
+version:     0.1.1
 synopsis:    Library providing JSON parser that warns about unexpected fields in
              objects.
 description: Please see the README on GitHub at <https://github.com/commercialhaskell/aeson-warning-parser#readme>

src/Data/Aeson/WarningParser.hs

@@ -94,39 +94,39 @@ wp ..!= d =
     a <- fmap snd p
     fmap (, a) (fmap fst p .!= d)
 
-presentCount :: Object -> [Text] -> Int
-presentCount o = length . filter (\x -> HashMap.member (textToKey x) o)
+present :: Object -> [Text] -> [Text]
+present o = filter (\x -> HashMap.member (textToKey x) o)
 
 -- | Synonym version of @..:@.
 (...:) :: FromJSON a => Object -> [Text] -> WarningParser a
 _ ...: [] = fail "failed to find an empty key"
 o ...: ss@(key:_) = apply
  where
-  pc = presentCount o ss
-  apply | pc == 0   = fail $
-                        "failed to parse field " ++
-                        show key ++ ": " ++
-                        "keys " ++ show ss ++ " not present"
-        | pc >  1   = fail $
-                        "failed to parse field " ++
-                        show key ++ ": " ++
-                        "two or more synonym keys " ++
-                        show ss ++ " present"
-        | otherwise = asum $ map (o..:) ss
+  apply = case present o ss of
+    [] -> fail $
+      "failed to parse field " ++
+      show key ++ ": " ++
+      "keys " ++ show ss ++ " not present"
+    [s] -> o ..: s
+    _ -> fail $
+      "failed to parse field " ++
+      show key ++ ": " ++
+      "two or more synonym keys " ++
+      show ss ++ " present"
 
 -- | Synonym version of @..:?@.
 (...:?) :: FromJSON a => Object -> [Text] -> WarningParser (Maybe a)
 _ ...:? [] = fail "failed to find an empty key"
 o ...:? ss@(key:_) = apply
  where
-  pc = presentCount o ss
-  apply | pc == 0   = pure Nothing
-        | pc >  1   = fail $
-                        "failed to parse field " ++
-                        show key ++ ": " ++
-                        "two or more synonym keys " ++
-                        show ss ++ " present"
-        | otherwise = asum $ map (o..:) ss
+  apply = case present o ss of
+    [] -> pure Nothing
+    [s] -> o ..: s
+    _ -> fail $
+      "failed to parse field " ++
+      show key ++ ": " ++
+      "two or more synonym keys " ++
+      show ss ++ " present"
 
 -- | Tell the warning parser about an expected field, so it doesn't warn about
 -- it.