paul/opium
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: paul:e68bc655761b6917644d8cd5190dfc8478207ffa
Branches Tags
paul:main
paul:feature/more-instances
..
compare: paul:4bf489c554911f66a150043ffb1b199ee5cfbafe
Branches Tags
paul:main
paul:feature/more-instances

No commits in common. "e68bc655761b6917644d8cd5190dfc8478207ffa" and "4bf489c554911f66a150043ffb1b199ee5cfbafe" have entirely different histories.
e68bc65576 ... 4bf489c554

7 changed files with 52 additions and 196 deletions
Show Stats Expand all files Collapse all files

3
README.md
View File

@ -69,8 +69,7 @@ getScoreByAge conn = do
- [x] Test negative integer decoding, especially for `Integer`
- [ ] Implement time intervals
- [ ] and zoned time decoding
- [ ] How about `timezone`? This could prove problematic when the server and application have different time zones
- [x] Implement `fetch` (`fetch_` but with parameter passing)
- [ ] Implement `fetch` (`fetch_` but with parameter passing)
- [ ] Implement JSON decoding
- [ ] Implement (anonymous) composite types
- [ ] Catch [UnicodeException](https://hackage.haskell.org/package/text-2.1/docs/Data-Text-Encoding-Error.html#t:UnicodeException) when decoding text

29
lib/Database/PostgreSQL/Opium.hs
View File

@ -16,7 +16,6 @@ module Database.PostgreSQL.Opium
, FromField (..)
, FromRow (..)
, RawField (..)
, fetch
, fetch_
, toListColumnTable
)
@ -46,17 +45,11 @@ import qualified Database.PostgreSQL.LibPQ as LibPQ
import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
import Database.PostgreSQL.Opium.FromField (FromField (..), fromField, RawField (..))
import Database.PostgreSQL.Opium.ToParamList (ToParamList (..))
execParams
:: ToParamList a
=> Connection
-> Text
-> a
-> ExceptT Error IO Result
execParams conn query params = do
execParams :: Connection -> Text -> ExceptT Error IO Result
execParams conn query = do
let queryBytes = Encoding.encodeUtf8 query
liftIO (LibPQ.execParams conn queryBytes (toParamList params) LibPQ.Binary) >>= \case
liftIO (LibPQ.execParams conn queryBytes [] LibPQ.Binary) >>= \case
Nothing ->
except $ Left ErrorNoResult
Just result -> do
@ -67,21 +60,13 @@ execParams conn query params = do
Nothing -> pure result
Just message -> except $ Left $ ErrorInvalidResult status $ Encoding.decodeUtf8 message
fetch
:: forall a b. (ToParamList a, FromRow b)
=> Connection
-> Text
-> a
-> IO (Either Error [b])
fetch conn query params = runExceptT $ do
result <- execParams conn query params
columnTable <- ExceptT $ getColumnTable @b Proxy result
fetch_ :: forall a. FromRow a => Connection -> Text -> IO (Either Error [a])
fetch_ conn query = runExceptT $ do
result <- execParams conn query
columnTable <- ExceptT $ getColumnTable @a Proxy result
nRows <- liftIO $ LibPQ.ntuples result
mapM (ExceptT . fromRow result columnTable) [0..nRows - 1]
fetch_ :: forall a. FromRow a => Connection -> Text -> IO (Either Error [a])
fetch_ conn query = fetch conn query ()
newtype ColumnTable = ColumnTable (Vector (Column, Oid))
deriving (Eq, Show)

27
lib/Database/PostgreSQL/Opium/FromField.hs
View File

