Project setup and implementation sketch

lib/Database/PostgreSQL/Opium.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Database.PostgreSQL.Opium where
+
+import Data.ByteString (ByteString)
+import Data.Proxy (Proxy (Proxy))
+import Database.PostgreSQL.LibPQ
+  (Result
+  , Row
+  )
+import GHC.Generics (C, D, Generic, K1 (..), M1 (..), Meta (..), Rec0, Rep, S, to, (:*:) (..))
+import GHC.TypeLits (KnownSymbol, symbolVal)
+import Text.Printf (printf)
+
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Encoding
+import qualified Database.PostgreSQL.LibPQ as LibPQ
+
+class FromRow a where
+  fromRow :: Row -> Result -> IO (Maybe a)
+  default fromRow :: (Generic a, FromRow' (Rep a)) => Row -> Result -> IO (Maybe a)
+  fromRow row result = fmap to <$> fromRow' row result
+
+class FromRow' f where
+  fromRow' :: Row -> Result -> IO (Maybe (f p))
+
+instance FromRow' f => FromRow' (M1 D c f) where
+  fromRow' row result = fmap M1 <$> fromRow' row result
+
+instance FromRow' f => FromRow' (M1 C c f) where
+  fromRow' row result = fmap M1 <$> fromRow' row result
+
+instance (FromRow' f, FromRow' g) => FromRow' (f :*: g) where
+  fromRow' row result = do
+    y <- fromRow' row result
+    z <- fromRow' row result
+    pure $ (:*:) <$> y <*> z
+
+instance (KnownSymbol nameSym, FromField t) => FromRow' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
+  fromRow' row result = do
+    mbColumn <- LibPQ.fnumber result name
+    case mbColumn of
+      Nothing -> pure Nothing
+      Just column -> do
+        mbField <- LibPQ.getvalue result row column
+        printf "%s: %s" (show name) (show mbField)
+        pure $ M1 . K1 <$> fromField mbField
+    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)