on dev help sign in
createTypeEnumFromHaskell

createTypeEnumFromHaskell

commit7018d90f3334c7ecdb9e554b12b69d12bae3e4d4 authorEitan Chatav <eitan.chatav@gmail.com> dateThu 26 Apr 2018, 17:16 (9 years ago) parentd3bfaa5
3 files changed+27−1
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+1−1 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+13 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+13
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+1−1
@@ -313,7 +313,7 @@ instance FromValue pg y => FromAliasedValue (alias ::: pg) y where
313313 fromAliasedValue _ = fromValue (Proxy @pg)
314314
315315-- | 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`,
317317-- decoding `Null`s to `Maybe`s. You should not define instances for
318318-- `FromColumnValue`, just use the provided instances.
319319class FromColumnValue (colty :: (Symbol,NullityType)) (y :: Type) where
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+13
@@ -66,6 +66,7 @@ module Squeal.PostgreSQL.Definition
6666 -- * Types
6767 , createType
6868 , createTypeEnum
69+ , createTypeEnumFromHaskell
6970 , dropType
7071 , ColumnTypeExpression (..)
7172 , notNull
@@ -789,6 +790,18 @@ createTypeEnum enum labels = UnsafeDefinition $
789790 "CREATE" <+> "TYPE" <+> renderAlias enum <+> "AS" <+>
790791 parenthesized (commaSeparated (renderLabels labels)) <> ";"
791792
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+
792805createType
793806 :: (KnownSymbol comp, SOP.SListI fields)
794807 => Alias comp
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+13
@@ -98,6 +98,9 @@ module Squeal.PostgreSQL.Schema
9898 , PGlabel (..)
9999 , renderLabel
100100 , renderLabels
101+ , LabelOf
102+ , LabelsOf
103+ , DatatypeLabels
101104 -- * Schema
102105 , SchemumType (..)
103106 , SchemaType
@@ -640,3 +643,13 @@ renderLabels
640643 :: SOP.All KnownSymbol labels => SOP.NP PGlabel labels -> [ByteString]
641644renderLabels = SOP.hcollapse
642645 . 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