registry-aeson 0.2.3.0 → 0.2.3.1

raw patch · 9 files changed

+131/−18 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• registry-aeson.cabal +1/−1
• src/Data/Registry/Aeson/Decoder.hs +31/−0
• src/Data/Registry/Aeson/Encoder.hs +35/−1
• src/Data/Registry/Aeson/TH/Decoder.hs +1/−1
• src/Data/Registry/Aeson/TH/Encoder.hs +2/−2
• src/Data/Registry/Aeson/TH/TH.hs +10/−4
• test/Test/Data/Registry/Aeson/DataTypes.hs +12/−0
• test/Test/Data/Registry/Aeson/DecoderSpec.hs +17/−4
• test/Test/Data/Registry/Aeson/EncoderSpec.hs +22/−5

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           registry-aeson-version:        0.2.3.0+version:        0.2.3.1 synopsis:       Aeson encoders / decoders description:    This library provides encoders / decoders which can be easily customized for the Aeson format. category:       Data

@@ -17,6 +17,7 @@ where  import Data.Aeson+import Data.Map qualified as M import Data.Aeson.Key qualified as K import Data.Aeson.KeyMap qualified as KM import Data.ByteString.Lazy qualified as BL@@ -49,6 +50,11 @@       [] -> (,) <$> da o <*> db o   o -> (,) <$> da o <*> db o +newtype KeyDecoder a = KeyDecoder {decodeKeyAs :: Key -> Either Text a}++instance Functor KeyDecoder where+  fmap f (KeyDecoder d) = KeyDecoder (fmap f . d)+ -- * DECODING  -- | Use a Decoder to decode a ByteString into the desired type@@ -61,6 +67,15 @@         Right a -> pure a         Left e -> Left $ "Cannot decode the type '" <> toS (showType @a) <> "' >> " <> e +-- * CREATING KEY DECODERS++-- | Create a decoder for a key which can be read from text+decodeKey :: forall a. (Typeable a) => (Text -> Either Text a) -> Typed (KeyDecoder a)+decodeKey f = fun (keyDecoder f)++keyDecoder :: forall a. (Text -> Either Text a) -> KeyDecoder a+keyDecoder f = KeyDecoder $ f . K.toText+ -- * CREATING DECODERS  -- | Add a Decoder a to a registry of decoders when a Aeson a instance exists@@ -124,6 +139,14 @@   Array vs -> for (toList vs) a   _ -> Left . toS $ "not a list of " <> showType @a +decodeMapOf :: forall a b. (Typeable a, Ord a, Typeable b) => Typed (KeyDecoder a -> Decoder b -> Decoder (Map a b))+decodeMapOf = fun (mapOfDecoder @a @b)++mapOfDecoder :: forall a b. (Typeable a, Ord a, Typeable b) => KeyDecoder a -> Decoder b -> Decoder (Map a b)+mapOfDecoder (KeyDecoder a) (Decoder b) = Decoder $ \case+  Object vs -> M.fromList <$> for (KM.toList vs) (\(k, v) -> (,) <$> a k <*> b v)+  _ -> Left . toS $ "not a map of " <> showType @a <> " " <> showType @b+ -- | Add a Decoder (NonEmpty a) to a registry of decoders --   usage: decoders = decodeNonEmptyOf @a <: otherDecoders --   the list of otherDecoders must contain a Decoder a@@ -147,7 +170,15 @@ defaultDecoderOptions :: Registry _ _ defaultDecoderOptions =   fun defaultConstructorsDecoder+    <: fun textKeyDecoder+    <: fun stringKeyDecoder     <: val defaultOptions++textKeyDecoder :: KeyDecoder Text+textKeyDecoder = keyDecoder Right++stringKeyDecoder :: KeyDecoder String+stringKeyDecoder = keyDecoder (Right . toS)  -- * TEMPLATE HASKELL 