@ -41,9 +41,6 @@ import qualified Database.PostgreSQL.Opium.Oid as Oid
(\/) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
p \/ q = \x -> p x || q x
eq :: Eq a => a -> a -> Bool
eq = (==)
fromField :: FromField a => ByteString -> Either String a
fromField =
AP.parseOnly parseField
@ -55,13 +52,13 @@ class FromField a where
-- | See https://www.postgresql.org/docs/current/datatype-binary.html.
-- Accepts @bytea@.
instance FromField ByteString where
validOid Proxy = eq Oid.bytea
validOid Proxy = Oid.bytea
parseField = AP.takeByteString
-- | See https://www.postgresql.org/docs/current/datatype-character.html.
-- Accepts @text@, @character@ and @character varying@.
instance FromField Text where
validOid Proxy = eq Oid.text \/ eq Oid.character \/ eq Oid.characterVarying
validOid Proxy = Oid.text \/ Oid.character \/ Oid.characterVarying
parseField = Encoding.decodeUtf8 <$> AP.takeByteString
-- Accepts @text@, @character@ and @character varying@.
@ -101,22 +98,22 @@ readWord bs = case BS.length bs of
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
-- We assume that 'Int' has 64 bits. This is not guaranteed but reasonable enough.
instance FromField Int where
validOid Proxy = eq Oid.smallint \/ eq Oid.integer \/ eq Oid.bigint
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
parseField = readInt =<< AP.takeByteString
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
instance FromField Integer where
validOid Proxy = eq Oid.smallint \/ eq Oid.integer \/ eq Oid.bigint
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
parseField = readInt =<< AP.takeByteString
instance FromField Word where
validOid Proxy = eq Oid.smallint \/ eq Oid.integer \/ eq Oid.bigint
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
parseField = readWord =<< AP.takeByteString
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
-- Accepts only @real@ fields, not @double precision@.
instance FromField Float where
validOid Proxy = eq Oid.real
validOid Proxy = Oid.real
-- Afaict there's no cleaner (@base@) way to access the underlying bits.
-- In C we'd do
--
@ -128,7 +125,7 @@ instance FromField Float where
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
-- Accepts only @double precision@ fields, not @real@.
instance FromField Double where
validOid Proxy = eq Oid.doublePrecision
validOid Proxy = Oid.doublePrecision
parseField = unsafeCoerce <$> readBigEndian @Word <$> AP.takeByteString
boolParser :: Parser Bool
@ -139,7 +136,7 @@ boolParser = AP.choice
-- | See https://www.postgresql.org/docs/current/datatype-boolean.html.
instance FromField Bool where
validOid Proxy = eq Oid.boolean
validOid Proxy = Oid.boolean
parseField = boolParser
postgresEpoch :: Day
@ -154,14 +151,14 @@ fromPostgresJulian x = addDays x postgresEpoch
-- 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 = eq Oid.date
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 = eq Oid.time
validOid Proxy = Oid.time
parseField = microsecondsToDiffTime . fromIntegral <$> readBigEndian @Int <$> AP.takeByteString
where
microsecondsToDiffTime :: Integer -> DiffTime
@ -171,7 +168,7 @@ instance FromField DiffTime where
-- 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 = eq Oid.time
validOid Proxy = Oid.time
parseField = timeToTimeOfDay <$> parseField @DiffTime
fromPostgresTimestamp :: Int -> (Day, DiffTime)
@ -184,7 +181,7 @@ fromPostgresTimestamp ts = (day, time)
-- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
-- Accepts @timestamp with timezone@.
instance FromField UTCTime where
validOid Proxy = eq Oid.timestampWithTimezone
validOid Proxy = Oid.timestampWithTimezone
parseField = toUTCTime . fromPostgresTimestamp <$> readBigEndian @Int <$> AP.takeByteString
where
toUTCTime (day, time) = UTCTime day time

61
lib/Database/PostgreSQL/Opium/Oid.hs
View File

@ -2,62 +2,65 @@ module Database.PostgreSQL.Opium.Oid where
import Database.PostgreSQL.LibPQ (Oid (..))
eq :: Eq a => a -> a -> Bool
eq = (==)
-- raw byte string
bytea :: Oid
bytea = Oid 17
bytea :: Oid -> Bool
bytea = eq $ Oid 17
-- string types
text :: Oid
text = Oid 25
text :: Oid -> Bool
text = eq $ Oid 25
character :: Oid
character = Oid 1042
character :: Oid -> Bool
character = eq $ Oid 1042
characterVarying :: Oid
characterVarying = Oid 1043
characterVarying :: Oid -> Bool
characterVarying = eq $ Oid 1043
-- integer types
-- | 16-bit integer
smallint :: Oid
smallint = Oid 21
smallint :: Oid -> Bool
smallint = eq $ Oid 21
-- | 32-bit integer
integer :: Oid
integer = Oid 23
integer :: Oid -> Bool
integer = eq $ Oid 23
-- | 64-bit integer
bigint :: Oid
bigint = Oid 20
bigint :: Oid -> Bool
bigint = eq $ Oid 20
-- floating point types
-- | 32-bit IEEE float
real :: Oid
real = Oid 700
real :: Oid -> Bool
real = eq $ Oid 700
-- | 64-bit IEEE float
doublePrecision :: Oid
doublePrecision = Oid 701
doublePrecision :: Oid -> Bool
doublePrecision = eq $ Oid 701
-- | Oid
boolean :: Oid
boolean = Oid 16
-- | Boolean
boolean :: Oid -> Bool
boolean = eq $ Oid 16
-- | Single days/dates.
date :: Oid
date = Oid 1082
date :: Oid -> Bool
date = eq $ Oid 1082
-- | Time of day.
time :: Oid
time = Oid 1083
time :: Oid -> Bool
time = eq $ Oid 1083
-- | A point in time.
timestamp :: Oid
timestamp = Oid 1114
timestamp :: Oid -> Bool
timestamp = eq $ Oid 1114
-- | A point in time.
timestampWithTimezone :: Oid
timestampWithTimezone = Oid 1184
timestampWithTimezone :: Oid -> Bool
timestampWithTimezone = eq $ Oid 1184

50
lib/Database/PostgreSQL/Opium/ToField.hs
View File

