on dev help sign in
ZipAliased
commit8f2ed09f6418bd49276844f4692a3f4d26303959 authorEitan Chatav <eitan.chatav@gmail.com> dateFri 1 Jun 2018, 15:04 (8 years ago) parente027ede
1 file changed+23−6
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+23−6
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+23−6
@@ -58,6 +58,7 @@ module Squeal.PostgreSQL.Schema
5858 , Aliased (As)
5959 , renderAliasedAs
6060 , AliasesOf
61+ , ZipAliased (..)
6162 , Has
6263 , HasUnique
6364 , HasAll
@@ -118,7 +119,6 @@ module Squeal.PostgreSQL.Schema
118119 , FieldTypeOf
119120 , FieldTypesOf
120121 , RecordFieldTypesOf
121− , Zip
122122 ) where
123123
124124import Control.DeepSeq
@@ -413,6 +413,27 @@ type family AliasesOf aliaseds where
413413 AliasesOf '[] = '[]
414414 AliasesOf (alias ::: ty ': tys) = alias ': AliasesOf tys
415415
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+
416437-- | @HasUnique alias fields field@ is a constraint that proves that
417438-- @fields@ is a singleton of @alias ::: field@.
418439type HasUnique alias fields field = fields ~ '[alias ::: field]
@@ -701,7 +722,7 @@ type family PGenumWith (hask :: Type) :: [Type.ConstructorName] where
701722
702723type family PGcompositeWith (hask :: Type) :: PGType where
703724 PGcompositeWith hask =
704− 'PGcomposite (Zip
725+ 'PGcomposite (ZipAs
705726 (FieldNamesOf (FieldsOf (SOP.DatatypeInfoOf hask)))
706727 (RecordFieldTypesOf (SOP.Code hask)))
707728
@@ -746,7 +767,3 @@ type family FieldTypesOf (fields :: [Type]) where
746767
747768type family RecordFieldTypesOf (code :: [[Type]]) where
748769 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