Add unit tests and reimplement FromField

README.md

@@ -0,0 +1,11 @@
+# opium
+
+> An opionated Haskell Postgres library.
+
+## TO DO
+
+- [x] Implement `String` and `Text` decoding
+- [x] Implement `Int` decoding
+- [ ] Implement error reporting i.e. use `Either OpiumError` instead of `Maybe`
+- [ ] Implement `Float` and `Double` decoding
+- [ ] Implement `UTCTime` and zoned time decoding

flake.nix

@@ -14,10 +14,13 @@
           pkgs.cabal-install
           pkgs.haskellPackages.implicit-hie
           (pkgs.ghc.withPackages (hp: with hp; [
+            attoparsec
             containers
             bytestring
+            hspec
             postgresql-libpq
             text
+            transformers
           ]))
 
           pkgs.haskell-language-server

lib/Database/PostgreSQL/Opium.hs

@@ -5,12 +5,19 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Database.PostgreSQL.Opium where
+module Database.PostgreSQL.Opium
+  ( FromField (..)
+  , FromRow (..)
+  , fetch_
+  )
+  where
 
+import Control.Monad.Trans.Maybe (MaybeT (..))
 import Data.ByteString (ByteString)
 import Data.Proxy (Proxy (Proxy))
 import Database.PostgreSQL.LibPQ
