aeson-injector 1.0.1.0 → 1.0.2.0

raw patch · 3 files changed

+89/−4 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• aeson-injector.cabal +1/−1
• src/Data/Aeson/WithField.hs +46/−3
• test/Main.hs +42/−0

@@ -1,5 +1,5 @@ name:                aeson-injector-version:             1.0.1.0+version:             1.0.2.0 synopsis:            Injecting fields into aeson values description:         See README.md license:             MIT

@@ -154,14 +154,16 @@   , WithId   -- * Multiple fields injector   , WithFields(..)+  -- * Single field wrapper+  , OnlyField(..)+  , OnlyId   ) where   import Control.Applicative import Control.DeepSeq import Control.Lens hiding ((.=)) import Control.Monad -import Data.Aeson -import Data.Bifunctor+import Data.Aeson import Data.Monoid  import Data.Proxy  import Data.Swagger @@ -349,4 +351,45 @@       & type_ .~ SwaggerObject       & properties .~ [ ("value", Inline nbs) ]       & required .~ [ "value" ]-  ++-- | Special case, when you want to wrap your type @a@ in field with name @s@.+--+-- >>> encode (OnlyField 0 :: OnlyField "id" Int)+-- "{\"id\":0}"+--+-- >>> encode $ toSchema (Proxy :: Proxy (OnlyField "id" Int))+-- "{\"required\":[\"id\"],\"type\":\"object\",\"properties\":{\"id\":{\"maximum\":9223372036854775807,\"minimum\":-9223372036854775808,\"type\":\"integer\"}}}"+--+-- Also the type can be used as an endpoint for 'WithField':+-- +-- >>> encode (WithField True (OnlyField 0) :: WithField "val" Bool (OnlyField "id" Int))+-- "{\"id\":0,\"val\":true}"+newtype OnlyField (s :: Symbol) a = OnlyField { unOnlyField :: a }+  deriving (Generic, Show, Read, Eq)++-- | Special case for the most common "id" field+type OnlyId i = OnlyField "id" i ++instance Functor (OnlyField s) where +  fmap f (OnlyField a) = OnlyField (f a)++instance (KnownSymbol s, ToJSON a) => ToJSON (OnlyField s a) where +  toJSON (OnlyField a) = object [ field .= a ]+    where +    field = T.pack $ symbolVal (Proxy :: Proxy s)++instance (KnownSymbol s, FromJSON a) => FromJSON (OnlyField s a) where +  parseJSON (Object o) = OnlyField <$> o .: field +    where +    field = T.pack $ symbolVal (Proxy :: Proxy s)+  parseJSON _ = mzero ++instance (KnownSymbol s, ToSchema a) => ToSchema (OnlyField s a) where +  declareNamedSchema _ = do+    NamedSchema an as <- declareNamedSchema (Proxy :: Proxy a)+    return $ NamedSchema (fmap ("OnlyField" <>) an) $ mempty +      & type_ .~ SwaggerObject+      & properties .~ [(field, Inline as)]+      & required .~ [field]+    where +    field = T.pack $ symbolVal (Proxy :: Proxy s)

@@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-} module Main where  import Control.Lens hiding ((.=))@@ -23,6 +24,9 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (WithFields a b) where    arbitrary = WithFields <$> arbitrary <*> arbitrary +instance Arbitrary a => Arbitrary (OnlyField s a) where +  arbitrary = OnlyField <$> arbitrary+ main :: IO () main = defaultMain tests @@ -33,12 +37,14 @@ qcProperties = testGroup "Properties" [     withFieldProps   , withFieldsProps+  , onlyFieldProps   ]  unitTests :: TestTree  unitTests = testGroup "Unit tests" [     withFieldTests   , withFieldsTests+  , onlyFieldTests   ]  data TestObj = TestObj !Text @@ -280,6 +286,34 @@         expected @=? (actual ^. properties)     ] +onlyFieldTests :: TestTree+onlyFieldTests = testGroup "OnlyField tests" [+    testsToJSON+  , testsFromJSON+  , testsToSchema+  ]+  where +  testsToJSON = testGroup "toJSON" [+      testCase "Normal mode" $ do +        let expected = object [ "a" .= (42 :: Int) ]+        let actual = toJSON (OnlyField 42 :: OnlyField "a" Int)+        expected @=? actual+    ]+  testsFromJSON = testGroup "FromJSON" [+      testCase "Normal mode" $ do +        let expected = OnlyField 42 :: OnlyField "a" Int+        let (A.Success (actual :: OnlyField "a" Int)) = fromJSON $ object [ +              "a" .= (42 :: Int) ]+        expected @=? actual+    ]+  testsToSchema = testGroup "ToSchema" [+      testCase "Normal mode" $ do +        let expected = [+                ("a", Inline $ toSchema (Proxy :: Proxy Int)) ]+        let actual = toSchema (Proxy :: Proxy (OnlyField "a" Int))+        expected @=? (actual ^. properties)+    ]+ withFieldProps :: TestTree withFieldProps = testGroup "withField properties" [     functorProps@@ -301,3 +335,11 @@       fmap id wf == wf      bifunctorProps = QC.testProperty "bimap id id == id" $  \(wf :: WithFields TestObj1 TestObj2) ->        bimap id id wf == wf ++onlyFieldProps :: TestTree +onlyFieldProps = testGroup "onlyField properties" [+    functorProps+  ]+  where +    functorProps = QC.testProperty "fmap id  ==  id" $  \(wf :: OnlyField "id" TestObj) -> +      fmap id wf == wf