aeson-match-qq 1.7.0 → 1.8.0

raw patch · 11 files changed

+385/−309 lines, 11 filesdep +attoparsec-aesonPVP ok

version bump matches the API change (PVP)

Dependencies added: attoparsec-aeson

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +9/−0
• aeson-match-qq.cabal +15/−4
• src/Aeson/Match/QQ.hs +9/−10
• src/Aeson/Match/QQ/Internal/AesonUtils.hs +15/−15
• src/Aeson/Match/QQ/Internal/Match.hs +51/−53
• src/Aeson/Match/QQ/Internal/Parse.hs +34/−34
• src/Aeson/Match/QQ/Internal/PrettyPrint.hs +65/−55
• src/Aeson/Match/QQ/Internal/Value.hs +52/−62
• test/Aeson/Match/QQ/Internal/ParseSpec.hs +81/−0
• test/Aeson/Match/QQ/Internal/PrettyPrintSpec.hs +16/−6
• test/Aeson/Match/QQSpec.hs +38/−70

@@ -1,3 +1,12 @@+1.8.0+====++  * GHC 9.8 compatibility++  * Added `any` type for consistency.++  * Duplicate keys in objects are handled ~~properly~~ better (https://github.com/supki/aeson-match-qq/pull/40)+ 1.7.0 ==== 

@@ -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.38.0. -- -- see: https://github.com/sol/hpack  name:           aeson-match-qq-version:        1.7.0+version:        1.8.0 synopsis:       Declarative JSON matchers. description:    See README.markdown category:       Web@@ -16,6 +16,9 @@ license:        BSD2 license-file:   LICENSE build-type:     Simple+tested-with:+    GHC==9.6.5+  , GHC==9.8.2 extra-source-files:     README.markdown     CHANGELOG.markdown@@ -36,10 +39,13 @@       Paths_aeson_match_qq   hs-source-dirs:       src-  ghc-options: -funbox-strict-fields -Wall+  default-extensions:+      ImportQualifiedPost+  ghc-options: -funbox-strict-fields -Wall -Wno-incomplete-uni-patterns   build-depends:       aeson     , attoparsec+    , attoparsec-aeson     , base >=4.14 && <5     , bytestring     , case-insensitive@@ -58,12 +64,17 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:+      Aeson.Match.QQ.Internal.ParseSpec       Aeson.Match.QQ.Internal.PrettyPrintSpec       Aeson.Match.QQSpec       Paths_aeson_match_qq   hs-source-dirs:       test-  ghc-options: -Wall -threaded -with-rtsopts=-N+  default-extensions:+      ImportQualifiedPost+  ghc-options: -Wall -Wno-incomplete-uni-patterns -threaded -with-rtsopts=-N+  build-tool-depends:+      hspec-discover:hspec-discover   build-depends:       aeson     , aeson-match-qq

@@ -1,3 +1,4 @@+{-# LANGUAGE DuplicateRecordFields #-} module Aeson.Match.QQ   ( match   , qq@@ -14,7 +15,6 @@   , Array   , Object   , Box(..)-  , HoleSig(..)   , Type(..)   , Path(..)   , PathElem(..)@@ -22,13 +22,13 @@   , parse   ) where -import           Data.String (IsString(..))-import qualified Data.Text.Encoding as Text-import           Language.Haskell.TH.Quote (QuasiQuoter(..))-import qualified Text.PrettyPrint as PP (render)-import qualified Text.PrettyPrint.HughesPJClass as PP (Pretty(..))+import Data.String (IsString(..))+import Data.Text.Encoding qualified as Text+import Language.Haskell.TH.Quote (QuasiQuoter(..))+import Text.PrettyPrint qualified as PP (render)+import Text.PrettyPrint.HughesPJClass qualified as PP (Pretty(..)) -import           Aeson.Match.QQ.Internal.Match+import Aeson.Match.QQ.Internal.Match   ( match   , Error(..)   , TypeMismatch(..)@@ -39,13 +39,12 @@   , Path(..)   , PathElem(..)   )-import           Aeson.Match.QQ.Internal.Parse (parse)-import           Aeson.Match.QQ.Internal.Value+import Aeson.Match.QQ.Internal.Parse (parse)+import Aeson.Match.QQ.Internal.Value   ( Matcher(..)   , Box(..)   , Array   , Object-  , HoleSig(..)   , Type(..)   , quote   )

@@ -6,21 +6,21 @@   , pp   ) where -import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Encoding.Internal as Aeson (encodingToLazyByteString)-import qualified Data.Aeson.KeyMap as Aeson.KeyMap-import           Data.Bool (bool)-import           Data.Foldable (toList)-import qualified Data.List as List-import           Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap-import           Data.Int (Int64)-import           Data.Scientific (Scientific, floatingOrInteger)-import           Data.String (fromString)-import           Data.Text (Text)-import           Data.Vector (Vector)-import           Text.PrettyPrint ((<+>))-import qualified Text.PrettyPrint as PP+import Data.Aeson qualified as Aeson+import Data.Aeson.Encoding.Internal qualified as Aeson (encodingToLazyByteString)+import Data.Aeson.KeyMap qualified as Aeson.KeyMap+import Data.Bool (bool)+import Data.Foldable (toList)+import Data.List qualified as List+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.Int (Int64)+import Data.Scientific (Scientific, floatingOrInteger)+import Data.String (fromString)+import Data.Text (Text)+import Data.Vector (Vector)+import Text.PrettyPrint ((<+>))+import Text.PrettyPrint qualified as PP   -- | This is a round-about way to produce a 'Aeson.Value' from a 'ToJSON' instance.

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -20,35 +19,32 @@   , PathElem(..)   ) where -import           Control.Applicative (liftA2)-import           Control.Monad (unless)-import           Data.Aeson ((.=))-import qualified Data.Aeson as Aeson-#if MIN_VERSION_aeson(2,0,0)-import qualified Data.Aeson.KeyMap as Aeson (toHashMapText)-#endif-import           Data.Bool (bool)-import qualified Data.CaseInsensitive as CI-import           Data.Either.Validation+import Control.Monad (unless)+import Data.Aeson ((.=))+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as Aeson (toHashMapText)+import Data.Bool (bool)+import Data.CaseInsensitive qualified as CI+import Data.Either.Validation   ( Validation(..)   , eitherToValidation   , validationToEither   )-import           Data.Foldable (for_, toList)-import           Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap-import qualified Data.List as List-import           Data.List.NonEmpty (NonEmpty, nonEmpty)-import           Data.Maybe (mapMaybe)-import qualified Data.Set as Set-import           Data.String (IsString(..))-import           Data.Text (Text)-import qualified Data.Text as Text-import           Data.Vector (Vector)-import qualified Data.Vector as Vector-import           GHC.Exts (IsList)-import           Prelude hiding (any, null)-import qualified Text.PrettyPrint as PP+import Data.Foldable (toList)+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.List qualified as List+import Data.List.NonEmpty (NonEmpty, nonEmpty)+import Data.Maybe (mapMaybe)+import Data.Set qualified as Set+import Data.String (IsString(..))+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Vector (Vector)+import Data.Vector qualified as Vector+import GHC.Exts (IsList)+import Prelude hiding (any, null)+import Text.PrettyPrint qualified as PP   ( vcat   , hsep   , brackets@@ -56,14 +52,13 @@   , char   , int   )-import qualified Text.PrettyPrint.HughesPJClass as PP (Pretty(..))+import Text.PrettyPrint.HughesPJClass qualified as PP (Pretty(..)) -import qualified Aeson.Match.QQ.Internal.AesonUtils as AesonUtils (pp)-import qualified Aeson.Match.QQ.Internal.PrettyPrint as Matcher (pp)-import           Aeson.Match.QQ.Internal.Value+import Aeson.Match.QQ.Internal.AesonUtils qualified as AesonUtils (pp)+import Aeson.Match.QQ.Internal.PrettyPrint qualified as Matcher (pp)+import Aeson.Match.QQ.Internal.Value   ( Matcher(..)   , Box(..)-  , HoleSig(..)   , Type(..)   , embed   )@@ -86,11 +81,6 @@       mistyped expected =         mistype path expected matcher given     case (matcher, given) of-      (Hole holeTypeO nameO, val) -> do-        for_ holeTypeO $ \holeType ->-          unless (holeTypeMatch holeType val) $-            mistyped (type_ holeType)-        pure (maybe mempty (\name -> HashMap.singleton name val) nameO)       (Null, Aeson.Null) ->         pure mempty       (Null, _) -> do@@ -142,11 +132,7 @@         mistyped ArrayUOT         pure mempty       ( Object Box {values, extra}-#if MIN_VERSION_aeson(2,0,0)         , Aeson.Object (Aeson.toHashMapText -> o)-#else-        , Aeson.Object o-#endif          ) ->         let fold f =@@ -158,26 +144,38 @@             (extra || HashMap.null extraValues)             (extraObjectValues path extraValues) *>           fold-            (\k v -> maybe (missingPathElem path (Key k)) (go (Key k : path) v) (HashMap.lookup k o))+            (\k vs ->+              maybe+                (missingPathElem path (Key k))+                (\ov -> foldr1 (liftA2 (<>)) (fmap (\v -> go (Key k : path) v ov) vs))+                (HashMap.lookup k o))             values       (Object _, _) -> do         mistyped ObjectT         pure mempty+      (Sig type_ nullable x, val) -> -- do -- ApplicativeDo shits the bed here for some reason+        unless (sigTypeMatch type_ nullable val) (mistyped type_) *>+        go path x val+      (Var "", _) ->+        pure mempty+      (Var name, val) ->+        pure (HashMap.singleton name val)       (Ext val, val') ->         go path (embed val) val' -holeTypeMatch :: HoleSig -> Aeson.Value -> Bool-holeTypeMatch type_ val =-  case (type_, val) of-    (HoleSig {nullable = True}, Aeson.Null) -> True-    (HoleSig {type_ = BoolT} , Aeson.Bool {}) -> True-    (HoleSig {type_ = NumberT} , Aeson.Number {}) -> True-    (HoleSig {type_ = StringT} , Aeson.String {}) -> True-    (HoleSig {type_ = StringCIT} , Aeson.String {}) -> True-    (HoleSig {type_ = ArrayT} , Aeson.Array {}) -> True-    (HoleSig {type_ = ArrayUOT} , Aeson.Array {}) -> True-    (HoleSig {type_ = ObjectT} , Aeson.Object {}) -> True-    (_, _) -> False+sigTypeMatch :: Type -> Bool -> Aeson.Value -> Bool+sigTypeMatch type_ nullable val =+  case (type_, nullable, val) of+    (AnyT,      _,    _) -> True+    (_,         True, Aeson.Null) -> True+    (BoolT,     _,    Aeson.Bool {}) -> True+    (NumberT,   _,    Aeson.Number {}) -> True+    (StringT,   _,    Aeson.String {}) -> True+    (StringCIT, _,    Aeson.String {}) -> True+    (ArrayT,    _,    Aeson.Array {}) -> True+    (ArrayUOT,  _,    Aeson.Array {}) -> True+    (ObjectT,   _,    Aeson.Object {}) -> True+    (_,         _,    _) -> False  matchArrayUO   :: Validation (NonEmpty Error) (HashMap Text Aeson.Value)

