persistent 2.12.0.1 → 2.12.0.2
raw patch · 6 files changed
+52/−16 lines, 6 files
Files
- ChangeLog.md +6/−1
- Database/Persist/Class/PersistField.hs +1/−4
- Database/Persist/Sql/Class.hs +3/−3
- Database/Persist/Types/Base.hs +10/−6
- persistent.cabal +2/−2
- test/main.hs +30/−0
ChangeLog.md view
@@ -1,6 +1,11 @@ # Changelog for persistent -## 2.12.0.1 (unreleased)+## 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) * Removing duplication from TH output [#1202](https://github.com/yesodweb/persistent/pull/1202)
Database/Persist/Class/PersistField.hs view
@@ -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 @@ 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
Database/Persist/Sql/Class.hs view
@@ -1135,12 +1135,12 @@ -- @ -- 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"
Database/Persist/Types/Base.hs view
@@ -637,9 +637,7 @@ 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 @@ 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) ""
persistent.cabal view
@@ -1,5 +1,5 @@ name: persistent-version: 2.12.0.1+version: 2.12.0.2 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -32,7 +32,7 @@ , resourcet >= 1.1.10 , scientific , silently- , template-haskell >= 2.11+ , template-haskell >= 2.11 && < 2.17 , text >= 1.2 , time >= 1.6 , transformers >= 0.5
test/main.hs view
@@ -18,6 +18,8 @@ #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@@ -869,6 +871,34 @@ it "works with format" $ 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