git.iko.soy/squeal
on dev help sign in
createTypeEnumFromHaskell
7018d90Eitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+1−1
compare with dev
unifiedsplit
@@ -313,7 +313,7 @@ instance FromValue pg y => FromAliasedValue (alias ::: pg) y where
313 fromAliasedValue _ = fromValue (Proxy @pg)
313 fromAliasedValue _ = fromValue (Proxy @pg)
314
314
315-- | A `FromColumnValue` constraint lifts the `FromValue` parser
315-- | A `FromColumnValue` constraint lifts the `FromValue` parser
316−-- to a decoding of a @(Symbol, ColumnType)@ to a `Type`,
316+-- to a decoding of a @(Symbol, NullityType)@ to a `Type`,
317-- decoding `Null`s to `Maybe`s. You should not define instances for
317-- decoding `Null`s to `Maybe`s. You should not define instances for
318-- `FromColumnValue`, just use the provided instances.
318-- `FromColumnValue`, just use the provided instances.
319class FromColumnValue (colty :: (Symbol,NullityType)) (y :: Type) where
319class FromColumnValue (colty :: (Symbol,NullityType)) (y :: Type) where
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+13
@@ -66,6 +66,7 @@ module Squeal.PostgreSQL.Definition
66 -- * Types
66 -- * Types
67 , createType
67 , createType
68 , createTypeEnum
68 , createTypeEnum
69+ , createTypeEnumFromHaskell
69 , dropType
70 , dropType
70 , ColumnTypeExpression (..)
71 , ColumnTypeExpression (..)
71 , notNull
72 , notNull
@@ -789,6 +790,18 @@ createTypeEnum enum labels = UnsafeDefinition $
789 "CREATE" <+> "TYPE" <+> renderAlias enum <+> "AS" <+>
790 "CREATE" <+> "TYPE" <+> renderAlias enum <+> "AS" <+>
790 parenthesized (commaSeparated (renderLabels labels)) <> ";"
791 parenthesized (commaSeparated (renderLabels labels)) <> ";"
791
792
793+createTypeEnumFromHaskell
794+ :: forall enum labels hask proxy schema
795+ . ( KnownSymbol enum
796+ , SOP.All KnownSymbol labels
797+ , SOP.IsEnumType hask
798+ , labels ~ DatatypeLabels (SOP.DatatypeInfoOf hask) )
799+ => Alias enum
800+ -> proxy hask
801+ -> Definition schema (Create enum ('Typedef ('PGenum labels)) schema)
802+createTypeEnumFromHaskell enum _ = createTypeEnum enum
803+ (SOP.hpure label :: NP PGlabel labels)
804+
792createType
805createType
793 :: (KnownSymbol comp, SOP.SListI fields)
806 :: (KnownSymbol comp, SOP.SListI fields)
794 => Alias comp
807 => Alias comp
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+13
@@ -98,6 +98,9 @@ module Squeal.PostgreSQL.Schema
98 , PGlabel (..)
98 , PGlabel (..)
99 , renderLabel
99 , renderLabel
100 , renderLabels
100 , renderLabels
101+ , LabelOf
102+ , LabelsOf
103+ , DatatypeLabels
101 -- * Schema
104 -- * Schema
102 , SchemumType (..)
105 , SchemumType (..)
103 , SchemaType
106 , SchemaType
@@ -640,3 +643,13 @@ renderLabels
640 :: SOP.All KnownSymbol labels => SOP.NP PGlabel labels -> [ByteString]
643 :: SOP.All KnownSymbol labels => SOP.NP PGlabel labels -> [ByteString]
641renderLabels = SOP.hcollapse
644renderLabels = SOP.hcollapse
642 . SOP.hcmap (SOP.Proxy @KnownSymbol) (SOP.K . renderLabel)
645 . SOP.hcmap (SOP.Proxy @KnownSymbol) (SOP.K . renderLabel)
646+
647+type family LabelOf (cons :: Type.ConstructorInfo) :: Symbol where
648+ LabelOf ('Type.Constructor name) = name
649+
650+type family LabelsOf (conss :: [Type.ConstructorInfo]) :: [Symbol] where
651+ LabelsOf '[] = '[]
652+ LabelsOf (cons ': conss) = LabelOf cons ': LabelsOf conss
653+
654+type family DatatypeLabels (info :: Type.DatatypeInfo) :: [Symbol] where
655+ DatatypeLabels ('Type.ADT _module _datatype constructors) = LabelsOf constructors