diff --git a/persistent-mongoDB/Database/Persist/MongoDB.hs b/persistent-mongoDB/Database/Persist/MongoDB.hs index d68e68966..a138949d1 100644 --- a/persistent-mongoDB/Database/Persist/MongoDB.hs +++ b/persistent-mongoDB/Database/Persist/MongoDB.hs @@ -1040,6 +1040,7 @@ instance DB.Val PersistValue where val (PersistByteString x) = DB.Bin (DB.Binary x) val x@(PersistObjectId _) = DB.ObjId $ persistObjectIdToDbOid x val (PersistTimeOfDay _) = throw $ PersistMongoDBUnsupported "PersistTimeOfDay not implemented for the MongoDB backend. only PersistUTCTime currently implemented" + val (PersistWord64 _) = throw $ PersistMongoDBUnsupported "PersistWord64 not implemented for the MongoDB backend" val (PersistRational _) = throw $ PersistMongoDBUnsupported "PersistRational not implemented for the MongoDB backend" val (PersistArray a) = DB.val $ PersistList a val (PersistDbSpecific _) = throw $ PersistMongoDBUnsupported "PersistDbSpecific not implemented for the MongoDB backend" diff --git a/persistent-mysql/Database/Persist/MySQL.hs b/persistent-mysql/Database/Persist/MySQL.hs index 973eabd57..87b94077d 100644 --- a/persistent-mysql/Database/Persist/MySQL.hs +++ b/persistent-mysql/Database/Persist/MySQL.hs @@ -225,6 +225,7 @@ instance MySQL.Param P where render (P (PersistText t)) = MySQL.render t render (P (PersistByteString bs)) = MySQL.render bs render (P (PersistInt64 i)) = MySQL.render i + render (P (PersistWord64 i)) = MySQL.render i render (P (PersistDouble d)) = MySQL.render d render (P (PersistBool b)) = MySQL.render b render (P (PersistDay d)) = MySQL.render d @@ -785,6 +786,7 @@ showSqlType SqlDay _ _ = "DATE" showSqlType SqlDayTime _ _ = "DATETIME" showSqlType SqlInt32 _ _ = "INT(11)" showSqlType SqlInt64 _ _ = "BIGINT" +showSqlType SqlWord64 _ _ = "NUMERIC(20,0)" -- length (show (maxBound :: Word64)) showSqlType SqlReal _ _ = "DOUBLE" showSqlType (SqlNumeric s prec) _ _ = "NUMERIC(" ++ show s ++ "," ++ show prec ++ ")" showSqlType SqlString Nothing True = "TEXT CHARACTER SET utf8mb4" diff --git a/persistent-postgresql/ChangeLog.md b/persistent-postgresql/ChangeLog.md index fdbaaa7fe..ee6cf1796 100644 --- a/persistent-postgresql/ChangeLog.md +++ b/persistent-postgresql/ChangeLog.md @@ -11,6 +11,8 @@ * added `runConn_` to run a db connection and return result * Renamed `db` to `runConnAssert` in `test/PgInit.hs` for clarity * Ran `test/ArrayAggTest.hs` (which was previously written but not being run) +* [#1096](https://github.com/yesodweb/persistent/pull/1096) + * Add proper support for `Word64`. ## 2.10.1.2 diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 5f8777f1a..54274eada 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -428,6 +428,7 @@ instance PGTF.ToField P where toField (P (PersistText t)) = PGTF.toField t toField (P (PersistByteString bs)) = PGTF.toField (PG.Binary bs) toField (P (PersistInt64 i)) = PGTF.toField i + toField (P (PersistWord64 i)) = PGTF.toField i toField (P (PersistDouble d)) = PGTF.toField d toField (P (PersistRational r)) = PGTF.Plain $ BBB.fromString $ @@ -1110,6 +1111,7 @@ showSqlType :: SqlType -> Text showSqlType SqlString = "VARCHAR" showSqlType SqlInt32 = "INT4" showSqlType SqlInt64 = "INT8" +showSqlType SqlWord64 = "NUMERIC(20,0)" -- length (show (maxBound :: Word64)) == 20 showSqlType SqlReal = "DOUBLE PRECISION" showSqlType (SqlNumeric s prec) = T.concat [ "NUMERIC(", T.pack (show s), ",", T.pack (show prec), ")" ] showSqlType SqlDay = "DATE" diff --git a/persistent-redis/Database/Persist/Redis/Parser.hs b/persistent-redis/Database/Persist/Redis/Parser.hs index f75490ac3..52f6a8924 100644 --- a/persistent-redis/Database/Persist/Redis/Parser.hs +++ b/persistent-redis/Database/Persist/Redis/Parser.hs @@ -16,7 +16,7 @@ import Data.Int (Int64) import Data.Text (Text, unpack) import qualified Data.Text as T import Data.Time -import Data.Word (Word8) +import Data.Word (Word8, Word64) import Database.Persist.Types import Database.Persist.Redis.Exception @@ -126,6 +126,10 @@ instance Binary BinPersistValue where put (12 :: Word8) put x + put (BinPersistValue (PersistWord64 x)) = do + put (13 :: Word8) + put x + put (BinPersistValue (PersistArray _)) = throw $ NotSupportedValueType "PersistArray" put (BinPersistValue (PersistDbSpecific _)) = throw $ NotSupportedValueType "PersistDbSpecific" put (BinPersistValue (PersistObjectId _)) = throw $ NotSupportedValueType "PersistObjectId" @@ -149,7 +153,7 @@ instance Binary BinPersistValue where 10-> liftM (PersistList . map unBinPersistValue) (Q.get :: Get [BinPersistValue]) 11-> liftM (PersistMap . map (unBinText *** unBinPersistValue)) (Q.get :: Get [(BinText, BinPersistValue)]) 12-> liftM PersistRational (Q.get :: Get Rational) --- 13-> liftM (PersistZonedTime . unBinZT) (Q.get :: Get BinZT) + 13-> liftM PersistWord64 (Q.get :: Get Word64) z -> throw $ ParserError ("Incorrect tag " ++ show z ++ " came to Binary deserialization") liftM BinPersistValue pv @@ -160,4 +164,4 @@ castOne :: B.ByteString -> PersistValue castOne = unBinPersistValue . Q.decode . L.fromStrict redisToPerisistValues :: [(B.ByteString, B.ByteString)] -> [PersistValue] -redisToPerisistValues = map (castOne . snd) \ No newline at end of file +redisToPerisistValues = map (castOne . snd) diff --git a/persistent-sqlite/Database/Persist/Sqlite.hs b/persistent-sqlite/Database/Persist/Sqlite.hs index 51e90fe59..99dbe0e8d 100644 --- a/persistent-sqlite/Database/Persist/Sqlite.hs +++ b/persistent-sqlite/Database/Persist/Sqlite.hs @@ -382,6 +382,7 @@ showSqlType :: SqlType -> Text showSqlType SqlString = "VARCHAR" showSqlType SqlInt32 = "INTEGER" showSqlType SqlInt64 = "INTEGER" +showSqlType SqlWord64 = "INTEGER" showSqlType SqlReal = "REAL" showSqlType (SqlNumeric precision scale) = T.concat [ "NUMERIC(", T.pack (show precision), ",", T.pack (show scale), ")" ] showSqlType SqlDay = "DATE" diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index c6c8844e3..8720b55b0 100644 --- a/persistent/ChangeLog.md +++ b/persistent/ChangeLog.md @@ -20,6 +20,8 @@ * Fix a bug where unsafe migration error messages were being shown using `Show` prior to printing, resulting in less helpful output. [#1080](https://github.com/yesodweb/persistent/pull/1080) * [#1087](https://github.com/yesodweb/persistent/pull/1087) * `RawSql` now has tuple instances up to GHC's max tuple size (62) +* [#1096](https://github.com/yesodweb/persistent/pull/1096) + * Add proper support for `Word64`. ## 2.10.5.2 @@ -30,7 +32,7 @@ ## 2.10.5.1 * [#1024](https://github.com/yesodweb/persistent/pull/1024) - * Add the ability to do documentation comments in entity definition syntax. Unfortunately, TemplateHaskell cannot add documentation comments, so this can't be used to add Haddocks to entities. + * Add the ability to do documentation comments in entity definition syntax. Unfortunately, TemplateHaskell cannot add documentation comments, so this can't be used to add Haddocks to entities. * Add Haddock explainers for some of the supported entity syntax in `Database.Persist.Quasi` ## 2.10.5 diff --git a/persistent/Database/Persist/Class/PersistField.hs b/persistent/Database/Persist/Class/PersistField.hs index 9a62045fe..88f52290d 100644 --- a/persistent/Database/Persist/Class/PersistField.hs +++ b/persistent/Database/Persist/Class/PersistField.hs @@ -19,6 +19,7 @@ import Data.Int (Int8, Int16, Int32, Int64) import qualified Data.IntMap as IM import qualified Data.Map as M import Data.Monoid ((<>)) +import Data.Ratio (denominator, numerator) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T @@ -101,6 +102,7 @@ instance {-# OVERLAPPING #-} PersistField [Char] where fromPersistValue (PersistByteString bs) = Right $ T.unpack $ TE.decodeUtf8With TERR.lenientDecode bs fromPersistValue (PersistInt64 i) = Right $ Prelude.show i + fromPersistValue (PersistWord64 i) = Right $ Prelude.show i fromPersistValue (PersistDouble d) = Right $ Prelude.show d fromPersistValue (PersistRational r) = Right $ Prelude.show r fromPersistValue (PersistDay d) = Right $ Prelude.show d @@ -226,8 +228,13 @@ instance PersistField Word32 where fromPersistValue x = Left $ fromPersistValueError "Word32" "integer" x instance PersistField Word64 where - toPersistValue = PersistInt64 . fromIntegral + toPersistValue = PersistWord64 . fromIntegral + fromPersistValue (PersistWord64 w) = Right $ fromIntegral w fromPersistValue (PersistInt64 i) = Right $ fromIntegral i + fromPersistValue x@(PersistRational r) = if denominator r == 1 + then Right $ fromIntegral (numerator r) + else Left $ fromPersistValueError "Word64" "rational" x + fromPersistValue x@(PersistDouble 0.0) = Right 0 fromPersistValue x = Left $ fromPersistValueError "Word64" "integer" x instance PersistField Double where diff --git a/persistent/Database/Persist/Sql/Class.hs b/persistent/Database/Persist/Sql/Class.hs index 22ed8b983..57400b320 100644 --- a/persistent/Database/Persist/Sql/Class.hs +++ b/persistent/Database/Persist/Sql/Class.hs @@ -1203,7 +1203,7 @@ instance PersistFieldSql Word16 where instance PersistFieldSql Word32 where sqlType _ = SqlInt64 instance PersistFieldSql Word64 where - sqlType _ = SqlInt64 + sqlType _ = SqlWord64 instance PersistFieldSql Double where sqlType _ = SqlReal instance PersistFieldSql Bool where diff --git a/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs b/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs index 696bcb95d..e326c917b 100644 --- a/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs +++ b/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs @@ -46,6 +46,7 @@ instance PersistQueryRead SqlBackend where mm <- CL.head case mm of Just [PersistInt64 i] -> return $ fromIntegral i + Just [PersistWord64 i] -> return $ fromIntegral i Just [PersistDouble i] ->return $ fromIntegral (truncate i :: Int64) -- gb oracle Just [PersistByteString i] -> case readInteger i of -- gb mssql Just (ret,"") -> return $ fromIntegral ret @@ -116,6 +117,7 @@ instance PersistQueryRead SqlBackend where Nothing -> case xs of [PersistInt64 x] -> return [PersistInt64 x] + [PersistWord64 x] -> return [PersistWord64 x] [PersistDouble x] -> return [PersistInt64 (truncate x)] -- oracle returns Double _ -> return xs Just pdef -> diff --git a/persistent/Database/Persist/Sql/Orphan/PersistStore.hs b/persistent/Database/Persist/Sql/Orphan/PersistStore.hs index dfc51e87c..f2302d6f8 100644 --- a/persistent/Database/Persist/Sql/Orphan/PersistStore.hs +++ b/persistent/Database/Persist/Sql/Orphan/PersistStore.hs @@ -155,6 +155,9 @@ instance PersistStoreWrite SqlBackend where Just [PersistInt64 i] -> case keyFromValues [PersistInt64 i] of Left err -> error $ "SQL insert: keyFromValues: PersistInt64 " `mappend` show i `mappend` " " `mappend` unpack err Right k -> return k + Just [PersistWord64 i] -> case keyFromValues [PersistWord64 i] of + Left err -> error $ "SQL insert: keyFromValues: PersistWord64 " `mappend` show i `mappend` " " `mappend` unpack err + Right k -> return k Nothing -> error $ "SQL insert did not return a result giving the generated ID" Just vals' -> case keyFromValues vals' of Left e -> error $ "Invalid result from a SQL insert, got: " ++ show vals' ++ ". Error was: " ++ unpack e diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs index f8686151e..0023be468 100644 --- a/persistent/Database/Persist/Types/Base.hs +++ b/persistent/Database/Persist/Types/Base.hs @@ -22,7 +22,7 @@ import Data.Text.Encoding.Error (lenientDecode) import Data.Time (Day, TimeOfDay, UTCTime) import Data.Typeable (Typeable) import qualified Data.Vector as V -import Data.Word (Word32) +import Data.Word (Word32, Word64) import Numeric (showHex, readHex) import Web.PathPieces (PathPiece(..)) import Web.HttpApiData (ToHttpApiData (..), FromHttpApiData (..), parseUrlPieceMaybe, showTextData, readTextData, parseBoundedTextData) @@ -368,6 +368,7 @@ instance Error PersistException where data PersistValue = PersistText Text | PersistByteString ByteString | PersistInt64 Int64 + | PersistWord64 Word64 -- @since 2.11.0 | PersistDouble Double | PersistRational Rational | PersistBool Bool @@ -417,6 +418,7 @@ instance ToHttpApiData PersistValue where instance FromHttpApiData PersistValue where parseUrlPiece input = PersistInt64 <$> parseUrlPiece input + PersistWord64 <$> parseUrlPiece input PersistList <$> readTextData input PersistText <$> return input where @@ -433,6 +435,7 @@ fromPersistValueText (PersistText s) = Right s fromPersistValueText (PersistByteString bs) = Right $ TE.decodeUtf8With lenientDecode bs fromPersistValueText (PersistInt64 i) = Right $ T.pack $ show i +fromPersistValueText (PersistWord64 w) = Right $ T.pack $ show w fromPersistValueText (PersistDouble d) = Right $ T.pack $ show d fromPersistValueText (PersistRational r) = Right $ T.pack $ show r fromPersistValueText (PersistDay d) = Right $ T.pack $ show d @@ -450,6 +453,7 @@ instance A.ToJSON PersistValue where toJSON (PersistText t) = A.String $ T.cons 's' t toJSON (PersistByteString b) = A.String $ T.cons 'b' $ TE.decodeUtf8 $ B64.encode b toJSON (PersistInt64 i) = A.Number $ fromIntegral i + toJSON (PersistWord64 w) = A.Number $ fromIntegral w toJSON (PersistDouble d) = A.Number $ Data.Scientific.fromFloatDigits d toJSON (PersistRational r) = A.String $ T.pack $ 'r' : show r toJSON (PersistBool b) = A.Bool b @@ -534,6 +538,7 @@ data SqlType = SqlString | SqlTime | SqlDayTime -- ^ Always uses UTC timezone | SqlBlob + | SqlWord64 -- @since 2.11.0 | SqlOther T.Text -- ^ a backend-specific name deriving (Show, Read, Eq, Typeable, Ord)