git.iko.soy/squeal
on dev help sign in
introduce PG labels

just like aliases but instead of `Label`, `PGLabel` see #27 discussion

commit87d962c7817f1565d9f2f04bff26d30f6dd3fc90 authorEitan Chatav <eitan.chatav@gmail.com> dateWed 25 Apr 2018, 17:22 (9 years ago) parent3be316a
4 files changed+27−20
compare with dev
unifiedsplit
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+2−11 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+4−7 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+19
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+2−11
@@ -211,18 +211,9 @@ instance FromValue pg y => FromValue ('PGfixarray n pg) (Vector (Maybe y)) where
211211instance
212212 ( IsEnumType y
213213 , Read y
214− -- , SameLabels (DatatypeInfoOf y) labels
215− --
216− -- uncomment above constraint when GHC issue #11671 is fixed
217− -- Allow labels starting with uppercase with OverloadedLabels
218− -- https://ghc.haskell.org/trac/ghc/ticket/11671?cversion=0&cnum_hist=8
214+ , SameLabels (DatatypeInfoOf y) labels
219215 ) => FromValue ('PGenum labels) y where
220− fromValue _ =
221− let
222− upper "" = ""
223− upper (ch:chs) = toUpper ch : chs
224− in
225− Decoding.enum (readMaybe . upper . Strict.unpack)
216+ fromValue _ = Decoding.enum (readMaybe . Strict.unpack)
226217instance
227218 ( SListI fields
228219 , MapMaybes ys
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+2−2
@@ -783,11 +783,11 @@ dropView v = UnsafeDefinition $ "DROP VIEW" <+> renderAlias v <> ";"
783783createTypeEnum
784784 :: (KnownSymbol enum, SOP.All KnownSymbol labels)
785785 => Alias enum
786− -> NP Alias labels
786+ -> NP PGlabel labels
787787 -> Definition schema (Create enum ('Typedef ('PGenum labels)) schema)
788788createTypeEnum enum labels = UnsafeDefinition $
789789 "CREATE" <+> "TYPE" <+> renderAlias enum <+> "AS" <+>
790− parenthesized (commaSeparated (renderAliases labels)) <> ";"
790+ parenthesized (commaSeparated (renderLabels labels)) <> ";"
791791
792792createType
793793 :: (KnownSymbol comp, SOP.SListI fields)
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+4−7
@@ -42,7 +42,6 @@ module Squeal.PostgreSQL.Expression
4242 , nullIf
4343 -- ** Arrays, Enums, Composites
4444 , array
45− , label
4645 , row
4746 -- ** Functions
4847 , unsafeBinaryOp
@@ -319,12 +318,10 @@ array
319318array xs = UnsafeExpression $
320319 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"
321320
322−label
323− :: (KnownSymbol label, label `In` labels)
324− => Alias label
325− -> Expression relations grouping params (nullity ('PGenum labels))
326−label (_ :: Alias label) = UnsafeExpression $
327− fromString $ symbolVal (Proxy @label)
321+instance (KnownSymbol label, label `In` labels) => IsPGlabel label
322+ (Expression relations grouping params (nullity ('PGenum labels))) where
323+ label = UnsafeExpression $
324+ "\'" <> fromString (symbolVal (Proxy @label)) <> "\'"
328325
329326row
330327 :: (SListI (Nulls fields))
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+19
@@ -19,6 +19,7 @@ A type-level DSL for kinds of PostgreSQL types, constraints, and aliases.
1919 , GADTs
2020 , OverloadedStrings
2121 , RankNTypes
22+ , ScopedTypeVariables
2223 , StandaloneDeriving
2324 , TypeApplications
2425 , TypeFamilyDependencies
@@ -93,6 +94,10 @@ module Squeal.PostgreSQL.Schema
9394 , SameLabels
9495 , MapMaybes (..)
9596 , Nulls
97+ , IsPGlabel (..)
98+ , PGlabel (..)
99+ , renderLabel
100+ , renderLabels
96101 -- * Schema
97102 , SchemumType (..)
98103 , SchemaType
@@ -618,3 +623,17 @@ type family With
618623 With '[] schema = schema
619624 With (alias ::: rel ': rels) schema =
620625 alias ::: 'View rel ': With rels schema
626+
627+class IsPGlabel (label :: Symbol) expr where label :: expr
628+instance label ~ label'
629+ => IsPGlabel label (PGlabel label') where label = PGlabel
630+data PGlabel (label :: Symbol) = PGlabel
631+
632+renderLabel :: KnownSymbol label => proxy label -> ByteString
633+renderLabel (_ :: proxy label) =
634+ "\'" <> fromString (symbolVal (SOP.Proxy @label)) <> "\'"
635+
636+renderLabels
637+ :: SOP.All KnownSymbol labels => SOP.NP PGlabel labels -> [ByteString]
638+renderLabels = SOP.hcollapse
639+ . SOP.hcmap (SOP.Proxy @KnownSymbol) (SOP.K . renderLabel)