Author SHA1 Message Date
paul 4bf489c554 Implement UTCTime decoding
Remove LocalTime decoding because it requires IO to convert from Postgres time.
2024-01-08 15:28:14 +01:00
paul 68d747f605 Fix error messages 2023-10-23 17:44:57 +02:00
paul cf2055f39e Fix negative integer decoding
Use Int and Word instead of Int64 and Word64 consistently
2023-10-05 08:58:55 +02:00
paul 4f39966da2 Add comment about difference between Postgres and Haskell dates 2023-10-04 13:30:51 +02:00
paul 9c93d3a42b Change negative days by 1 to account for missing year zero 2023-10-03 20:19:40 +02:00
paul 94401a2753 Implement FromField UTCTime 2023-10-02 17:00:49 +02:00
paul f6ad7b157c Rewrite RawField 2023-10-02 14:30:12 +02:00
paul 7eccd0d778 Add FromField DiffTime and FromField TimeOfDay 2023-10-02 14:09:45 +02:00
paul 9628a4b57f Add RawField utility type 2023-10-02 13:44:45 +02:00
paul 126b8ee6e9 Implement date -> Day decoding 2023-09-23 11:11:29 +02:00
paul 4d21e67130 Decode values from binary instead of text format 2023-09-23 05:53:30 +02:00
9 changed files with 302 additions and 66 deletions
+9 -4
View File
@@ -62,10 +62,15 @@ getScoreByAge conn = do
- [x] Implement error reporting i.e. use `Either OpiumError` instead of `Maybe` - [x] Implement error reporting i.e. use `Either OpiumError` instead of `Maybe`
- [x] Implement `Float` and `Double` decoding - [x] Implement `Float` and `Double` decoding
- [x] Clean up and document column table stuff - [x] Clean up and document column table stuff
- [x] Decode `LibPQ.Binary`
- [x] Implement `date -> Day` decoding
- [x] Implement `UTCTime`
- [x] Implement `ByteString` decoding (`bytea`)
- [x] Test negative integer decoding, especially for `Integer`
- [ ] Implement time intervals
- [ ] and zoned time decoding
- [ ] Implement `fetch` (`fetch_` but with parameter passing) - [ ] Implement `fetch` (`fetch_` but with parameter passing)
- [ ] Implement `UTCTime` and zoned time decoding
- [ ] Implement JSON decoding - [ ] Implement JSON decoding
- [ ] Implement `ByteString` decoding (`bytea`)
- Can we make the fromField instance choose whether it wants binary or text?
- [ ] Implement (anonymous) composite types - [ ] Implement (anonymous) composite types
- It seems that in order to decode these, we'd need to use binary mode. In order to avoid writing everything twice it would be wise to move the whole `FromField` machinery to decoding from binary first - [ ] Catch [UnicodeException](https://hackage.haskell.org/package/text-2.1/docs/Data-Text-Encoding-Error.html#t:UnicodeException) when decoding text
- [ ] Implement array decoding
+1
View File
@@ -20,6 +20,7 @@
hspec hspec
postgresql-libpq postgresql-libpq
text text
time
transformers transformers
vector vector
])) ]))
+11 -13
View File
@@ -15,6 +15,7 @@ module Database.PostgreSQL.Opium
, ErrorPosition (..) , ErrorPosition (..)
, FromField (..) , FromField (..)
, FromRow (..) , FromRow (..)
, RawField (..)
, fetch_ , fetch_
, toListColumnTable , toListColumnTable
) )
@@ -43,11 +44,12 @@ import qualified Data.Vector as Vector
import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Database.PostgreSQL.LibPQ as LibPQ
import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..)) import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
import Database.PostgreSQL.Opium.FromField (FromField (..), fromField) import Database.PostgreSQL.Opium.FromField (FromField (..), fromField, RawField (..))
execParams :: Connection -> ByteString -> ExceptT Error IO Result execParams :: Connection -> Text -> ExceptT Error IO Result
execParams conn query = do execParams conn query = do
liftIO (LibPQ.execParams conn query [] LibPQ.Text) >>= \case let queryBytes = Encoding.encodeUtf8 query
liftIO (LibPQ.execParams conn queryBytes [] LibPQ.Binary) >>= \case
Nothing -> Nothing ->
except $ Left ErrorNoResult except $ Left ErrorNoResult
Just result -> do Just result -> do
@@ -58,7 +60,7 @@ execParams conn query = do
Nothing -> pure result Nothing -> pure result
Just message -> except $ Left $ ErrorInvalidResult status $ Encoding.decodeUtf8 message Just message -> except $ Left $ ErrorInvalidResult status $ Encoding.decodeUtf8 message
fetch_ :: forall a. FromRow a => Connection -> ByteString -> IO (Either Error [a]) fetch_ :: forall a. FromRow a => Connection -> Text -> IO (Either Error [a])
fetch_ conn query = runExceptT $ do fetch_ conn query = runExceptT $ do
result <- execParams conn query result <- execParams conn query
columnTable <- ExceptT $ getColumnTable @a Proxy result columnTable <- ExceptT $ getColumnTable @a Proxy result
@@ -147,20 +149,16 @@ decodeField nameText g (FromRowCtx result columnTable iRef) row = do
i <- liftIO $ readIORef iRef i <- liftIO $ readIORef iRef
liftIO $ modifyIORef' iRef (+1) liftIO $ modifyIORef' iRef (+1)
let (column, oid) = columnTable `indexColumnTable` i let (column, oid) = columnTable `indexColumnTable` i
mbField <- liftIO $ getFieldText column mbField <- liftIO $ LibPQ.getvalue result row column
mbValue <- except $ getValue oid mbField mbValue <- except $ getValue oid mbField
value <- except $ g row mbValue value <- except $ g row mbValue
pure $ M1 $ K1 value pure $ M1 $ K1 value
where where
getFieldText :: Column -> IO (Maybe Text) getValue :: FromField u => LibPQ.Oid -> Maybe ByteString -> Either Error (Maybe u)
getFieldText column = getValue oid = maybe (Right Nothing) $ \field ->
fmap Encoding.decodeUtf8 <$> LibPQ.getvalue result row column
getValue :: FromField u => LibPQ.Oid -> Maybe Text -> Either Error (Maybe u)
getValue oid = maybe (Right Nothing) $ \fieldText ->
mapLeft mapLeft
(ErrorInvalidField (ErrorPosition row nameText) oid fieldText) (ErrorInvalidField (ErrorPosition row nameText) oid field)
(Just <$> fromField fieldText) (Just <$> fromField field)
mapLeft :: (b -> c) -> Either b a -> Either c a mapLeft :: (b -> c) -> Either b a -> Either c a
mapLeft f (Left l) = Left $ f l mapLeft f (Left l) = Left $ f l
+2 -1
View File
@@ -1,6 +1,7 @@
module Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..)) where module Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..)) where
import Control.Exception (Exception) import Control.Exception (Exception)
import Data.ByteString (ByteString)
import Data.Text (Text) import Data.Text (Text)
import Database.PostgreSQL.LibPQ (ExecStatus, Oid, Row) import Database.PostgreSQL.LibPQ (ExecStatus, Oid, Row)
@@ -15,7 +16,7 @@ data Error
| ErrorMissingColumn Text | ErrorMissingColumn Text
| ErrorInvalidOid Text Oid | ErrorInvalidOid Text Oid
| ErrorUnexpectedNull ErrorPosition | ErrorUnexpectedNull ErrorPosition
| ErrorInvalidField ErrorPosition Oid Text String | ErrorInvalidField ErrorPosition Oid ByteString String
deriving (Eq, Show) deriving (Eq, Show)
instance Exception Error where instance Exception Error where
+130 -36
View File
@@ -3,47 +3,65 @@
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
module Database.PostgreSQL.Opium.FromField module Database.PostgreSQL.Opium.FromField
( FromField (..) ( -- * Decoding data from @libpq@
FromField (..)
, fromField , fromField
-- * Utility types
, RawField (..)
) where ) where
import Data.Attoparsec.Text import Data.Attoparsec.ByteString (Parser)
( Parser import Data.Bits (Bits (..))
, anyChar import Data.ByteString (ByteString)
, choice
, decimal
, double
, parseOnly
, signed
, string
, takeText
)
import Data.Functor (($>)) import Data.Functor (($>))
import Data.Int (Int16, Int32)
import Data.Proxy (Proxy (..)) import Data.Proxy (Proxy (..))
import Data.Time
( Day (..)
, DiffTime
, TimeOfDay
, UTCTime (..)
, addDays
, fromGregorian
, picosecondsToDiffTime
, timeToTimeOfDay
)
import Data.Text (Text) import Data.Text (Text)
import Data.Word (Word16, Word32)
import Database.PostgreSQL.LibPQ (Oid) import Database.PostgreSQL.LibPQ (Oid)
import GHC.Float (double2Float) import Unsafe.Coerce (unsafeCoerce)
import qualified Data.Attoparsec.ByteString as AP
import qualified Data.ByteString as BS
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Text.Encoding as Encoding
import qualified Database.PostgreSQL.Opium.Oid as Oid import qualified Database.PostgreSQL.Opium.Oid as Oid
(\/) :: (a -> Bool) -> (a -> Bool) -> a -> Bool (\/) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
p \/ q = \x -> p x || q x p \/ q = \x -> p x || q x
fromField :: FromField a => Text -> Either String a fromField :: FromField a => ByteString -> Either String a
fromField = fromField =
parseOnly parseField AP.parseOnly parseField
class FromField a where class FromField a where
validOid :: Proxy a -> Oid -> Bool validOid :: Proxy a -> Oid -> Bool
parseField :: Parser a parseField :: Parser a
-- | See https://www.postgresql.org/docs/current/datatype-binary.html.
-- Accepts @bytea@.
instance FromField ByteString where
validOid Proxy = Oid.bytea
parseField = AP.takeByteString
-- | See https://www.postgresql.org/docs/current/datatype-character.html. -- | See https://www.postgresql.org/docs/current/datatype-character.html.
-- Accepts @text@, @character@ and @character varying@.
instance FromField Text where instance FromField Text where
validOid Proxy = Oid.text \/ Oid.character \/ Oid.characterVarying validOid Proxy = Oid.text \/ Oid.character \/ Oid.characterVarying
parseField = takeText parseField = Encoding.decodeUtf8 <$> AP.takeByteString
-- Accepts @text@, @character@ and @character varying@.
-- | See https://www.postgresql.org/docs/current/datatype-character.html. -- | See https://www.postgresql.org/docs/current/datatype-character.html.
instance FromField String where instance FromField String where
validOid Proxy = validOid @Text Proxy validOid Proxy = validOid @Text Proxy
@@ -53,48 +71,124 @@ instance FromField String where
-- This instance accepts all character types but fails to decode fields that are not exactly one character. -- This instance accepts all character types but fails to decode fields that are not exactly one character.
instance FromField Char where instance FromField Char where
validOid Proxy = validOid @Text Proxy validOid Proxy = validOid @Text Proxy
parseField = anyChar parseField = do
str <- parseField
case str of
[c] -> pure c
_ -> fail "Char accepts single characters only"
readBigEndian :: (Bits a, Num a) => ByteString -> a
readBigEndian = BS.foldl' (\x b -> x `shiftL` 8 .|. fromIntegral b) 0
readInt :: Num a => ByteString -> Parser a
readInt bs = case BS.length bs of
4 -> pure $ fromIntegral $ readBigEndian @Int32 bs
8 -> pure $ fromIntegral $ readBigEndian @Int bs
2 -> pure $ fromIntegral $ readBigEndian @Int16 bs
_ -> fail "Wrong number of bytes for integer"
readWord :: Num a => ByteString -> Parser a
readWord bs = case BS.length bs of
4 -> pure $ fromIntegral $ readBigEndian @Word32 bs
8 -> pure $ fromIntegral $ readBigEndian @Word bs
2 -> pure $ fromIntegral $ readBigEndian @Word16 bs
_ -> fail "Wrong number of bytes for word"
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html. -- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
-- We assume that 'Int' has 64 bits. This is not guaranteed but reasonable enough. -- We assume that 'Int' has 64 bits. This is not guaranteed but reasonable enough.
instance FromField Int where instance FromField Int where
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
parseField = signed decimal parseField = readInt =<< AP.takeByteString
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html. -- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
instance FromField Integer where instance FromField Integer where
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
parseField = signed decimal parseField = readInt =<< AP.takeByteString
instance FromField Word where instance FromField Word where
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
parseField = decimal parseField = readWord =<< AP.takeByteString
doubleParser :: Parser Double
doubleParser = choice
[ string "NaN" $> nan
, signed (string "Infinity" $> infinity)
, double
]
where
nan = 0 / 0
infinity = 1 / 0
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
-- Accepts only @real@ fields, not @double precision@.
instance FromField Float where instance FromField Float where
validOid Proxy = Oid.real validOid Proxy = Oid.real
parseField = fmap double2Float doubleParser -- Afaict there's no cleaner (@base@) way to access the underlying bits.
-- In C we'd do
--
-- union { float a; uint32_t b; } x;
-- x.b = ...;
-- return x.a;
parseField = unsafeCoerce <$> readBigEndian @Word32 <$> AP.takeByteString
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
-- Accepts only @double precision@ fields, not @real@.
instance FromField Double where instance FromField Double where
validOid Proxy = Oid.real \/ Oid.doublePrecision validOid Proxy = Oid.doublePrecision
parseField = doubleParser parseField = unsafeCoerce <$> readBigEndian @Word <$> AP.takeByteString
boolParser :: Parser Bool boolParser :: Parser Bool
boolParser = choice boolParser = AP.choice
[ string "t" $> True [ AP.word8 1 $> True
, string "f" $> False , AP.word8 0 $> False
] ]
-- | See https://www.postgresql.org/docs/current/datatype-boolean.html. -- | See https://www.postgresql.org/docs/current/datatype-boolean.html.
instance FromField Bool where instance FromField Bool where
validOid Proxy = Oid.boolean validOid Proxy = Oid.boolean
parseField = boolParser parseField = boolParser
postgresEpoch :: Day
postgresEpoch = fromGregorian 2000 1 1
fromPostgresJulian :: Integer -> Day
fromPostgresJulian x = addDays x postgresEpoch
-- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
-- Relevant as well: https://git.postgresql.org/gitweb/?p=postgresql.git;a=blob;f=src/backend/utils/adt/datetime.c;h=267dfd37b2e8b9bc63797c69b9ca2e45e6bfde61;hb=HEAD#l267.
-- Note that Postgres uses the proleptic Gregorian calendar, whereas @Show Day@ and @fromGregorian@ use an astronomical calendar.
-- In short, Postgres treats 1 BC as a leap year and doesn't have a year zero.
-- This means that working with negative dates will be different in Postgres and your application code.
instance FromField Day where
validOid Proxy = Oid.date
parseField = fromPostgresJulian . fromIntegral <$> readBigEndian @Int32 <$> AP.takeByteString
-- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
-- Binary format: https://git.postgresql.org/gitweb/?p=postgresql.git;a=blob;f=src/backend/utils/adt/date.c;h=ae0f24de2c3c54eb6d0405cdb212597c2407238e;hb=HEAD#l1542.
-- Accepts @time@.
instance FromField DiffTime where
validOid Proxy = Oid.time
parseField = microsecondsToDiffTime . fromIntegral <$> readBigEndian @Int <$> AP.takeByteString
where
microsecondsToDiffTime :: Integer -> DiffTime
microsecondsToDiffTime ms = picosecondsToDiffTime $ ms * 1000000
-- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
-- Binary format: https://git.postgresql.org/gitweb/?p=postgresql.git;a=blob;f=src/backend/utils/adt/date.c;h=ae0f24de2c3c54eb6d0405cdb212597c2407238e;hb=HEAD#l1542.
-- Accepts @time@.
instance FromField TimeOfDay where
validOid Proxy = Oid.time
parseField = timeToTimeOfDay <$> parseField @DiffTime
fromPostgresTimestamp :: Int -> (Day, DiffTime)
fromPostgresTimestamp ts = (day, time)
where
(days, microseconds) = ts `divMod` (86400 * 1000000)
day = fromPostgresJulian $ fromIntegral days
time = picosecondsToDiffTime $ fromIntegral microseconds * 1000000
-- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
-- Accepts @timestamp with timezone@.
instance FromField UTCTime where
validOid Proxy = Oid.timestampWithTimezone
parseField = toUTCTime . fromPostgresTimestamp <$> readBigEndian @Int <$> AP.takeByteString
where
toUTCTime (day, time) = UTCTime day time
newtype RawField a = RawField a
deriving (Eq, Show)
instance FromField a => FromField (RawField a) where
validOid Proxy = const True
parseField = RawField <$> parseField
+21
View File
@@ -5,6 +5,11 @@ import Database.PostgreSQL.LibPQ (Oid (..))
eq :: Eq a => a -> a -> Bool eq :: Eq a => a -> a -> Bool
eq = (==) eq = (==)
-- raw byte string
bytea :: Oid -> Bool
bytea = eq $ Oid 17
-- string types -- string types
text :: Oid -> Bool text :: Oid -> Bool
@@ -43,3 +48,19 @@ doublePrecision = eq $ Oid 701
-- | Boolean -- | Boolean
boolean :: Oid -> Bool boolean :: Oid -> Bool
boolean = eq $ Oid 16 boolean = eq $ Oid 16
-- | Single days/dates.
date :: Oid -> Bool
date = eq $ Oid 1082
-- | Time of day.
time :: Oid -> Bool
time = eq $ Oid 1083
-- | A point in time.
timestamp :: Oid -> Bool
timestamp = eq $ Oid 1114
-- | A point in time.
timestampWithTimezone :: Oid -> Bool
timestampWithTimezone = eq $ Oid 1184
+4 -2
View File
@@ -60,12 +60,12 @@ library
-- Modules exported by the library. -- Modules exported by the library.
exposed-modules: exposed-modules:
Database.PostgreSQL.Opium Database.PostgreSQL.Opium,
Database.PostgreSQL.Opium.FromField,
-- Modules included in this library but not exported. -- Modules included in this library but not exported.
other-modules: other-modules:
Database.PostgreSQL.Opium.Error, Database.PostgreSQL.Opium.Error,
Database.PostgreSQL.Opium.FromField,
Database.PostgreSQL.Opium.Oid Database.PostgreSQL.Opium.Oid
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.
@@ -79,6 +79,7 @@ library
containers, containers,
postgresql-libpq, postgresql-libpq,
text, text,
time,
transformers, transformers,
vector vector
@@ -122,4 +123,5 @@ test-suite opium-test
bytestring, bytestring,
hspec, hspec,
postgresql-libpq, postgresql-libpq,
time,
text text
+118 -4
View File
@@ -4,12 +4,23 @@
module Database.PostgreSQL.Opium.FromFieldSpec (spec) where module Database.PostgreSQL.Opium.FromFieldSpec (spec) where
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Time
( Day (..)
, DiffTime
, TimeOfDay (..)
, UTCTime (..)
, fromGregorian
, secondsToDiffTime
, timeOfDayToTime
)
import Data.Text (Text) import Data.Text (Text)
import Database.PostgreSQL.LibPQ (Connection) import Database.PostgreSQL.LibPQ (Connection)
import Database.PostgreSQL.Opium (FromRow) import Database.PostgreSQL.Opium (FromRow)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy) import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy)
import qualified Data.ByteString as BS
import qualified Database.PostgreSQL.Opium as Opium import qualified Database.PostgreSQL.Opium as Opium
newtype AnInt = AnInt newtype AnInt = AnInt
@@ -30,6 +41,12 @@ newtype AWord = AWord
instance FromRow AWord where instance FromRow AWord where
newtype AByteString = AByteString
{ bytestring :: ByteString
} deriving (Eq, Generic, Show)
instance FromRow AByteString where
newtype AText = AText newtype AText = AText
{ text :: Text { text :: Text
} deriving (Eq, Generic, Show) } deriving (Eq, Generic, Show)
@@ -66,7 +83,37 @@ newtype ABool = ABool
instance FromRow ABool where instance FromRow ABool where
shouldFetch :: (Eq a, FromRow a, Show a) => Connection -> ByteString -> [a] -> IO () newtype ADay = ADay
{ day :: Day
} deriving (Eq, Generic, Show)
instance FromRow ADay where
newtype ADiffTime = ADiffTime
{ difftime :: DiffTime
} deriving (Eq, Generic, Show)
instance FromRow ADiffTime where
newtype ATimeOfDay = ATimeOfDay
{ timeofday :: TimeOfDay
} deriving (Eq, Generic, Show)
instance FromRow ATimeOfDay where
newtype AUTCTime = AUTCTime
{ utctime :: UTCTime
} deriving (Eq, Generic, Show)
instance FromRow AUTCTime where
newtype ARawField = ARawField
{ raw :: Opium.RawField ByteString
} deriving (Eq, Generic, Show)
instance FromRow ARawField where
shouldFetch :: (Eq a, FromRow a, Show a) => Connection -> Text -> [a] -> IO ()
shouldFetch conn query expectedRows = do shouldFetch conn query expectedRows = do
actualRows <- Opium.fetch_ conn query actualRows <- Opium.fetch_ conn query
actualRows `shouldBe` Right expectedRows actualRows `shouldBe` Right expectedRows
@@ -86,6 +133,15 @@ spec = do
it "Decodes bigint" $ \conn -> do it "Decodes bigint" $ \conn -> do
shouldFetch conn "SELECT pow(2, 48)::BIGINT AS int" [AnInt $ (2 :: Int) ^ (48 :: Int)] shouldFetch conn "SELECT pow(2, 48)::BIGINT AS int" [AnInt $ (2 :: Int) ^ (48 :: Int)]
it "Decodes smallint -42" $ \conn -> do
shouldFetch conn "SELECT -42::SMALLINT AS int" [AnInt (-42)]
it "Decodes integer -42" $ \conn -> do
shouldFetch conn "SELECT -42::INTEGER AS int" [AnInt (-42)]
it "Decodes bigint -42" $ \conn -> do
shouldFetch conn "SELECT -42::BIGINT AS int" [AnInt (-42)]
describe "FromField Integer" $ do describe "FromField Integer" $ do
it "Decodes smallint" $ \conn -> do it "Decodes smallint" $ \conn -> do
shouldFetch conn "SELECT 42::SMALLINT AS integer" [AnInteger 42] shouldFetch conn "SELECT 42::SMALLINT AS integer" [AnInteger 42]
@@ -96,6 +152,9 @@ spec = do
it "Decodes bigint" $ \conn -> do it "Decodes bigint" $ \conn -> do
shouldFetch conn "SELECT pow(2, 48)::BIGINT AS integer" [AnInteger $ (2 :: Integer) ^ (48 :: Integer)] shouldFetch conn "SELECT pow(2, 48)::BIGINT AS integer" [AnInteger $ (2 :: Integer) ^ (48 :: Integer)]
it "Decodes -42" $ \conn -> do
shouldFetch conn "SELECT -42 AS integer" [AnInteger (-42)]
describe "FromField Word" $ do describe "FromField Word" $ do
it "Decodes smallint" $ \conn -> do it "Decodes smallint" $ \conn -> do
shouldFetch conn "SELECT 42::SMALLINT AS word" [AWord 42] shouldFetch conn "SELECT 42::SMALLINT AS word" [AWord 42]
@@ -106,6 +165,16 @@ spec = do
it "Decodes bigint" $ \conn -> do it "Decodes bigint" $ \conn -> do
shouldFetch conn "SELECT pow(2, 48)::BIGINT AS word" [AWord $ (2 :: Word) ^ (48 :: Word)] shouldFetch conn "SELECT pow(2, 48)::BIGINT AS word" [AWord $ (2 :: Word) ^ (48 :: Word)]
it "Decodes negative one as 2^64-1" $ \conn -> do
shouldFetch conn "SELECT -1::BIGINT AS word" [AWord maxBound]
it "Decodes integer negative one as 2^32-1" $ \conn -> do
shouldFetch conn "SELECT -1::INTEGER AS word" [AWord $ (2 :: Word) ^ (32 :: Word) - 1]
describe "FromField ByteString" $ do
it "Decodes bytea" $ \conn -> do
shouldFetch conn "SELECT 'Hello, World!'::BYTEA AS bytestring" [AByteString "Hello, World!"]
describe "FromField Text" $ do describe "FromField Text" $ do
it "Decodes text" $ \conn -> do it "Decodes text" $ \conn -> do
shouldFetch conn "SELECT 'Hello, World!'::TEXT AS text" [AText "Hello, World!"] shouldFetch conn "SELECT 'Hello, World!'::TEXT AS text" [AText "Hello, World!"]
@@ -159,9 +228,6 @@ spec = do
it "Decodes double precision" $ \conn -> do it "Decodes double precision" $ \conn -> do
shouldFetch conn "SELECT 4.2::double precision AS double" [ADouble 4.2] shouldFetch conn "SELECT 4.2::double precision AS double" [ADouble 4.2]
it "Decodes real" $ \conn -> do
shouldFetch conn "SELECT 4.2::real AS double" [ADouble 4.2]
it "Decodes NaN::double precision" $ \conn -> do it "Decodes NaN::double precision" $ \conn -> do
Right [ADouble value] <- Opium.fetch_ conn "SELECT 'NaN'::double precision AS double" Right [ADouble value] <- Opium.fetch_ conn "SELECT 'NaN'::double precision AS double"
value `shouldSatisfy` isNaN value `shouldSatisfy` isNaN
@@ -193,3 +259,51 @@ spec = do
shouldFetch conn "SELECT 'no'::boolean AS bool" [ABool False] shouldFetch conn "SELECT 'no'::boolean AS bool" [ABool False]
shouldFetch conn "SELECT 'off'::boolean AS bool" [ABool False] shouldFetch conn "SELECT 'off'::boolean AS bool" [ABool False]
shouldFetch conn "SELECT 0::boolean AS bool" [ABool False] shouldFetch conn "SELECT 0::boolean AS bool" [ABool False]
describe "FromField Day" $ do
it "Decodes date" $ \conn -> do
shouldFetch conn "SELECT date '1970-01-01' AS day" [ADay $ fromGregorian 1970 1 1]
shouldFetch conn "SELECT date '2023-09-23' AS day" [ADay $ fromGregorian 2023 9 23]
-- Example from postgres doc page
shouldFetch conn "SELECT date 'J2451187' AS day" [ADay $ fromGregorian 1999 1 8]
-- BC
-- See https://www.postgresql.org/docs/current/datetime-input-rules.html:
-- "If BC has been specified, negate the year and add one for internal storage. (There is no year zero in the Gregorian calendar, so numerically 1 BC becomes year zero.)"
shouldFetch conn "SELECT date '0001-02-29 BC' AS day" [ADay $ fromGregorian 0 2 29]
describe "FromField DiffTime" $ do
it "Decodes the time" $ \conn -> do
shouldFetch conn "SELECT time '00:00:00' AS difftime" [ADiffTime 0]
shouldFetch conn "SELECT time '00:01:00' AS difftime" [ADiffTime $ secondsToDiffTime 60]
shouldFetch conn "SELECT time '13:07:43' AS difftime" [ADiffTime $ secondsToDiffTime $ 13 * 3600 + 7 * 60 + 43]
describe "FromField TimeOfDay" $ do
it "Decodes the time" $ \conn -> do
shouldFetch conn "SELECT time '00:00:00' AS timeofday" [ATimeOfDay $ TimeOfDay 0 0 0]
shouldFetch conn "SELECT time '00:01:00' AS timeofday" [ATimeOfDay $ TimeOfDay 0 1 0]
shouldFetch conn "SELECT time '13:07:43' AS timeofday" [ATimeOfDay $ TimeOfDay 13 7 43]
describe "FromField UTCTime" $ do
it "Decodes timestamp with timezone" $ \conn -> do
let ts0 = UTCTime (fromGregorian 2023 10 2) (timeOfDayToTime $ TimeOfDay 12 42 23)
shouldFetch conn "SELECT timestamp with time zone '2023-10-02 12:42:23' AS utctime" [AUTCTime ts0]
let ts1 = UTCTime (fromGregorian 294275 12 31) (timeOfDayToTime $ TimeOfDay 23 59 59)
shouldFetch conn "SELECT timestamp with time zone '294275-12-31 23:59:59' AS utctime" [AUTCTime ts1]
let ts2 = UTCTime (fromGregorian 1 1 1) (timeOfDayToTime $ TimeOfDay 0 0 0)
shouldFetch conn "SELECT timestamp with time zone '0001-01-01 00:00:00' AS utctime" [AUTCTime ts2]
-- See note at the FromField Day instance.
let ts3 = UTCTime (fromGregorian 0 2 29) (timeOfDayToTime $ TimeOfDay 0 0 0)
shouldFetch conn "SELECT timestamp with time zone '0001-02-29 BC 00:00:00' AS utctime" [AUTCTime ts3]
describe "FromField RawField" $ do
it "Simply returns the bytestring without decoding it" $ \conn -> do
shouldFetch conn "SELECT 'Hello, World!'::bytea AS raw" [ARawField $ Opium.RawField "Hello, World!"]
shouldFetch conn "SELECT 42::int AS raw" [ARawField $ Opium.RawField "\0\0\0\42"]
shouldFetch conn "SELECT 42::bigint AS raw" [ARawField $ Opium.RawField "\0\0\0\0\0\0\0\42"]
-- Opium assumes that the connection always uses UTF-8.
-- The query string is encoded using UTF-8 before passing it to @libpq@.
shouldFetch conn "SELECT 'Ära'::text AS raw" [ARawField $ Opium.RawField $ BS.pack [0xC3, 0x84, 0x72, 0x61]]
+6 -6
View File
@@ -58,7 +58,7 @@ shouldHaveColumns
-> [LibPQ.Column] -> [LibPQ.Column]
-> IO () -> IO ()
shouldHaveColumns proxy conn query expectedColumns = do shouldHaveColumns proxy conn query expectedColumns = do
Just result <- LibPQ.execParams conn query [] LibPQ.Text Just result <- LibPQ.execParams conn query [] LibPQ.Binary
columnTable <- Opium.getColumnTable proxy result columnTable <- Opium.getColumnTable proxy result
let actualColumns = fmap (map fst . Opium.toListColumnTable) columnTable let actualColumns = fmap (map fst . Opium.toListColumnTable) columnTable
actualColumns `shouldBe` Right expectedColumns actualColumns `shouldBe` Right expectedColumns
@@ -81,13 +81,13 @@ spec = do
[5, 3] [5, 3]
it "Fails for missing columns" $ \conn -> do it "Fails for missing columns" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Text Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Binary
columnTable <- Opium.getColumnTable @Person Proxy result columnTable <- Opium.getColumnTable @Person Proxy result
columnTable `shouldBe` Left (Opium.ErrorMissingColumn "name") columnTable `shouldBe` Left (Opium.ErrorMissingColumn "name")
describe "fromRow" $ do describe "fromRow" $ do
it "Decodes rows in a Result" $ \conn -> do it "Decodes rows in a Result" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Text Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @Person Proxy result Right columnTable <- Opium.getColumnTable @Person Proxy result
row0 <- Opium.fromRow @Person result columnTable 0 row0 <- Opium.fromRow @Person result columnTable 0
@@ -97,21 +97,21 @@ spec = do
row1 `shouldBe` Right (Person "albus" 103) row1 `shouldBe` Right (Person "albus" 103)
it "Decodes NULL into Nothing for Maybes" $ \conn -> do it "Decodes NULL into Nothing for Maybes" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Text Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
row <- Opium.fromRow result columnTable 0 row <- Opium.fromRow result columnTable 0
row `shouldBe` Right (MaybeTest Nothing) row `shouldBe` Right (MaybeTest Nothing)
it "Decodes values into Just for Maybes" $ \conn -> do it "Decodes values into Just for Maybes" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Text Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
row <- Opium.fromRow result columnTable 0 row <- Opium.fromRow result columnTable 0
row `shouldBe` Right (MaybeTest $ Just "abc") row `shouldBe` Right (MaybeTest $ Just "abc")
it "Works for many fields" $ \conn -> do it "Works for many fields" $ \conn -> do
Just result <- LibPQ.execParams conn "SELECT 'abc' AS a, 42 AS b, 1.0::double precision AS c, 'test' AS d, true AS e" [] LibPQ.Text Just result <- LibPQ.execParams conn "SELECT 'abc' AS a, 42 AS b, 1.0::double precision AS c, 'test' AS d, true AS e" [] LibPQ.Binary
Right columnTable <- Opium.getColumnTable @ManyFields Proxy result Right columnTable <- Opium.getColumnTable @ManyFields Proxy result
row <- Opium.fromRow result columnTable 0 row <- Opium.fromRow result columnTable 0