aeson-injector 1.0.0.1 → 1.0.1.0

raw patch · 3 files changed

+130/−63 lines, 3 filesdep +QuickCheckdep +bifunctorsdep +quickcheck-textPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, bifunctors, quickcheck-text, tasty, tasty-hunit, tasty-quickcheck

API changes (from Hackage documentation)

Files

• aeson-injector.cabal +7/−1
• src/Data/Aeson/WithField.hs +14/−0
• test/Main.hs +109/−62

@@ -1,5 +1,5 @@ name:                aeson-injector-version:             1.0.0.1+version:             1.0.1.0 synopsis:            Injecting fields into aeson values description:         See README.md license:             MIT@@ -30,6 +30,7 @@   build-depends:        base                 >= 4.7   && < 4.10     , aeson                >= 0.11  && < 0.13+    , bifunctors           >= 5.2   && < 6     , deepseq              >= 1.4   && < 2     , lens                 >= 4.13  && < 5     , swagger2             >= 2.0   && < 3.0@@ -47,5 +48,10 @@     , aeson-injector     , HUnit >= 1.3     , lens+    , QuickCheck >= 2.8.2+    , quickcheck-text     , swagger2 +    , tasty >= 0.11+    , tasty-hunit >= 0.9+    , tasty-quickcheck >= 0.8     , text

@@ -161,6 +161,7 @@ import Control.Lens hiding ((.=)) import Control.Monad  import Data.Aeson +import Data.Bifunctor import Data.Monoid  import Data.Proxy  import Data.Swagger @@ -190,6 +191,12 @@  instance (NFData a, NFData b) => NFData (WithField s a b) +instance Functor (WithField s a) where +  fmap f (WithField a b) = WithField a (f b)++instance Bifunctor (WithField s) where +  bimap fa fb (WithField a b) = WithField (fa a) (fb b)+ -- | Workaround for a problem that is discribed as: -- sometimes I need a id with the data, sometimes not. --@@ -270,6 +277,13 @@   deriving (Generic, Eq, Show, Read)  instance (NFData a, NFData b) => NFData (WithFields a b)++instance Functor (WithFields a) where +  fmap f (WithFields a b) = WithFields a (f b)++instance Bifunctor WithFields where +  bimap fa fb (WithFields a b) = WithFields (fa a) (fb b)+  -- | Note: the instance injects field only in 'Object' case. -- In other cases it forms a wrapper around the 'Value' produced 