@@ -7,30 +7,29 @@   ( parse   ) where -import           Control.Applicative ((<|>), optional)-import qualified Data.Aeson.Parser as Aeson-import qualified Data.Attoparsec.ByteString as Atto-import qualified Data.ByteString as ByteString+import Control.Applicative ((<|>), optional)+import Data.Aeson.Parser qualified as Aeson+import Data.Attoparsec.ByteString qualified as Atto+import Data.ByteString qualified as ByteString -- cannot use .Text here due to .Aeson parsers being tied to .ByteString-import           Data.ByteString (ByteString)-import qualified Data.CaseInsensitive as CI-import qualified Data.Char as Char-import           Data.Foldable (asum)-import qualified Data.HashMap.Strict as HashMap-import           Data.Maybe (isJust)-import           Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import qualified Data.Vector as Vector-import           Data.Word (Word8)-import           Language.Haskell.Meta.Parse (parseExp)-import           Language.Haskell.TH (Exp(..))-import           Prelude hiding (any, null)+import Data.ByteString (ByteString)+import Data.CaseInsensitive qualified as CI+import Data.Char qualified as Char+import Data.Foldable (asum)+import Data.HashMap.Strict qualified as HashMap+import Data.Maybe (isJust)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Vector qualified as Vector+import Data.Word (Word8)+import Language.Haskell.Meta.Parse (parseExp)+import Language.Haskell.TH (Exp(..))+import Prelude hiding (any, null) -import           Aeson.Match.QQ.Internal.Value+import Aeson.Match.QQ.Internal.Value   ( Matcher(..)   , Box(..)-  , HoleSig(..)   , Type(..)   ) @@ -80,30 +79,30 @@ optimize = \case   -- [...] -> _ : array   Array Box {extra = True, values = (Vector.null -> True)} ->-    Hole (Just (HoleSig ArrayT False)) Nothing+    Sig ArrayT False (Var "")   -- this optimization is probably never going to be used,   -- but I'll include it for completeness:   -- (unordered) [...] -> _ : unordered-array   ArrayUO Box {extra = True, values = (Vector.null -> True)} ->-    Hole (Just (HoleSig ArrayUOT False)) Nothing+    Sig ArrayUOT False (Var "")   -- {...} -> _ : object   Object Box {extra = True, values = (HashMap.null -> True)} ->-    Hole (Just (HoleSig ObjectT False)) Nothing+    Sig ObjectT False (Var "")   val ->     val  any :: Atto.Parser (Matcher Exp) any = do   _ <- Atto.word8 HoleP-  name <- fmap Just key <|> pure Nothing+  name <- key <|> pure ""   spaces   b <- optional Atto.peekWord8'-  expectedType <- case b of+  (type_, nullable) <- case b of     Just ColonP ->-      fmap Just holeSig+      sig     _ ->-      pure Nothing-  pure (Hole expectedType name)+      pure (AnyT, False)+  pure (Sig type_ nullable (Var name))  null :: Atto.Parser (Matcher Exp) null =@@ -208,10 +207,10 @@         sep <- Atto.satisfy (\w -> w == CommaP || w == CloseCurlyBracketP) Atto.<?> "',' or '}'"         case sep of           CommaP ->-            loop ((k, val) : acc)+            loop ((k, pure val) : acc)           CloseCurlyBracketP ->             pure $ Object Box-              { values = HashMap.fromList ((k, val) : acc)+              { values = HashMap.fromListWith (<>) ((k, pure val) : acc)               , extra = False               }           _ ->@@ -244,12 +243,13 @@     str <- Atto.takeWhile1 (/= CloseCurlyBracketP) <* Atto.word8 CloseCurlyBracketP     either fail pure (parseExp (Text.unpack (Text.decodeUtf8 str))) -holeSig :: Atto.Parser HoleSig-holeSig = do+sig :: Atto.Parser (Type, Bool)+sig = do   _ <- Atto.word8 ColonP   spaces   asum-    [ p "bool" BoolT+    [ p "any" AnyT+    , p "bool" BoolT     , p "number" NumberT     , p "string" StringT     , p "ci-string" StringCIT@@ -261,7 +261,7 @@   p name typeName = do     _ <- Atto.string name     q <- optional (Atto.word8 QuestionMarkP)-    pure (HoleSig typeName (isJust q))+    pure (typeName, isJust q)  eof :: Atto.Parser () eof =

@@ -6,29 +6,30 @@   ( pp   ) where -import qualified Data.Aeson as Aeson-import           Data.Bool (bool)-import qualified Data.ByteString.Lazy as ByteString.Lazy-import           Data.CaseInsensitive (CI)-import qualified Data.CaseInsensitive as CI-import qualified Data.Char as Char-import           Data.Foldable (toList)-import           Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap-import           Data.Int (Int64)-import qualified Data.List as List-import           Data.Scientific (Scientific, floatingOrInteger)-import           Data.String (fromString)-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import           Data.Text (Text)-import           Data.Vector (Vector)-import           Text.PrettyPrint ((<+>))-import qualified Text.PrettyPrint as PP+import Control.Monad ((<=<))+import Data.Aeson qualified as Aeson+import Data.Bool (bool)+import Data.ByteString.Lazy qualified as ByteString.Lazy+import Data.CaseInsensitive (CI)+import Data.CaseInsensitive qualified as CI+import Data.Char qualified as Char+import Data.Foldable (toList)+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.Int (Int64)+import Data.List qualified as List+import Data.List.NonEmpty (NonEmpty)+import Data.Scientific (Scientific, floatingOrInteger)+import Data.String (fromString)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Text (Text)+import Data.Vector (Vector)+import Text.PrettyPrint ((<+>))+import Text.PrettyPrint qualified as PP -import           Aeson.Match.QQ.Internal.Value+import Aeson.Match.QQ.Internal.Value   ( Matcher(..)-  , HoleSig(..)   , Type(..)   , Box(..)   )@@ -44,8 +45,6 @@  rValue :: Matcher Aeson.Value -> PP.Doc rValue = \case-  Hole sig name ->-    rHole sig name   Null ->     rNull   Bool b ->@@ -62,33 +61,13 @@     rArrayUO xs   Object o ->     rObject o+  Sig type_ nullable v ->+    rSig type_ nullable v+  Var name ->+    rVar name   Ext ext ->     rExt ext -rHole :: Maybe HoleSig -> Maybe Text -> PP.Doc-rHole sig name =-  ("_" <> maybe PP.empty rName name) <+> maybe PP.empty rSig sig--rName :: Text -> PP.Doc-rName name =-  PP.text (bool (Text.unpack name) (show name) (hasSpaces name))- where-  hasSpaces =-    Text.any Char.isSpace--rSig :: HoleSig -> PP.Doc-rSig HoleSig {type_, nullable} =-  (":" <+> rType type_) <> bool PP.empty "?" nullable- where-  rType = \case-    BoolT -> "bool"-    NumberT -> "number"-    StringT -> "string"-    StringCIT -> "ci-string"-    ArrayT -> "array"-    ArrayUOT -> "unordered-array"-    ObjectT -> "object"- rNull :: PP.Doc rNull =   "null"@@ -130,13 +109,9 @@     , rArray box     ] -rExt :: Aeson.Value -> PP.Doc-rExt =-  fromString . Text.unpack . Text.decodeUtf8 . ByteString.Lazy.toStrict . Aeson.encode--rObject :: Box (HashMap Text (Matcher Aeson.Value)) -> PP.Doc+rObject :: Box (HashMap Text (NonEmpty (Matcher Aeson.Value))) -> PP.Doc rObject Box {values, extra} =-  case List.sortOn fst (HashMap.toList values) of+  case toKeyValues values of     [] ->       "{}"     kv : kvs ->@@ -154,10 +129,41 @@         , rValue value         ] +toKeyValues :: (Ord k, Foldable t) => HashMap k (t v) -> [(k, v)]+toKeyValues =+  traverse toList <=< List.sortOn fst . HashMap.toList++rSig :: Type -> Bool -> Matcher Aeson.Value -> PP.Doc+rSig type_ nullable val =+  rValue val <+> ((":" <+> rType type_) <> bool PP.empty "?" nullable)+ where+  rType = \case+    AnyT -> "any"+    BoolT -> "bool"+    NumberT -> "number"+    StringT -> "string"+    StringCIT -> "ci-string"+    ArrayT -> "array"+    ArrayUOT -> "unordered-array"+    ObjectT -> "object"++rVar :: Text -> PP.Doc+rVar name =+  "_" <> rName name++rName :: Text -> PP.Doc+rName name =+  PP.text (bool (Text.unpack name) (show name) (hasSpaces name))+ where+  hasSpaces =+    Text.any Char.isSpace++rExt :: Aeson.Value -> PP.Doc+rExt =+  fromString . Text.unpack . Text.decodeUtf8 . ByteString.Lazy.toStrict . Aeson.encode+ simpleValue :: Matcher Aeson.Value -> Bool simpleValue = \case-  Hole {} ->-    True   Null {} ->     True   Bool {} ->@@ -174,5 +180,9 @@     False   Object {} ->     False+  Sig {} ->+    True+  Var {} ->+    True   Ext {} ->     True

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE LambdaCase #-}@@ -8,50 +7,41 @@ {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ViewPatterns #-} module Aeson.Match.QQ.Internal.Value   ( Matcher(..)   , Box(..)   , Array   , Object-  , HoleSig(..)   , Type(..)   , embed   , quote   ) where -import           Data.Aeson ((.=))-import qualified Data.Aeson as Aeson-#if MIN_VERSION_aeson(2,0,0)-import qualified Data.Aeson.KeyMap as Aeson (toHashMapText)-#endif-import           Data.CaseInsensitive (CI)-import qualified Data.CaseInsensitive as CI-import           Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap-import           Data.Scientific (Scientific)-import           Data.Text (Text)-import qualified Data.Text as Text-import           Data.Vector (Vector)-import qualified Data.Vector as Vector-import           Language.Haskell.TH (Q, Exp(..), Lit(..))-import           Language.Haskell.TH.Syntax (Lift(..))-import           Prelude hiding (any, null)-import qualified Text.PrettyPrint.HughesPJClass as PP (Pretty(..))+import Data.Aeson ((.=))+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as Aeson (toHashMapText)+import Data.CaseInsensitive (CI)+import Data.CaseInsensitive qualified as CI+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.List.NonEmpty (NonEmpty(..))+import Data.Scientific (Scientific)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Vector (Vector)+import Data.Vector qualified as Vector+import Language.Haskell.TH (Q, Exp(..), Lit(..))+import Language.Haskell.TH.Syntax (Lift(..))+import Prelude hiding (any, null)+import Text.PrettyPrint.HughesPJClass qualified as PP (Pretty(..)) -import           Aeson.Match.QQ.Internal.AesonUtils (toJSONE)+import Aeson.Match.QQ.Internal.AesonUtils (toJSONE)   -- | A value constructed using 'qq' that attempts to match -- a JSON document. data Matcher ext-  = Hole (Maybe HoleSig) (Maybe Text)-    -- ^ Optionally typed, optionally named _hole.-    -- If a type is provided, the _hole only matches those values-    -- that have that type.-    -- If a name is provided, the matched value is returned-    -- to the user.-  | Null+  = Null   | Bool Bool   | Number Scientific   | String Text@@ -61,18 +51,21 @@   | ArrayUO (Array ext)     -- ^ Unordered arrays   | Object (Object ext)+  | Var Text+    -- ^ Unless the name of the variable is '_', then+    -- the value is returned to the user in a 'HashMap'.+  | Sig Type Bool (Matcher ext)   | Ext ext     -- ^ External values spliced into a 'Matcher' using the `#{}` syntax     deriving (Show, Eq, Functor) +type Array ext = Box (Vector (Matcher ext))++type Object ext = Box (HashMap Text (NonEmpty (Matcher ext)))+ instance Aeson.ToJSON ext => Aeson.ToJSON (Matcher ext) where   toJSON =     Aeson.object . \case-      Hole type_ name ->-        [ "type" .= ("hole" :: Text)-        , "expected-type" .= type_-        , "name" .= name-        ]       Null ->         [ "type" .= ("null" :: Text)         ]@@ -104,6 +97,16 @@         [ "type" .= ("object" :: Text)         , "value" .= v         ]+      Var name ->+        [ "type" .= ("var" :: Text)+        , "name" .= name+        ]+      Sig type_ nullable v ->+        [ "type" .= ("sig" :: Text)+        , "expected-type" .= type_+        , "nullable" .= nullable+        , "value" .= v+        ]       Ext v ->         [ "type" .= ("extension" :: Text)         , "value" .= v@@ -124,18 +127,12 @@       , "extra" .= extra       ] -type Array ext = Box (Vector (Matcher ext))--type Object ext = Box (HashMap Text (Matcher ext))- -- | It may be tempting to make this the 'Lift' instance for 'Matcher', but I don't -- think it would be correct. We can get a lot from re-using 'Lift' machinery: namely, -- we can cpmpletely bypass manual 'Exp' construction. But, fundamentally, 'Lift' is -- for "serializing" Haskell values and it is not what we are attempting here. quote :: Matcher Exp -> Q Exp quote = \case-  Hole type_ name ->-    [| Hole type_ name :: Matcher Aeson.Value |]   Null ->     [| Null :: Matcher Aeson.Value |]   Bool b ->@@ -167,35 +164,30 @@   Object Box {values, extra} -> do     let       quoted =-        fmap toExp (traverse (traverse quote) (HashMap.toList values))+        fmap toExp (traverse (traverse (traverse quote)) (HashMap.toList values))       toExp =-        ListE . map (\(k, v) -> tup2 (LitE (StringL (Text.unpack k)), v))+        ListE . map (\(k, v) -> tup2 (LitE (StringL (Text.unpack k)), nonEmptyE v))       tup2 (a, b) =         TupE [Just a, Just b]+      nonEmptyE (e :| es) =+        AppE (AppE (ConE '(:|)) e) (ListE es)     [| Object Box          { values = HashMap.fromList $quoted          , extra          } :: Matcher Aeson.Value |]+  Sig type_ nullable val ->+    [| Sig type_ nullable $(quote val) :: Matcher Aeson.Value |]+  Var name ->+    [| Var name :: Matcher Aeson.Value |]   -- | This is fundamentally type-unsafe as long as we try to splice `Exp` in.   Ext ext ->     [| Ext (toJSONE $(pure ext)) :: Matcher Aeson.Value |] --- | _hole type signature-data HoleSig = HoleSig-  { type_    :: Type-  , nullable :: Bool-  } deriving (Show, Eq, Lift)--instance Aeson.ToJSON HoleSig where-  toJSON HoleSig {..} =-    Aeson.object-      [ "type" .= type_-      , "nullable" .= nullable-      ]- -- | _hole type data Type-  = BoolT+  = AnyT+    -- ^ @_ : any@ or, equivalently, @_@+  | BoolT     -- ^ @_ : bool@   | NumberT     -- ^ @_ : number@@@ -214,7 +206,8 @@ instance Aeson.ToJSON Type where   toJSON =     Aeson.toJSON . \case-      BoolT {} -> "bool" :: Text+      AnyT {} -> "any" :: Text+      BoolT {} -> "bool"       NumberT {} -> "number"       StringT {} -> "string"       StringCIT {} -> "ci-string"@@ -224,6 +217,7 @@  instance PP.Pretty Type where   pPrint = \case+    AnyT {} -> "any"     BoolT {} -> "bool"     NumberT {} -> "number"     StringT {} -> "string"@@ -244,9 +238,5 @@     String n   Aeson.Array xs ->     Array Box {values = fmap embed xs, extra = False}-#if MIN_VERSION_aeson(2,0,0)-  Aeson.Object (Aeson.toHashMapText -> o) ->-#else   Aeson.Object o ->-#endif-    Object Box {values = fmap embed o, extra = False}+    Object Box {values = fmap (pure . embed) (Aeson.toHashMapText o), extra = False}

@@ -0,0 +1,81 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+module Aeson.Match.QQ.Internal.ParseSpec (spec) where++import Data.Aeson qualified as Aeson+import Test.Hspec++import Aeson.Match.QQ+++spec :: Spec+spec = do+  it "specs" $ do+    [qq| _ |] `shouldBe` Sig AnyT False (Var "")+    [qq| _hole |] `shouldBe` Sig AnyT False (Var "hole")+    [qq| _"fancy hole" |] `shouldBe` Sig AnyT False (Var "fancy hole")+    [qq| _typed-hole : number |] `shouldBe` Sig NumberT False (Var "typed-hole")+    [qq| _typed-?-hole : number? |] `shouldBe` Sig NumberT True (Var "typed-?-hole")+    [qq| _ : any |] `shouldBe` Sig AnyT False (Var "")++    [qq| null |] `shouldBe` Null++    [qq| false |] `shouldBe` Bool False+    [qq| true |] `shouldBe` Bool True++    [qq| 4 |] `shouldBe` Number 4+    [qq| -7 |] `shouldBe` Number (-7)++    [qq| "foo" |] `shouldBe` String "foo"++    [qq| [] |] `shouldBe`+      Array Box {values = [], extra = False}+    [qq| [1, 2, 3] |] `shouldBe`+      Array Box {values = [Number 1, Number 2, Number 3], extra = False}+    [qq| [1, _, 3] |] `shouldBe`+      Array Box {values = [Number 1, Sig AnyT False (Var ""), Number 3], extra = False}+    [qq| [1, _, 3, ...] |] `shouldBe`+      Array Box {values = [Number 1, Sig AnyT False (Var ""), Number 3], extra = True}++    [qq| (unordered) [] |] `shouldBe`+      ArrayUO Box {values = [], extra = False}+    [qq| (unordered) [1, 2, 3] |] `shouldBe`+      ArrayUO Box {values = [Number 1, Number 2, Number 3], extra = False}+    [qq| (unordered) [1, _, 3] |] `shouldBe`+      ArrayUO Box {values = [Number 1, Sig AnyT False (Var ""), Number 3], extra = False}+    [qq| (unordered) [1, _, 3, ...] |] `shouldBe`+      ArrayUO Box {values = [Number 1, Sig AnyT False (Var ""), Number 3], extra = True}++    [qq| {} |] `shouldBe`+      Object Box {values = [], extra = False}+    [qq| {foo: 4} |] `shouldBe`+      Object Box {values = [("foo", [Number 4])], extra = False}+    [qq| {foo: 4, "bar": 7} |] `shouldBe`+      Object Box {values = [("foo", [Number 4]), ("bar", [Number 7])], extra = False}+    [qq| {foo: 4, "bar": 7, ...} |] `shouldBe`+      Object Box {values = [("foo", [Number 4]), ("bar", [Number 7])], extra = True}+    [qq| {foo: 4, foo: _name, "bar": 7} |] `shouldBe`+      Object Box+        { values =+          [ ("foo", [Number 4, Sig AnyT False (Var "name")])+          , ("bar", [Number 7])+          ]+        , extra = False+        }++    [qq| {foo: #{4 + 7 :: Int}} |] `shouldBe`+      Object Box {values = [("foo", [Ext (Aeson.Number 11)])], extra = False}+    [qq| {foo: #{4 + 7 :: ToEncoding Int}} |] `shouldBe`+      Object Box {values = [("foo", [Ext (Aeson.Number 11)])], extra = False}++newtype ToEncoding a = ToEncoding { unToEncoding :: a }+    deriving (Show, Eq, Num)++instance Aeson.ToJSON a => Aeson.ToJSON (ToEncoding a) where+  toJSON =+    error "ToJSON is undefined"+  toEncoding =+    Aeson.toEncoding . unToEncoding

@@ -5,10 +5,10 @@ {-# LANGUAGE QuasiQuotes #-} module Aeson.Match.QQ.Internal.PrettyPrintSpec (spec) where -import           Test.Hspec+import Test.Hspec -import           Aeson.Match.QQ (qq)-import           Aeson.Match.QQ.Internal.PrettyPrint (pp)+import Aeson.Match.QQ (qq)+import Aeson.Match.QQ.Internal.PrettyPrint (pp)   spec :: Spec@@ -16,20 +16,24 @@   it "holes" $ do     pp [qq| _ |] `shouldBe`       "[qq|\n\-      \  _\n\+      \  _ : any\n\       \|]"     pp [qq| _hole |] `shouldBe`       "[qq|\n\-      \  _hole\n\+      \  _hole : any\n\       \|]"     pp [qq| _"fancy hole" |] `shouldBe`       "[qq|\n\-      \  _\"fancy hole\"\n\+      \  _\"fancy hole\" : any\n\       \|]"     pp [qq| _typed-hole : number |] `shouldBe`       "[qq|\n\       \  _typed-hole : number\n\       \|]"+    pp [qq| _nullable-hole : string? |] `shouldBe`+      "[qq|\n\+      \  _nullable-hole : string?\n\+      \|]"    it "basic values" $ do     pp [qq| null |] `shouldBe`@@ -152,5 +156,11 @@     pp [qq| {foo: #{spliced}} |] `shouldBe`       "[qq|\n\       \  { foo: 7\n\+      \  }\n\+      \|]"+    pp [qq| {foo: 4, foo: 7} |] `shouldBe`+      "[qq|\n\+      \  { foo: 4\n\+      \  , foo: 7\n\       \  }\n\       \|]"

@@ -5,70 +5,21 @@ {-# LANGUAGE QuasiQuotes #-} module Aeson.Match.QQSpec (spec) where -import qualified Data.Aeson as Aeson-import           Data.Aeson.QQ (aesonQQ)-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.HashMap.Strict as HashMap-import           Test.Hspec+import Data.Aeson qualified as Aeson+import Data.Aeson.QQ (aesonQQ)+import Data.List.NonEmpty (NonEmpty(..))+import Data.HashMap.Strict qualified as HashMap+import Test.Hspec -import           Aeson.Match.QQ+import Aeson.Match.QQ   spec :: Spec spec = do-  describe "parse" $-    it "specs" $ do-      [qq| _ |] `shouldBe` Hole Nothing Nothing-      [qq| _hole |] `shouldBe` Hole Nothing (pure "hole")-      [qq| _"fancy hole" |] `shouldBe` Hole Nothing (pure "fancy hole")-      [qq| _typed-hole : number |] `shouldBe` Hole (pure (HoleSig NumberT False)) (pure "typed-hole")-      [qq| _typed-nullable-hole : number? |] `shouldBe` Hole (pure (HoleSig NumberT True)) (pure "typed-nullable-hole")--      [qq| null |] `shouldBe` Null--      [qq| false |] `shouldBe` Bool False-      [qq| true |] `shouldBe` Bool True--      [qq| 4 |] `shouldBe` Number 4-      [qq| -7 |] `shouldBe` Number (-7)--      [qq| "foo" |] `shouldBe` String "foo"--      [qq| [] |] `shouldBe`-        Array Box {values = [], extra = False}-      [qq| [1, 2, 3] |] `shouldBe`-        Array Box {values = [Number 1, Number 2, Number 3], extra = False}-      [qq| [1, _, 3] |] `shouldBe`-        Array Box {values = [Number 1, Hole Nothing Nothing, Number 3], extra = False}-      [qq| [1, _, 3, ...] |] `shouldBe`-        Array Box {values = [Number 1, Hole Nothing Nothing, Number 3], extra = True}--      [qq| (unordered) [] |] `shouldBe`-        ArrayUO Box {values = [], extra = False}-      [qq| (unordered) [1, 2, 3] |] `shouldBe`-        ArrayUO Box {values = [Number 1, Number 2, Number 3], extra = False}-      [qq| (unordered) [1, _, 3] |] `shouldBe`-        ArrayUO Box {values = [Number 1, Hole Nothing Nothing, Number 3], extra = False}-      [qq| (unordered) [1, _, 3, ...] |] `shouldBe`-        ArrayUO Box {values = [Number 1, Hole Nothing Nothing, Number 3], extra = True}--      [qq| {} |] `shouldBe`-        Object Box {values = [], extra = False}-      [qq| {foo: 4} |] `shouldBe`-        Object Box {values = [("foo", Number 4)], extra = False}-      [qq| {foo: 4, "bar": 7} |] `shouldBe`-        Object Box {values = [("foo", Number 4), ("bar", Number 7)], extra = False}-      [qq| {foo: 4, "bar": 7, ...} |] `shouldBe`-        Object Box {values = [("foo", Number 4), ("bar", Number 7)], extra = True}--      [qq| {foo: #{4 + 7 :: Int}} |] `shouldBe`-        Object Box {values = [("foo", Ext (Aeson.Number 11))], extra = False}-      [qq| {foo: #{4 + 7 :: ToEncoding Int}} |] `shouldBe`-        Object Box {values = [("foo", Ext (Aeson.Number 11))], extra = False}-   describe "match" $ do     it "specs" $ do       [qq| _ |] `shouldMatch` [aesonQQ| {foo: 4, bar: 7} |]+      [qq| _ : any |] `shouldMatch` [aesonQQ| {foo: 4, bar: 7} |]       [qq| null |] `shouldMatch` [aesonQQ| null |]       [qq| true |] `shouldMatch` [aesonQQ| true |]       [qq| false |] `shouldMatch` [aesonQQ| false |]@@ -116,6 +67,8 @@         { foo: _ : string         , bar: 7         } |] `shouldNotMatch` [aesonQQ| {foo: null, bar: 7} |]+      [qq| {foo: 4, foo: 7} |] `shouldNotMatch` [aesonQQ| {foo: 4} |]+      [qq| {foo: 4, foo: 7} |] `shouldNotMatch` [aesonQQ| {foo: 7} |]      it "paths" $ do       match [qq| {foo: {bar: {baz: [1, 4]}}} |] [aesonQQ| {foo: {bar: {baz: [1, 7]}}} |] `shouldBe`@@ -130,21 +83,28 @@         match [qq| {foo: _hole} |] [aesonQQ| {foo: {bar: {baz: [1, 4]}}} |] `shouldBe`           pure (HashMap.singleton "hole" [aesonQQ| {bar: {baz: [1, 4]}} |]) -      -- https://github.com/supki/aeson-match-qq/issues/26-      it "#26" $-        match [qq|-          { foo: _hole-          }-        |] [aesonQQ| {foo: {bar: {baz: [1, 4]}}} |] `shouldBe`-          pure (HashMap.singleton "hole" [aesonQQ| {bar: {baz: [1, 4]}} |])+      context "unordered array" $+        it "matches" $ do+          match [qq| (unordered) [1, _hole] |] [aesonQQ| [2, 1] |] `shouldBe`+            pure (HashMap.singleton "hole" [aesonQQ| 2 |])+          match [qq| (unordered) [{foo: _hole}, ...] |] [aesonQQ| [{foo: 2}, 1] |] `shouldBe`+            pure (HashMap.singleton "hole" [aesonQQ| 2 |]) -    context "unordered array" $-      it "named holes" $ do-        match [qq| (unordered) [1, _hole] |] [aesonQQ| [2, 1] |] `shouldBe`-          pure (HashMap.singleton "hole" [aesonQQ| 2 |])-        match [qq| (unordered) [{foo: _hole}, ...] |] [aesonQQ| [{foo: 2}, 1] |] `shouldBe`-          pure (HashMap.singleton "hole" [aesonQQ| 2 |])+      context "duplicate keys" $ do+        it "matches" $ do+          match [qq| {foo: _name, foo: 4} |] [aesonQQ| {foo: 4} |] `shouldBe`+            pure (HashMap.singleton "name" [aesonQQ| 4 |])+          match [qq| {foo: [_a, 7], foo: [4, _b]} |] [aesonQQ| {foo: [4, 7]} |] `shouldBe`+            pure [("a", [aesonQQ| 4 |]), ("b", [aesonQQ| 7 |])] +        it "doesn't match" $ do+          match [qq| {foo: _name, foo: 7} |] [aesonQQ| {foo: 4} |] `shouldBe`+            throwE (Mismatch MkMismatch+              { path = [Key "foo"]+              , matcher = [qq| 7 |]+              , given = Aeson.Number 4+              })+   describe "repro" $ do     -- https://github.com/supki/aeson-match-qq/issues/7     it "#7" $ do@@ -164,7 +124,7 @@       [qq| {foo: []} |] `shouldBe`         Object           (Box-            { values = [("foo", Array (Box {values = [], extra = False}))]+            { values = [("foo", [Array (Box {values = [], extra = False})])]             , extra = False             })       [qq| [{}] |] `shouldBe`@@ -216,6 +176,14 @@           , matcher = Null           , given = Aeson.Number 4           })++    -- https://github.com/supki/aeson-match-qq/issues/26+    it "#26" $+      match [qq|+        { foo: _hole+        }+      |] [aesonQQ| {foo: {bar: {baz: [1, 4]}}} |] `shouldBe`+        pure (HashMap.singleton "hole" [aesonQQ| {bar: {baz: [1, 4]}} |])      -- https://github.com/supki/aeson-match-qq/issues/28     it "#28" $ do