Add getColumnTable function

lib/Database/PostgreSQL/Opium.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
 module Database.PostgreSQL.Opium
@@ -61,10 +62,45 @@ fetchResult result = do
   runExceptT $ mapM (ExceptT . flip fromRow result) [0..nRows - 1]
 
 class FromRow a where
+  getColumnTable :: Proxy a -> Result -> IO [LibPQ.Column]
+  default getColumnTable :: (Generic a, GetColumnTable' (Rep a)) => Proxy a -> Result -> IO [LibPQ.Column]
+  getColumnTable Proxy = getColumnTable' @(Rep a) Proxy
+
   fromRow :: Row -> Result -> IO (Either Error a)
   default fromRow :: (Generic a, FromRow' (Rep a)) => Row -> Result -> IO (Either Error a)
   fromRow row result = fmap to <$> fromRow' row result
 
+class GetColumnTable' f where
+  getColumnTable' :: Proxy (f p) -> Result -> IO [LibPQ.Column]
+
+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 :: FromField f => Proxy f -> String -> Result -> IO [Column]
+checkColumn Proxy nameStr result = LibPQ.fnumber result name >>= \case
+    Just column -> do
+      -- TODO: Rewrite FromField to check whether oid works for decoding t
+      _oid <- LibPQ.ftype result column
+      pure [column]
+    Nothing -> do
+      -- TODO: Return ErrorMissingColumn
+      undefined
+    where
+      name = Encoding.encodeUtf8 $ Text.pack nameStr
+
+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
+
 class FromRow' f where
   fromRow' :: Row -> Result -> IO (Either Error (f p))