packages feed

aeson-match-qq 1.4.3 → 1.5.0

raw patch · 6 files changed

+115/−42 lines, 6 files

Files

CHANGELOG.markdown view
@@ -1,3 +1,8 @@+1.5.0+=====++  * Streamlined API.+ 1.4.3 =====
aeson-match-qq.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           aeson-match-qq-version:        1.4.3+version:        1.5.0 synopsis:       Declarative JSON matchers. description:    See README.markdown category:       Web
src/Aeson/Match/QQ.hs view
@@ -1,5 +1,14 @@ module Aeson.Match.QQ-  ( Value(..)+  ( match+  , qq++  , Error(..)+  , Mismatch(..)+  , MissingPathElem(..)+  , ExtraArrayValues(..)+  , ExtraObjectValues(..)++  , Value(..)   , Array   , Object   , Box(..)@@ -8,14 +17,6 @@   , Nullable(..)   , Path   , PathElem(..)-  , parse-  , qq-  , match-  , mismatch-  , mistype-  , missingPathElem-  , extraArrayValues-  , extraObjectValues   ) where  import           Data.String (IsString(..))@@ -24,14 +25,14 @@ import           Language.Haskell.TH.Syntax (Lift(..))  import           Aeson.Match.QQ.Internal.Match-  ( Path+  ( match+  , Error(..)+  , Mismatch(..)+  , MissingPathElem(..)+  , ExtraArrayValues(..)+  , ExtraObjectValues(..)+  , Path   , PathElem(..)-  , match-  , mismatch-  , mistype-  , missingPathElem-  , extraArrayValues-  , extraObjectValues   ) import           Aeson.Match.QQ.Internal.Parse (parse) import           Aeson.Match.QQ.Internal.Value
src/Aeson/Match/QQ/Internal/Match.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-}@@ -5,16 +6,31 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-}-module Aeson.Match.QQ.Internal.Match where+module Aeson.Match.QQ.Internal.Match+  ( match+  , Error(..)+  , Mismatch(..)+  , MissingPathElem(..)+  , ExtraArrayValues(..)+  , ExtraObjectValues(..)+  , Path+  , 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 (Validation(..), eitherToValidation)+import           Data.Either.Validation+  ( Validation(..)+  , eitherToValidation+  , validationToEither+  ) import           Data.Foldable (for_, toList) import           Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap@@ -37,12 +53,17 @@   )  +-- | Test if a matcher matches a 'Aeson.Value'. match   :: Value Aeson.Value+     -- ^ A 'qq`-created 'Value'   -> Aeson.Value-  -> Validation (NonEmpty VE) (HashMap Text Aeson.Value)-match =-  go []+     -- ^ A 'Value' from aeson+  -> Either (NonEmpty Error) (HashMap Text Aeson.Value)+     -- ^ Either a non-empty list of errors, or a mapping+     -- from _holes to their values.+match matcher0 given0 =+  validationToEither (go [] matcher0 given0)  where   go path matcher given = do     let mismatched = mismatch (reverse path) matcher given@@ -103,7 +124,14 @@       (ArrayUO _, _) -> do         mistyped         pure mempty-      (Object Box {knownValues, extendable}, Aeson.Object (Aeson.toHashMapText -> o)) ->+      ( Object Box {knownValues, extendable}+#if MIN_VERSION_aeson(2,0,0)+        , Aeson.Object (Aeson.toHashMapText -> o)+#else+        , Aeson.Object o+#endif++        ) ->         let fold f =               HashMap.foldrWithKey (\k v a -> liftA2 HashMap.union a (f k v)) (pure mempty)             extraValues =@@ -135,11 +163,11 @@     (_, _) -> False  matchArrayUO-  :: Validation (NonEmpty VE) (HashMap Text Aeson.Value)+  :: Validation (NonEmpty Error) (HashMap Text Aeson.Value)   -> Path   -> Box (Vector (Value Aeson.Value))   -> Vector Aeson.Value-  -> Validation (NonEmpty VE) (HashMap Text Aeson.Value)+  -> Validation (NonEmpty Error) (HashMap Text Aeson.Value) matchArrayUO mismatched path Box {knownValues, extendable} xs = do   -- Collect possible indices in `xs` for each position in `knownValues`.   let indices = map (collectMatchingIndices (toList xs)) (toList knownValues)@@ -169,10 +197,10 @@    where     matchingIndex i x =       case match knownValue x of-        Success vs ->-          Just (i, vs)-        Failure _ ->+        Left _ ->           Nothing+        Right vs ->+          Just (i, vs)   allIndicesAssignments = map (map unI) . cleanUp . go Set.empty    where     go _ [] = [[]]@@ -192,23 +220,23 @@   I (a, _) `compare` I (b, _) =     a `compare` b -mismatch :: Path -> Value Aeson.Value -> Aeson.Value -> Validation (NonEmpty VE) a+mismatch :: Path -> Value Aeson.Value -> Aeson.Value -> Validation (NonEmpty Error) a mismatch path matcher given =   throwE (Mismatch MkMismatch {..}) -mistype :: Path -> Value Aeson.Value -> Aeson.Value -> Validation (NonEmpty VE) a+mistype :: Path -> Value Aeson.Value -> Aeson.Value -> Validation (NonEmpty Error) a mistype path matcher given =   throwE (Mistype MkMismatch {..}) -missingPathElem :: Path -> PathElem -> Validation (NonEmpty VE) a+missingPathElem :: Path -> PathElem -> Validation (NonEmpty Error) a missingPathElem path missing =   throwE (MissingPathElem MkMissingPathElem {..}) -extraArrayValues :: Path -> Vector Aeson.Value -> Validation (NonEmpty VE) a+extraArrayValues :: Path -> Vector Aeson.Value -> Validation (NonEmpty Error) a extraArrayValues path values =   throwE (ExtraArrayValues MkExtraArrayValues {..}) -extraObjectValues :: Path -> HashMap Text Aeson.Value -> Validation (NonEmpty VE) a+extraObjectValues :: Path -> HashMap Text Aeson.Value -> Validation (NonEmpty Error) a extraObjectValues path values =   throwE (ExtraObjectValues MkExtraObjectValues {..}) @@ -216,7 +244,7 @@ throwE =   eitherToValidation . Left . pure -data VE+data Error   = Mismatch Mismatch   | Mistype Mismatch   | MissingPathElem MissingPathElem@@ -224,7 +252,7 @@   | ExtraObjectValues ExtraObjectValues     deriving (Show, Eq) -instance Aeson.ToJSON VE where+instance Aeson.ToJSON Error where   toJSON =     Aeson.object . \case       Mismatch v ->
src/Aeson/Match/QQ/Internal/Value.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}@@ -20,7 +21,9 @@  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 qualified Data.Aeson.Encoding.Internal as Aeson (encodingToLazyByteString) import           Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI@@ -212,5 +215,9 @@     String n   Aeson.Array xs ->     Array Box {knownValues = fmap embed xs, extendable = False}+#if MIN_VERSION_aeson(2,0,0)   Aeson.Object (Aeson.toHashMapText -> o) ->+#else+  Aeson.Object o ->+#endif     Object Box {knownValues = fmap embed o, extendable = False}
test/Aeson/Match/QQSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-}@@ -6,6 +7,7 @@  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 @@ -117,7 +119,11 @@      it "paths" $ do       match [qq| {foo: {bar: {baz: [1, 4]}}} |] [aesonQQ| {foo: {bar: {baz: [1, 7]}}} |] `shouldBe`-        mismatch ["foo", "bar", "baz", Idx 1] [qq| 4 |] [aesonQQ| 7 |]+        throwE (Mismatch MkMismatch+          { path = ["foo", "bar", "baz", Idx 1]+          , matcher = [qq| 4 |]+          , given = [aesonQQ| 7 |]+          })      it "named holes" $ do       match [qq| {foo: _hole} |] [aesonQQ| {foo: {bar: {baz: [1, 4]}}} |] `shouldBe`@@ -133,9 +139,15 @@     -- https://github.com/supki/aeson-match-qq/issues/7     it "#7" $ do       match [qq| {foo: _} |] [aesonQQ| {} |] `shouldBe`-        missingPathElem [] "foo"+        throwE (MissingPathElem MkMissingPathElem+          { path = []+          , missing = "foo"+          })       match [qq| [_] |] [aesonQQ| [] |] `shouldBe`-        missingPathElem [] (Idx 0)+        throwE (MissingPathElem MkMissingPathElem+          { path = []+          , missing = Idx 0+          })      -- https://github.com/supki/aeson-match-qq/issues/10     it "#10" $ do@@ -160,16 +172,32 @@     it "#18" $ do       -- string ~ string       match [qq| "foo" |] [aesonQQ| "bar" |] `shouldBe`-        mismatch [] (String "foo") (Aeson.String "bar")+        throwE (Mismatch MkMismatch+          { path = []+          , matcher = String "foo"+          , given = Aeson.String "bar"+          })       -- string !~ number       match [qq| "foo" |] [aesonQQ| 4 |] `shouldBe`-        mistype [] (String "foo") (Aeson.Number 4)+        throwE (Mistype MkMismatch+          { path = []+          , matcher = String "foo"+          , given = Aeson.Number 4+          })       -- string !~ null       match [qq| "foo" |] [aesonQQ| null |] `shouldBe`-        mistype [] (String "foo") Aeson.Null+        throwE (Mistype MkMismatch+          { path = []+          , matcher = String "foo"+          , given = Aeson.Null+          })       -- null !~ number       match [qq| null |] [aesonQQ| 4 |] `shouldBe`-        mistype [] Null (Aeson.Number 4)+        throwE (Mistype MkMismatch+          { path = []+          , matcher = Null+          , given = Aeson.Number 4+          })  newtype ToEncoding a = ToEncoding { unToEncoding :: a }     deriving (Show, Eq, Num)@@ -187,3 +215,7 @@ shouldNotMatch :: Value Aeson.Value -> Aeson.Value -> Expectation shouldNotMatch a b =   match a b `shouldNotBe` pure mempty++throwE :: e -> Either (NonEmpty e) a+throwE =+  Left . pure