@@ -6,22 +6,41 @@  import Control.Lens hiding ((.=)) import Control.Monad -import Data.Aeson+import Data.Aeson as A  import Data.Aeson.WithField+import Data.Proxy import Data.Swagger import Data.Swagger.Internal.Schema-import Data.Text -import Data.Proxy-import Test.HUnit +import Data.Text+import Data.Text.Arbitrary+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck as QC +instance (Arbitrary a, Arbitrary b) => Arbitrary (WithField s a b) where +  arbitrary = WithField <$> arbitrary <*> arbitrary++instance (Arbitrary a, Arbitrary b) => Arbitrary (WithFields a b) where +  arbitrary = WithFields <$> arbitrary <*> arbitrary+ main :: IO ()-main = runTestTT tests >> return ()-  where-  tests = TestList [-      (TestLabel "WithField tests" withFieldTests)-    , (TestLabel "WithFields tests" withFieldsTests)-    ]+main = defaultMain tests +tests :: TestTree+tests = testGroup "Tests" [qcProperties, unitTests]++qcProperties :: TestTree +qcProperties = testGroup "Properties" [+    withFieldProps+  , withFieldsProps+  ]++unitTests :: TestTree +unitTests = testGroup "Unit tests" [+    withFieldTests+  , withFieldsTests+  ]+ data TestObj = TestObj !Text    deriving (Eq, Show) @@ -37,99 +56,101 @@       & type_ .~ SwaggerObject       & properties .~ [("field", Inline t)]       & required .~ ["field"]+instance Arbitrary TestObj where +  arbitrary = TestObj <$> arbitrary -withFieldTests :: Test-withFieldTests = TestList [-    TestLabel "toJSON" testsToJSON-  , TestLabel "fromJSON" testsFromJSON-  , TestLabel "toSchema" testsToSchema+withFieldTests :: TestTree+withFieldTests = testGroup "WithField tests" [+    testsToJSON+  , testsFromJSON+  , testsToSchema   ]   where-  testsToJSON = TestList [-      TestLabel "Inline mode: atomic field" $ TestCase $ do +  testsToJSON = testGroup "toJSON" [+      testCase "Inline mode: atomic field" $ do          let expected = object ["a" .= (0 :: Int), "field" .= ("val" :: Text)]         let actual = toJSON (WithField 0 (TestObj "val") :: WithField "a" Int TestObj)         expected @=? actual-    , TestLabel "Inline mode: complex field" $ TestCase $ do +    , testCase "Inline mode: complex field" $ do          let expected = object [                 "a" .= object ["field" .= ("key" :: Text)]               , "field" .= ("val" :: Text)]         let actual = toJSON (WithField (TestObj "key") (TestObj "val")                :: WithField "a" TestObj TestObj)         expected @=? actual-    , TestLabel "Wrapper mode: atomic" $ TestCase $ do +    , testCase "Wrapper mode: atomic" $ do          let expected = object ["a" .= (0 :: Int), "value" .= ("val" :: Text)]         let actual = toJSON (WithField 0 "val" :: WithField "a" Int String)         expected @=? actual-    , TestLabel "Wrapper mode: array" $ TestCase $ do +    , testCase "Wrapper mode: array" $ do          let expected = object ["a" .= (0 :: Int), "value" .= (["val1", "val2"] :: [Text])]         let actual = toJSON (WithField 0 ["val1", "val2"] :: WithField "a" Int [String])         expected @=? actual-    , TestLabel "Wrapper mode: complex field" $ TestCase $ do +    , testCase "Wrapper mode: complex field" $ do          let expected = object [                 "a" .= object ["field" .= ("key" :: Text)]               , "value" .= ("val":: Text)]         let actual = toJSON (WithField (TestObj "key") "val" :: WithField "a" TestObj String)         expected @=? actual     ]-  testsFromJSON = TestList [-      TestLabel "Inline mode: atomic field" $ TestCase $ do -        let Success (expected :: WithField "a" Int TestObj) = fromJSON $ object [+  testsFromJSON = testGroup "fromJSON" [+      testCase "Inline mode: atomic field" $ do +        let A.Success (expected :: WithField "a" Int TestObj) = fromJSON $ object [                 "a" .= (0 :: Int)               , "field" .= ("val" :: Text)]         let actual = WithField 0 (TestObj "val") :: WithField "a" Int TestObj         expected @=? actual-    , TestLabel "Inline mode: complex field" $ TestCase $ do -        let Success (expected :: WithField "a" TestObj TestObj) = fromJSON $ object [+    , testCase "Inline mode: complex field" $ do +        let A.Success (expected :: WithField "a" TestObj TestObj) = fromJSON $ object [                 "a" .= object ["field" .= ("key" :: Text)]               , "field" .= ("val" :: Text)]         let actual = WithField (TestObj "key") (TestObj "val") :: WithField "a" TestObj TestObj         expected @=? actual-    , TestLabel "Wrapper mode: atomic" $ TestCase $ do -        let Success (expected :: WithField "a" Int String) = fromJSON $ object [+    , testCase "Wrapper mode: atomic" $ do +        let A.Success (expected :: WithField "a" Int String) = fromJSON $ object [                 "a" .= (0 :: Int)               , "value" .= ("val" :: Text)]         let actual = WithField 0 "val" :: WithField "a" Int String         expected @=? actual-    , TestLabel "Wrapper mode: array" $ TestCase $ do -        let Success (expected :: WithField "a" Int [String]) = fromJSON $ object [+    , testCase "Wrapper mode: array" $ do +        let A.Success (expected :: WithField "a" Int [String]) = fromJSON $ object [                 "a" .= (0 :: Int)               , "value" .= (["val1", "val2"] :: [Text]) ]         let actual = WithField 0 ["val1", "val2"] :: WithField "a" Int [String]         expected @=? actual-    , TestLabel "Wrapper mode: complex field" $ TestCase $ do -        let Success (expected :: WithField "a" TestObj String) = fromJSON $ object [+    , testCase "Wrapper mode: complex field" $ do +        let A.Success (expected :: WithField "a" TestObj String) = fromJSON $ object [                 "a" .= object ["field" .= ("key" :: Text)]               , "value" .= ("val":: Text)]         let actual = WithField (TestObj "key") "val" :: WithField "a" TestObj String         expected @=? actual     ]-  testsToSchema = TestList [-      TestLabel "Inline mode: atomic field" $ TestCase $ do +  testsToSchema = testGroup "toSchema" [+      testCase "Inline mode: atomic field" $ do          let expected = [                 ("a", Inline $ toSchema (Proxy :: Proxy Int))               , ("field", Inline $ toSchema (Proxy :: Proxy String))]         let actual = toSchema (Proxy :: Proxy (WithField "a" Int TestObj))         expected @=? (actual ^. properties)-    , TestLabel "Inline mode: complex field" $ TestCase $ do +    , testCase "Inline mode: complex field" $ do          let expected = [                 ("a", Inline $ toSchema (Proxy :: Proxy TestObj))               , ("field", Inline $ toSchema (Proxy :: Proxy String))]         let actual = toSchema (Proxy :: Proxy (WithField "a" TestObj TestObj))         expected @=? (actual ^. properties)-    , TestLabel "Wrapper mode: atomic" $ TestCase $ do +    , testCase "Wrapper mode: atomic" $ do          let expected = [                 ("a", Inline $ toSchema (Proxy :: Proxy Int))               , ("value", Inline $ toSchema (Proxy :: Proxy String))]         let actual = toSchema (Proxy :: Proxy (WithField "a" Int String))         expected @=? (actual ^. properties)-    , TestLabel "Wrapper mode: array" $ TestCase $ do +    , testCase "Wrapper mode: array" $ do          let expected = [                 ("a", Inline $ toSchema (Proxy :: Proxy Int))               , ("value", Inline $ toSchema (Proxy :: Proxy [String]))]         let actual = toSchema (Proxy :: Proxy (WithField "a" Int [String]))         expected @=? (actual ^. properties)-    , TestLabel "Wrapper mode: complex field" $ TestCase $ do +    , testCase "Wrapper mode: complex field" $ do          let expected = [                 ("a", Inline $ toSchema (Proxy :: Proxy TestObj))               , ("value", Inline $ toSchema (Proxy :: Proxy String))]@@ -152,6 +173,8 @@       & type_ .~ SwaggerObject       & properties .~ [("field1", Inline t)]       & required .~ ["field1"]+instance Arbitrary TestObj1 where +  arbitrary = TestObj1 <$> arbitrary  data TestObj2 = TestObj2 !Text    deriving (Eq, Show)@@ -168,89 +191,113 @@       & type_ .~ SwaggerObject       & properties .~ [("field2", Inline t)]       & required .~ ["field2"]+instance Arbitrary TestObj2 where +  arbitrary = TestObj2 <$> arbitrary -withFieldsTests :: Test-withFieldsTests = TestList [-    TestLabel "toJSON" testsToJSON-  , TestLabel "fromJSON" testsFromJSON-  , TestLabel "toSchema" testsToSchema+withFieldsTests :: TestTree+withFieldsTests = testGroup "WithFields tests" [+    testsToJSON+  , testsFromJSON+  , testsToSchema   ]   where-  testsToJSON = TestList [-      TestLabel "Inline mode" $ TestCase $ do +  testsToJSON = testGroup "toJSON" [+      testCase "Inline mode" $ do          let expected = object [                 "field1" .= ("val1" :: Text)               , "field2" .= ("val2" :: Text) ]         let actual = toJSON (WithFields (TestObj1 "val1") (TestObj2 "val2"))         expected @=? actual-    , TestLabel "Wrapper mode: first" $ TestCase $ do +    , testCase "Wrapper mode: first" $ do          let expected = object [                 "injected" .= ("val1" :: Text)               , "field2" .= ("val2" :: Text) ]         let actual = toJSON (WithFields ("val1" :: Text) (TestObj2 "val2"))         expected @=? actual-    , TestLabel "Wrapper mode: second" $ TestCase $ do +    , testCase "Wrapper mode: second" $ do          let expected = object [                 "field1" .= ("val1" :: Text)               , "value" .= ("val2" :: Text) ]         let actual = toJSON (WithFields (TestObj1 "val1") ("val2" :: Text))         expected @=? actual-    , TestLabel "Wrapper mode: both" $ TestCase $ do +    , testCase "Wrapper mode: both" $ do          let expected = object [                 "injected" .= ("val1" :: Text)               , "value" .= ("val2" :: Text) ]         let actual = toJSON (WithFields ("val1" :: Text) ("val2" :: Text))         expected @=? actual     ]-  testsFromJSON = TestList [-      TestLabel "Inline mode" $ TestCase $ do -        let Success (expected :: WithFields TestObj1 TestObj2) = fromJSON $ object [+  testsFromJSON = testGroup "fromJSON" [+      testCase "Inline mode" $ do +        let A.Success (expected :: WithFields TestObj1 TestObj2) = fromJSON $ object [                 "field1" .= ("val1" :: Text)               , "field2" .= ("val2" :: Text)]         let actual = WithFields (TestObj1 "val1") (TestObj2 "val2")         expected @=? actual-    , TestLabel "Wrapper mode: first" $ TestCase $ do -        let Success (expected :: WithFields Text TestObj2) = fromJSON $ object [+    , testCase "Wrapper mode: first" $ do +        let A.Success (expected :: WithFields Text TestObj2) = fromJSON $ object [                 "injected" .= ("val1" :: Text)               , "field2" .= ("val2" :: Text)]         let actual = WithFields ("val1" :: Text) (TestObj2 "val2")         expected @=? actual-    , TestLabel "Wrapper mode: second" $ TestCase $ do -        let Success (expected :: WithFields TestObj1 Text) = fromJSON $ object [+    , testCase "Wrapper mode: second" $ do +        let A.Success (expected :: WithFields TestObj1 Text) = fromJSON $ object [                 "field1" .= ("val1" :: Text)               , "value" .= ("val2" :: Text)]         let actual = WithFields (TestObj1 "val1") ("val2" :: Text)         expected @=? actual-    , TestLabel "Wrapper mode: both" $ TestCase $ do -        let Success (expected :: WithFields Text Text) = fromJSON $ object [+    , testCase "Wrapper mode: both" $ do +        let A.Success (expected :: WithFields Text Text) = fromJSON $ object [                 "injected" .= ("val1" :: Text)               , "value" .= ("val2" :: Text)]         let actual = WithFields ("val1" :: Text) ("val2" :: Text)         expected @=? actual     ]-  testsToSchema = TestList [-      TestLabel "Inline mode" $ TestCase $ do +  testsToSchema = testGroup "toSchema" [+      testCase "Inline mode" $ do          let expected = [                 ("field1", Inline $ toSchema (Proxy :: Proxy Text))               , ("field2", Inline $ toSchema (Proxy :: Proxy Text))]         let actual = toSchema (Proxy :: Proxy (WithFields TestObj1 TestObj2))         expected @=? (actual ^. properties)-    , TestLabel "Wrapper mode: first" $ TestCase $ do +    , testCase "Wrapper mode: first" $ do          let expected = [                 ("injected", Inline $ toSchema (Proxy :: Proxy Text))               , ("field2", Inline $ toSchema (Proxy :: Proxy Text))]         let actual = toSchema (Proxy :: Proxy (WithFields Text TestObj2))         expected @=? (actual ^. properties)-    , TestLabel "Wrapper mode: second" $ TestCase $ do +    , testCase "Wrapper mode: second" $ do          let expected = [                 ("field1", Inline $ toSchema (Proxy :: Proxy Text))               , ("value", Inline $ toSchema (Proxy :: Proxy Text))]         let actual = toSchema (Proxy :: Proxy (WithFields TestObj1 Text))         expected @=? (actual ^. properties)-    , TestLabel "Wrapper mode: both" $ TestCase $ do +    , testCase "Wrapper mode: both" $ do          let expected = [                 ("injected", Inline $ toSchema (Proxy :: Proxy Text))               , ("value", Inline $ toSchema (Proxy :: Proxy Text))]         let actual = toSchema (Proxy :: Proxy (WithFields Text Text))         expected @=? (actual ^. properties)     ]++withFieldProps :: TestTree+withFieldProps = testGroup "withField properties" [+    functorProps+  , bifunctorProps+  ]+  where +    functorProps = QC.testProperty "fmap id  ==  id" $  \(wf :: WithField "id" Int TestObj) -> +      fmap id wf == wf +    bifunctorProps = QC.testProperty "bimap id id == id" $  \(wf :: WithField "id" Int TestObj) -> +      bimap id id wf == wf ++withFieldsProps :: TestTree+withFieldsProps = testGroup "withFields properties" [+    functorProps+  , bifunctorProps+  ]+  where +    functorProps = QC.testProperty "fmap id  ==  id" $  \(wf :: WithFields TestObj1 TestObj2) -> +      fmap id wf == wf +    bifunctorProps = QC.testProperty "bimap id id == id" $  \(wf :: WithFields TestObj1 TestObj2) -> +      bimap id id wf == wf