From 6748884e47ac260d94f5cb4b430c478950adf9f3 Mon Sep 17 00:00:00 2001 From: Daan Rijks Date: Wed, 3 May 2023 15:51:57 +0200 Subject: [PATCH 1/2] Support deserialising Word (and Word8 etc.) from PersistDouble --- persistent/Database/Persist/Class/PersistField.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/persistent/Database/Persist/Class/PersistField.hs b/persistent/Database/Persist/Class/PersistField.hs index 560df6e77..68e3b156e 100644 --- a/persistent/Database/Persist/Class/PersistField.hs +++ b/persistent/Database/Persist/Class/PersistField.hs @@ -209,26 +209,31 @@ intParseError haskellType original = T.concat instance PersistField Data.Word.Word where toPersistValue = PersistInt64 . fromIntegral fromPersistValue (PersistInt64 i) = Right $ fromIntegral i + fromPersistValue (PersistDouble i) = Right $ truncate i fromPersistValue x = Left $ fromPersistValueError "Word" "integer" x instance PersistField Word8 where toPersistValue = PersistInt64 . fromIntegral fromPersistValue (PersistInt64 i) = Right $ fromIntegral i + fromPersistValue (PersistDouble i) = Right $ truncate i fromPersistValue x = Left $ fromPersistValueError "Word8" "integer" x instance PersistField Word16 where toPersistValue = PersistInt64 . fromIntegral fromPersistValue (PersistInt64 i) = Right $ fromIntegral i + fromPersistValue (PersistDouble i) = Right $ truncate i fromPersistValue x = Left $ fromPersistValueError "Word16" "integer" x instance PersistField Word32 where toPersistValue = PersistInt64 . fromIntegral fromPersistValue (PersistInt64 i) = Right $ fromIntegral i + fromPersistValue (PersistDouble i) = Right $ truncate i fromPersistValue x = Left $ fromPersistValueError "Word32" "integer" x instance PersistField Word64 where toPersistValue = PersistInt64 . fromIntegral fromPersistValue (PersistInt64 i) = Right $ fromIntegral i + fromPersistValue (PersistDouble i) = Right $ truncate i fromPersistValue x = Left $ fromPersistValueError "Word64" "integer" x instance PersistField Double where From a4c72ce5cfec553e8b50178031be47f5ff9fdf4c Mon Sep 17 00:00:00 2001 From: Daan Rijks Date: Wed, 3 May 2023 16:31:19 +0200 Subject: [PATCH 2/2] Run stylish-haskell on Database.Persist.Class.PersistField --- persistent/ChangeLog.md | 7 ++++++ .../Database/Persist/Class/PersistField.hs | 24 ++++++++++--------- persistent/persistent.cabal | 2 +- 3 files changed, 21 insertions(+), 12 deletions(-) diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index 9ad9967aa..2857ffcf4 100644 --- a/persistent/ChangeLog.md +++ b/persistent/ChangeLog.md @@ -1,5 +1,12 @@ # Changelog for persistent +## 2.14.5.1 + +* [#1491](https://github.com/yesodweb/persistent/pull/1491) + * Change `PersistField` instance for `Word`, `Word64`, etc. to allow + deserialising from `PersistDouble` values, by truncating the floating + point value. + ## 2.14.5.0 * [#1469](https://github.com/yesodweb/persistent/pull/1469) diff --git a/persistent/Database/Persist/Class/PersistField.hs b/persistent/Database/Persist/Class/PersistField.hs index 68e3b156e..f2db3433d 100644 --- a/persistent/Database/Persist/Class/PersistField.hs +++ b/persistent/Database/Persist/Class/PersistField.hs @@ -1,44 +1,46 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE PatternGuards, DataKinds, TypeOperators, UndecidableInstances, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Database.Persist.Class.PersistField ( PersistField (..) , getPersistMap , OverflowNatural(..) ) where +import Control.Applicative ((<|>)) import Control.Arrow (second) import Control.Monad ((<=<)) -import Control.Applicative ((<|>)) import qualified Data.Aeson as A -import Data.ByteString.Char8 (ByteString, unpack, readInt) +import Data.ByteString.Char8 (ByteString, readInt, unpack) import qualified Data.ByteString.Lazy as L import Data.Fixed -import Data.Int (Int8, Int16, Int32, Int64) +import Data.Int (Int16, Int32, Int64, Int8) import qualified Data.IntMap as IM import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as M import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Read (double) import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TERR import qualified Data.Text.Lazy as TL +import Data.Text.Read (double) import qualified Data.Vector as V -import Data.Word (Word, Word8, Word16, Word32, Word64) +import Data.Word (Word, Word16, Word32, Word64, Word8) +import GHC.TypeLits import Numeric.Natural (Natural) import Text.Blaze.Html import Text.Blaze.Html.Renderer.Text (renderHtml) -import GHC.TypeLits import Database.Persist.Types.Base -import Data.Time (Day(..), TimeOfDay, UTCTime, - parseTimeM) -import Data.Time (defaultTimeLocale) +import Data.Time (Day(..), TimeOfDay, UTCTime, defaultTimeLocale, parseTimeM) #ifdef HIGH_PRECISION_DATE import Data.Time.Clock.POSIX (posixSecondsToUTCTime) diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal index cfe446ebf..857cd8b47 100644 --- a/persistent/persistent.cabal +++ b/persistent/persistent.cabal @@ -1,5 +1,5 @@ name: persistent -version: 2.14.5.0 +version: 2.14.5.1 license: MIT license-file: LICENSE author: Michael Snoyman