git.iko.soy/squeal
on dev help sign in
generic fixed length array binary instances
8dde22dEitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+55−10
compare with dev
unifiedsplit
@@ -243,6 +243,28 @@ instance (HasOid pg, ToParam x pg)
243 => ToParam (Vector x) ('PGvararray ('NotNull pg)) where
243 => ToParam (Vector x) ('PGvararray ('NotNull pg)) where
244 toParam = K . Encoding.array_vector
244 toParam = K . Encoding.array_vector
245 (oid @pg) (unK . toParam @x @pg)
245 (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
246instance
268instance
247 ( IsEnumType x
269 ( IsEnumType x
248 , HasDatatypeInfo x
270 , HasDatatypeInfo x
@@ -388,16 +410,39 @@ instance FromValue pg y
388 fromValue = Decoding.array
410 fromValue = Decoding.array
389 (Decoding.dimensionArray Vector.replicateM
411 (Decoding.dimensionArray Vector.replicateM
390 (Decoding.valueArray (fromValue @pg)))
412 (Decoding.valueArray (fromValue @pg)))
391−instance FromValue pg y
413+fromVector
392− => FromValue ('PGfixarray n ('Null pg)) (Vector (Maybe y)) where
414+ :: forall x xs. (All ((~) x) xs, SListI xs)
393− fromValue = Decoding.array
415+ => Vector x
394− (Decoding.dimensionArray Vector.replicateM
416+ -> Decoding.Value (NP I xs)
395− (Decoding.nullableValueArray (fromValue @pg)))
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
396−instance FromValue pg y
424+ , FromValue pg y
397− => FromValue ('PGfixarray n ('NotNull pg)) (Vector y) where
425+ ) => FromValue ('PGfixarray len ('NotNull pg)) hask where
398− fromValue = Decoding.array
426+ fromValue =
427+ let
428+ vectorValue = Decoding.array
399− (Decoding.dimensionArray Vector.replicateM
429+ (Decoding.dimensionArray Vector.replicateM
400− (Decoding.valueArray (fromValue @pg)))
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)
401instance
446instance
402 ( IsEnumType y
447 ( IsEnumType y
403 , HasDatatypeInfo y
448 , HasDatatypeInfo y
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+5−13
@@ -85,6 +85,7 @@ module Squeal.PostgreSQL.Schema
85 , Rename
85 , Rename
86 , Elem
86 , Elem
87 , In
87 , In
88+ , Length
88 , PGNum
89 , PGNum
89 , PGIntegral
90 , PGIntegral
90 , PGFloating
91 , PGFloating
@@ -562,19 +563,6 @@ type family Alter alias x xs where
562 Alter alias x1 (alias ::: x0 ': xs) = alias ::: x1 ': xs
563 Alter alias x1 (alias ::: x0 ': xs) = alias ::: x1 ': xs
563 Alter alias x1 (x0 ': xs) = x0 ': Alter alias x1 xs
564 Alter alias x1 (x0 ': xs) = x0 ': Alter alias x1 xs
564
565
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−
578-- | @Rename alias0 alias1 xs@ replaces the alias @alias0@ by @alias1@ in @xs@
566-- | @Rename alias0 alias1 xs@ replaces the alias @alias0@ by @alias1@ in @xs@
579-- and is used in `Squeal.PostgreSQL.Definition.alterTableRename` and
567-- and is used in `Squeal.PostgreSQL.Definition.alterTableRename` and
580-- `Squeal.PostgreSQL.Definition.renameColumn`.
568-- `Squeal.PostgreSQL.Definition.renameColumn`.
@@ -598,6 +586,10 @@ type family DropIfConstraintsInvolve column constraints where
598 (DropIfConstraintsInvolve column constraints)
586 (DropIfConstraintsInvolve column constraints)
599 (alias ::: constraint ': DropIfConstraintsInvolve column constraints)
587 (alias ::: constraint ': DropIfConstraintsInvolve column constraints)
600
588
589+type family Length (xs :: [k]) :: Nat where
590+ Length (x : xs) = 1 + Length xs
591+ Length '[] = 0
592+
601-- | A `SchemumType` is a user-defined type, either a `Table`,
593-- | A `SchemumType` is a user-defined type, either a `Table`,
602-- `View` or `Typedef`.
594-- `View` or `Typedef`.
603data SchemumType
595data SchemumType