Implement column table stuff

lib/Database/PostgreSQL/Opium/Error.hs

@@ -1,7 +1,7 @@
 module Database.PostgreSQL.Opium.Error (Error (..)) where
 
 import Data.Text (Text)
-import Database.PostgreSQL.LibPQ (ExecStatus, Row)
+import Database.PostgreSQL.LibPQ (ExecStatus, Oid, Row)
 
 import Database.PostgreSQL.Opium.FromField (FieldError)
 
@@ -10,5 +10,6 @@ data Error
   | ErrorNoResult
   | ErrorInvalidResult ExecStatus Text
   | ErrorMissingColumn Text
+  | ErrorInvalidOid Text Oid
   | ErrorUnexpectedNull Row Text
   deriving (Eq, Show)

lib/Database/PostgreSQL/Opium/FromField.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Database.PostgreSQL.Opium.FromField
   ( FieldError (..)
   , FromField (..)
+  , fromField
   ) where
 
 import Data.Attoparsec.Text
@@ -17,6 +19,7 @@ import Data.Attoparsec.Text
   , takeText
   )
 import Data.Functor (($>))
+import Data.Proxy (Proxy (..))
 import Data.Text (Text)
 import Database.PostgreSQL.LibPQ (Oid)
 import GHC.Float (double2Float)
@@ -29,8 +32,6 @@ p \/ q = \x -> p x || q x
 
 data FieldError
   = FieldErrorUnexpectedNull
-  -- TODO: Move this to the normal Error
-  | FieldErrorInvalidOid Oid
   | FieldErrorInvalidField Oid Text String
   deriving (Eq, Show)
 
@@ -38,36 +39,28 @@ mapLeft :: (b -> c) -> Either b a -> Either c a
 mapLeft f (Left l) = Left $ f l
 mapLeft _ (Right r) = Right r
 
-fromParser
-  :: (Oid -> Bool)
-  -> Parser a
-  -> Oid
-  -> Text
-  -> Either FieldError a
-fromParser validOid parser oid field
-    | validOid oid =
-      mapLeft (FieldErrorInvalidField oid field) $ parseOnly parser field
-    | otherwise =
-      Left $ FieldErrorInvalidOid oid
+fromField :: FromField a => Oid -> Text -> Either FieldError a
+fromField oid field =
+  mapLeft (FieldErrorInvalidField oid field) $ parseOnly parseField field
 
 class FromField a where
-  fromField :: Oid -> Text -> Either FieldError a
+  validOid :: Proxy a -> Oid -> Bool
+  parseField :: Parser a
 
 instance FromField Text where
-  fromField = fromParser
-    (Oid.text \/ Oid.character \/ Oid.characterVarying)
-    takeText
+  validOid _ = Oid.text \/ Oid.character \/ Oid.characterVarying
+  parseField = takeText
 
 instance FromField String where
-  fromField oid text = Text.unpack <$> fromField oid text
+  validOid _ = validOid @Text Proxy
+  parseField = Text.unpack <$> parseField
 
 instance FromField Int where
-  fromField = fromParser
-    (Oid.smallint \/ Oid.integer \/ Oid.bigint)
-    (signed decimal)
+  validOid _ = Oid.smallint \/ Oid.integer \/ Oid.bigint
+  parseField = signed decimal
 
-floatParser :: Parser Double
-floatParser = choice
+doubleParser :: Parser Double
+doubleParser = choice
   [ string "NaN" $> nan
   , signed (string "Infinity" $> infinity)
   , double
@@ -77,14 +70,12 @@ floatParser = choice
     infinity = 1 / 0
 
 instance FromField Float where
-  fromField = fromParser
-    Oid.real
-    (fmap double2Float floatParser)
+  validOid _ = Oid.real
+  parseField = fmap double2Float doubleParser
 
 instance FromField Double where
-  fromField = fromParser
-    (Oid.real \/ Oid.doublePrecision)
-    floatParser
+  validOid _ = Oid.real \/ Oid.doublePrecision
+  parseField = doubleParser
 
 boolParser :: Parser Bool
 boolParser = choice
@@ -94,6 +85,5 @@ boolParser = choice
 
 -- | See https://www.postgresql.org/docs/current/datatype-boolean.html.
 instance FromField Bool where
-  fromField = fromParser
-    Oid.boolean
-    boolParser
+  validOid _ = Oid.boolean
+  parseField = boolParser