on dev help sign in
Merge pull request #105 from morphismtech/dev-join

Nested rows

commitd3bf5af473a04737a2c7776bd2ae28bbbfa09553 authorEitan Chatav <eitan.chatav@gmail.com> dateFri 1 Mar 2019, 08:45 (8 years ago) parentb6433963d24153
3 files changed+66−7
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+44−3 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+3−3 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+19−1
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+44−3
@@ -634,9 +634,50 @@ 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+ ( row ~ Join row1 row2
642+ , FromRow row1 hask1
643+ , FromRow row2 hask2
644+ , SListI row
645+ ) => FromRow row (hask1, hask2) where
646+ fromRow row = case disjoin @row1 @row2 row of
647+ (row1, row2) -> (,) <$> fromRow row1 <*> fromRow row2
648+instance
649+ ( row ~ Join row1 row23
650+ , FromRow row1 hask1
651+ , FromRow row23 (hask2, hask3)
652+ , SListI row
653+ ) => FromRow row (hask1, hask2, hask3) where
654+ fromRow row = case disjoin @row1 @row23 row of
655+ (row1, row23) -> do
656+ hask1 <- fromRow row1
657+ (hask2, hask3) <- fromRow row23
658+ return (hask1, hask2, hask3)
659+instance
660+ ( row ~ Join row1 row234
661+ , FromRow row1 hask1
662+ , FromRow row234 (hask2, hask3, hask4)
663+ , SListI row
664+ ) => FromRow row (hask1, hask2, hask3, hask4) where
665+ fromRow row = case disjoin @row1 @row234 row of
666+ (row1, row234) -> do
667+ hask1 <- fromRow row1
668+ (hask2, hask3, hask4) <- fromRow row234
669+ return (hask1, hask2, hask3, hask4)
670+instance
671+ ( row ~ Join row1 row2345
672+ , FromRow row1 hask1
673+ , FromRow row2345 (hask2, hask3, hask4, hask5)
674+ , SListI row
675+ ) => FromRow row (hask1, hask2, hask3, hask4, hask5) where
676+ fromRow row = case disjoin @row1 @row2345 row of
677+ (row1, row2345) -> do
678+ hask1 <- fromRow row1
679+ (hask2, hask3, hask4, hask5) <- fromRow row2345
680+ return (hask1, hask2, hask3, hask4, hask5)
640681
641682-- | `Only` is a 1-tuple type, useful for encoding a single parameter with
642683-- `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+19−1
@@ -93,6 +93,7 @@ module Squeal.PostgreSQL.Schema
9393 , DropIfConstraintsInvolve
9494 -- * Lists
9595 , Join
96+ , disjoin
9697 , Elem
9798 , In
9899 , Length
@@ -632,6 +633,16 @@ type family Join xs ys where
632633 Join '[] ys = ys
633634 Join (x ': xs) ys = x ': Join xs ys
634635
636+-- | `disjoin` is a utility function for splitting an `NP` list into pieces.
637+disjoin
638+ :: forall xs ys expr. SListI xs
639+ => NP expr (Join xs ys)
640+ -> (NP expr xs, NP expr ys)
641+disjoin = case sList @xs of
642+ SNil -> \ys -> (Nil, ys)
643+ SCons -> \(x :* xsys) ->
644+ case disjoin xsys of (xs,ys) -> (x :* xs, ys)
645+
635646-- | @Create alias x xs@ adds @alias ::: x@ to the end of @xs@ and is used in
636647-- `Squeal.PostgreSQL.Definition.createTable` statements and in @ALTER TABLE@
637648-- `Squeal.PostgreSQL.Definition.addColumn`.
@@ -824,7 +835,14 @@ RowPG Person :: [(Symbol, NullityType)]
824835= '["name" ::: 'NotNull 'PGtext, "age" ::: 'NotNull 'PGint4]
825836-}
826837type family RowPG (hask :: Type) :: RowType where
827− RowPG (P (col ::: head), tail) = col ::: NullPG head ': RowPG tail
838+ RowPG (hask1, hask2) = Join (RowPG hask1) (RowPG hask2)
839+ RowPG (hask1, hask2, hask3) =
840+ Join (RowPG hask1) (RowPG (hask2, hask3))
841+ RowPG (hask1, hask2, hask3, hask4) =
842+ Join (RowPG hask1) (RowPG (hask2, hask3, hask4))
843+ RowPG (hask1, hask2, hask3, hask4, hask5) =
844+ Join (RowPG hask1) (RowPG (hask2, hask3, hask4, hask5))
845+ RowPG (P (col ::: head)) = '[col ::: NullPG head]
828846 RowPG hask = RowOf (RecordCodeOf hask)
829847
830848type family RowOf (fields :: [(Symbol, Type)]) :: RowType where