diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2016 Anton Gushcha + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/aeson-injector.cabal b/aeson-injector.cabal new file mode 100644 --- /dev/null +++ b/aeson-injector.cabal @@ -0,0 +1,49 @@ +name: aeson-injector +version: 1.0.0.0 +synopsis: Injecting fields into aeson values +description: See Readme.md +license: MIT +license-file: LICENSE +author: Anton Gushcha +maintainer: ncrashed@gmail.com +copyright: 2016 Anton Gushcha +category: Data, JSON, Web +build-type: Simple +cabal-version: >=1.18 +tested-with: + GHC == 7.10.3 + , GHC == 8.0.1 + , GHC == 8.0.2 + +source-repository head + type: git + location: https://github.com/NCrashed/aeson-injector + +library + default-language: Haskell2010 + hs-source-dirs: src + exposed-modules: + Data.Aeson.WithField + + build-depends: + base >= 4.7 && < 4.10 + , aeson >= 0.11 && < 0.13 + , deepseq >= 1.4 && < 2 + , lens >= 4.13 && < 5 + , swagger2 >= 2.0 && < 3.0 + , text >= 1.2 && < 2.0 + , unordered-containers >= 0.2.7 && < 0.3 + +test-suite test-aeson-injector + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: + base + , aeson + , aeson-injector + , HUnit >= 1.3 + , lens + , swagger2 + , text diff --git a/src/Data/Aeson/WithField.hs b/src/Data/Aeson/WithField.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aeson/WithField.hs @@ -0,0 +1,338 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-| +Module : Data.Aeson.WithField +Description : Provides utility to inject fields into aeson values. +Copyright : (c) Anton Gushcha, 2016 +License : MIT +Maintainer : ncrashed@gmail.com +Stability : experimental +Portability : Portable + +When builds a RESTful API one often faces the problem that some methods +need inbound data without unique identifier (for instance, a creation of +new resource) and some methods need the same outbound data with additional +fields attached to the response. + +The module provides you with 'WithField' and 'WithFields' data types that +help you to solve the issue without code duplication. + +It is small utility library that is intented to be used in RESTful APIs, +especially with +and . Its main purpose is simple injection of +fields into JSONs produced by +library. + +Consider the following common data type in web service developing: + +@ +data News = News { + title :: Text +, body :: Text +, author :: Text +, timestamp :: UTCTime +} + +-- Consider we have simple 'ToJSON' and 'FromJSON' instances +$(deriveJSON defaultOptions ''News) +@ + +'ToJSON' instance produces JSON's like: + +@ +{ + "title": "Awesome piece of news!" +, "body": "Big chunk of text" +, "author": "Just Me" +, "timestamp": "2016-07-26T18:54:42.678999Z" +} +@ + +Now one can create a simple web server with servant DSL: + +> type NewsId = Word +> +> type NewsAPI = +> ReqBody '[JSON] News :> Post '[JSON] NewsId +> :<|> Capture "news-id" NewsId :> Get '[JSON] News +> :<|> "list" :> Get '[JSON] [News] + + +All seems legit, but, wait a second, an API user definitely would +like to know id of news in the "list" method. One way to do this is declare +new data type @NewsInfo@ with additional field, but it is bad solution as requires +to code duplication for each resource. + +So, here @aeson-injector@ steps in, now you can write: + +> type NewsAPI = +> ReqBody '[JSON] News :> Post '[JSON] NewsId +> :<|> Capture "news-id" NewsId :> Get '[JSON] News +> :<|> "list" :> Get '[JSON] [WithField "id" NewsId News] + +@'WithField' "id" NewsId News@ or simply @'WithId' NewsId News@ wraps you data type +and injects "id" field in produced JSON values: + +>>> encode (WithField 42 myNews :: WithField "id" NewsId News) + +> { +> "id": 42 +> , "title": "Awesome piece of news!" +> , "body": "Big chunk of text" +> , "author": "Just Me" +> , "timestamp": "2016-07-26T18:54:42.678999Z" +> } + +'WithField' data type has `FromJSON` instance for seamless parsing of data with +injected fields and 'ToSchema' instance for support. + += Injecting multiple values + +The library also has more general data type 'WithFields a b' that injects fields of 'toJSON a' into 'toJSON b'. + +@ haskell +data NewsPatch = NewsPatch { + taggs :: [Text] +, rating :: Double +} +$(deriveJSON defaultOptions ''NewsPatch) +@ + +@ haskell +let myNewsPatch = NewsPatch ["tag1", "tag2"] 42 +in encode $ WithFields myNewsPatch myNews +@ + +> { +> "title": "Awesome piece of news!" +> , "body": "Big chunk of text" +> , "author": "Just Me" +> , "timestamp": "2016-07-26T18:54:42.678999Z" +> , "tags": ["tag1", "tag2"] +> , "rating": 42.0 +> } + += Corner cases + +Unfortunately, we cannot inject in non object values of produced JSON, +so the library creates a wrapper object around non-object value: + +@ +encode (WithId 0 "non-object" :: WithId Int String) +@ + +@ +{ + "id": 0 +, "value": "non-object" +} +@ + +The same story is about 'WithFields' data type: + +@ +encode (WithFields 0 "non-object" :: WithFields Int String) +@ + +@ +{ + "injected": 0 +, "value": "non-object" +} +@ + +-} +module Data.Aeson.WithField( + -- * Single field injector + WithField(..) + , WithId + -- * Multiple fields injector + , WithFields(..) + ) where + +import Control.Applicative +import Control.DeepSeq +import Control.Lens hiding ((.=)) +import Control.Monad +import Data.Aeson +import Data.Monoid +import Data.Proxy +import Data.Swagger +import GHC.Generics +import GHC.TypeLits + +import qualified Data.HashMap.Strict as H +import qualified Data.Text as T + +-- | Injects field 'a' into 'b' with tag 's'. It has +-- special instances for 'ToJSON' and 'FromJSON' for +-- such injection and corresponding Swagger 'ToSchema' +-- instance. +-- +-- For instance: +-- +-- >>> encode (WithField "val" (Left 42) :: WithField "injected" String (Either Int Int)) +-- "{\"Left\":42,\"id\":\"val\"}" +-- +-- If the instance cannot inject field (in case of single values and arrays), +-- it wraps the result in the following way: +-- +-- >>> encode (WithField "val" 42 :: WithField "injected" String Int) +-- "{\"value\":42,\"injected\":\"val\"}" +data WithField (s :: Symbol) a b = WithField !a !b + deriving (Generic, Eq, Show, Read) + +instance (NFData a, NFData b) => NFData (WithField s a b) + +-- | Workaround for a problem that is discribed as: +-- sometimes I need a id with the data, sometimes not. +-- +-- The important note that 'ToJSON' and 'FromJSON' instances +-- behaves as it is 'a' but with additional 'id' field. +type WithId i a = WithField "id" i a + +-- | Note: the instance injects field only in 'Object' case. +-- In other cases it forms a wrapper around the 'Value' produced +-- by 'toJSON' of inner 'b' body. +-- +-- Example of wrapper: +-- +-- > { "id": 0, "value": [1, 2, 3] } +instance (KnownSymbol s, ToJSON a, ToJSON b) => ToJSON (WithField s a b) where + toJSON (WithField a b) = let + jsonb = toJSON b + field = T.pack $ symbolVal (Proxy :: Proxy s) + in case toJSON b of + Object vs -> Object $ H.insert field (toJSON a) vs + _ -> object [ + field .= a + , "value" .= jsonb + ] + +-- | Note: the instance tries to parse the json as object with +-- additional field value, if it fails it assumes that it is a +-- wrapper produced by corresponding 'ToJSON' instance. +instance (KnownSymbol s, FromJSON a, FromJSON b) => FromJSON (WithField s a b) where + parseJSON val@(Object o) = injected <|> wrapper + where + field = T.pack $ symbolVal (Proxy :: Proxy s) + injected = WithField + <$> o .: field + <*> parseJSON val + wrapper = WithField + <$> o .: field + <*> o .: "value" + parseJSON _ = mzero + +-- | Note: the instance tries to generate schema of the json as object with +-- additional field value, if it fails it assumes that it is a +-- wrapper produced by corresponding 'ToJSON' instance. +instance (KnownSymbol s, ToSchema a, ToSchema b) => ToSchema (WithField s a b) where + declareNamedSchema _ = do + NamedSchema n s <- declareNamedSchema (Proxy :: Proxy b) + if s ^. type_ == SwaggerObject then inline n s + else wrapper n s + where + field = T.pack $ symbolVal (Proxy :: Proxy s) + namePrefix = "WithField '" <> field <> "' " + wrapper n s = do + indexSchema <- declareSchema (Proxy :: Proxy a) + return $ NamedSchema (fmap (namePrefix <>) n) $ mempty + & type_ .~ SwaggerObject + & properties .~ + [ (field, Inline indexSchema) + , ("value", Inline s) + ] + & required .~ [ field, "value" ] + inline n s = do + indexSchema <- declareSchema (Proxy :: Proxy a) + return $ NamedSchema (fmap (namePrefix <>) n) $ s + & properties %~ ([(field, Inline indexSchema)] <>) + & required %~ ([field] <>) + +-- | Merge fields of 'a' into 'b', more general version of 'WithField'. +-- +-- The usual mode of the data type assumes that 'ToJSON' instances of 'a' and 'b' +-- produce 'Object' subtype of aeson 'Value'. If it is not true, a wrapper +-- layer is introduced. +-- +-- If 'a' is not a 'Object', the wrapper contains 'injected' field with body of 'a'. +-- If 'b' is not a 'Object', the wrapper contains 'value' field with body of 'b'. +-- If both are not 'Object', the wrapper contains 'injected' and 'value' keys with +-- 'a' and 'b' respectively. +data WithFields a b = WithFields !a !b + deriving (Generic, Eq, Show, Read) + +instance (NFData a, NFData b) => NFData (WithFields a b) + +-- | Note: the instance injects field only in 'Object' case. +-- In other cases it forms a wrapper around the 'Value' produced +-- by 'toJSON' of inner 'b' body. +-- +-- Example of wrapper when 'b' is not a 'Object', 'b' goes into "value" field: +-- +-- > { "field1": 0, "field2": "val", "value": [1, 2, 3] } +-- +-- Example of wrapper when 'a' is not a 'Object', but 'b' is. 'a' goes into +-- "injected" field: +-- +-- > { "field1": 0, "field2": "val", "injected": [1, 2, 3] } +-- +-- Example of wrapper when as 'a' is not a 'Object', as 'b' is not. 'a' goes into +-- "injected" field, 'b' goes into "value" field: +-- +-- > { "value": 42, "injected": [1, 2, 3] } +instance (ToJSON a, ToJSON b) => ToJSON (WithFields a b) where + toJSON (WithFields a b) = let + jsonb = toJSON b + jsona = toJSON a + in case jsonb of + Object bvs -> case jsona of + Object avs -> Object $ H.union avs bvs + _ -> Object $ H.insert "injected" jsona bvs + _ -> case jsona of + Object avs -> Object $ H.insert "value" jsonb avs + _ -> object [ + "injected" .= jsona + , "value" .= jsonb + ] + +-- | Note: the instance tries to parse the json as object with +-- additional field value, if it fails it assumes that it is a +-- wrapper produced by corresponding 'ToJSON' instance. +instance (FromJSON a, FromJSON b) => FromJSON (WithFields a b) where + parseJSON val@(Object o) = WithFields + <$> (parseJSON val <|> o .: "injected") + <*> (parseJSON val <|> o .: "value") + parseJSON _ = mzero + +-- | Note: the instance tries to generate schema of the json as object with +-- additional field value, if it fails it assumes that it is a +-- wrapper produced by corresponding 'ToJSON' instance. +instance (ToSchema a, ToSchema b) => ToSchema (WithFields a b) where + declareNamedSchema _ = do + NamedSchema nb sb <- declareNamedSchema (Proxy :: Proxy b) + NamedSchema na sa <- declareNamedSchema (Proxy :: Proxy a) + let newName = combinedName <$> na <*> nb + return . NamedSchema newName $ case (sa ^. type_ , sb ^. type_) of + (SwaggerObject, SwaggerObject) -> sa <> sb + (SwaggerObject, _) -> sa <> bwrapper sb + (_, SwaggerObject) -> awrapper sa <> sb + _ -> awrapper sa <> bwrapper sb + where + combinedName a b = "WithFields_" <> a <> "_" <> b + awrapper nas = mempty + & type_ .~ SwaggerObject + & properties .~ [ ("injected", Inline nas) ] + & required .~ [ "injected" ] + bwrapper nbs = mempty + & type_ .~ SwaggerObject + & properties .~ [ ("value", Inline nbs) ] + & required .~ [ "value" ] + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,256 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Main where + +import Control.Lens hiding ((.=)) +import Control.Monad +import Data.Aeson +import Data.Aeson.WithField +import Data.Swagger +import Data.Swagger.Internal.Schema +import Data.Text +import Data.Proxy +import Test.HUnit + +main :: IO () +main = runTestTT tests >> return () + where + tests = TestList [ + (TestLabel "WithField tests" withFieldTests) + , (TestLabel "WithFields tests" withFieldsTests) + ] + +data TestObj = TestObj !Text + deriving (Eq, Show) + +instance ToJSON TestObj where + toJSON (TestObj t) = object ["field" .= t] +instance FromJSON TestObj where + parseJSON (Object o) = TestObj <$> o .: "field" + parseJSON _ = mzero +instance ToSchema TestObj where + declareNamedSchema prx = do + t <- declareSchema (Proxy :: Proxy Text) + return $ NamedSchema (Just "TestObj") $ mempty + & type_ .~ SwaggerObject + & properties .~ [("field", Inline t)] + & required .~ ["field"] + +withFieldTests :: Test +withFieldTests = TestList [ + TestLabel "toJSON" testsToJSON + , TestLabel "fromJSON" testsFromJSON + , TestLabel "toSchema" testsToSchema + ] + where + testsToJSON = TestList [ + TestLabel "Inline mode: atomic field" $ TestCase $ 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 + 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 + 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 + 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 + 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 [ + "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 [ + "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 [ + "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 [ + "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 [ + "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 + 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 + 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 + 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 + 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 + let expected = [ + ("a", Inline $ toSchema (Proxy :: Proxy TestObj)) + , ("value", Inline $ toSchema (Proxy :: Proxy String))] + let actual = toSchema (Proxy :: Proxy (WithField "a" TestObj String)) + expected @=? (actual ^. properties) + ] + +data TestObj1 = TestObj1 !Text + deriving (Eq, Show) + +instance ToJSON TestObj1 where + toJSON (TestObj1 t) = object ["field1" .= t] +instance FromJSON TestObj1 where + parseJSON (Object o) = TestObj1 <$> o .: "field1" + parseJSON _ = mzero +instance ToSchema TestObj1 where + declareNamedSchema prx = do + t <- declareSchema (Proxy :: Proxy Text) + return $ NamedSchema (Just "TestObj1") $ mempty + & type_ .~ SwaggerObject + & properties .~ [("field1", Inline t)] + & required .~ ["field1"] + +data TestObj2 = TestObj2 !Text + deriving (Eq, Show) + +instance ToJSON TestObj2 where + toJSON (TestObj2 t) = object ["field2" .= t] +instance FromJSON TestObj2 where + parseJSON (Object o) = TestObj2 <$> o .: "field2" + parseJSON _ = mzero +instance ToSchema TestObj2 where + declareNamedSchema prx = do + t <- declareSchema (Proxy :: Proxy Text) + return $ NamedSchema (Just "TestObj2") $ mempty + & type_ .~ SwaggerObject + & properties .~ [("field2", Inline t)] + & required .~ ["field2"] + +withFieldsTests :: Test +withFieldsTests = TestList [ + TestLabel "toJSON" testsToJSON + , TestLabel "fromJSON" testsFromJSON + , TestLabel "toSchema" testsToSchema + ] + where + testsToJSON = TestList [ + TestLabel "Inline mode" $ TestCase $ 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 + 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 + 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 + 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 [ + "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 [ + "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 [ + "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 [ + "injected" .= ("val1" :: Text) + , "value" .= ("val2" :: Text)] + let actual = WithFields ("val1" :: Text) ("val2" :: Text) + expected @=? actual + ] + testsToSchema = TestList [ + TestLabel "Inline mode" $ TestCase $ 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 + 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 + 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 + 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) + ]