git.iko.soy/squeal
on dev help sign in
Joinable
commitff7665a2eaced5706eca45030139bcef69b75a21 authorEitan Chatav <eitan@Eitans-MacBook-Pro.local> dateThu 28 Feb 2019, 11:50 (8 years ago) parentb643396
3 files changed+27−11
compare with dev
unifiedsplit
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+12−3 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+3−3 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+12−5
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+12−3
@@ -634,9 +634,18 @@ instance
634634 = fmap fromRecord
635635 . hsequence'
636636 . htrans (Proxy @FromField) fromField
637−instance (FromField (col ::: pgkey) (col ::: key), FromRow pgval val)
638− => FromRow (col ::: pgkey ': pgval) (P (col ::: key), val) where
639− fromRow (key :* val) = (,) <$> (unComp . fromField) key <*> fromRow val
637+instance (FromField (col ::: pg) (col ::: hask))
638+ => FromRow '[col ::: pg] (P (col ::: hask)) where
639+ fromRow (pg :* Nil) = (unComp . fromField) pg
640+instance
641+ ( Joinable row1 row2
642+ , row ~ Join row1 row2
643+ , FromRow row1 hask1
644+ , FromRow row2 hask2
645+ , SListI row
646+ ) => FromRow row (hask1, hask2) where
647+ fromRow row = case disjoin @row1 @row2 row of
648+ (row1, row2) -> (,) <$> fromRow row1 <*> fromRow row2
640649
641650-- | `Only` is a 1-tuple type, useful for encoding a single parameter with
642651-- `toParams` or decoding a single value with `fromRow`.
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+3−3
@@ -1217,7 +1217,7 @@ jsonbBuildArray
12171217jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"
12181218
12191219unsafeRowFunction
1220− :: SOP.All SOP.Top elems
1220+ :: SOP.SListI elems
12211221 => NP (Aliased (Expression outer grp commons schemas params from)) elems
12221222 -> [ByteString]
12231223unsafeRowFunction =
@@ -1232,7 +1232,7 @@ unsafeRowFunction =
12321232-- argument list. The elements of the argument list must alternate between text
12331233-- and values.
12341234jsonBuildObject
1235− :: SOP.All SOP.Top elems
1235+ :: SOP.SListI elems
12361236 => NP (Aliased (Expression outer grp commons schemas params from)) elems
12371237 -> Expression outer grp commons schemas params from (nullity 'PGjson)
12381238jsonBuildObject
@@ -1245,7 +1245,7 @@ jsonBuildObject
12451245-- variadic argument list. The elements of the argument list must alternate
12461246-- between text and values.
12471247jsonbBuildObject
1248− :: SOP.All SOP.Top elems
1248+ :: SOP.SListI elems
12491249 => NP (Aliased (Expression outer grp commons schemas params from)) elems
12501250 -> Expression outer grp commons schemas params from (nullity 'PGjsonb)
12511251jsonbBuildObject
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+12−5
@@ -92,7 +92,7 @@ module Squeal.PostgreSQL.Schema
9292 , Rename
9393 , DropIfConstraintsInvolve
9494 -- * Lists
95− , Join
95+ , Joinable (..)
9696 , Elem
9797 , In
9898 , Length
@@ -628,9 +628,15 @@ type family NullifyFrom (tables :: FromType) :: FromType where
628628
629629-- | `Join` is simply promoted `++` and is used in @JOIN@s in
630630-- `Squeal.PostgreSQL.Query.FromClause`s.
631−type family Join xs ys where
632− Join '[] ys = ys
633− Join (x ': xs) ys = x ': Join xs ys
631+class Joinable xs ys where
632+ type family Join (xs :: [k]) (ys :: [k]) :: [k]
633+ disjoin :: NP expr (Join xs ys) -> (NP expr xs, NP expr ys)
634+instance Joinable '[] ys where
635+ type Join '[] ys = ys
636+ disjoin list = (Nil, list)
637+instance Joinable xs ys => Joinable (x ': xs) ys where
638+ type Join (x ': xs) ys = x ': Join xs ys
639+ disjoin (x :* xsys) = case disjoin xsys of (xs,ys) -> (x :* xs, ys)
634640
635641-- | @Create alias x xs@ adds @alias ::: x@ to the end of @xs@ and is used in
636642-- `Squeal.PostgreSQL.Definition.createTable` statements and in @ALTER TABLE@
@@ -824,7 +830,8 @@ RowPG Person :: [(Symbol, NullityType)]
824830= '["name" ::: 'NotNull 'PGtext, "age" ::: 'NotNull 'PGint4]
825831-}
826832type family RowPG (hask :: Type) :: RowType where
827− RowPG (P (col ::: head), tail) = col ::: NullPG head ': RowPG tail
833+ RowPG (hask1, hask2) = Join (RowPG hask1) (RowPG hask2)
834+ RowPG (P (col ::: head)) = '[col ::: NullPG head]
828835 RowPG hask = RowOf (RecordCodeOf hask)
829836
830837type family RowOf (fields :: [(Symbol, Type)]) :: RowType where