From 7eb8fed88d38c6701be7ad99572fcf5e999ab51d Mon Sep 17 00:00:00 2001 From: parsonsmatt <parsonsmatt@gmail.com> Date: Mon, 5 Feb 2024 17:50:41 -0700 Subject: [PATCH 1/6] ok --- .../Database/Persist/Class/PersistField.hs | 63 ++++++++++--------- 1 file changed, 32 insertions(+), 31 deletions(-) diff --git a/persistent/Database/Persist/Class/PersistField.hs b/persistent/Database/Persist/Class/PersistField.hs index 560df6e77..1220e9e6a 100644 --- a/persistent/Database/Persist/Class/PersistField.hs +++ b/persistent/Database/Persist/Class/PersistField.hs @@ -33,6 +33,7 @@ import Numeric.Natural (Natural) import Text.Blaze.Html import Text.Blaze.Html.Renderer.Text (renderHtml) import GHC.TypeLits +import Data.Ratio (numerator, denominator) import Database.Persist.Types.Base @@ -135,49 +136,49 @@ instance PersistField Html where instance PersistField Int where toPersistValue = PersistInt64 . fromIntegral - fromPersistValue (PersistInt64 i) = Right $ fromIntegral i - fromPersistValue (PersistDouble i) = Right (truncate i :: Int) -- oracle - fromPersistValue x = Left $ fromPersistValueError "Int" "integer" x + fromPersistValue = fromPersistValueIntegral "Int" "integer" instance PersistField Int8 where toPersistValue = PersistInt64 . fromIntegral - fromPersistValue (PersistInt64 i) = Right $ fromIntegral i - fromPersistValue (PersistDouble i) = Right (truncate i :: Int8) -- oracle - fromPersistValue (PersistByteString bs) = case readInt bs of -- oracle - Just (i,"") -> Right $ fromIntegral i - Just (i,extra) -> Left $ extraInputError "Int64" bs i extra - Nothing -> Left $ intParseError "Int64" bs - fromPersistValue x = Left $ fromPersistValueError "Int8" "integer" x + fromPersistValue = fromPersistValueIntegral "Int8" "integer" instance PersistField Int16 where toPersistValue = PersistInt64 . fromIntegral - fromPersistValue (PersistInt64 i) = Right $ fromIntegral i - fromPersistValue (PersistDouble i) = Right (truncate i :: Int16) -- oracle - fromPersistValue (PersistByteString bs) = case readInt bs of -- oracle - Just (i,"") -> Right $ fromIntegral i - Just (i,extra) -> Left $ extraInputError "Int64" bs i extra - Nothing -> Left $ intParseError "Int64" bs - fromPersistValue x = Left $ fromPersistValueError "Int16" "integer" x + fromPersistValue = fromPersistValueIntegral "Int16" "integer" instance PersistField Int32 where toPersistValue = PersistInt64 . fromIntegral - fromPersistValue (PersistInt64 i) = Right $ fromIntegral i - fromPersistValue (PersistDouble i) = Right (truncate i :: Int32) -- oracle - fromPersistValue (PersistByteString bs) = case readInt bs of -- oracle - Just (i,"") -> Right $ fromIntegral i - Just (i,extra) -> Left $ extraInputError "Int64" bs i extra - Nothing -> Left $ intParseError "Int64" bs - fromPersistValue x = Left $ fromPersistValueError "Int32" "integer" x + fromPersistValue = fromPersistValueIntegral "Int32" "integer" instance PersistField Int64 where toPersistValue = PersistInt64 - fromPersistValue (PersistInt64 i) = Right i - fromPersistValue (PersistDouble i) = Right (truncate i :: Int64) -- oracle - fromPersistValue (PersistByteString bs) = case readInt bs of -- oracle - Just (i,"") -> Right $ fromIntegral i - Just (i,extra) -> Left $ extraInputError "Int64" bs i extra - Nothing -> Left $ intParseError "Int64" bs - fromPersistValue x = Left $ fromPersistValueError "Int64" "integer" x + fromPersistValue = fromPersistValueIntegral "Int64" "integer" + +fromPersistValueIntegral :: Integral a => Text -> Text -> PersistValue -> Either Text a +fromPersistValueIntegral haskellType sqlType pv = case pv of + PersistInt64 i -> + Right (fromIntegral i) + PersistDouble i -> + Right $ truncate i -- oracle + PersistRational i -> + case denominator i of + 1 -> + Right $ fromIntegral $ numerator i + _denom -> + boom + PersistByteString bs -> + case readInt bs of -- oracle + Just (i,"") -> + Right $ fromIntegral i + Just (i,extra) -> + Left $ extraInputError haskellType bs i extra + Nothing -> + Left $ intParseError haskellType bs + _ -> + boom + where + boom = + Left $ fromPersistValueError haskellType sqlType pv extraInputError :: (Show result) => Text -- ^ Haskell type From 2346020cee2c02549f3b24e847570220d5732e20 Mon Sep 17 00:00:00 2001 From: parsonsmatt <parsonsmatt@gmail.com> Date: Mon, 5 Feb 2024 17:54:23 -0700 Subject: [PATCH 2/6] k --- stack.yaml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/stack.yaml b/stack.yaml index cc3a58e26..6988c907d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -9,3 +9,6 @@ packages: - ./persistent-postgresql - ./persistent-redis - ./persistent-qq + +extra-deps: + - attoparsec-aeson-2.1.0.0 From 5eda212446abca4dc89cf789fca6beb84ab245a7 Mon Sep 17 00:00:00 2001 From: parsonsmatt <parsonsmatt@gmail.com> Date: Tue, 6 Feb 2024 08:50:03 -0700 Subject: [PATCH 3/6] sigh --- cabal.project | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cabal.project b/cabal.project index 76dc711de..a4e21dc7a 100644 --- a/cabal.project +++ b/cabal.project @@ -8,6 +8,9 @@ packages: persistent-redis persistent-qq +constraints: + mongoDB < 2.7.1.3 + -- GHC 9.4 shims for persistent -- These need hackage revisions but otherwise test fine in the repo From 18152a75ffe2a0323472f64b79a99d761eda8453 Mon Sep 17 00:00:00 2001 From: parsonsmatt <parsonsmatt@gmail.com> Date: Tue, 6 Feb 2024 08:50:35 -0700 Subject: [PATCH 4/6] sigh --- cabal.project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index a4e21dc7a..cc99a7fb9 100644 --- a/cabal.project +++ b/cabal.project @@ -9,7 +9,7 @@ packages: persistent-qq constraints: - mongoDB < 2.7.1.3 + mongoDB < 2.7.1.3 -- https://github.com/mongodb-haskell/mongodb/pull/152 -- GHC 9.4 shims for persistent From 1b6c4e71fc3af470acab443da000563ab0771e66 Mon Sep 17 00:00:00 2001 From: parsonsmatt <parsonsmatt@gmail.com> Date: Tue, 6 Feb 2024 09:12:14 -0700 Subject: [PATCH 5/6] omg --- cabal.project | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index cc99a7fb9..447eb5faa 100644 --- a/cabal.project +++ b/cabal.project @@ -9,7 +9,8 @@ packages: persistent-qq constraints: - mongoDB < 2.7.1.3 -- https://github.com/mongodb-haskell/mongodb/pull/152 + -- https://github.com/mongodb-haskell/mongodb/pull/152 + mongoDB < 2.7.1.3 -- GHC 9.4 shims for persistent From 609b56db759e3ea18062b999a5814a5cc7894a3c Mon Sep 17 00:00:00 2001 From: parsonsmatt <parsonsmatt@gmail.com> Date: Wed, 7 Feb 2024 16:43:50 -0700 Subject: [PATCH 6/6] Update changelog, cabal file --- persistent/ChangeLog.md | 7 +++++++ persistent/persistent.cabal | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index 9d5510f28..ceb25f41a 100644 --- a/persistent/ChangeLog.md +++ b/persistent/ChangeLog.md @@ -1,5 +1,12 @@ # Changelog for persistent +## 2.14.6.1 + +* [#1528](https://github.com/yesodweb/persistent/pull/1528) + * The `PersistField Int{,8,16,32,64}` instances will now work with a + `PersistRational`, provided that the denominator is 1. This fixes the bug + where `SUM` in Postgres would change the type of a column being summed. + ## 2.14.6.0 * [#1477](https://github.com/yesodweb/persistent/pull/1477) diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal index 605401cb9..e50010262 100644 --- a/persistent/persistent.cabal +++ b/persistent/persistent.cabal @@ -1,5 +1,5 @@ name: persistent -version: 2.14.6.0 +version: 2.14.6.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>