diff --git a/persistent-mysql/Database/Persist/MySQL.hs b/persistent-mysql/Database/Persist/MySQL.hs index 4f3476abb..c29751819 100644 --- a/persistent-mysql/Database/Persist/MySQL.hs +++ b/persistent-mysql/Database/Persist/MySQL.hs @@ -320,7 +320,7 @@ getGetter field = go (MySQLBase.fieldType field) -- Controversial conversions go MySQLBase.Set _ _ = convertPV PersistText go MySQLBase.Enum _ _ = convertPV PersistText - -- Conversion using PersistDbSpecific + -- Conversion using PersistLiteral go MySQLBase.Geometry _ _ = \_ m -> case m of Just g -> PersistLiteral g diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 459d69ffc..30e56e872 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -6,7 +6,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -fno-warn-deprecations #-} -- Pattern match 'PersistDbSpecific' -- | A postgresql backend for persistent. module Database.Persist.Postgresql diff --git a/persistent-redis/ChangeLog.md b/persistent-redis/ChangeLog.md index 4fface158..0d5669fdb 100644 --- a/persistent-redis/ChangeLog.md +++ b/persistent-redis/ChangeLog.md @@ -1,3 +1,8 @@ +## 2.12.0.1 (unreleased) + +* [#1123](https://github.com/yesodweb/persistent/pull/1223): + * Changed the error message from trying to serialize a `PersistDbSpecific` value into `PersistLiteral_`. + ## 2.12.0.0 * Decomposed `HaskellName` into `ConstraintNameHS`, `EntityNameHS`, `FieldNameHS`. Decomposed `DBName` into `ConstraintNameDB`, `EntityNameDB`, `FieldNameDB` respectively. [#1174](https://github.com/yesodweb/persistent/pull/1174) diff --git a/persistent-redis/Database/Persist/Redis/Parser.hs b/persistent-redis/Database/Persist/Redis/Parser.hs index 5e74b976c..4f878d4de 100644 --- a/persistent-redis/Database/Persist/Redis/Parser.hs +++ b/persistent-redis/Database/Persist/Redis/Parser.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -fno-warn-deprecations #-} -- Pattern match 'PersistDbSpecific' module Database.Persist.Redis.Parser ( redisToPerisistValues , toValue @@ -128,9 +127,7 @@ instance Binary BinPersistValue where put x put (BinPersistValue (PersistArray _)) = throw $ NotSupportedValueType "PersistArray" - put (BinPersistValue (PersistDbSpecific _)) = throw $ NotSupportedValueType "PersistDbSpecific" - put (BinPersistValue (PersistLiteral _)) = throw $ NotSupportedValueType "PersistLiteral" - put (BinPersistValue (PersistLiteralEscaped _)) = throw $ NotSupportedValueType "PersistLiteralEscaped" + put (BinPersistValue (PersistLiteral_ _ _)) = throw $ NotSupportedValueType "PersistLiteral_" put (BinPersistValue (PersistObjectId _)) = throw $ NotSupportedValueType "PersistObjectId" get = do diff --git a/persistent-redis/persistent-redis.cabal b/persistent-redis/persistent-redis.cabal index 89dac54d9..8a52ecb4f 100644 --- a/persistent-redis/persistent-redis.cabal +++ b/persistent-redis/persistent-redis.cabal @@ -1,5 +1,5 @@ name: persistent-redis -version: 2.12.0.0 +version: 2.12.0.1 license: BSD3 license-file: LICENSE author: Pavel Ryzhov diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index 0e2ada329..87913f4d3 100644 --- a/persistent/ChangeLog.md +++ b/persistent/ChangeLog.md @@ -1,5 +1,10 @@ # Changelog for persistent +## 2.12.0.2 + +* [#1123](https://github.com/yesodweb/persistent/pull/1223) + * Fix JSON encoding for `PersistValue` + ## 2.12.0.1 * Refactoring token parsing in quasi module [#1206](https://github.com/yesodweb/persistent/pull/1206) diff --git a/persistent/Database/Persist/Class/PersistField.hs b/persistent/Database/Persist/Class/PersistField.hs index dce25f32c..8f559aab7 100644 --- a/persistent/Database/Persist/Class/PersistField.hs +++ b/persistent/Database/Persist/Class/PersistField.hs @@ -3,7 +3,6 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternGuards, DataKinds, TypeOperators, UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-deprecations #-} -- Pattern match 'PersistDbSpecific' module Database.Persist.Class.PersistField ( PersistField (..) , SomePersistField (..) @@ -113,9 +112,7 @@ instance {-# OVERLAPPING #-} PersistField [Char] where fromPersistValue (PersistBool b) = Right $ Prelude.show b fromPersistValue (PersistList _) = Left $ T.pack "Cannot convert PersistList to String" fromPersistValue (PersistMap _) = Left $ T.pack "Cannot convert PersistMap to String" - fromPersistValue (PersistDbSpecific _) = Left $ T.pack "Cannot convert PersistDbSpecific to String" - fromPersistValue (PersistLiteralEscaped _) = Left $ T.pack "Cannot convert PersistLiteralEscaped to String" - fromPersistValue (PersistLiteral _) = Left $ T.pack "Cannot convert PersistLiteral to String" + fromPersistValue (PersistLiteral_ _ _) = Left $ T.pack "Cannot convert PersistLiteral_ to String" fromPersistValue (PersistArray _) = Left $ T.pack "Cannot convert PersistArray to String" fromPersistValue (PersistObjectId _) = Left $ T.pack "Cannot convert PersistObjectId to String" #endif diff --git a/persistent/Database/Persist/Sql/Class.hs b/persistent/Database/Persist/Sql/Class.hs index 4a3df33be..9a4aa9a71 100644 --- a/persistent/Database/Persist/Sql/Class.hs +++ b/persistent/Database/Persist/Sql/Class.hs @@ -1135,12 +1135,12 @@ extractMaybe = fromMaybe (error "Database.Persist.GenericSql.extractMaybe") -- @ -- import qualified Data.UUID as UUID -- instance 'PersistField' UUID where --- 'toPersistValue' = 'PersistDbSpecific' . toASCIIBytes --- 'fromPersistValue' ('PersistDbSpecific' uuid) = +-- 'toPersistValue' = 'PersistLiteralEncoded' . toASCIIBytes +-- 'fromPersistValue' ('PersistLiteralEncoded' uuid) = -- case fromASCIIBytes uuid of -- 'Nothing' -> 'Left' $ "Model/CustomTypes.hs: Failed to deserialize a UUID; received: " <> T.pack (show uuid) -- 'Just' uuid' -> 'Right' uuid' --- 'fromPersistValue' x = Left $ "File.hs: When trying to deserialize a UUID: expected PersistDbSpecific, received: "-- > <> T.pack (show x) +-- 'fromPersistValue' x = Left $ "File.hs: When trying to deserialize a UUID: expected PersistLiteralEncoded, received: "-- > <> T.pack (show x) -- -- instance 'PersistFieldSql' UUID where -- 'sqlType' _ = 'SqlOther' "uuid" diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs index 1c92fc2b6..1f6054bc2 100644 --- a/persistent/Database/Persist/Types/Base.hs +++ b/persistent/Database/Persist/Types/Base.hs @@ -637,9 +637,7 @@ fromPersistValueText (PersistList _) = Left "Cannot convert PersistList to Text" fromPersistValueText (PersistMap _) = Left "Cannot convert PersistMap to Text" fromPersistValueText (PersistObjectId _) = Left "Cannot convert PersistObjectId to Text" fromPersistValueText (PersistArray _) = Left "Cannot convert PersistArray to Text" -fromPersistValueText (PersistDbSpecific _) = Left "Cannot convert PersistDbSpecific to Text" -fromPersistValueText (PersistLiteral _) = Left "Cannot convert PersistLiteral to Text" -fromPersistValueText (PersistLiteralEscaped _) = Left "Cannot convert PersistLiteralEscaped to Text" +fromPersistValueText (PersistLiteral_ _ _) = Left "Cannot convert PersistLiteral to Text" instance A.ToJSON PersistValue where toJSON (PersistText t) = A.String $ T.cons 's' t @@ -654,9 +652,15 @@ instance A.ToJSON PersistValue where 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 (PersistDbSpecific b) = A.String $ T.cons 'p' $ TE.decodeUtf8 $ B64.encode b - toJSON (PersistLiteral b) = A.String $ T.cons 'l' $ TE.decodeUtf8 $ B64.encode b - toJSON (PersistLiteralEscaped b) = A.String $ T.cons 'e' $ TE.decodeUtf8 $ B64.encode b + toJSON (PersistLiteral_ litTy b) = + let encoded = TE.decodeUtf8 $ B64.encode b + prefix = + case litTy of + DbSpecific -> 'p' + Unescaped -> 'l' + Escaped -> 'e' + in + A.String $ T.cons prefix encoded toJSON (PersistArray a) = A.Array $ V.fromList $ map A.toJSON a toJSON (PersistObjectId o) = A.toJSON $ showChar 'o' $ showHexLen 8 (bs2i four) $ showHexLen 16 (bs2i eight) "" diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal index a7d473510..26f1c9d27 100644 --- a/persistent/persistent.cabal +++ b/persistent/persistent.cabal @@ -1,5 +1,5 @@ name: persistent -version: 2.12.0.1 +version: 2.12.0.2 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/persistent/test/main.hs b/persistent/test/main.hs index 6dd534b58..67a2c73e0 100644 --- a/persistent/test/main.hs +++ b/persistent/test/main.hs @@ -18,6 +18,8 @@ import Data.Semigroup ((<>)) #endif import Data.Time import Text.Shakespeare.Text +import Data.Aeson +import qualified Data.ByteString.Char8 as BS8 import Database.Persist.Class.PersistField import Database.Persist.Quasi @@ -870,6 +872,34 @@ Baz fromPersistValue (PersistText "2018-02-27 10:49:42.123") `shouldBe` Right (UTCTime (fromGregorian 2018 02 27) (timeOfDayToTime (TimeOfDay 10 49 42.123))) + describe "PersistValue" $ do + describe "Aeson" $ do + let + testPrefix constr prefixChar bytes = + takePrefix (toJSON (constr (BS8.pack bytes))) + === + String (T.singleton prefixChar) + roundTrip constr bytes = + fromJSON (toJSON (constr (BS8.pack bytes))) + === + Data.Aeson.Success (constr (BS8.pack bytes)) + subject constr prefixChar = do + prop ("encodes with a " ++ [prefixChar] ++ " prefix") $ + testPrefix constr prefixChar + prop "Round Trips" $ + roundTrip constr + + describe "PersistDbSpecific" $ do + subject PersistDbSpecific 'p' + describe "PersistLiteral" $ do + subject PersistLiteral 'l' + describe "PersistLiteralEscaped" $ do + subject PersistLiteralEscaped 'e' + +takePrefix :: Value -> Value +takePrefix (String a) = String (T.take 1 a) +takePrefix a = a + asTokens :: [T.Text] -> [Token] asTokens = fmap Token