@@ -21,11 +21,13 @@ import Data.Aeson.KeyMap qualified as KM import Data.ByteString.Lazy qualified as BL (toStrict) import Data.Functor.Contravariant+import Data.Map qualified as M import Data.Registry import Data.Registry.Aeson.TH.Encoder import Data.Registry.Aeson.TH.ThOptions import Data.Vector qualified as V import Protolude hiding (Type, list)+import Prelude (String)  -- * ENCODER DATA TYPE @@ -34,6 +36,11 @@ instance Contravariant Encoder where   contramap f (Encoder a) = Encoder (a . f) +newtype KeyEncoder a = KeyEncoder {encodeAsKey :: a -> Key}++instance Contravariant KeyEncoder where+  contramap f (KeyEncoder a) = KeyEncoder (a . f)+ -- * ENCODE VALUES  encodeByteString :: Encoder a -> a -> ByteString@@ -42,6 +49,15 @@ encodeValue :: Encoder a -> a -> Value encodeValue (Encoder e) = fst . e +-- * CREATE KEY ENCODERS++-- | Make a key encoder from a function returning some text+encodeKey :: forall a. Typeable a => (a -> Text) -> Typed (KeyEncoder a)+encodeKey f = fun (keyEncoder f)++keyEncoder :: (a -> Text) -> KeyEncoder a+keyEncoder f = KeyEncoder $ K.fromString . toS . f+ -- * CREATE ENCODERS  -- | Create an Encoder from a function returning a Value@@ -95,6 +111,16 @@   let (ls1, ls2) = unzip (ea <$> as)   (array ls1, list identity ls2) +-- | Create an Encoder for a map a b+encodeMapOf :: forall a b. (Typeable a, Typeable b) => Typed (KeyEncoder a -> Encoder b -> Encoder (Map a b))+encodeMapOf = fun (mapOfEncoder @a @b)++mapOfEncoder :: KeyEncoder a -> Encoder b -> Encoder (Map a b)+mapOfEncoder ea (Encoder eb) = Encoder $ \ms -> do+  let ks = encodeAsKey ea <$> M.keys ms+  let (vs1, vs2) = unzip (eb <$> toList ms)+  (Object $ KM.fromList $ zip ks vs1, pairs $ foldMap (uncurry pair) (zip ks vs2))+ -- | Create an Encoder for a non-empty list (NonEmpty a) encodeNonEmptyOf :: forall a. (Typeable a) => Typed (Encoder a -> Encoder (NonEmpty a)) encodeNonEmptyOf = fun (nonEmptyOfEncoder @a)@@ -111,8 +137,16 @@ defaultEncoderOptions :: Registry _ _ defaultEncoderOptions =   fun defaultConstructorEncoder+    <: fun textKeyEncoder+    <: fun stringKeyEncoder     <: val defaultOptions +textKeyEncoder :: KeyEncoder Text+textKeyEncoder = KeyEncoder K.fromText++stringKeyEncoder :: KeyEncoder String+stringKeyEncoder = KeyEncoder K.fromString+ -- * BUILDING ENCODERS  -- | A ConstructorEncoder uses configuration options + type information extracted from@@ -267,4 +301,4 @@ valuesToObject fieldNames values = do   let (vs, es) = unzip values   let fieldNamesKeys = K.fromText <$> fieldNames-  (Object $ KM.fromList (zip fieldNamesKeys vs), pairs $ foldMap identity (uncurry pair <$> zip fieldNamesKeys es))+  (Object $ KM.fromList (zip fieldNamesKeys vs), pairs $ foldMap (uncurry pair) (zip fieldNamesKeys es))

@@ -90,7 +90,7 @@ makeMatchClause :: ThOptions -> Name -> [Type] -> Con -> MatchQ makeMatchClause thOptions typeName allTypes c = do   ts <- typesOf c-  constructorTypes <- fmap snd <$> indexConstructorTypes allTypes ts+  constructorTypes <- fmap (\(_,_,k) -> k) <$> indexConstructorTypes allTypes ts   cName <- makeName thOptions <$> nameOf c   let fieldsP = listP $ (\i -> varP $ mkName ("v" <> P.show i)) <$> constructorTypes   match

@@ -78,8 +78,8 @@   let types = listE $ litE . StringL . show <$> allTypes   fields <- fieldsOf c   let fieldNames = listE $ litE . StringL . show . makeName thOptions <$> fields-  let params = conP (mkName $ show cName) $ (\(_, n) -> varP (mkName $ "a" <> show n)) <$> constructorTypes-  let values = listE $ (\(_, n) -> appE (appE (varE $ mkName "encode") (varE (mkName $ "e" <> show n))) (varE (mkName $ "a" <> show n))) <$> constructorTypes+  let params = conP (mkName $ show cName) $ (\(_, n, _) -> varP (mkName $ "a" <> show n)) <$> constructorTypes+  let values = listE $ (\(_, n, k) -> appE (appE (varE $ mkName "encode") (varE (mkName $ "e" <> show k))) (varE (mkName $ "a" <> show n))) <$> constructorTypes   let encoded =         varE (mkName "encodeConstructor")           `appE` varE (mkName "ce")

