git.iko.soy/squeal
on dev help sign in
generic fixed length array binary instances
commit8dde22da1088a038737b7d96d477eb54665c9996 authorEitan Chatav <eitan.chatav@gmail.com> dateSat 14 Jul 2018, 12:51 (8 years ago) parent3a2c8cf
2 files changed+60−23
compare with dev
unifiedsplit
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+55−10 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+5−13
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+55−10
@@ -243,6 +243,28 @@ instance (HasOid pg, ToParam x pg)
243243 => ToParam (Vector x) ('PGvararray ('NotNull pg)) where
244244 toParam = K . Encoding.array_vector
245245 (oid @pg) (unK . toParam @x @pg)
246+toVector :: (All ((~) x) xs) => NP I xs -> Vector x
247+toVector = \case
248+ Nil -> Vector.empty
249+ I x :* xs -> Vector.singleton x <> toVector xs
250+instance
251+ ( HasOid pg
252+ , ToParam x pg
253+ , IsProductType hask xs
254+ , All ((~) x) xs
255+ , len ~ Length xs
256+ ) => ToParam hask ('PGfixarray len ('NotNull pg)) where
257+ toParam = K . Encoding.array_vector
258+ (oid @pg) (unK . toParam @x @pg) . toVector . unZ . unSOP . from
259+instance
260+ ( HasOid pg
261+ , ToParam x pg
262+ , IsProductType hask xs
263+ , All ((~) (Maybe x)) xs
264+ , len ~ Length xs
265+ ) => ToParam hask ('PGfixarray len ('Null pg)) where
266+ toParam = K . Encoding.nullableArray_vector
267+ (oid @pg) (unK . toParam @x @pg) . toVector . unZ . unSOP . from
246268instance
247269 ( IsEnumType x
248270 , HasDatatypeInfo x
@@ -388,16 +410,39 @@ instance FromValue pg y
388410 fromValue = Decoding.array
389411 (Decoding.dimensionArray Vector.replicateM
390412 (Decoding.valueArray (fromValue @pg)))
391−instance FromValue pg y
392− => FromValue ('PGfixarray n ('Null pg)) (Vector (Maybe y)) where
393− fromValue = Decoding.array
394− (Decoding.dimensionArray Vector.replicateM
395− (Decoding.nullableValueArray (fromValue @pg)))
396−instance FromValue pg y
397− => FromValue ('PGfixarray n ('NotNull pg)) (Vector y) where
398− fromValue = Decoding.array
399− (Decoding.dimensionArray Vector.replicateM
400− (Decoding.valueArray (fromValue @pg)))
413+fromVector
414+ :: forall x xs. (All ((~) x) xs, SListI xs)
415+ => Vector x
416+ -> Decoding.Value (NP I xs)
417+fromVector vec = case fromList (Vector.toList vec) of
418+ Nothing -> failure "fromVector: unexpected length"
419+ Just xs -> return $ hcmap (Proxy :: Proxy ((~) x)) (I . unK) xs
420+instance
421+ ( IsProductType hask ys
422+ , All ((~) y) ys
423+ , len ~ Length ys
424+ , FromValue pg y
425+ ) => FromValue ('PGfixarray len ('NotNull pg)) hask where
426+ fromValue =
427+ let
428+ vectorValue = Decoding.array
429+ (Decoding.dimensionArray Vector.replicateM
430+ (Decoding.valueArray (fromValue @pg)))
431+ in
432+ fmap (to . SOP . Z) (fromVector @y =<< vectorValue)
433+instance
434+ ( IsProductType hask ys
435+ , All ((~) (Maybe y)) ys
436+ , len ~ Length ys
437+ , FromValue pg y
438+ ) => FromValue ('PGfixarray len ('Null pg)) hask where
439+ fromValue =
440+ let
441+ vectorValue = Decoding.array
442+ (Decoding.dimensionArray Vector.replicateM
443+ (Decoding.nullableValueArray (fromValue @pg)))
444+ in
445+ fmap (to . SOP . Z) (fromVector @(Maybe y) =<< vectorValue)
401446instance
402447 ( IsEnumType y
403448 , HasDatatypeInfo y
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+5−13
@@ -85,6 +85,7 @@ module Squeal.PostgreSQL.Schema
8585 , Rename
8686 , Elem
8787 , In
88+ , Length
8889 , PGNum
8990 , PGIntegral
9091 , PGFloating
@@ -562,19 +563,6 @@ type family Alter alias x xs where
562563 Alter alias x1 (alias ::: x0 ': xs) = alias ::: x1 ': xs
563564 Alter alias x1 (x0 ': xs) = x0 ': Alter alias x1 xs
564565
565−-- type family AddConstraint constraint ty where
566−-- AddConstraint constraint (constraints :=> ty)
567−-- = AsSet (constraint ': constraints) :=> ty
568−
569−-- type family DeleteFromList (e :: elem) (list :: [elem]) where
570−-- DeleteFromList elem '[] = '[]
571−-- DeleteFromList elem (x ': xs) =
572−-- If (Cmp elem x == 'EQ) xs (x ': DeleteFromList elem xs)
573−
574−-- type family DropConstraint constraint ty where
575−-- DropConstraint constraint (constraints :=> ty)
576−-- = (AsSet (DeleteFromList constraint constraints)) :=> ty
577−
578566-- | @Rename alias0 alias1 xs@ replaces the alias @alias0@ by @alias1@ in @xs@
579567-- and is used in `Squeal.PostgreSQL.Definition.alterTableRename` and
580568-- `Squeal.PostgreSQL.Definition.renameColumn`.
@@ -598,6 +586,10 @@ type family DropIfConstraintsInvolve column constraints where
598586 (DropIfConstraintsInvolve column constraints)
599587 (alias ::: constraint ': DropIfConstraintsInvolve column constraints)
600588
589+type family Length (xs :: [k]) :: Nat where
590+ Length (x : xs) = 1 + Length xs
591+ Length '[] = 0
592+
601593-- | A `SchemumType` is a user-defined type, either a `Table`,
602594-- `View` or `Typedef`.
603595data SchemumType