paul/opium
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases Wiki Activity

Minor fixes

Browse Source
This commit is contained in:
Paul Brinkmeier 2024-06-20 20:10:51 +02:00
parent 2caa00c06a
commit 19a1aa26e4
2 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
README.md
View File

@ -83,3 +83,4 @@ getScoreByAge conn = do
- [ ] `FromRow` - [ ] `FromRow`
- [ ] Custom `FromField` impls - [ ] Custom `FromField` impls
- [ ] Improve type errors when trying to `instance` a type that isn't a record (e.g. sum type) - [ ] Improve type errors when trying to `instance` a type that isn't a record (e.g. sum type)
- [ ] Improve documentation for `fromRow` module

13
lib/Database/PostgreSQL/Opium/FromRow.hs
View File

@ -89,7 +89,7 @@ type family NumberOfMembers f where
NumberOfMembers (M1 D _ f) = NumberOfMembers f NumberOfMembers (M1 D _ f) = NumberOfMembers f
-- The constructor has as many members as the type that it contains. -- The constructor has as many members as the type that it contains.
NumberOfMembers (M1 C _ f) = NumberOfMembers f NumberOfMembers (M1 C _ f) = NumberOfMembers f
-- A product type has as many types as its subtypes have together. -- A product type has as many members as its subtypes have together.
NumberOfMembers (f :*: g) = NumberOfMembers f + NumberOfMembers g NumberOfMembers (f :*: g) = NumberOfMembers f + NumberOfMembers g
-- A selector has/is exactly one member. -- A selector has/is exactly one member.
NumberOfMembers (M1 S _ f) = 1 NumberOfMembers (M1 S _ f) = 1
@ -99,19 +99,23 @@ data FromRowCtx = FromRowCtx
Result -- ^ Obtained from 'LibPQ.execParams'. Result -- ^ Obtained from 'LibPQ.execParams'.
ColumnTable -- ^ 'Vector' of expected columns indices and OIDs. ColumnTable -- ^ 'Vector' of expected columns indices and OIDs.
-- Specialized proxy type to be used instead of `Proxy (n, f)`
data FRProxy (n :: Nat) (f :: Type -> Type) = FRProxy data FRProxy (n :: Nat) (f :: Type -> Type) = FRProxy
class FromRow' (n :: Nat) (f :: Type -> Type) where class FromRow' (n :: Nat) (f :: Type -> Type) where
fromRow' :: FRProxy n f -> FromRowCtx -> Row -> ExceptT Error IO (f p) fromRow' :: FRProxy n f -> FromRowCtx -> Row -> ExceptT Error IO (f p)
instance FromRow' n f => FromRow' n (M1 D c f) where instance FromRow' n f => FromRow' n (M1 D c f) where
fromRow' FRProxy ctx row = M1 <$> fromRow' @n FRProxy ctx row fromRow' FRProxy ctx row =
M1 <$> fromRow' @n FRProxy ctx row
instance FromRow' n f => FromRow' n (M1 C c f) where instance FromRow' n f => FromRow' n (M1 C c f) where
fromRow' FRProxy ctx row = M1 <$> fromRow' @n FRProxy ctx row fromRow' FRProxy ctx row =
M1 <$> fromRow' @n FRProxy ctx row
instance (FromRow' n f, FromRow' (n + NumberOfMembers f) g) => FromRow' n (f :*: g) where instance (FromRow' n f, FromRow' (n + NumberOfMembers f) g) => FromRow' n (f :*: g) where
fromRow' FRProxy ctx row = (:*:) <$> fromRow' @n FRProxy ctx row <*> fromRow' @(n + NumberOfMembers f) FRProxy ctx row fromRow' FRProxy ctx row =
(:*:) <$> fromRow' @n FRProxy ctx row <*> fromRow' @(n + NumberOfMembers f) FRProxy ctx row
instance {-# OVERLAPPABLE #-} (KnownNat n, KnownSymbol nameSym, FromField t) => FromRow' n (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where instance {-# OVERLAPPABLE #-} (KnownNat n, KnownSymbol nameSym, FromField t) => FromRow' n (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
fromRow' FRProxy = decodeField memberIndex nameText $ \row -> fromRow' FRProxy = decodeField memberIndex nameText $ \row ->
@ -158,4 +162,3 @@ decodeField memberIndex nameText g (FromRowCtx result columnTable) row = do
first first
(ErrorInvalidField (ErrorPosition row nameText) oid field) (ErrorInvalidField (ErrorPosition row nameText) oid field)
(Just <$> fromField field) (Just <$> fromField field)