87d962c · squeal · git.iko.soy

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+2−11

compare with dev

unifiedsplit

@@ -211,18 +211,9 @@ instance FromValue pg y => FromValue ('PGfixarray n pg) (Vector (Maybe y)) where

211instance

212 ( IsEnumType y

213 , Read y

214− -- , SameLabels (DatatypeInfoOf y) labels

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

219 ) => FromValue ('PGenum labels) y where

215 ) => 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)

226instance

217instance

227 ( SListI fields

218 ( SListI fields

228 , MapMaybes ys

219 , MapMaybes ys

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+2−2

@@ -783,11 +783,11 @@ dropView v = UnsafeDefinition $ "DROP VIEW" <+> renderAlias v <> ";"

783createTypeEnum

784 :: (KnownSymbol enum, SOP.All KnownSymbol labels)

785 => Alias enum

786− -> NP Alias labels

786+ -> NP PGlabel labels

787 -> Definition schema (Create enum ('Typedef ('PGenum labels)) schema)

788createTypeEnum enum labels = UnsafeDefinition $

789 "CREATE" <+> "TYPE" <+> renderAlias enum <+> "AS" <+>

790− parenthesized (commaSeparated (renderAliases labels)) <> ";"

790+ parenthesized (commaSeparated (renderLabels labels)) <> ";"

791

792createType

793 :: (KnownSymbol comp, SOP.SListI fields)

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+4−7

@@ -42,7 +42,6 @@ module Squeal.PostgreSQL.Expression

42 , nullIf

43 -- ** Arrays, Enums, Composites

44 , array

45− , label

46 , row

45 , row

47 -- ** Functions

46 -- ** Functions

48 , unsafeBinaryOp

47 , unsafeBinaryOp

@@ -319,12 +318,10 @@ array

319array xs = UnsafeExpression $

318array xs = UnsafeExpression $

320 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"

319 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"

321

320

322−label

323− :: (KnownSymbol label, label `In` labels)

321+instance (KnownSymbol label, label `In` labels) => IsPGlabel label

324− => Alias label

325− -> Expression relations grouping params (nullity ('PGenum labels))

322+ (Expression relations grouping params (nullity ('PGenum labels))) where

326−label (_ :: Alias label) = UnsafeExpression $

323+ label = UnsafeExpression $

327− fromString $ symbolVal (Proxy @label)

324+ "\'" <> fromString (symbolVal (Proxy @label)) <> "\'"

328

325

329row

326row

330 :: (SListI (Nulls fields))

327 :: (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.

19 , GADTs

20 , OverloadedStrings

21 , RankNTypes

22+ , ScopedTypeVariables

22 , StandaloneDeriving

23 , StandaloneDeriving

23 , TypeApplications

24 , TypeApplications

24 , TypeFamilyDependencies

25 , TypeFamilyDependencies

@@ -93,6 +94,10 @@ module Squeal.PostgreSQL.Schema

93 , SameLabels

94 , SameLabels

94 , MapMaybes (..)

95 , MapMaybes (..)

95 , Nulls

96 , Nulls

97+ , IsPGlabel (..)

98+ , PGlabel (..)

99+ , renderLabel

100+ , renderLabels

96 -- * Schema

101 -- * Schema

97 , SchemumType (..)

102 , SchemumType (..)

98 , SchemaType

103 , SchemaType

@@ -618,3 +623,17 @@ type family With

618 With '[] schema = schema

623 With '[] schema = schema

619 With (alias ::: rel ': rels) schema =

624 With (alias ::: rel ': rels) schema =

620 alias ::: 'View rel ': With rels schema

625 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)