README.md

@@ -33,8 +33,8 @@ data User = User
 
 instance Opium.FromRow User where
 
-getUsers :: Connection -> IO (Either Opium.Error [User])
+getUsers :: Connection -> IO (Either Opium.Error [Users])
-getUsers = Opium.fetch_ "SELECT * FROM user"
+getUsers conn = Opium.fetch_ conn "SELECT * FROM user"
 ```
 
 The `Opium.FromRow` instance is implemented generically for all product types ("records"). It looks up the field name in the query result and decodes the column value using `Opium.FromField`.
@@ -51,7 +51,7 @@ instance Opium.FromRow ScoreByAge where
 getScoreByAge :: Connection -> IO ScoreByAge
 getScoreByAge conn = do
   let query = "SELECT regr_intercept(score, age) AS t, regr_slope(score, age) AS m FROM user"
-  Right (Identity x) <- Opium.fetch_ query conn
+  Right [x] <- Opium.fetch_ conn query
   pure x
 ```
 
@@ -62,25 +62,10 @@ getScoreByAge conn = do
 - [x] Implement error reporting i.e. use `Either OpiumError` instead of `Maybe`
 - [x] Implement `Float` and `Double` decoding
 - [x] Clean up and document column table stuff
-- [x] Decode `LibPQ.Binary`
+- [ ] Implement `fetch` (`fetch_` but with parameter passing)
-- [x] Implement `date -> Day` decoding
+- [ ] Implement `UTCTime` and zoned time decoding
-- [x] Implement `UTCTime`
-- [x] Implement `ByteString` decoding (`bytea`)
-- [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 JSON decoding
+- [ ] Implement `ByteString` decoding (`bytea`)
+  - Can we make the fromField instance choose whether it wants binary or text?
 - [ ] 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
+  - 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
-    - This might not be necessary if Postgres guarantees us that having a textual OID on a field means that the field is encoded correctly.
-- [ ] Implement array decoding
-- [ ] Better docs and structure for `FromRow` module
-- [ ] Lexer for PostgreSQL that replaces $name by $1, $2, etc.
-- [ ] Tutorial
-    - [ ] Rationale
-    - [ ] `FromRow`
-    - [ ] Custom `FromField` impls
-- [ ] Improve type errors when trying to `instance` a type that isn't a record (e.g. sum type)
-- [ ] Improve documentation for `fromRow` module

flake.lock

@@ -2,11 +2,11 @@
   "nodes": {
     "nixpkgs": {
       "locked": {
-        "lastModified": 1719285171,
+        "lastModified": 1681753173,
-        "narHash": "sha256-kOUKtKfYEh8h8goL/P6lKF4Jb0sXnEkFyEganzdTGvo=",
+        "narHash": "sha256-MrGmzZWLUqh2VstoikKLFFIELXm/lsf/G9U9zR96VD4=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "cfb89a95f19bea461fc37228dc4d07b22fe617c2",
+        "rev": "0a4206a51b386e5cda731e8ac78d76ad924c7125",
         "type": "github"
       },
       "original": {

flake.nix

@@ -3,24 +3,32 @@
 
   outputs = { self, nixpkgs }:
     let
-      system = "x86_64-linux";
+      pkgs = nixpkgs.legacyPackages.x86_64-linux;
-      pkgs = nixpkgs.legacyPackages.${system};
+    in {
-      opium = pkgs.haskellPackages.developPackage {
+      apps.x86_64-linux.cabal = {
-        root = ./.;
+        type = "app";
-        modifier = drv:
+        program = "${nixpkgs.legacyPackages.x86_64-linux.cabal-install}/bin/cabal";
-          pkgs.haskell.lib.addBuildTools drv [
+      };
+      devShells.x86_64-linux.default = pkgs.mkShell {
+        packages = [
           pkgs.cabal-install
           pkgs.haskellPackages.implicit-hie
+          (pkgs.ghc.withPackages (hp: with hp; [
+            attoparsec
+            containers
+            bytestring
+            hspec
+            postgresql-libpq
+            text
+            transformers
+            vector
+          ]))
+
           pkgs.haskell-language-server
         ];
+        shellHook = ''
+          PS1="<opium> ''${PS1}"
+        '';
       };
-    in {
-      packages.${system}.opium = pkgs.haskell.lib.overrideCabal opium {
-        # Currently the tests require a running Postgres instance.
-        # This is not automated yet, so don't export the tests.
-        doCheck = false;
-      };
-
-      devShells.${system}.default = opium.env;
     };
 }

lib/Database/PostgreSQL/Opium.hs

@@ -1,105 +1,53 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Database.PostgreSQL.Opium
-    -- * Queries
+  ( ColumnTable
-    --
-    -- Functions for performing queries. @fetch@ retrieves rows, @execute@ doesn't.
-    -- The 'Connection' parameter comes last to facilitate currying for implicitly passing in the connection, e.g. from some framework's connection pool.
-    --
-    -- | TODO: Add @newtype Query = Query Text@ with @IsString@ instance to make constructing query strings at run time harder.
-  ( fetch
-  , fetch_
-  , execute
-  , execute_
-    -- * Classes to Implement
-  , FromRow (..)
-  , FromField (..)
-  , ToParamList (..)
-  , ToField (..)
-    -- * Utility Stuff
   , Error (..)
   , ErrorPosition (..)
-  , RawField (..)
+  , FromField (..)
+  , FromRow (..)
+  , fetch_
+  , toListColumnTable
   )
   where
 
-import Control.Monad (unless, void)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT, throwE)
+import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT)
-import Data.Functor.Identity (Identity (..))
+import Data.ByteString (ByteString)
+import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
 import Data.Proxy (Proxy (..))
 import Data.Text (Text)
+import Data.Vector (Vector)
 import Database.PostgreSQL.LibPQ
-  ( Connection
+  ( Column
+  , Connection
+  , Oid
   , Result
+  , Row
   )
+import GHC.Generics (C, D, Generic, K1 (..), M1 (..), Meta (..), Rec0, Rep, S, to, (:*:) (..))
+import GHC.TypeLits (KnownSymbol, symbolVal)
 
+import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Encoding
+import qualified Data.Vector as Vector
 import qualified Database.PostgreSQL.LibPQ as LibPQ
 
 import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
-import Database.PostgreSQL.Opium.FromField (FromField (..), RawField (..))
+import Database.PostgreSQL.Opium.FromField (FromField (..), fromField)
-import Database.PostgreSQL.Opium.FromRow (FromRow (..), ColumnTable)
-import Database.PostgreSQL.Opium.ToField (ToField (..))
-import Database.PostgreSQL.Opium.ToParamList (ToParamList (..))
 
-class RowContainer c where
+execParams :: Connection -> ByteString -> ExceptT Error IO Result
-  extract :: FromRow a => Result -> LibPQ.Row -> ColumnTable -> ExceptT Error IO (c a)
+execParams conn query = do
-
+  liftIO (LibPQ.execParams conn query [] LibPQ.Text) >>= \case
-instance RowContainer [] where
-  extract result nRows columnTable = do
-    mapM (ExceptT . fromRow result columnTable) [0..nRows - 1]
-
-instance RowContainer Maybe where
-  extract result nRows columnTable
-    | nRows == 0 = pure Nothing
-    | nRows == 1 = Just <$> ExceptT (fromRow result columnTable 0)
-    | otherwise = throwE ErrorMoreThanOneRow
-
-instance RowContainer Identity where
-  extract result nRows columnTable = do
-    unless (nRows == 1) $ throwE ErrorNotExactlyOneRow
-    Identity <$> ExceptT (fromRow result columnTable 0)
-
--- The order of the type parameters is important, because it is more common to use type applications for providing the row type and row container type.
-fetch
-  :: forall a b c. (ToParamList c, FromRow a, RowContainer b)
-  => Text
-  -> c
-  -> Connection
-  -> IO (Either Error (b a))
-fetch query params conn = runExceptT $ do
-  result <- execParams conn query params
-  nRows <- liftIO $ LibPQ.ntuples result
-  columnTable <- ExceptT $ getColumnTable @a Proxy result
-  extract result nRows columnTable
-
-fetch_ :: forall a c. (FromRow a, RowContainer c) => Text -> Connection -> IO (Either Error (c a))
-fetch_ query = fetch query ()
-
-execute
-  :: forall a. ToParamList a
-  => Text
-  -> a
-  -> Connection
-  -> IO (Either Error ())
-execute query params conn = runExceptT $ void $ execParams conn query params
-
-execute_ :: Text -> Connection -> IO (Either Error ())
-execute_ query = execute query ()
-
-execParams
-  :: ToParamList a
-  => Connection
-  -> Text
-  -> a
-  -> ExceptT Error IO Result
-execParams conn query params = do
-  let queryBytes = Encoding.encodeUtf8 query
-  liftIO (LibPQ.execParams conn queryBytes (toParamList params) LibPQ.Binary) >>= \case
     Nothing ->
       except $ Left ErrorNoResult
     Just result -> do
@@ -109,3 +57,122 @@ execParams conn query params = do
         Just "" -> pure result
         Nothing -> pure result
         Just message -> except $ Left $ ErrorInvalidResult status $ Encoding.decodeUtf8 message
+
+fetch_ :: forall a. FromRow a => Connection -> ByteString -> 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]
+
+newtype ColumnTable = ColumnTable (Vector (Column, Oid))
+  deriving (Eq, Show)
+
+newColumnTable :: [(Column, Oid)] -> ColumnTable
+newColumnTable = ColumnTable . Vector.fromList
+
+indexColumnTable :: ColumnTable -> Int -> (Column, Oid)
+indexColumnTable (ColumnTable v) i = v `Vector.unsafeIndex` i
+
+toListColumnTable :: ColumnTable -> [(Column, Oid)]
+toListColumnTable (ColumnTable v) = Vector.toList v
+
+class FromRow a where
+  getColumnTable :: Proxy a -> Result -> IO (Either Error ColumnTable)
+  default getColumnTable :: (Generic a, GetColumnTable' (Rep a)) => Proxy a -> Result -> IO (Either Error ColumnTable)
+  getColumnTable Proxy = runExceptT . fmap newColumnTable . getColumnTable' @(Rep a) Proxy
+
+  fromRow :: Result -> ColumnTable -> Row -> IO (Either Error a)
+  default fromRow :: (Generic a, FromRow' (Rep a)) => Result -> ColumnTable -> Row -> IO (Either Error a)
+  fromRow result columnTable row = do
+    iRef <- newIORef 0
+    runExceptT $ to <$> fromRow' (FromRowCtx result columnTable iRef) row
+
+class GetColumnTable' f where
+  getColumnTable' :: Proxy (f p) -> Result -> ExceptT Error IO [(Column, Oid)]
+
+instance GetColumnTable' f => GetColumnTable' (M1 D c f) where
+  getColumnTable' Proxy = getColumnTable' @f Proxy
+
+instance GetColumnTable' f => GetColumnTable' (M1 C c f) where
+  getColumnTable' Proxy = getColumnTable' @f Proxy
+
+instance (GetColumnTable' f, GetColumnTable' g) => GetColumnTable' (f :*: g) where
+  getColumnTable' Proxy result =
+    (++) <$> getColumnTable' @f Proxy result <*> getColumnTable' @g Proxy result
+
+checkColumn :: forall a. FromField a => Proxy a -> String -> Result -> ExceptT Error IO [(Column, Oid)]
+checkColumn Proxy nameStr result = do
+  column <- ExceptT $ maybe (Left $ ErrorMissingColumn nameText) Right <$> LibPQ.fnumber result name
+  oid <- liftIO $ LibPQ.ftype result column
+  if validOid @a Proxy oid then
+    pure [(column, oid)]
+  else
+    except $ Left $ ErrorInvalidOid nameText oid
+  where
+    nameText = Text.pack nameStr
+    name = Encoding.encodeUtf8 nameText
+
+instance {-# OVERLAPPABLE #-} (FromField t, KnownSymbol nameSym) => GetColumnTable' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
+  getColumnTable' Proxy = checkColumn @t Proxy $ symbolVal @nameSym Proxy
+
+instance {-# OVERLAPPING #-} (KnownSymbol nameSym, FromField t) => GetColumnTable' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 (Maybe t))) where
+  getColumnTable' Proxy = checkColumn @t Proxy $ symbolVal @nameSym Proxy
+
+data FromRowCtx = FromRowCtx Result ColumnTable (IORef Int)
+
+class FromRow' f where
+  fromRow' :: FromRowCtx -> Row -> ExceptT Error IO (f p)
+
+instance FromRow' f => FromRow' (M1 D c f) where
+  fromRow' ctx row = M1 <$> fromRow' ctx row
+
+instance FromRow' f => FromRow' (M1 C c f) where
+  fromRow' ctx row = M1 <$> fromRow' ctx row
+
+instance (FromRow' f, FromRow' g) => FromRow' (f :*: g) where
+  fromRow' ctx row = do
+    y <- fromRow' ctx row
+    z <- fromRow' ctx row
+    pure $ y :*: z
+
+decodeField
+  :: FromField t
+  => Text
+  -> (Row -> Maybe t -> Either Error t')
+  -> FromRowCtx
+  -> Row
+  -> ExceptT Error IO (M1 S m (Rec0 t') p)
+decodeField nameText g (FromRowCtx result columnTable iRef) row = do
+  i <- liftIO $ readIORef iRef
+  liftIO $ modifyIORef' iRef (+1)
+  let (column, oid) = columnTable `indexColumnTable` i
+  mbField <- liftIO $ getFieldText column
+  mbValue <- except $ getValue oid mbField
+  value <- except $ g row mbValue
+  pure $ M1 $ K1 value
+  where
+    getFieldText :: Column -> IO (Maybe Text)
+    getFieldText column = 
+      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
+        (ErrorInvalidField (ErrorPosition row nameText) oid fieldText)
+        (Just <$> fromField fieldText)
+
+mapLeft :: (b -> c) -> Either b a -> Either c a
+mapLeft f (Left l) = Left $ f l
+mapLeft _ (Right r) = Right r
+
+instance {-# OVERLAPPABLE #-} (FromField t, KnownSymbol nameSym) => FromRow' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
+  fromRow' = decodeField nameText $ \row ->
+    maybe (Left $ ErrorUnexpectedNull $ ErrorPosition row nameText) Right
+    where
+      nameText = Text.pack $ symbolVal @nameSym Proxy
+
+instance {-# OVERLAPPING #-} (KnownSymbol nameSym, FromField t) => FromRow' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 (Maybe t))) where
+  fromRow' = decodeField nameText $ const pure
+    where
+      nameText = Text.pack $ symbolVal @nameSym Proxy

lib/Database/PostgreSQL/Opium/Error.hs

@@ -1,7 +1,6 @@
 module Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..)) where
 
 import Control.Exception (Exception)
-import Data.ByteString (ByteString)
 import Data.Text (Text)
 import Database.PostgreSQL.LibPQ (ExecStatus, Oid, Row)
 
@@ -16,9 +15,7 @@ data Error
   | ErrorMissingColumn Text
   | ErrorInvalidOid Text Oid
   | ErrorUnexpectedNull ErrorPosition
-  | ErrorInvalidField ErrorPosition Oid ByteString String
+  | ErrorInvalidField ErrorPosition Oid Text String
-  | ErrorNotExactlyOneRow
-  | ErrorMoreThanOneRow
   deriving (Eq, Show)
 
 instance Exception Error where

lib/Database/PostgreSQL/Opium/FromField.hs

@@ -3,68 +3,47 @@
 {-# LANGUAGE TypeApplications #-}
 
 module Database.PostgreSQL.Opium.FromField
-  ( -- * Decoding data from @libpq@
+  ( FromField (..)
-    FromField (..)
   , fromField
-    -- * Utility types
-  , RawField (..)
   ) where
 
-import Data.Attoparsec.ByteString (Parser)
+import Data.Attoparsec.Text
-import Data.Bits (Bits (..))
+  ( Parser
-import Data.ByteString (ByteString)
+  , anyChar
-import Data.Functor (($>))
+  , choice
-import Data.Int (Int16, Int32)
+  , decimal
-import Data.Proxy (Proxy (..))
+  , double
-import Data.Time
+  , parseOnly
-  ( Day (..)
+  , signed
-  , DiffTime
+  , string
-  , TimeOfDay
+  , takeText
-  , UTCTime (..)
-  , addDays
-  , fromGregorian
-  , picosecondsToDiffTime
-  , timeToTimeOfDay
   )
+import Data.Functor (($>))
+import Data.Proxy (Proxy (..))
 import Data.Text (Text)
-import Data.Word (Word16, Word32)
 import Database.PostgreSQL.LibPQ (Oid)
-import Unsafe.Coerce (unsafeCoerce)
+import GHC.Float (double2Float)
 
-import qualified Data.Attoparsec.ByteString as AP
-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
 
 (\/) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
 p \/ q = \x -> p x || q x
 
-eq :: Eq a => a -> a -> Bool
+fromField :: FromField a => Text -> Either String a
-eq = (==)
-
-fromField :: FromField a => ByteString -> Either String a
 fromField =
-  AP.parseOnly parseField
+  parseOnly parseField
 
 class FromField a where
   validOid :: Proxy a -> Oid -> Bool
   parseField :: Parser a
 
--- | See https://www.postgresql.org/docs/current/datatype-binary.html.
--- Accepts @bytea@.
-instance FromField ByteString where
-  validOid Proxy = eq 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
+  parseField = takeText
 
--- Accepts @text@, @character@ and @character varying@.
 -- | See https://www.postgresql.org/docs/current/datatype-character.html.
 instance FromField String where
   validOid Proxy = validOid @Text Proxy
@@ -74,124 +53,48 @@ instance FromField String where
 -- This instance accepts all character types but fails to decode fields that are not exactly one character.
 instance FromField Char where
   validOid Proxy = validOid @Text Proxy
-  parseField = do
+  parseField = anyChar
-    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.
 -- 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
+  parseField = signed decimal
 
 -- | 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
+  parseField = signed decimal
 
 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
+  parseField = decimal
+
+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
-  validOid Proxy = eq Oid.real
+  validOid Proxy = Oid.real
-  -- Afaict there's no cleaner (@base@) way to access the underlying bits.
+  parseField = fmap double2Float doubleParser
-  -- 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
-  validOid Proxy = eq Oid.doublePrecision
+  validOid Proxy = Oid.real \/ Oid.doublePrecision
-  parseField = unsafeCoerce <$> readBigEndian @Word <$> AP.takeByteString
+  parseField = doubleParser
 
 boolParser :: Parser Bool
-boolParser = AP.choice
+boolParser = choice
-  [ AP.word8 1 $> True
+  [ string "t" $> True
-  , AP.word8 0 $> False
+  , string "f" $> False
   ]
 
 -- | 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
-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 = eq 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
-  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 = eq 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 = eq 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

lib/Database/PostgreSQL/Opium/FromRow.hs

@@ -1,187 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-module Database.PostgreSQL.Opium.FromRow
-  -- * FromRow
-  ( FromRow (..)
-  -- * Internal
-  , ColumnTable
-  , toListColumnTable
-  ) where
-
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT)
-import Data.ByteString (ByteString)
-import Data.Bifunctor (first)
-import Data.Kind (Type)
-import Data.Proxy (Proxy (..))
-import Data.Text (Text)
-import Data.Vector (Vector)
-import Database.PostgreSQL.LibPQ
-  ( Column
-  , Oid
-  , Result
-  , Row
-  )
-import GHC.Generics (Generic, C, D, K1 (..), M1 (..), Meta (..), Rec0, Rep, S, to, (:*:) (..))
-import GHC.TypeLits (KnownNat, KnownSymbol, Nat, natVal, symbolVal, type (+))
-
-import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Encoding
-import qualified Data.Vector as Vector
-import qualified Database.PostgreSQL.LibPQ as LibPQ
-
-import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
-import Database.PostgreSQL.Opium.FromField (FromField (..), fromField)
-
-class FromRow a where
-  getColumnTable :: Proxy a -> Result -> IO (Either Error ColumnTable)
-  default getColumnTable :: (Generic a, GetColumnTable' (Rep a)) => Proxy a -> Result -> IO (Either Error ColumnTable)
-  getColumnTable Proxy = runExceptT . fmap newColumnTable . getColumnTable' @(Rep a) Proxy
-
-  fromRow :: Result -> ColumnTable -> Row -> IO (Either Error a)
-  default fromRow :: (Generic a, FromRow' 0 (Rep a)) => Result -> ColumnTable -> Row -> IO (Either Error a)
-  fromRow result columnTable row =
-    runExceptT $ to <$> fromRow' @0 FRProxy (FromRowCtx result columnTable) row
-
-instance
-  ( Generic a
-  , GetColumnTable' (Rep a)
-  , FromRow' 0 (Rep a)
-  , Generic b
-  , GetColumnTable' (Rep b)
-  , FromRow' (NumberOfMembers (Rep a)) (Rep b)
-  ) => FromRow (a, b) where
-  getColumnTable Proxy result = runExceptT $ do
-    ctA <- newColumnTable <$> getColumnTable' @(Rep a) Proxy result
-    ctB <- newColumnTable <$> getColumnTable' @(Rep b) Proxy result
-    pure $ ctA `concatColumnTables` ctB
-
-  fromRow result ct row = runExceptT $ do
-    x <- to <$> fromRow' @0 FRProxy (FromRowCtx result ct) row
-    y <- to <$> fromRow' @(NumberOfMembers (Rep a)) FRProxy (FromRowCtx result ct) row
-    pure (x, y)
-
-newtype ColumnTable = ColumnTable (Vector (Column, Oid))
-  deriving (Eq, Show)
-
-newColumnTable :: [(Column, Oid)] -> ColumnTable
-newColumnTable = ColumnTable . Vector.fromList
-
-concatColumnTables :: ColumnTable -> ColumnTable -> ColumnTable
-concatColumnTables (ColumnTable a) (ColumnTable b) =
-  ColumnTable $ a <> b
-
-indexColumnTable :: ColumnTable -> Int -> (Column, Oid)
-indexColumnTable (ColumnTable v) i = v `Vector.unsafeIndex` i
-
-toListColumnTable :: ColumnTable -> [(Column, Oid)]
-toListColumnTable (ColumnTable v) = Vector.toList v
-
-class GetColumnTable' f where
-  getColumnTable' :: Proxy (f p) -> Result -> ExceptT Error IO [(Column, Oid)]
-
-instance GetColumnTable' f => GetColumnTable' (M1 D c f) where
-  getColumnTable' Proxy = getColumnTable' @f Proxy
-
-instance GetColumnTable' f => GetColumnTable' (M1 C c f) where
-  getColumnTable' Proxy = getColumnTable' @f Proxy
-
-instance (GetColumnTable' f, GetColumnTable' g) => GetColumnTable' (f :*: g) where
-  getColumnTable' Proxy result =
-    (++) <$> getColumnTable' @f Proxy result <*> getColumnTable' @g Proxy result
-
-instance {-# OVERLAPPABLE #-} (FromField t, KnownSymbol nameSym) => GetColumnTable' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
-  getColumnTable' Proxy = checkColumn @t Proxy $ symbolVal @nameSym Proxy
-
-instance {-# OVERLAPPING #-} (KnownSymbol nameSym, FromField t) => GetColumnTable' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 (Maybe t))) where
-  getColumnTable' Proxy = checkColumn @t Proxy $ symbolVal @nameSym Proxy
-
--- | Number of members in the generic representation of a record type (doesn't support sum types).
-type family NumberOfMembers f where
-  -- The data type itself has as many members as the type that it defines.
-  NumberOfMembers (M1 D _ f) = NumberOfMembers f
-  -- The constructor has as many members as the type that it contains.
-  NumberOfMembers (M1 C _ f) = NumberOfMembers f
-  -- A product type has as many members as its subtypes have together.
-  NumberOfMembers (f :*: g) = NumberOfMembers f + NumberOfMembers g
-  -- A selector has/is exactly one member.
-  NumberOfMembers (M1 S _ f) = 1
-
--- | State kept for a call to 'fromRow'.
-data FromRowCtx = FromRowCtx
-  Result -- ^ Obtained from 'LibPQ.execParams'.
-  ColumnTable -- ^ 'Vector' of expected columns indices and OIDs.
-
--- Specialized proxy type to be used instead of `Proxy (n, f)`
-data FRProxy (n :: Nat) (f :: Type -> Type) = FRProxy
-
-class FromRow' (n :: Nat) (f :: Type -> Type) where
-  fromRow' :: FRProxy n f -> FromRowCtx -> Row -> ExceptT Error IO (f p)
-
-instance FromRow' n f => FromRow' n (M1 D c f) where
-  fromRow' FRProxy ctx row =
-    M1 <$> fromRow' @n FRProxy ctx row
-
-instance FromRow' n f => FromRow' n (M1 C c f) where
-  fromRow' FRProxy ctx row =
-    M1 <$> fromRow' @n FRProxy ctx row
-
-instance (FromRow' n f, FromRow' (n + NumberOfMembers f) g) => FromRow' n (f :*: g) where
-  fromRow' FRProxy ctx row =
-    (:*:) <$> fromRow' @n FRProxy ctx row <*> fromRow' @(n + NumberOfMembers f) FRProxy ctx row
-
-instance {-# OVERLAPPABLE #-} (KnownNat n, KnownSymbol nameSym, FromField t) => FromRow' n (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
-  fromRow' FRProxy = decodeField memberIndex nameText $ \row ->
-    maybe (Left $ ErrorUnexpectedNull $ ErrorPosition row nameText) Right
-    where
-      memberIndex = fromIntegral $ natVal @n Proxy
-      nameText = Text.pack $ symbolVal @nameSym Proxy
-
-instance {-# OVERLAPPING #-} (KnownNat n, KnownSymbol nameSym, FromField t) => FromRow' n (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 (Maybe t))) where
-  fromRow' FRProxy = decodeField memberIndex nameText $ const pure
-    where
-      memberIndex = fromIntegral $ natVal @n Proxy
-      nameText = Text.pack $ symbolVal @nameSym Proxy
-
-checkColumn :: forall a. FromField a => Proxy a -> String -> Result -> ExceptT Error IO [(Column, Oid)]
-checkColumn Proxy nameStr result = do
-  column <- ExceptT $ maybe (Left $ ErrorMissingColumn nameText) Right <$> LibPQ.fnumber result name
-  oid <- liftIO $ LibPQ.ftype result column
-  if validOid @a Proxy oid then
-    pure [(column, oid)]
-  else
-    except $ Left $ ErrorInvalidOid nameText oid
-  where
-    nameText = Text.pack nameStr
-    name = Encoding.encodeUtf8 nameText
-
-decodeField
-  :: FromField t
-  => Int
-  -> Text
-  -> (Row -> Maybe t -> Either Error t')
-  -> FromRowCtx
-  -> Row
-  -> ExceptT Error IO (M1 S m (Rec0 t') p)
-decodeField memberIndex nameText g (FromRowCtx result columnTable) row = do
-  let (column, oid) = columnTable `indexColumnTable` memberIndex
-  mbField <- liftIO $ LibPQ.getvalue result row column
-  mbValue <- except $ fromFieldIfPresent oid mbField
-  value <- except $ g row mbValue
-  pure $ M1 $ K1 value
-  where
-    fromFieldIfPresent :: FromField u => LibPQ.Oid -> Maybe ByteString -> Either Error (Maybe u)
-    fromFieldIfPresent oid = maybe (Right Nothing) $ \field ->
-      first
-        (ErrorInvalidField (ErrorPosition row nameText) oid field)
-        (Just <$> fromField field)

lib/Database/PostgreSQL/Opium/Oid.hs

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

lib/Database/PostgreSQL/Opium/ToField.hs

@@ -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)

lib/Database/PostgreSQL/Opium/ToParamList.hs

@@ -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

opium.cabal

@@ -52,7 +52,7 @@ build-type:         Simple
 -- extra-source-files:
 
 common warnings
-    ghc-options: -Wall -Wextra
+    ghc-options: -Wall
 
 library
     -- Import common warning flags.
@@ -60,16 +60,13 @@ library
 
     -- Modules exported by the library.
     exposed-modules:
-        Database.PostgreSQL.Opium,
+        Database.PostgreSQL.Opium
-        Database.PostgreSQL.Opium.FromField,
-        Database.PostgreSQL.Opium.FromRow,
-        Database.PostgreSQL.Opium.ToField
 
     -- Modules included in this library but not exported.
     other-modules:
         Database.PostgreSQL.Opium.Error,
-        Database.PostgreSQL.Opium.Oid,
+        Database.PostgreSQL.Opium.FromField,
-        Database.PostgreSQL.Opium.ToParamList
+        Database.PostgreSQL.Opium.Oid
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
@@ -82,7 +79,6 @@ library
         containers,
         postgresql-libpq,
         text,
-        time,
         transformers,
         vector
 
@@ -126,5 +122,4 @@ test-suite opium-test
         bytestring,
         hspec,
         postgresql-libpq,
-        time,
         text

test/Database/PostgreSQL/Opium/FromFieldSpec.hs

@@ -4,23 +4,12 @@
 module Database.PostgreSQL.Opium.FromFieldSpec (spec) where
 
 import Data.ByteString (ByteString)
-import Data.Time
-  ( Day (..)
-  , DiffTime
-  , TimeOfDay (..)
-  , UTCTime (..)
-  , fromGregorian
-  , secondsToDiffTime
-  , timeOfDayToTime
-  )
 import Data.Text (Text)
 import Database.PostgreSQL.LibPQ (Connection)
 import Database.PostgreSQL.Opium (FromRow)
 import GHC.Generics (Generic)
 import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy)
 
-import qualified Data.ByteString as BS
-
 import qualified Database.PostgreSQL.Opium as Opium
 
 newtype AnInt = AnInt
@@ -41,12 +30,6 @@ newtype AWord = AWord
 
 instance FromRow AWord where
 
-newtype AByteString = AByteString
-  { bytestring :: ByteString
-  } deriving (Eq, Generic, Show)
-
-instance FromRow AByteString where
-
 newtype AText = AText
   { text :: Text
   } deriving (Eq, Generic, Show)
@@ -83,39 +66,9 @@ newtype ABool = ABool
 
 instance FromRow ABool where
 
-newtype ADay = ADay
+shouldFetch :: (Eq a, FromRow a, Show a) => Connection -> ByteString -> [a] -> IO ()
-  { 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
-  actualRows <- Opium.fetch_ query conn
+  actualRows <- Opium.fetch_ conn query
   actualRows `shouldBe` Right expectedRows
 
 (/\) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
@@ -133,15 +86,6 @@ spec = do
     it "Decodes bigint" $ \conn -> do
       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
     it "Decodes smallint" $ \conn -> do
       shouldFetch conn "SELECT 42::SMALLINT AS integer" [AnInteger 42]
@@ -152,9 +96,6 @@ spec = do
     it "Decodes bigint" $ \conn -> do
       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
     it "Decodes smallint" $ \conn -> do
       shouldFetch conn "SELECT 42::SMALLINT AS word" [AWord 42]
@@ -165,16 +106,6 @@ spec = do
     it "Decodes bigint" $ \conn -> do
       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
     it "Decodes text" $ \conn -> do
       shouldFetch conn "SELECT 'Hello, World!'::TEXT AS text" [AText "Hello, World!"]
@@ -213,38 +144,41 @@ spec = do
       shouldFetch conn "SELECT 4.2::real AS float" [AFloat 4.2]
 
     it "Decodes NaN::real" $ \conn -> do
-      Right [AFloat value] <- Opium.fetch_ "SELECT 'NaN'::real AS float" conn
+      Right [AFloat value] <- Opium.fetch_ conn "SELECT 'NaN'::real AS float"
       value `shouldSatisfy` isNaN
 
     it "Decodes Infinity::real" $ \conn -> do
-      Right [AFloat value] <- Opium.fetch_ "SELECT 'Infinity'::real AS float" conn
+      Right [AFloat value] <- Opium.fetch_ conn "SELECT 'Infinity'::real AS float"
       value `shouldSatisfy` (isInfinite /\ (> 0))
 
     it "Decodes -Infinity::real" $ \conn -> do
-      Right [AFloat value] <- Opium.fetch_ "SELECT '-Infinity'::real AS float" conn
+      Right [AFloat value] <- Opium.fetch_ conn "SELECT '-Infinity'::real AS float"
       value `shouldSatisfy` (isInfinite /\ (< 0))
 
   describe "FromField Double" $ do
     it "Decodes double precision" $ \conn -> do
       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
-      Right [ADouble value] <- Opium.fetch_ "SELECT 'NaN'::double precision AS double" conn
+      Right [ADouble value] <- Opium.fetch_ conn "SELECT 'NaN'::double precision AS double"
       value `shouldSatisfy` isNaN
 
     it "Decodes Infinity::double precision" $ \conn -> do
-      Right [ADouble value] <- Opium.fetch_ "SELECT 'Infinity'::double precision AS double" conn
+      Right [ADouble value] <- Opium.fetch_ conn "SELECT 'Infinity'::double precision AS double"
       value `shouldSatisfy` (isInfinite /\ (> 0))
 
     it "Decodes -Infinity::double precision" $ \conn -> do
-      Right [ADouble value] <- Opium.fetch_ "SELECT '-Infinity'::double precision AS double" conn
+      Right [ADouble value] <- Opium.fetch_ conn "SELECT '-Infinity'::double precision AS double"
       value `shouldSatisfy` (isInfinite /\ (< 0))
 
     it "Decodes {inf,-inf}::double precision" $ \conn -> do
-      Right [ADouble value0] <- Opium.fetch_ "SELECT 'inf'::double precision AS double" conn
+      Right [ADouble value0] <- Opium.fetch_ conn "SELECT 'inf'::double precision AS double"
       value0 `shouldSatisfy` (isInfinite /\ (> 0))
 
-      Right [ADouble value1] <- Opium.fetch_ "SELECT '-inf'::double precision AS double" conn
+      Right [ADouble value1] <- Opium.fetch_ conn "SELECT '-inf'::double precision AS double"
       value1 `shouldSatisfy` (isInfinite /\ (< 0))
 
   describe "FromField Bool" $ do
@@ -259,51 +193,3 @@ spec = do
       shouldFetch conn "SELECT 'no'::boolean AS bool" [ABool False]
       shouldFetch conn "SELECT 'off'::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]]

test/Database/PostgreSQL/OpiumSpec.hs

@@ -7,8 +7,6 @@
 module Database.PostgreSQL.OpiumSpec (spec) where
 
 import Data.ByteString (ByteString)
-import Data.Either (isLeft)
-import Data.Functor.Identity (Identity (..))
 import Data.Proxy (Proxy (..))
 import Data.Text (Text)
 import Database.PostgreSQL.LibPQ (Connection)
@@ -17,7 +15,6 @@ import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy)
 
 import qualified Database.PostgreSQL.LibPQ as LibPQ
 import qualified Database.PostgreSQL.Opium as Opium
-import qualified Database.PostgreSQL.Opium.FromRow as Opium.FromRow
 
 data Person = Person
   { name :: Text
@@ -49,11 +46,9 @@ data ScoreByAge = ScoreByAge
 
 instance Opium.FromRow ScoreByAge where
 
-newtype Only a = Only
+isLeft :: Either a b -> Bool
-  { only :: a
+isLeft (Left _) = True
-  } deriving (Eq, Generic, Show)
+isLeft _ = False
-
-instance Opium.FromField a => Opium.FromRow (Only a) where
 
 shouldHaveColumns
   :: Opium.FromRow a
@@ -63,9 +58,9 @@ shouldHaveColumns
   -> [LibPQ.Column]
   -> IO ()
 shouldHaveColumns proxy conn query expectedColumns = do
-  Just result <- LibPQ.execParams conn query [] LibPQ.Binary
+  Just result <- LibPQ.execParams conn query [] LibPQ.Text
   columnTable <- Opium.getColumnTable proxy result
-  let actualColumns = fmap (map fst . Opium.FromRow.toListColumnTable) columnTable
+  let actualColumns = fmap (map fst . Opium.toListColumnTable) columnTable
   actualColumns `shouldBe` Right expectedColumns
 
 spec :: SpecWith Connection
@@ -86,13 +81,13 @@ spec = do
         [5, 3]
 
     it "Fails for missing columns" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Binary
+      Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Text
       columnTable <- Opium.getColumnTable @Person Proxy result
       columnTable `shouldBe` Left (Opium.ErrorMissingColumn "name")
 
   describe "fromRow" $ do
     it "Decodes rows in a Result" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Binary
+      Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Text
       Right columnTable <- Opium.getColumnTable @Person Proxy result
 
       row0 <- Opium.fromRow @Person result columnTable 0
@@ -102,83 +97,43 @@ spec = do
       row1 `shouldBe` Right (Person "albus" 103)
 
     it "Decodes NULL into Nothing for Maybes" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Binary
+      Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Text
       Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
 
       row <- Opium.fromRow result columnTable 0
       row `shouldBe` Right (MaybeTest Nothing)
 
     it "Decodes values into Just for Maybes" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Binary
+      Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Text
       Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
 
       row <- Opium.fromRow result columnTable 0
       row `shouldBe` Right (MaybeTest $ Just "abc")
 
     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.Binary
+      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
       Right columnTable <- Opium.getColumnTable @ManyFields Proxy result
 
       row <- Opium.fromRow result columnTable 0
       row `shouldBe` Right (ManyFields "abc" 42 1.0 "test" True)
 
-    it "Decodes multiple records into a tuple" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT 'albus' AS name, 123 AS age, 42 AS only" [] LibPQ.Binary
-      Right columnTable <- Opium.getColumnTable @(Person, Only Int) Proxy result
-
-      row <- Opium.fromRow @(Person, Only Int) result columnTable 0
-      row `shouldBe` Right (Person "albus" 123, Only 42)
-
-  describe "fetch" $ do
-    it "Passes numbered parameters and retrieves a list of rows" $ \conn -> do
-      rows <- Opium.fetch "SELECT ($1 + $2) AS only" (17 :: Int, 25 :: Int) conn
-      rows `shouldBe` Right [Only (42 :: Int)]
-
-    it "Uses Identity to pass single parameters" $ \conn -> do
-      rows <- Opium.fetch "SELECT count(*) AS only FROM person WHERE name = $1" (Identity ("paul" :: Text)) conn
-      rows `shouldBe` Right [Only (1 :: Int)]
-
   describe "fetch_" $ do
     it "Retrieves a list of rows" $ \conn -> do
-      rows <- Opium.fetch_ "SELECT * FROM person" conn
+      rows <- Opium.fetch_ conn "SELECT * FROM person"
       rows `shouldBe` Right [Person "paul" 25, Person "albus" 103]
 
     it "Fails for invalid queries" $ \conn -> do
-      rows <- Opium.fetch_ @Person @[] "MRTLBRNFT" conn
+      rows <- Opium.fetch_ @Person conn "MRTLBRNFT"
       rows `shouldSatisfy` isLeft
 
     it "Fails for unexpected NULLs" $ \conn -> do
-      rows <- Opium.fetch_ @Person @[] "SELECT NULL AS name, 0 AS age" conn
+      rows <- Opium.fetch_ @Person conn "SELECT NULL AS name, 0 AS age"
       rows `shouldBe` Left (Opium.ErrorUnexpectedNull (Opium.ErrorPosition 0 "name"))
 
     it "Fails for the wrong column type" $ \conn -> do
-      rows <- Opium.fetch_ @Person @[] "SELECT 'quby' AS name, 'indeterminate' AS age" conn
+      rows <- Opium.fetch_ @Person conn "SELECT 'quby' AS name, 'indeterminate' AS age"
       rows `shouldBe` Left (Opium.ErrorInvalidOid "age" $ LibPQ.Oid 25)
 
     it "Works for the readme regression example" $ \conn -> do
-      rows <- Opium.fetch_ @ScoreByAge @[] "SELECT regr_intercept(score, age) AS t, regr_slope(score, age) AS m FROM person" conn
+      rows <- Opium.fetch_ @ScoreByAge conn "SELECT regr_intercept(score, age) AS t, regr_slope(score, age) AS m FROM person"
       rows `shouldSatisfy` \case { (Right [ScoreByAge _ _]) -> True; _ -> False }
-
-    it "Accepts exactly one row when Identity is the row container type" $ \conn -> do
-      row <- Opium.fetch_ "SELECT 42 AS only" conn
-      row `shouldBe` Right (Identity (Only (42 :: Int)))
-
-    it "Does not accept zero rows when Identity is the row container type" $ \conn -> do
-      row <- Opium.fetch_ @(Only Int) @Identity "SELECT 42 AS only WHERE false" conn
-      row `shouldSatisfy` isLeft
-
-    it "Does not accept two rows when Identity is the row container type" $ \conn -> do
-      row <- Opium.fetch_ @(Only Int) @Identity "SELECT 17 AS only UNION ALL SELECT 25 AS only" conn
-      row `shouldSatisfy` isLeft
-
-    it "Accepts zero rows when Maybe is the row container type" $ \conn -> do
-      row <- Opium.fetch_ @(Only Int) @Maybe "SELECT 17 AS only WHERE false" conn
-      row `shouldBe` Right Nothing
-
-    it "Accepts one row when Maybe is the row container type" $ \conn -> do
-      row <- Opium.fetch_ @(Only Int) @Maybe "SELECT 42 AS only" conn
-      row `shouldBe` Right (Just (Only 42))
-
-    it "Does not accept two rows when Maybe is the row container type" $ \conn -> do
-      row <- Opium.fetch_ @(Only Int) @Maybe "SELECT 17 AS only UNION ALL SELECT 25 AS only" conn
-      row `shouldSatisfy` isLeft