packages feed

aeson-match-qq 1.3.1 → 1.3.2

raw patch · 7 files changed

+132/−26 lines, 7 filesdep +case-insensitive

Dependencies added: case-insensitive

Files

CHANGELOG.markdown view
@@ -1,3 +1,12 @@+1.3.2+=====++  * Improved matching errors for embedded Haskell values (https://github.com/supki/aeson-match-qq/pull/18)++ * Separate error types for type- and value- level mismatches (https://github.com/supki/aeson-match-qq/pull/18)++ * Case insensitive strings (https://github.com/supki/aeson-match-qq/pull/17)+ 1.3.1 =====
aeson-match-qq.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.6.+-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack  name:           aeson-match-qq-version:        1.3.1+version:        1.3.2 synopsis:       Declarative JSON matchers. description:    See README.markdown category:       Web@@ -40,6 +40,7 @@     , attoparsec     , base >=4.14 && <5     , bytestring+    , case-insensitive     , containers     , either     , haskell-src-meta
src/Aeson/Match/QQ.hs view
@@ -12,6 +12,7 @@   , qq   , match   , mismatch+  , mistype   , missingPathElem   , extraArrayValues   , extraObjectValues@@ -22,9 +23,26 @@ import           Language.Haskell.TH.Quote (QuasiQuoter(..)) import           Language.Haskell.TH.Syntax (Lift(..)) -import           Aeson.Match.QQ.Internal.Match (Path, PathElem(..), match, mismatch, missingPathElem, extraArrayValues, extraObjectValues)+import           Aeson.Match.QQ.Internal.Match+  ( Path+  , PathElem(..)+  , match+  , mismatch+  , mistype+  , missingPathElem+  , extraArrayValues+  , extraObjectValues+  ) import           Aeson.Match.QQ.Internal.Parse (parse)-import           Aeson.Match.QQ.Internal.Value (Value(..), Box(..), Array, Object, TypeSig(..), Type(..), Nullable(..))+import           Aeson.Match.QQ.Internal.Value+  ( Value(..)+  , Box(..)+  , Array+  , Object+  , TypeSig(..)+  , Type(..)+  , Nullable(..)+  )   qq :: QuasiQuoter
src/Aeson/Match/QQ/Internal/Match.hs view
@@ -10,9 +10,10 @@ import           Control.Monad (unless) import           Data.Aeson ((.=)) import qualified Data.Aeson as Aeson+import           Data.Bool (bool)+import qualified Data.CaseInsensitive as CI import           Data.Either.Validation (Validation(..), eitherToValidation) import           Data.Foldable (for_, toList)-import           Data.Bool (bool) import           Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import           Data.List.NonEmpty (NonEmpty)@@ -24,7 +25,14 @@ import qualified Data.Vector as Vector import           Prelude hiding (any, null) -import           Aeson.Match.QQ.Internal.Value (Value(..), Box(..), TypeSig(..), Type(..), Nullable(..))+import           Aeson.Match.QQ.Internal.Value+  ( Value(..)+  , Box(..)+  , TypeSig(..)+  , Type(..)+  , Nullable(..)+  , embed+  )   match@@ -36,35 +44,42 @@  where   go path matcher given = do     let mismatched = mismatch (reverse path) matcher given+        mistyped = mistype (reverse path) matcher given     case (matcher, given) of       (Any holeTypeO nameO, val) -> do         for_ holeTypeO $ \holeType ->           unless (holeTypeMatch holeType val)-            mismatched+            mistyped         pure (maybe mempty (\name -> HashMap.singleton name val) nameO)       (Null, Aeson.Null) ->         pure mempty       (Null, _) -> do-        mismatched+        mistyped         pure mempty       (Bool b, Aeson.Bool b') -> do         unless (b == b') mismatched         pure mempty       (Bool _, _) -> do-        mismatched+        mistyped         pure mempty       (Number n, Aeson.Number n') -> do         unless (n == n') mismatched         pure mempty       (Number _, _) -> do-        mismatched+        mistyped         pure mempty       (String str, Aeson.String str') -> do         unless (str == str') mismatched         pure mempty       (String _, _) -> do-        mismatched+        mistyped         pure mempty+      (StringCI str, Aeson.String str') -> do+        unless (str == CI.mk str') mismatched+        pure mempty+      (StringCI _, _) -> do+        mistyped+        pure mempty       (Array Box {knownValues, extendable}, Aeson.Array arr) ->         let           fold f =@@ -79,12 +94,12 @@             (\i v -> maybe (missingPathElem (reverse path) (Idx i)) (go (Idx i : path) v) (arr Vector.!? i))             knownValues       (Array _, _) -> do-        mismatched+        mistyped         pure mempty       (ArrayUO box, Aeson.Array arr) ->         matchArrayUO mismatched path box arr       (ArrayUO _, _) -> do-        mismatched+        mistyped         pure mempty       (Object Box {knownValues, extendable}, Aeson.Object o) ->         let fold f =@@ -99,11 +114,10 @@             (\k v -> maybe (missingPathElem (reverse path) (Key k)) (go (Key k : path) v) (HashMap.lookup k o))             knownValues       (Object _, _) -> do-        mismatched-        pure mempty-      (Ext val, val') -> do-        unless (val == val') mismatched+        mistyped         pure mempty+      (Ext val, val') ->+        go path (embed val) val'  holeTypeMatch :: TypeSig -> Aeson.Value -> Bool holeTypeMatch type_ val =@@ -112,7 +126,9 @@     (TypeSig {type_ = BoolT} , Aeson.Bool {}) -> True     (TypeSig {type_ = NumberT} , Aeson.Number {}) -> True     (TypeSig {type_ = StringT} , Aeson.String {}) -> True+    (TypeSig {type_ = StringCIT} , Aeson.String {}) -> True     (TypeSig {type_ = ArrayT} , Aeson.Array {}) -> True+    (TypeSig {type_ = ArrayUOT} , Aeson.Array {}) -> True     (TypeSig {type_ = ObjectT} , Aeson.Object {}) -> True     (_, _) -> False @@ -178,6 +194,10 @@ mismatch path matcher given =   throwE (Mismatch MkMismatch {..}) +mistype :: Path -> Value Aeson.Value -> Aeson.Value -> Validation (NonEmpty VE) a+mistype path matcher given =+  throwE (Mistype MkMismatch {..})+ missingPathElem :: Path -> PathElem -> Validation (NonEmpty VE) a missingPathElem path missing =   throwE (MissingPathElem MkMissingPathElem {..})@@ -196,6 +216,7 @@  data VE   = Mismatch Mismatch+  | Mistype Mismatch   | MissingPathElem MissingPathElem   | ExtraArrayValues ExtraArrayValues   | ExtraObjectValues ExtraObjectValues@@ -206,6 +227,10 @@     Aeson.object . \case       Mismatch v ->         [ "type" .= ("mismatch" :: Text)+        , "value" .= v+        ]+      Mistype v ->+        [ "type" .= ("mistype" :: Text)         , "value" .= v         ]       MissingPathElem v ->
src/Aeson/Match/QQ/Internal/Parse.hs view
@@ -7,11 +7,12 @@  import           Control.Applicative ((<|>), optional) import qualified Data.Aeson.Parser as Aeson+import qualified Data.Attoparsec.ByteString as Atto import qualified Data.ByteString as ByteString -- cannot use .Text here due to .Aeson parsers being tied to .ByteString-import qualified Data.Attoparsec.ByteString as Atto import           Data.Bool (bool) 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@@ -50,7 +51,7 @@     OpenSquareBracketP ->       array     OpenParenP ->-      arrayUO+      arrayUO <|> stringCI     OpenCurlyBracketP ->       object     HashP ->@@ -91,6 +92,12 @@ string =   fmap String Aeson.jstring +stringCI :: Atto.Parser (Value Exp)+stringCI = do+  _ <- Atto.string "(ci)"+  spaces+  fmap (StringCI . CI.mk) Aeson.jstring+ array :: Atto.Parser (Value Exp) array = do   _ <- Atto.word8 OpenSquareBracketP@@ -132,11 +139,7 @@  arrayUO :: Atto.Parser (Value Exp) arrayUO = do-  _ <- Atto.word8 OpenParenP-  spaces-  _ <- Atto.string "unordered"-  spaces-  _ <- Atto.word8 CloseParenP+  _ <- Atto.string "(unordered)"   spaces   Array box <- array   pure (ArrayUO box)@@ -209,7 +212,9 @@     [ p "bool" BoolT     , p "number" NumberT     , p "string" StringT+    , p "ci-string" StringCIT     , p "array" ArrayT+    , p "unordered-array" ArrayUOT     , p "object" ObjectT     ]  where@@ -239,9 +244,10 @@ pattern OpenSquareBracketP = 91 -- '[' pattern CloseSquareBracketP = 93 -- ']' -pattern OpenParenP, CloseParenP :: Word8+pattern OpenParenP :: Word8 pattern OpenParenP = 40 -- '('-pattern CloseParenP = 41 -- ')'+-- pattern CloseParenP :: Word8+-- pattern CloseParenP = 41 -- ')'  pattern OpenCurlyBracketP, CloseCurlyBracketP, ColonP :: Word8 pattern OpenCurlyBracketP = 123 -- '{'
src/Aeson/Match/QQ/Internal/Value.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-} module Aeson.Match.QQ.Internal.Value   ( Value(..)   , Box(..)@@ -14,11 +15,14 @@   , TypeSig(..)   , Type(..)   , Nullable(..)+  , embed   ) where  import           Data.Aeson ((.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encoding.Internal as Aeson (encodingToLazyByteString)+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)@@ -38,6 +42,7 @@   | Bool Bool   | Number Scientific   | String Text+  | StringCI (CI Text)   | Array (Array ext)   | ArrayUO (Array ext)   | Object (Object ext)@@ -67,6 +72,10 @@         [ "type" .= ("string" :: Text)         , "value" .= v         ]+      StringCI v ->+        [ "type" .= ("string-ci" :: Text)+        , "value" .= CI.original v+        ]       Array v ->         [ "type" .= ("array" :: Text)         , "value" .= v@@ -115,6 +124,8 @@       [| Number (fromRational $(pure (LitE (RationalL (toRational n))))) :: Value Aeson.Value |]     String str ->       [| String (fromString $(pure (LitE (textL str)))) :: Value Aeson.Value |]+    StringCI str ->+      [| StringCI (fromString $(pure (LitE (textL (CI.original str))))) :: Value Aeson.Value |]     Array Box {knownValues, extendable} -> [|         Array Box           { knownValues =@@ -158,6 +169,7 @@   = BoolT   | NumberT   | StringT+  | StringCIT   | ArrayT   | ArrayUOT   | ObjectT@@ -169,6 +181,7 @@       BoolT {} -> "bool" :: Text       NumberT {} -> "number"       StringT {} -> "string"+      StringCIT {} -> "string-ci"       ArrayT {} -> "array"       ArrayUOT {} -> "array-unordered"       ObjectT {} -> "object"@@ -183,3 +196,18 @@     Aeson.toJSON . \case       Nullable -> True       NonNullable -> False++embed :: Aeson.Value -> Value ext+embed = \case+  Aeson.Null ->+    Null+  Aeson.Bool b ->+    Bool b+  Aeson.Number n ->+    Number n+  Aeson.String n ->+    String n+  Aeson.Array xs ->+    Array Box {knownValues = fmap embed xs, extendable = False}+  Aeson.Object o ->+    Object Box {knownValues = fmap embed o, extendable = False}
test/Aeson/Match/QQSpec.hs view
@@ -72,9 +72,12 @@       [qq| false |] `shouldMatch` [aesonQQ| false |]       [qq| 4 |] `shouldMatch` [aesonQQ| 4 |]       [qq| "foo" |] `shouldMatch` [aesonQQ| "foo" |]+      [qq| (ci) "foo" |] `shouldMatch` [aesonQQ| "Foo" |]       [qq| [1, 2, 3] |] `shouldMatch` [aesonQQ| [1, 2, 3] |]       [qq| [1, _ : number, 3, ...] |] `shouldMatch` [aesonQQ| [1, 2, 3, 4] |]       [qq| [1, _ : string] |] `shouldMatch` [aesonQQ| [1, "foo"] |]+      [qq| [1, _ : ci-string] |] `shouldMatch` [aesonQQ| [1, "foo"] |]+      [qq| [1, _ : unordered-array] |] `shouldMatch` [aesonQQ| [1, ["foo"]] |]       [qq| (unordered) [] |] `shouldMatch` [aesonQQ| [] |]       [qq| (unordered) [1, 2, 3] |] `shouldMatch` [aesonQQ| [1, 2, 3] |]       [qq| (unordered) [1, 2, 3] |] `shouldMatch` [aesonQQ| [2, 3, 1] |]@@ -93,6 +96,7 @@       [qq| false |] `shouldNotMatch` [aesonQQ| true |]       [qq| 4 |] `shouldNotMatch` [aesonQQ| 7 |]       [qq| "foo" |] `shouldNotMatch` [aesonQQ| "bar" |]+      [qq| (ci) "foo" |] `shouldNotMatch` [aesonQQ| "Bar" |]       [qq| [1, 2, 3] |] `shouldNotMatch` [aesonQQ| [1, 2, 3, 4] |]       [qq| [1, 2, 3, ...] |] `shouldNotMatch` [aesonQQ| [1, 2] |]       [qq| [1, _ : string] |] `shouldNotMatch` [aesonQQ| [1, 2] |]@@ -147,6 +151,21 @@     -- https://github.com/supki/aeson-match-qq/issues/13     it "#13" $       [qq| "Слава Україні" |] `shouldMatch` [aesonQQ| "Слава Україні" |]++    -- https://github.com/supki/aeson-match-qq/issues/18+    it "#18" $ do+      -- string ~ string+      match [qq| "foo" |] [aesonQQ| "bar" |] `shouldBe`+        mismatch [] (String "foo") (Aeson.String "bar")+      -- string !~ number+      match [qq| "foo" |] [aesonQQ| 4 |] `shouldBe`+        mistype [] (String "foo") (Aeson.Number 4)+      -- string !~ null+      match [qq| "foo" |] [aesonQQ| null |] `shouldBe`+        mistype [] (String "foo") Aeson.Null+      -- null !~ number+      match [qq| null |] [aesonQQ| 4 |] `shouldBe`+        mistype [] Null (Aeson.Number 4)  newtype ToEncoding a = ToEncoding { unToEncoding :: a }     deriving (Show, Eq, Num)