persistent 2.13.2.1 → 2.13.2.2
raw patch · 8 files changed
+73/−26 lines, 8 filesdep ~aeson
Dependency ranges changed: aeson
Files
- ChangeLog.md +5/−0
- Database/Persist/Class/PersistConfig.hs +11/−3
- Database/Persist/Class/PersistEntity.hs +9/−2
- Database/Persist/PersistValue.hs +28/−7
- Database/Persist/TH.hs +10/−3
- persistent.cabal +2/−2
- test/Database/Persist/TH/JsonEncodingSpec.hs +7/−8
- test/Database/Persist/THSpec.hs +1/−1
ChangeLog.md view
@@ -1,5 +1,10 @@ # Changelog for persistent +## 2.13.2.2++* [#1351](https://github.com/yesodweb/persistent/pull/1351/)+ * `aeson-2.0` support+ ## 2.13.2.1 * [#1329](https://github.com/yesodweb/persistent/pull/1329)
Database/Persist/Class/PersistConfig.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ module Database.Persist.Class.PersistConfig ( PersistConfig (..) ) where@@ -5,7 +7,13 @@ import Control.Monad.IO.Unlift (MonadUnliftIO) import Data.Aeson (Value (Object)) import Data.Aeson.Types (Parser)-import qualified Data.HashMap.Strict as HashMap++#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as AM+#else+import qualified Data.HashMap.Strict as AM+#endif+ import Data.Kind (Type) -- | Represents a value containing all the configuration options for a specific@@ -43,10 +51,10 @@ type PersistConfigPool (Either c1 c2) = PersistConfigPool c1 loadConfig (Object o) =- case HashMap.lookup "left" o of+ case AM.lookup "left" o of Just v -> Left <$> loadConfig v Nothing ->- case HashMap.lookup "right" o of+ case AM.lookup "right" o of Just v -> Right <$> loadConfig v Nothing -> fail "PersistConfig for Either: need either a left or right" loadConfig _ = fail "PersistConfig for Either: need an object"
Database/Persist/Class/PersistEntity.hs view
@@ -10,6 +10,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-} module Database.Persist.Class.PersistEntity ( PersistEntity (..)@@ -46,7 +47,13 @@ import Data.Aeson.Text (encodeToTextBuilder) import Data.Aeson.Types (Parser, Result(Error, Success)) import Data.Attoparsec.ByteString (parseOnly)-import qualified Data.HashMap.Strict as HM++#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as AM+#else+import qualified Data.HashMap.Strict as AM+#endif+ import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (isJust) import Data.Text (Text)@@ -288,7 +295,7 @@ -- @ entityIdToJSON :: (PersistEntity record, ToJSON record) => Entity record -> Value entityIdToJSON (Entity key value) = case toJSON value of- Object o -> Object $ HM.insert "id" (toJSON key) o+ Object o -> Object $ AM.insert "id" (toJSON key) o x -> x -- | Predefined @parseJSON@. The input JSON looks like
Database/Persist/PersistValue.hs view
@@ -1,12 +1,14 @@ {-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE CPP #-} -- | This module contains an intermediate representation of values before the -- backends serialize them into explicit database types. -- -- @since 2.13.0.0 module Database.Persist.PersistValue- ( module Database.Persist.PersistValue- , PersistValue(.., PersistLiteral, PersistLiteralEscaped, PersistDbSpecific)+ ( PersistValue(.., PersistLiteral, PersistLiteralEscaped, PersistDbSpecific)+ , fromPersistValueText+ , LiteralType(..) ) where import qualified Data.ByteString.Base64 as B64@@ -17,7 +19,6 @@ import qualified Data.Scientific import Data.Text.Encoding.Error (lenientDecode) import Data.Bits (shiftL, shiftR)-import Control.Arrow (second) import Numeric (readHex, showHex) import qualified Data.Text as Text import Data.Text (Text)@@ -26,7 +27,14 @@ import Web.PathPieces (PathPiece(..)) import qualified Data.Aeson as A import qualified Data.ByteString as BS-import qualified Data.HashMap.Strict as HM++#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as K+import qualified Data.Aeson.KeyMap as AM+#else+import qualified Data.HashMap.Strict as AM+#endif+ import Web.HttpApiData ( FromHttpApiData(..) , ToHttpApiData(..)@@ -124,6 +132,18 @@ {-# DEPRECATED PersistDbSpecific "Deprecated since 2.11 because of inconsistent escaping behavior across backends. The Postgres backend escapes these values, while the MySQL backend does not. If you are using this, please switch to 'PersistLiteral_' and provide a relevant 'LiteralType' for your conversion." #-} +keyToText :: Key -> Text+keyFromText :: Text -> Key+#if MIN_VERSION_aeson(2,0,0)+type Key = K.Key+keyToText = K.toText+keyFromText = K.fromText+#else+type Key = Text+keyToText = id+keyFromText = id+#endif+ instance ToHttpApiData PersistValue where toUrlPiece val = case fromPersistValueText val of@@ -174,7 +194,8 @@ toJSON (PersistDay d) = A.String $ Text.pack $ 'd' : show d toJSON PersistNull = A.Null toJSON (PersistList l) = A.Array $ V.fromList $ map A.toJSON l- toJSON (PersistMap m) = A.object $ map (second A.toJSON) m+ toJSON (PersistMap m) = A.object $ map go m+ where go (k, v) = (keyFromText k, A.toJSON v) toJSON (PersistLiteral_ litTy b) = let encoded = TE.decodeUtf8 $ B64.encode b prefix =@@ -247,7 +268,7 @@ parseJSON A.Null = return PersistNull parseJSON (A.Array a) = fmap PersistList (mapM A.parseJSON $ V.toList a) parseJSON (A.Object o) =- fmap PersistMap $ mapM go $ HM.toList o+ fmap PersistMap $ mapM go $ AM.toList o where- go (k, v) = (,) k <$> A.parseJSON v+ go (k, v) = (,) (keyToText k) <$> A.parseJSON v
Database/Persist/TH.hs view
@@ -82,6 +82,9 @@ , (.:?) , (.=) )+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as Key+#endif import qualified Data.ByteString as BS import Data.Char (toLower, toUpper) import Data.Coerce@@ -2636,7 +2639,11 @@ requireExtensions [[FlexibleInstances]] pureE <- [|pure|] apE' <- [|(<*>)|]- packE <- [|pack|]+#if MIN_VERSION_aeson(2,0,0)+ toKeyE <- [|Key.fromString|]+#else+ toKeyE <- [|pack|]+#endif dotEqualE <- [|(.=)|] dotColonE <- [|(.:)|] dotColonQE <- [|(.:?)|]@@ -2663,7 +2670,7 @@ where pairs = zipWith toPair fields xs toPair f x = InfixE- (Just (packE `AppE` LitE (StringL $ unpack $ unFieldNameHS $ unboundFieldNameHS f)))+ (Just (toKeyE `AppE` LitE (StringL $ unpack $ unFieldNameHS $ unboundFieldNameHS f))) dotEqualE (Just $ VarE x) fromJSONI =@@ -2684,7 +2691,7 @@ toPull f = InfixE (Just $ VarE obj) (if maybeNullable f then dotColonQE else dotColonE)- (Just $ AppE packE $ LitE $ StringL $ unpack $ unFieldNameHS $ unboundFieldNameHS f)+ (Just $ AppE toKeyE $ LitE $ StringL $ unpack $ unFieldNameHS $ unboundFieldNameHS f) case mpsEntityJSON mps of Nothing -> return [toJSONI, fromJSONI]
persistent.cabal view
@@ -1,5 +1,5 @@ name: persistent-version: 2.13.2.1+version: 2.13.2.2 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -17,7 +17,7 @@ library build-depends: base >= 4.11.1.0 && < 5- , aeson >= 1.0+ , aeson >= 1.0 && < 2.1 , attoparsec , base64-bytestring , blaze-html >= 0.9
test/Database/Persist/TH/JsonEncodingSpec.hs view
@@ -19,7 +19,6 @@ import TemplateTestImports import Data.Aeson-import qualified Data.HashMap.Lazy as M import Data.Text (Text) import Test.QuickCheck.Instances () import Test.Hspec.QuickCheck@@ -73,15 +72,15 @@ it "encodes without an ID field" $ do toJSON subjectEntity `shouldBe`- Object (M.fromList+ object [ ("name", String "Bob") , ("age", toJSON (32 :: Int)) , ("id", String "Bob")- ])+ ] it "decodes without an ID field" $ do let- json_ = encode . Object . M.fromList $+ json_ = encode . object $ [ ("name", String "Bob") , ("age", toJSON (32 :: Int)) ]@@ -103,11 +102,11 @@ Entity (JsonEncodingKey jsonEncodingName) j toJSON ent `shouldBe`- Object (M.fromList+ object [ ("name", toJSON jsonEncodingName) , ("age", toJSON jsonEncodingAge) , ("id", toJSON jsonEncodingName)- ])+ ] prop "round trip works with composite key" $ \j@JsonEncoding2{..} -> do let@@ -125,9 +124,9 @@ Entity key j toJSON ent `shouldBe`- Object (M.fromList+ object [ ("name", toJSON jsonEncoding2Name) , ("age", toJSON jsonEncoding2Age) , ("blood", toJSON jsonEncoding2Blood) , ("id", toJSON key)- ])+ ]
test/Database/Persist/THSpec.hs view
@@ -24,7 +24,7 @@ module Database.Persist.THSpec where import Control.Applicative (Const(..))-import Data.Aeson+import Data.Aeson hiding (Key) import Data.ByteString.Lazy.Char8 () import Data.Coerce import Data.Functor.Identity (Identity(..))