@@ -1,4 +1,3 @@-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE PartialTypeSignatures #-} {-# OPTIONS_GHC -Wno-type-defaults #-} {-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}@@ -16,11 +15,18 @@ import Language.Haskell.TH.Syntax import Protolude hiding (Type) -indexConstructorTypes :: [Type] -> [Type] -> Q [(Type, Int)]+-- | From:+--    - the list of all the types of a data type+--    - the list of the parameters types for one of the constructors+--    Return:+--     - the type+--     - its index in the list of parameter types+--     - its index in the list of all the types+indexConstructorTypes :: [Type] -> [Type] -> Q [(Type, Int, Int)] indexConstructorTypes allTypes constructorTypes =-  for constructorTypes $ \t ->+  for (zip [0..] constructorTypes) $ \(n, t) ->     case elemIndex t allTypes of-      Just n -> pure (t, n)+      Just k -> pure (t, n, k)       Nothing -> fail $ "the type " <> show t <> " cannot be found in the list of all types " <> show allTypes  -- | Get the types of all the fields of a constructor

@@ -4,6 +4,7 @@ module Test.Data.Registry.Aeson.DataTypes where  import Data.Aeson+import Data.String import Data.Time import Protolude @@ -173,3 +174,14 @@  instance FromJSON TwoElemArraySumEncoding where   parseJSON = genericParseJSON twoElemArraySumEncodingOptions++data Stats = Stats+  { s1 :: Int,+    s2 :: Int+  }+  deriving (Eq, Show)++newtype Name = Name {_name :: Text} deriving (Eq, Show, Ord)++instance IsString Name where+  fromString = Name . toS

@@ -1,16 +1,17 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE PartialTypeSignatures #-} {-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}  module Test.Data.Registry.Aeson.DecoderSpec where  import Data.Aeson hiding (decode)-import qualified Data.Aeson as A-import qualified Data.ByteString.Lazy as BL (ByteString, fromStrict)+import Data.Aeson qualified as A+import Data.ByteString.Lazy qualified as BL (ByteString, fromStrict) import Data.Registry import Data.Registry.Aeson.Decoder-import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import Data.Text qualified as T+import Data.Text.Encoding qualified as T import Data.Time import Protolude import Test.Data.Registry.Aeson.DataTypes@@ -122,6 +123,18 @@     reject {sumEncoding = ObjectWithSingleField}     "{'InPerson':[{'email':{'_email':'me@here.com'},'identifier':123,'f1':1,'f2':1},{'_datetime':'2022-04-18T00:00:12Z'}]}"     "Cannot decode the type 'Delivery' >> (InPerson) unknown fields: f1, f2"++test_decode_map = test "decode map" $ do+  let ds =+        decodeMapOf @Name @Int+          <: decodeKey (Right . Name)+          <: jsonDecoder @Int+          <: jsonDecoder @Text+          <: defaultDecoderOptions++  case decodeByteString (make @(Decoder (Map Name Int)) ds) "{\"name1\":1,\"name2\":2}" of+    Left e -> annotateShow e >> failure+    Right a -> a === [("name1", 1), ("name2", 2)]  -- * HELPERS 

@@ -8,12 +8,12 @@ module Test.Data.Registry.Aeson.EncoderSpec where  import Data.Aeson hiding (encode)-import qualified Data.Aeson as A-import qualified Data.ByteString.Lazy as BL (fromStrict, toStrict)+import Data.Aeson qualified as A+import Data.ByteString.Lazy qualified as BL (fromStrict, toStrict) import Data.Registry import Data.Registry.Aeson.Encoder-import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import Data.Text qualified as T+import Data.Text.Encoding qualified as T import Data.Time import Protolude import Test.Data.Registry.Aeson.DataTypes@@ -57,12 +57,29 @@ test_two_elem_array_sum_encoding = test "TwoElemArray" $ do   checkEncodingsWith twoElemArraySumEncodingOptions (TwoElemArraySumEncoding1 123) "['TwoElemArraySumEncoding1',{'teaField1':123}]" +test_types_th_index_error = test "error with TH when 2 fields have the same type" $ do+  -- this code did not compile before+  let _ = $(makeEncoder ''Stats) <: jsonEncoder @Int <: defaultEncoderOptions+  success++test_encode_map = test "encode maps" $ do+  let es =+        encodeMapOf @Name @Int+          <: jsonEncoder @Int+          <: jsonEncoder @Text+          <: encodeKey _name+          <: defaultEncoderOptions+  let bs = encodeByteString (make @(Encoder (Map Name Int)) es) [("name1", 1), ("name2", 2)]++  -- we check both the encoding and the application of the Options for+  checkValue bs "{\"name1\":1,\"name2\":2}"+ -- * HELPERS  encoders :: Registry _ _ encoders =   $(makeEncoder ''Delivery)-      -- test that it is possible to generate an Encoder when there are name clashes+    -- test that it is possible to generate an Encoder when there are name clashes     <: $(makeEncoderQualifiedLast ''SimilarDataTypes.Person)     <: $(makeEncoderQualifiedLast ''SimilarDataTypes.Email)     <: $(makeEncoderQualifiedLast ''SimilarDataTypes.Identifier)