-  (Result
+  ( Connection
+  , Result
   , Row
   )
 import GHC.Generics (C, D, Generic, K1 (..), M1 (..), Meta (..), Rec0, Rep, S, to, (:*:) (..))
@@ -21,6 +28,18 @@ import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Encoding
 import qualified Database.PostgreSQL.LibPQ as LibPQ
 
+import Database.PostgreSQL.Opium.FromField (FromField (..))
+
+fetch_ :: FromRow a => Connection -> ByteString -> IO (Maybe [a])
+fetch_ conn query = runMaybeT $ do
+  result <- MaybeT $ LibPQ.execParams conn query [] LibPQ.Text
+  MaybeT $ fetchResult result
+
+fetchResult :: FromRow a => Result -> IO (Maybe [a])
+fetchResult result = do
+  nRows <- LibPQ.ntuples result
+  runMaybeT $ mapM (MaybeT . flip fromRow result) [0..nRows - 1]
+
 class FromRow a where
   fromRow :: Row -> Result -> IO (Maybe a)
   default fromRow :: (Generic a, FromRow' (Rep a)) => Row -> Result -> IO (Maybe a)
@@ -48,16 +67,13 @@ instance (KnownSymbol nameSym, FromField t) => FromRow' (M1 S ('MetaSel ('Just n
       Nothing -> pure Nothing
       Just column -> do
         mbField <- LibPQ.getvalue result row column
-        printf "%s: %s" (show name) (show mbField)
-        pure $ M1 . K1 <$> fromField mbField
+        ty <- LibPQ.ftype result column
+        case fromField ty . Encoding.decodeUtf8 =<< mbField of
+          Nothing -> do
+            format <- LibPQ.fformat result column
+            printf "field %s: %s (oid: %s, format: %s)\n" (show name) (show mbField) (show ty) (show format)
+            pure Nothing
+          Just value ->
+            pure $ Just $ M1 $ K1 value
     where
       name = Encoding.encodeUtf8 $ Text.pack $ symbolVal (Proxy :: Proxy nameSym)
-
-class FromField a where
-  fromField :: Maybe ByteString -> Maybe a
-
-instance FromField String where
-  fromField = fmap (Text.unpack . Encoding.decodeUtf8)
-
-instance FromField Int where
-  fromField = fmap (read . Text.unpack . Encoding.decodeUtf8)

lib/Database/PostgreSQL/Opium/FromField.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Database.PostgreSQL.Opium.FromField (FromField (..)) where
+
+import Data.Attoparsec.Text
+  ( Parser
+  , decimal
+  , parseOnly
+  , signed
+  )
+import Data.Text (Text)
+import Database.PostgreSQL.LibPQ (Oid)
+
+import qualified Data.Text as Text
+import qualified Database.PostgreSQL.Opium.Oid as Oid
+
+(\/) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
+p \/ q = \x -> p x || q x
+
+eitherToMaybe :: Either b a -> Maybe a
+eitherToMaybe = \case
+  Left _ -> Nothing
+  Right x -> Just x
+
+fromParser
+  :: (Oid -> Bool)
+  -> Parser a
+  -> Oid
+  -> Text
+  -> Maybe a
+fromParser validOid parser oid value
+  | validOid oid = eitherToMaybe $ parseOnly parser value
+  | otherwise = Nothing
+
+class FromField a where
+  fromField :: Oid -> Text -> Maybe a
+
+instance FromField Int where
+  fromField = fromParser
+    (Oid.smallint \/ Oid.integer \/ Oid.bigint)
+    (signed decimal)
+
+instance FromField Text where
+  fromField oid text =
+    if Oid.text oid || Oid.character oid || Oid.characterVarying oid then
+      Just text
+    else
+      Nothing
+
+instance FromField String where
+  fromField oid text = Text.unpack <$> fromField oid text

lib/Database/PostgreSQL/Opium/Oid.hs

@@ -0,0 +1,31 @@
+module Database.PostgreSQL.Opium.Oid where
+
+import Database.PostgreSQL.LibPQ (Oid (..))
+
+eq :: Eq a => a -> a -> Bool
+eq = (==)
+
+-- integer types
+
+-- | 16-bit integer
+smallint :: Oid -> Bool
+smallint = eq $ Oid 21
+
+-- | 32-bit integer
+integer :: Oid -> Bool
+integer = eq $ Oid 23
+
+-- | 64-bit integer
+bigint :: Oid -> Bool
+bigint = eq $ Oid 20
+
+-- string types
+
+text :: Oid -> Bool
+text = eq $ Oid 25
+
+character :: Oid -> Bool
+character = eq $ Oid 1042
+
+characterVarying :: Oid -> Bool
+characterVarying = eq $ Oid 1043

opium.cabal

@@ -63,7 +63,9 @@ library
         Database.PostgreSQL.Opium
 
     -- Modules included in this library but not exported.
-    -- other-modules:
+    other-modules:
+        Database.PostgreSQL.Opium.FromField,
+        Database.PostgreSQL.Opium.Oid
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
@@ -71,10 +73,12 @@ library
     -- Other library packages from which modules are imported.
     build-depends:
         base,
+        attoparsec,
         bytestring,
         containers,
         postgresql-libpq,
-        text
+        text,
+        transformers
 
     -- Directories containing source files.
     hs-source-dirs:   lib
@@ -104,7 +108,16 @@ test-suite opium-test
     -- The entrypoint to the test suite.
     main-is:          Main.hs
 
+    other-modules:
+        SpecHook,
+        Database.PostgreSQL.OpiumSpec,
+        Database.PostgreSQL.Opium.FromFieldSpec
+
     -- Test dependencies.
     build-depends:
         base,
-        opium
+        opium,
+        bytestring,
+        hspec,
+        postgresql-libpq,
+        text

test/Database/PostgreSQL/Opium/FromFieldSpec.hs

@@ -0,0 +1,70 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.PostgreSQL.Opium.FromFieldSpec (spec) where
+
+import Data.ByteString (ByteString)
+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)
+
+import qualified Database.PostgreSQL.Opium as Opium
+
+newtype SingleInt = SingleInt
+  { int :: Int
+  } deriving (Eq, Generic, Show)
+
+instance FromRow SingleInt where
+
+newtype SingleText = SingleText
+  { text :: Text
+  } deriving (Eq, Generic, Show)
+
+instance FromRow SingleText where
+
+newtype SingleString = SingleString
+  { string :: String
+  } deriving (Eq, Generic, Show)
+
+instance FromRow SingleString where
+
+shouldFetch :: (Eq a, FromRow a, Show a) => Connection -> ByteString -> [a] -> IO ()
+shouldFetch conn query expectedRows = do
+  Just actualRows <- Opium.fetch_ conn query
+  actualRows `shouldBe` expectedRows
+
+spec :: SpecWith Connection
+spec = do
+  describe "FromField Int" $ do
+    it "Decodes smallint" $ \conn -> do
+      shouldFetch conn "SELECT 42::SMALLINT AS int" [SingleInt 42]
+
+    it "Decodes integer" $ \conn -> do
+      shouldFetch conn "SELECT 42::INTEGER AS int" [SingleInt 42]
+
+    it "Decodes bigint" $ \conn -> do
+      shouldFetch conn "SELECT 42::BIGINT AS int" [SingleInt 42]
+
+  describe "FromField Text" $ do
+    it "Decodes text" $ \conn -> do
+      shouldFetch conn "SELECT 'Hello, World!'::TEXT AS text" [SingleText "Hello, World!"]
+
+    it "Decodes character" $ \conn -> do
+      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS text" [SingleText "Hello, Wor"]
+      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS text" [SingleText "Hello, World!       "]
+
+    it "Decodes character varying" $ \conn -> do
+      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS text" [SingleText "Hello, World!"]
+
+  describe "FromField String" $ do
+    it "Decodes text" $ \conn -> do
+      shouldFetch conn "SELECT 'Hello, World!'::TEXT AS string" [SingleString "Hello, World!"]
+
+    it "Decodes character" $ \conn -> do
+      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(10) AS string" [SingleString "Hello, Wor"]
+      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER(20) AS string" [SingleString "Hello, World!       "]
+
+    it "Decodes character varying" $ \conn -> do
+      shouldFetch conn "SELECT 'Hello, World!'::CHARACTER VARYING (20) AS string" [SingleString "Hello, World!"]

test/Database/PostgreSQL/OpiumSpec.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Database.PostgreSQL.OpiumSpec (spec) where
+
+import Data.Text (Text)
+import Database.PostgreSQL.LibPQ (Connection)
+import GHC.Generics (Generic)
+import Test.Hspec (SpecWith, describe, it, shouldBe)
+
+import qualified Database.PostgreSQL.LibPQ as LibPQ
+import qualified Database.PostgreSQL.Opium as Opium
+
+data Person = Person
+  { name :: Text
+  , age :: Int
+  } deriving (Eq, Generic, Show)
+
+instance Opium.FromRow Person where
+
+spec :: SpecWith Connection
+spec = do
+  describe "fromRow" $ do
+    it "decodes rows in a Result" $ \conn -> do
+      Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Text
+
+      row0 <- Opium.fromRow @Person (LibPQ.Row 0) result
+      row0 `shouldBe` Just (Person "paul" 25)
+
+      row1 <- Opium.fromRow @Person (LibPQ.Row 1) result
+      row1 `shouldBe` Just (Person "albus" 103)
+
+  describe "fetch_" $ do
+    it "retrieves a list of rows" $ \conn -> do
+      rows <- Opium.fetch_ conn "SELECT * FROM person"
+      rows `shouldBe` Just [Person "paul" 25, Person "albus" 103]

test/Main.hs

@@ -1,18 +1 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Main (main) where
-
-import GHC.Generics (Generic)
-
-import Database.PostgreSQL.Opium (FromRow)
-
-data Person = Person
-  { name :: String
-  , age :: Int
---  , lovesCats :: Bool
-  } deriving (Generic)
-
-instance FromRow Person where
-
-main :: IO ()
-main = putStrLn "TBD"
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

test/SpecHook.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module SpecHook (hook) where
+
+import Control.Exception (bracket)
+import Database.PostgreSQL.LibPQ (Connection)
+import System.Environment (lookupEnv)
+import Test.Hspec (Spec, SpecWith, around)
+import Text.Printf (printf)
+
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Encoding
+import qualified Database.PostgreSQL.LibPQ as LibPQ
+
+setupConnection :: IO Connection
+setupConnection = do
+  Just dbUser <- lookupEnv "DB_USER"
+  Just dbPass <- lookupEnv "DB_PASS"
+  Just dbName <- lookupEnv "DB_NAME"
+  Just dbPort <- lookupEnv "DB_PORT"
+
+  let dsn = printf "host=localhost user=%s password=%s dbname=%s port=%s" dbUser dbPass dbName dbPort
+  conn <- LibPQ.connectdb $ Encoding.encodeUtf8 $ Text.pack dsn
+  _ <- LibPQ.setClientEncoding conn "UTF8"
+
+  _ <- LibPQ.exec conn "CREATE TABLE person (name TEXT NOT NULL, age INT NOT NULL)"
+  _ <- LibPQ.exec conn "INSERT INTO person VALUES ('paul', 25), ('albus', 103)"
+
+  pure conn
+
+teardownConnection :: Connection -> IO ()
+teardownConnection conn = do
+  _ <- LibPQ.exec conn "DROP TABLE person"
+  LibPQ.finish conn
+
+class SpecInput a where
+  hook :: SpecWith a -> Spec
+
+instance SpecInput Connection where
+  hook = around $ bracket setupConnection teardownConnection
+
+instance SpecInput () where
+  hook = id