From 3ef1f5bbde2137e6dd94851399d7266656e787ec Mon Sep 17 00:00:00 2001
From: Paul Brinkmeier <hallo@pbrinkmeier.de>
Date: Tue, 5 Sep 2023 16:23:29 +0200
Subject: [PATCH] Clean up FromRow instances a little

---
 lib/Database/PostgreSQL/Opium.hs | 34 ++++++++++++++++----------------
 1 file changed, 17 insertions(+), 17 deletions(-)

diff --git a/lib/Database/PostgreSQL/Opium.hs b/lib/Database/PostgreSQL/Opium.hs
index 790ca83..49339b5 100644
--- a/lib/Database/PostgreSQL/Opium.hs
+++ b/lib/Database/PostgreSQL/Opium.hs
@@ -28,7 +28,7 @@ import Database.PostgreSQL.LibPQ
   , Row
   )
 import GHC.Generics (C, D, Generic, K1 (..), M1 (..), Meta (..), Rec0, Rep, S, to, (:*:) (..))
-import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
+import GHC.TypeLits (KnownSymbol, symbolVal)
 
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Encoding
@@ -80,25 +80,19 @@ instance (FromRow' f, FromRow' g) => FromRow' (f :*: g) where
     z <- fromRow' row result
     pure $ (:*:) <$> y <*> z
 
--- TODO: Can we clean this up?
-
 decodeField
   :: FromField t
   => Text
   -> (Row -> Maybe t -> Either Error t')
   -> Row
   -> Result
-  -> IO (Either Error (M1 S ('MetaSel ('Just (nameSym :: Symbol)) nu ns dl) (Rec0 t') p))
+  -> IO (Either Error (M1 S m (Rec0 t') p))
 decodeField nameText g row result = runExceptT $ do
     column <- getColumn
-    oid <- ExceptT $ Right <$> LibPQ.ftype result column
-    mbField <- getValue column
-    value <- case mbField of
-      Nothing ->
-        except $ g row Nothing 
-      Just field -> do
-        value <- except $ mapLeft (ErrorDecode row nameText) $ fromField oid $ Encoding.decodeUtf8 field
-        except $ g row $ Just value
+    oid <- ExceptT $ pure <$> LibPQ.ftype result column
+    mbField <- getFieldText column
+    mbValue <- getValue oid mbField
+    value <- except $ g row mbValue
     pure $ M1 $ K1 value
     where
       name = Encoding.encodeUtf8 nameText
@@ -107,13 +101,19 @@ decodeField nameText g row result = runExceptT $ do
       getColumn = ExceptT $
         maybe (Left $ ErrorMissingColumn nameText) Right <$> LibPQ.fnumber result name
 
-      getValue :: Column -> ExceptT Error IO (Maybe ByteString)
-      getValue column = ExceptT $ Right <$> LibPQ.getvalue result row column
+      getFieldText :: Column -> ExceptT Error IO (Maybe Text)
+      getFieldText column = 
+        ExceptT $ Right . fmap Encoding.decodeUtf8 <$> LibPQ.getvalue result row column
+
+      getValue :: FromField u => LibPQ.Oid -> Maybe Text -> ExceptT Error IO (Maybe u)
+      getValue oid = except . maybe
+        (Right Nothing)
+        (fmap Just . mapLeft (ErrorDecode row nameText) . fromField oid)
 
 instance {-# OVERLAPPABLE #-} (FromField t, KnownSymbol nameSym) => FromRow' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
-  fromRow' = decodeField nameText $ \row -> \case
-    Nothing -> Left $ ErrorUnexpectedNull row nameText
-    Just value -> Right value
+  fromRow' = decodeField nameText $ \row -> maybe
+    (Left $ ErrorUnexpectedNull row nameText)
+    Right
     where
       nameText = Text.pack $ symbolVal (Proxy :: Proxy nameSym)