@@ -138,6 +138,7 @@ Person {name = Just "Faisal", age = Just 24}
138 , FlexibleInstances
138 , FlexibleInstances
140 , LambdaCase
140 , LambdaCase
141 , MultiParamTypeClasses
142 , MultiParamTypeClasses
142 , ScopedTypeVariables
143 , ScopedTypeVariables
143 , TypeApplications
144 , TypeApplications
@@ -159,7 +160,6 @@ module Squeal.PostgreSQL.Binary
159 , Only (..)
160 , Only (..)
163import ByteString.StrictBuilder
163import ByteString.StrictBuilder
164import Data.Aeson hiding (Null)
164import Data.Aeson hiding (Null)
165import Data.Int
165import Data.Int
@@ -270,6 +270,7 @@ instance
270 toParam =
270 toParam =
273+ -- encoders :: NP (Maybe :.: P) fields -> NP (K (Maybe Encoding.Encoding)) xs
273 encoders = htrans (Proxy @ToAliasedParam) toAliasedParam
274 encoders = htrans (Proxy @ToAliasedParam) toAliasedParam
275 composite
276 composite
@@ -304,17 +305,17 @@ instance
304 hcfoldMap (Proxy @HasAliasedOid) each fields
305 hcfoldMap (Proxy @HasAliasedOid) each fields
307− composite . encoders . unMaybes . unZ . unSOP . from
308+ composite . encoders . toRecord
309−class HasAliasedOid (field :: (Symbol, PGType)) where aliasedOid :: Word32
310+class HasAliasedOid (field :: (Symbol, NullityType)) where
311+ aliasedOid :: Word32
310−instance HasOid ty => HasAliasedOid (alias ::: ty) where aliasedOid = oid @ty
312+instance HasOid ty => HasAliasedOid (alias ::: nullity ty) where
313+ aliasedOid = oid @ty
312−class ToAliasedParam (x :: Type) (field :: (Symbol, PGType)) where
315+class ToAliasedParam (x :: (Symbol, Type)) (field :: (Symbol, NullityType)) where
313− toAliasedParam :: Maybe x -> K (Maybe Encoding.Encoding) field
316+ toAliasedParam :: P x -> K (Maybe Encoding.Encoding) field
314−instance ToParam x ty => ToAliasedParam x (alias ::: ty) where
317+instance ToColumnParam x ty => ToAliasedParam (alias ::: x) (alias ::: ty) where
315− toAliasedParam = \case
318+ toAliasedParam (P x) = K . unK $ toColumnParam @x @ty x
316− Nothing -> K Nothing
317− Just x -> K . Just . unK $ toParam @x @ty x
319-- | A `ToColumnParam` constraint lifts the `ToParam` encoding
320-- | A `ToColumnParam` constraint lifts the `ToParam` encoding
320-- of a `Type` to a `NullityType`, encoding `Maybe`s to `Null`s. You should
321-- of a `Type` to a `NullityType`, encoding `Maybe`s to `Null`s. You should
@@ -328,11 +329,11 @@ class ToColumnParam (x :: Type) (ty :: NullityType) where
329 -- >>> toColumnParam @(Maybe Int16) @('Null 'PGint2) Nothing
330 -- >>> toColumnParam @(Maybe Int16) @('Null 'PGint2) Nothing
330 -- K Nothing
331 -- K Nothing
331− toColumnParam :: x -> K (Maybe Strict.ByteString) ty
332+ toColumnParam :: x -> K (Maybe Encoding.Encoding) ty
332instance ToParam x pg => ToColumnParam x ('NotNull pg) where
333instance ToParam x pg => ToColumnParam x ('NotNull pg) where
333− toColumnParam = K . Just . Encoding.encodingBytes . unK . toParam @x @pg
334+ toColumnParam = K . Just . unK . toParam @x @pg
334instance ToParam x pg => ToColumnParam (Maybe x) ('Null pg) where
335instance ToParam x pg => ToColumnParam (Maybe x) ('Null pg) where
335− toColumnParam = K . fmap (Encoding.encodingBytes . unK . toParam @x @pg)
336+ toColumnParam = K . fmap (unK . toParam @x @pg)
337-- | A `ToParams` constraint generically sequences the encodings of `Type`s
338-- | A `ToParams` constraint generically sequences the encodings of `Type`s
338-- of the fields of a tuple or record to a row of `ColumnType`s. You should
339-- of the fields of a tuple or record to a row of `ColumnType`s. You should
@@ -348,7 +349,7 @@ class SListI tys => ToParams (x :: Type) (tys :: [NullityType]) where
348 -- >>> instance Generic Tuple
349 -- >>> instance Generic Tuple
349 -- >>> toParams @Tuple @Params (Tuple False (Just 0))
350 -- >>> toParams @Tuple @Params (Tuple False (Just 0))
350 -- K (Just "\NUL") :* K (Just "\NUL\NUL") :* Nil
351 -- K (Just "\NUL") :* K (Just "\NUL\NUL") :* Nil
351− toParams :: x -> NP (K (Maybe Strict.ByteString)) tys
352+ toParams :: x -> NP (K (Maybe Encoding.Encoding)) tys
352instance (SListI tys, IsProductType x xs, AllZip ToColumnParam xs tys)
353instance (SListI tys, IsProductType x xs, AllZip ToColumnParam xs tys)
353 => ToParams x tys where
354 => ToParams x tys where
@@ -433,21 +434,21 @@ instance
433 . Strict.unpack
434 . Strict.unpack
436− ( SListI fields
437+ ( FromRow fields y
438− , AllZip FromAliasedValue fields ys
439 ) => FromValue ('PGcomposite fields) y where
438 ) => FromValue ('PGcomposite fields) y where
440− fromValue =
439+ fromValue p =
442− decoders
441+ composite
443− :: forall pgs zs proxy
444− . AllZip FromAliasedValue pgs zs
445− => proxy ('PGcomposite pgs)
442+ :: proxy ('PGcomposite pgs)
443+ -> Strict.ByteString
444+ -> NP (K (Maybe Strict.ByteString)) pgs
445+ composite = undefined
449+ -- => NP ((->) (Maybe Strict.ByteString) :.: Either Strict.Text :.: P) zs
446− -> NP Decoding.Value zs
450+ -- -> Decoding.Value (NP P zs)
447− decoders _ = htrans (Proxy @FromAliasedValue) fromAliasedValue
448− (hpure Proxy :: NP Proxy pgs)
450− composite fields = do
451+ -- composite fields = do
451 -- <number of fields: 4 bytes>
452 -- <number of fields: 4 bytes>
452 -- [for each field]
453 -- [for each field]
453 -- <OID of field's type: sizeof(Oid) bytes>
454 -- <OID of field's type: sizeof(Oid) bytes>
@@ -458,26 +459,28 @@ instance
458 -- <value: <length> bytes>
459 -- <value: <length> bytes>
459 -- [end if]
460 -- [end if]
460 -- [end for]
461 -- [end for]
461− unitOfSize 4
462+ -- unitOfSize 4
465+ -- :: ((->) (Maybe Strict.ByteString) :.: Either Strict.Text :.: P) z
466+ -- -> Decoding.Value (P z)
463− each field = do
468+ -- each (Comp field) = _
464− unitOfSize 4
469+ -- unitOfSize 4
465− len <- sized 4 Decoding.int
470+ -- len <- sized 4 Decoding.int
466− if len == -1 then return Nothing else Just <$> sized len field
472+ -- then return (P (field Nothing))
473+ -- else sized len (fn _)
467− htraverse' each fields
474+ -- htraverse' each fields
469− in fmap (to . SOP . Z . maybes) . composite . decoders
476+ in
470−
477+ Decoding.fn (fromRow @fields @y . composite p)
471−class FromAliasedValue (pg :: (Symbol,PGType)) (y :: Type) where
472− fromAliasedValue :: proxy pg -> Decoding.Value y
473−instance FromValue pg y => FromAliasedValue (alias ::: pg) y where
474− fromAliasedValue _ = fromValue (Proxy @pg)
476-- | A `FromColumnValue` constraint lifts the `FromValue` parser
479-- | A `FromColumnValue` constraint lifts the `FromValue` parser
477-- to a decoding of a @(Symbol, NullityType)@ to a `Type`,
480-- to a decoding of a @(Symbol, NullityType)@ to a `Type`,
478-- decoding `Null`s to `Maybe`s. You should not define instances for
481-- decoding `Null`s to `Maybe`s. You should not define instances for
479-- `FromColumnValue`, just use the provided instances.
482-- `FromColumnValue`, just use the provided instances.
480−class FromColumnValue (colty :: (Symbol,NullityType)) (y :: Type) where
483+class FromColumnValue (pg :: (Symbol, NullityType)) (y :: (Symbol, Type)) where
481 -- | >>> :set -XTypeOperators -XOverloadedStrings
484 -- | >>> :set -XTypeOperators -XOverloadedStrings
482 -- >>> newtype Id = Id { getId :: Int16 } deriving Show
485 -- >>> newtype Id = Id { getId :: Int16 } deriving Show
483 -- >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue
486 -- >>> instance FromValue 'PGint2 Id where fromValue = fmap Id . fromValue
@@ -486,33 +489,28 @@ class FromColumnValue (colty :: (Symbol,NullityType)) (y :: Type) where
487 -- >>> fromColumnValue @("col" ::: 'Null 'PGint2) @(Maybe Id) (K (Just "\NUL\SOH"))
490 -- >>> fromColumnValue @("col" ::: 'Null 'PGint2) @(Maybe Id) (K (Just "\NUL\SOH"))
488 -- Just (Id {getId = 1})
491 -- Just (Id {getId = 1})
489− fromColumnValue :: K (Maybe Strict.ByteString) colty -> y
493+ :: K (Maybe Strict.ByteString) pg
494+ -> (Either Strict.Text :.: P) y
490instance FromValue pg y
495instance FromValue pg y
491− => FromColumnValue (column ::: ('NotNull pg)) y where
496+ => FromColumnValue (column ::: ('NotNull pg)) (column ::: y) where
492− fromColumnValue = \case
497+ fromColumnValue = Comp . \case
493− K Nothing -> error "fromColumnValue: saw NULL when expecting NOT NULL"
498+ K Nothing -> Left "fromColumnValue: saw NULL when expecting NOT NULL"
494− K (Just bs) ->
499+ K (Just bytestring) -> P <$>
497− Decoding.valueParser (fromValue @pg @y Proxy) bs
500+ Decoding.valueParser (fromValue @pg @y Proxy) bytestring
498− err str = error $ "fromColumnValue: " ++ Strict.unpack str
500− either err id errOrValue
501instance FromValue pg y
501instance FromValue pg y
502− => FromColumnValue (column ::: ('Null pg)) (Maybe y) where
502+ => FromColumnValue (column ::: 'Null pg) (column ::: Maybe y) where
503− fromColumnValue (K nullOrBytes)
503+ fromColumnValue = Comp . \case
504− = either err id
504+ K Nothing -> Right $ P Nothing
505+ K (Just bytestring) -> P . Just <$>
505− . Decoding.valueParser (fromValue @pg @y Proxy)
506+ Decoding.valueParser (fromValue @pg @y Proxy) bytestring
508− err str = error $ "fromColumnValue: " ++ Strict.unpack str
510-- | A `FromRow` constraint generically sequences the parsings of the columns
508-- | A `FromRow` constraint generically sequences the parsings of the columns
511-- of a `RelationType` into the fields of a record `Type` provided they have
509-- of a `RelationType` into the fields of a record `Type` provided they have
512-- the same field names. You should not define instances of `FromRow`.
510-- the same field names. You should not define instances of `FromRow`.
513-- Instead define `Generic` and `HasDatatypeInfo` instances which in turn
511-- Instead define `Generic` and `HasDatatypeInfo` instances which in turn
514-- provide `FromRow` instances.
512-- provide `FromRow` instances.
515−class SListI results => FromRow (results :: RelationType) y where
513+class SListI result => FromRow (result :: RelationType) y where
516 -- | >>> :set -XOverloadedStrings
514 -- | >>> :set -XOverloadedStrings
517 -- >>> import Data.Text
515 -- >>> import Data.Text
518 -- >>> newtype UserId = UserId { getUserId :: Int16 } deriving Show
516 -- >>> newtype UserId = UserId { getUserId :: Int16 } deriving Show
@@ -523,14 +521,16 @@ class SListI results => FromRow (results :: RelationType) y where
523 -- >>> type User = '["userId" ::: 'NotNull 'PGint2, "userName" ::: 'Null 'PGtext]
521 -- >>> type User = '["userId" ::: 'NotNull 'PGint2, "userName" ::: 'Null 'PGtext]
524 -- >>> fromRow @User @UserRow (K (Just "\NUL\SOH") :* K (Just "bloodninja") :* Nil)
522 -- >>> fromRow @User @UserRow (K (Just "\NUL\SOH") :* K (Just "bloodninja") :* Nil)
525 -- UserRow {userId = UserId {getUserId = 1}, userName = Just "bloodninja"}
523 -- UserRow {userId = UserId {getUserId = 1}, userName = Just "bloodninja"}
526− fromRow :: NP (K (Maybe Strict.ByteString)) results -> y
524+ fromRow :: NP (K (Maybe Strict.ByteString)) result -> Either Strict.Text y
528− ( SListI results
526+ ( SListI result
529 , IsRecord y ys
527 , IsRecord y ys
530− , AllZip FromColumnValue results ys
528+ , AllZip FromColumnValue result ys
531− ) => FromRow results y where
529+ ) => FromRow result y where
533− = to . SOP . Z . htrans (Proxy @FromColumnValue) (I . fromColumnValue)
533+ . htrans (Proxy @FromColumnValue) fromColumnValue
535-- | `Only` is a 1-tuple type, useful for encoding a single parameter with
535-- | `Only` is a 1-tuple type, useful for encoding a single parameter with
536-- `toParams` or decoding a single value with `fromRow`.
536-- `toParams` or decoding a single value with `fromRow`.