@ -1,50 +0,0 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
module Database.PostgreSQL.Opium.ToField
( ToField (..)
) where
import Data.Bits (Bits (..))
import Data.ByteString (ByteString)
import Data.List (singleton)
import Data.Text (Text)
import Data.Word (Word32)
import Database.PostgreSQL.LibPQ (Format (..), Oid)
import Unsafe.Coerce (unsafeCoerce)
import qualified Data.ByteString as BS
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Encoding
import qualified Database.PostgreSQL.Opium.Oid as Oid
class ToField a where
toField :: a -> Maybe (Oid, ByteString, Format)
instance ToField ByteString where
toField x = Just (Oid.bytea, x, Binary)
instance ToField Text where
toField x = Just (Oid.text, Encoding.encodeUtf8 x, Binary)
instance ToField String where
toField = toField . Text.pack
instance ToField Char where
toField = toField . singleton
-- Potentially slow, but good enough for now
encodeBigEndian :: (Integral a, Bits a) => Int -> a -> ByteString
encodeBigEndian n = BS.pack . go [] n
where
go acc 0 _ = acc
go acc i x = go (fromIntegral (x .&. 0xff) : acc) (i - 1) (x `shiftR` 8)
instance ToField Int where
toField x = Just (Oid.bigint, encodeBigEndian 8 x, Binary)
instance ToField Float where
toField x = Just (Oid.real, encodeBigEndian @Word32 4 $ unsafeCoerce x, Binary)
instance ToField Double where
toField x = Just (Oid.doublePrecision, encodeBigEndian @Word 8 $ unsafeCoerce x, Binary)

62
lib/Database/PostgreSQL/Opium/ToParamList.hs
View File

@ -1,62 +0,0 @@
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
module Database.PostgreSQL.Opium.ToParamList
( ToParamList (..)
) where
import Data.ByteString (ByteString)
import Data.Functor.Identity (Identity)
import Database.PostgreSQL.LibPQ (Format, Oid)
import GHC.Generics (Generic, K1 (..), M1 (..), Rec0, Rep, U1 (..), from, (:*:) (..))
import Database.PostgreSQL.Opium.ToField (ToField (..))
class ToParamList a where
toParamList :: a -> [Maybe (Oid, ByteString, Format)]
default toParamList :: (Generic a, ToParamList' (Rep a)) => a -> [Maybe (Oid, ByteString, Format)]
toParamList = toParamList' . from
instance ToField a => ToParamList [a] where
toParamList = map toField
instance ToParamList () where
instance ToField a => ToParamList (Identity a) where
instance (ToField a, ToField b) => ToParamList (a, b) where
instance (ToField a, ToField b, ToField c) => ToParamList (a, b, c) where
instance (ToField a, ToField b, ToField c, ToField d) => ToParamList (a, b, c, d) where
instance (ToField a, ToField b, ToField c, ToField d, ToField e) => ToParamList (a, b, c, d, e) where
instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) => ToParamList (a, b, c, d, e, f) where
instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g) => ToParamList (a, b, c, d, e, f, g) where
instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h) => ToParamList (a, b, c, d, e, f, g, h) where
instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h, ToField i) => ToParamList (a, b, c, d, e, f, g, h, i) where
instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h, ToField i, ToField j) => ToParamList (a, b, c, d, e, f, g, h, i, j) where
instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, ToField g, ToField h, ToField i, ToField j, ToField k) => ToParamList (a, b, c, d, e, f, g, h, i, j, k) where
class ToParamList' f where
toParamList' :: f p -> [Maybe (Oid, ByteString, Format)]
instance ToField t => ToParamList' (Rec0 t) where
toParamList' (K1 x) = [toField x]
instance ToParamList' f => ToParamList' (M1 t c f) where
toParamList' (M1 x) = toParamList' x
instance ToParamList' U1 where
toParamList' U1 = []
instance (ToParamList' f, ToParamList' g) => ToParamList' (f :*: g) where
toParamList' (x :*: y) = toParamList' x ++ toParamList' y

16
test/Database/PostgreSQL/OpiumSpec.hs
View File

@ -7,7 +7,6 @@
module Database.PostgreSQL.OpiumSpec (spec) where
import Data.ByteString (ByteString)
import Data.Functor.Identity (Identity (..))
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Database.PostgreSQL.LibPQ (Connection)
@ -47,12 +46,6 @@ data ScoreByAge = ScoreByAge
instance Opium.FromRow ScoreByAge where
data Only a = Only
{ only :: a
} deriving (Eq, Generic, Show)
instance Opium.FromField a => Opium.FromRow (Only a) where
isLeft :: Either a b -> Bool
isLeft (Left _) = True
isLeft _ = False
@ -124,15 +117,6 @@ spec = do
row <- Opium.fromRow result columnTable 0
row `shouldBe` Right (ManyFields "abc" 42 1.0 "test" True)
describe "fetch" $ do
it "Passes numbered parameters and retrieves a list of rows" $ \conn -> do
rows <- Opium.fetch conn "SELECT ($1 + $2) AS only" (17 :: Int, 25 :: Int)
rows `shouldBe` Right [Only (42 :: Int)]
it "Uses Identity to pass single parameters" $ \conn -> do
rows <- Opium.fetch conn "SELECT count(*) AS only FROM person WHERE name = $1" $ Identity ("paul" :: Text)
rows `shouldBe` Right [Only (1 :: Int)]
describe "fetch_" $ do
it "Retrieves a list of rows" $ \conn -> do
rows <- Opium.fetch_ conn "SELECT * FROM person"