diff --git a/registry-aeson.cabal b/registry-aeson.cabal --- a/registry-aeson.cabal +++ b/registry-aeson.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: registry-aeson -version: 0.2.3.3 +version: 0.3.0.0 synopsis: Aeson encoders / decoders description: This library provides encoders / decoders which can be easily customized for the Aeson format. category: Data @@ -53,7 +53,7 @@ , bytestring >=0.10 && <1 , containers >=0.2 && <1 , protolude ==0.3.* - , registry >=0.2 && <0.4 + , registry >=0.4 && <1 , template-haskell >=2.13 && <3.0 , text ==1.* , transformers >=0.5 && <2 @@ -69,6 +69,9 @@ Test.Data.Registry.Aeson.DataTypes Test.Data.Registry.Aeson.DecoderSpec Test.Data.Registry.Aeson.EncoderSpec + Test.Data.Registry.Aeson.Examples.Deliverix + Test.Data.Registry.Aeson.Examples.ProtocolEvolution + Test.Data.Registry.Aeson.Examples.Protocols Test.Data.Registry.Aeson.RecursiveSpec Test.Data.Registry.Aeson.RoundtripData Test.Data.Registry.Aeson.RoundtripSpec @@ -98,9 +101,10 @@ , containers >=0.2 && <1 , hedgehog , protolude ==0.3.* - , registry >=0.2 && <0.4 + , registry >=0.4 && <1 , registry-aeson , registry-hedgehog + , string-qq , tasty , template-haskell >=2.13 && <3.0 , text ==1.* diff --git a/test/Test/Data/Registry/Aeson/Examples/Deliverix.hs b/test/Test/Data/Registry/Aeson/Examples/Deliverix.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Registry/Aeson/Examples/Deliverix.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +module Test.Data.Registry.Aeson.Examples.Deliverix where + +import Protolude hiding (Product) + +{- + + Data model in its second incarnation + The initial version didn't have a coupon and the price was an Int + +-} + +data Delivery = Delivery + { customer :: Customer, + order :: Order + } + deriving (Eq, Show) + +data Order = Order + { price :: Price, + coupon :: Maybe Coupon, + items :: Map Int Product + } + deriving (Eq, Show) + +newtype Price = Price Double deriving (Eq, Show, Num) + +data Address = Address + { number :: StreetNumber, + street :: Text, + city :: Text + } + deriving (Eq, Show) + +newtype StreetNumber = StreetNumber { streetNumber :: Text } deriving (Eq, Show) + +data Customer = Customer + { customerName :: Text, + customerAddress :: Address + } + deriving (Eq, Show) + +data Product + = Pizza + | Sushis + | Tandoori + deriving (Eq, Show) + +data Coupon + = FivePercentOff + | TenPercentOff + deriving (Eq, Show) + +newtype PriceV1 = PriceV1 Int + +data OrderV1 = OrderV1 + { price :: Price, + items :: Map Int Product + } + +data AddressV2 = AddressV2 + { number :: Int, + street :: Text, + city :: Text + } + deriving (Eq, Show) diff --git a/test/Test/Data/Registry/Aeson/Examples/ProtocolEvolution.hs b/test/Test/Data/Registry/Aeson/Examples/ProtocolEvolution.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Registry/Aeson/Examples/ProtocolEvolution.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE QuasiQuotes #-} +{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-} + +{- + This specification shows an example of an evolving data model + where we must still be able to read old serialized data. + + The data model describes a delivery service with customers and orders. + + The current version of the data model: + - adds a new feature: coupons + - fixes a modelling issue: street numbers + + Our protocol must still be able to accept values which were serialized with the previous data model + +-} +module Test.Data.Registry.Aeson.Examples.ProtocolEvolution where + +import Data.Registry +import Data.Registry.Aeson.Decoder +import Data.String.QQ +import Protolude +import Test.Data.Registry.Aeson.Examples.Deliverix +import Test.Data.Registry.Aeson.Examples.Protocols +import Test.Tasty.Hedgehogx + +test_current_protocol = test "values created for the current protocol can be decoded" $ do + let decoder = make @(Decoder Delivery) currentProtocol + checkOk $ + decodeByteString + decoder + [s| + {"customer": + {"customerName":"eric", + "customerAddress": { + "number":"21", + "street":"Jump St.", + "city": "LA" + } + }, + "order": { + "price":100.0, + "coupon": "TenPercentOff", + "items": { + "1": "Pizza" + } + } + } + |] + +test_protocol_v1 = test "values created for the old protocol can also be decoded" $ do + let decoder = make @(Decoder Delivery) protocolV1 + checkOk $ + decodeByteString + decoder + [s| + {"customer": + {"customerName":"eric", + "customerAddress": { + "number":21, + "street":"Jump St.", + "city": "LA" + } + }, + "order": { + "price":100, + "items": { + "1": "Pizza" + } + } + } + |] + +-- * HELPERS + +checkOk :: Either Text a -> PropertyT IO () +checkOk (Left e) = withFrozenCallStack $ annotateShow e >> failure +checkOk (Right _) = success diff --git a/test/Test/Data/Registry/Aeson/Examples/Protocols.hs b/test/Test/Data/Registry/Aeson/Examples/Protocols.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/Registry/Aeson/Examples/Protocols.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-} + +module Test.Data.Registry.Aeson.Examples.Protocols where + +import Data.Aeson hiding (encode) +import Data.Registry +import Data.Registry.Aeson.Decoder +import Protolude hiding (Product) +import Test.Data.Registry.Aeson.Examples.Deliverix + +-- | This protocol is defined for the current data model +currentProtocol :: Registry _ _ +currentProtocol = + $(makeDecoder ''Delivery) + <: $(makeDecoder ''Order) + <: decodeMapOf @Int @Product + <: decodeMaybeOf @Coupon + <: $(makeDecoder ''Coupon) + <: $(makeDecoder ''Product) + <: $(makeDecoder ''Customer) + <: $(makeDecoder ''Address) + <: $(makeDecoder ''StreetNumber) + <: $(makeDecoder ''Price) + <: jsonDecoder @Text + <: decodeKey @Int parseInt + <: decodeMaybeOf @Double + <: jsonDecoder @Double + <: val (defaultOptions {unwrapUnaryRecords = True}) -- to unwrap StreetNumber + <: defaultDecoderOptions + +-- | The first version of the protocol did not have coupons +-- And street numbers were implemented as an Int (but street numbers can also have letters) +-- In this registry we specify how existing decoders need to be modified / extended in order to be +-- able to still read old values +protocolV1 :: Registry _ _ +protocolV1 = + val (defaultOptions {omitNothingFields = True}) -- to allow for missing coupons + <: fun streetNumberDecoder + <: jsonDecoder @Int + <: currentProtocol + +-- | A street number used to be a single Int +streetNumberDecoder :: Decoder Int -> Decoder StreetNumber +streetNumberDecoder = fmap (StreetNumber . show) + +-- | Read map keys that are Ints +parseInt :: Text -> Either Text Int +parseInt t = maybe (Left $ "the key " <> t <> " is not an Int") Right (readMaybe t)