git.iko.soy/squeal
on dev help sign in
ZipAliased
8f2ed09Eitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+23−6
compare with dev
unifiedsplit
@@ -58,6 +58,7 @@ module Squeal.PostgreSQL.Schema
58 , Aliased (As)
58 , Aliased (As)
59 , renderAliasedAs
59 , renderAliasedAs
60 , AliasesOf
60 , AliasesOf
61+ , ZipAliased (..)
61 , Has
62 , Has
62 , HasUnique
63 , HasUnique
63 , HasAll
64 , HasAll
@@ -118,7 +119,6 @@ module Squeal.PostgreSQL.Schema
118 , FieldTypeOf
119 , FieldTypeOf
119 , FieldTypesOf
120 , FieldTypesOf
120 , RecordFieldTypesOf
121 , RecordFieldTypesOf
121− , Zip
122 ) where
122 ) where
123
123
124import Control.DeepSeq
124import Control.DeepSeq
@@ -413,6 +413,27 @@ type family AliasesOf aliaseds where
413 AliasesOf '[] = '[]
413 AliasesOf '[] = '[]
414 AliasesOf (alias ::: ty ': tys) = alias ': AliasesOf tys
414 AliasesOf (alias ::: ty ': tys) = alias ': AliasesOf tys
415
415
416+class SOP.All KnownSymbol ns => ZipAliased ns xs where
417+
418+ type family ZipAs
419+ (ns :: [Symbol]) (xs :: [k]) = (zs :: [(Symbol,k)]) | zs -> ns xs
420+
421+ zipAliases
422+ :: SOP.NP Alias ns
423+ -> SOP.NP expr xs
424+ -> SOP.NP (Aliased expr) (ZipAs ns xs)
425+
426+instance ZipAliased '[] '[] where
427+ type ZipAs '[] '[] = '[]
428+ zipAliases SOP.Nil SOP.Nil = SOP.Nil
429+
430+instance
431+ ( KnownSymbol n
432+ , ZipAliased ns xs
433+ ) => ZipAliased (n ': ns) (x ': xs) where
434+ type ZipAs (n ': ns) (x ': xs) = '(n,x) ': ZipAs ns xs
435+ zipAliases (n SOP.:* ns) (x SOP.:* xs) = x `As` n SOP.:* zipAliases ns xs
436+
416-- | @HasUnique alias fields field@ is a constraint that proves that
437-- | @HasUnique alias fields field@ is a constraint that proves that
417-- @fields@ is a singleton of @alias ::: field@.
438-- @fields@ is a singleton of @alias ::: field@.
418type HasUnique alias fields field = fields ~ '[alias ::: field]
439type HasUnique alias fields field = fields ~ '[alias ::: field]
@@ -701,7 +722,7 @@ type family PGenumWith (hask :: Type) :: [Type.ConstructorName] where
701
722
702type family PGcompositeWith (hask :: Type) :: PGType where
723type family PGcompositeWith (hask :: Type) :: PGType where
703 PGcompositeWith hask =
724 PGcompositeWith hask =
704− 'PGcomposite (Zip
725+ 'PGcomposite (ZipAs
705 (FieldNamesOf (FieldsOf (SOP.DatatypeInfoOf hask)))
726 (FieldNamesOf (FieldsOf (SOP.DatatypeInfoOf hask)))
706 (RecordFieldTypesOf (SOP.Code hask)))
727 (RecordFieldTypesOf (SOP.Code hask)))
707
728
@@ -746,7 +767,3 @@ type family FieldTypesOf (fields :: [Type]) where
746
767
747type family RecordFieldTypesOf (code :: [[Type]]) where
768type family RecordFieldTypesOf (code :: [[Type]]) where
748 RecordFieldTypesOf '[fields] = FieldTypesOf fields
769 RecordFieldTypesOf '[fields] = FieldTypesOf fields
749−
750−type family Zip xs ys where
751− Zip '[] '[] = '[]
752− Zip (x ': xs) (y ': ys) = '(x,y) ': Zip xs ys