git.iko.soy/squeal
on dev help sign in
enum and composite pieces
e7e9693Eitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+11−2
compare with dev
unifiedsplit
@@ -60,7 +60,7 @@ import Network.IP.Addr
60import Text.Read (readMaybe)
60import Text.Read (readMaybe)
61
61
62import qualified Data.ByteString.Lazy as Lazy
62import qualified Data.ByteString.Lazy as Lazy
63−import qualified Data.ByteString as Strict hiding (unpack)
63+import qualified Data.ByteString as Strict hiding (pack, unpack)
64import qualified Data.Text.Lazy as Lazy
64import qualified Data.Text.Lazy as Lazy
65import qualified Data.Text as Strict
65import qualified Data.Text as Strict
66import qualified Data.Vector as Vector
66import qualified Data.Vector as Vector
@@ -123,7 +123,16 @@ instance (HasOid pg, ToParam x pg)
123 => ToParam (Vector (Maybe x)) ('PGvararray pg) where
123 => ToParam (Vector (Maybe x)) ('PGvararray pg) where
124 toParam = K . Encoding.nullableArray_vector
124 toParam = K . Encoding.nullableArray_vector
125 (oid @pg) (unK . toParam @x @pg)
125 (oid @pg) (unK . toParam @x @pg)
126−
126+instance
127+ ( IsEnumType x
128+ , Show x
129+ -- , SameLabels (DatatypeInfoOf y) labels
130+ --
131+ -- uncomment above constraint when GHC issue #11671 is fixed
132+ -- Allow labels starting with uppercase with OverloadedLabels
133+ -- https://ghc.haskell.org/trac/ghc/ticket/11671?cversion=0&cnum_hist=8
134+ ) => ToParam x ('PGenum labels) where
135+ toParam = K . Encoding.text_strict . Strict.pack . show
127-- | A `ToColumnParam` constraint lifts the `ToParam` encoding
136-- | A `ToColumnParam` constraint lifts the `ToParam` encoding
128-- of a `Type` to a `ColumnType`, encoding `Maybe`s to `Null`s. You should
137-- of a `Type` to a `ColumnType`, encoding `Maybe`s to `Null`s. You should
129-- not define instances of `ToColumnParam`, just use the provided instances.
138-- not define instances of `ToColumnParam`, just use the provided instances.
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+25
@@ -323,6 +323,31 @@ array
323array xs = UnsafeExpression $
323array xs = UnsafeExpression $
324 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"
324 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"
325
325
326+label
327+ :: (KnownSymbol label, label `In` labels)
328+ => Alias label
329+ -> Expression relations grouping params (nullity ('PGenum labels))
330+label (_ :: Alias label) = UnsafeExpression $
331+ fromString $ symbolVal (Proxy @label)
332+
333+type family Nulls tys where
334+ Nulls '[] = '[]
335+ Nulls (field ::: ty ': tys) = field ::: 'Null ty ': Nulls tys
336+
337+row
338+ :: (SListI (Nulls fields))
339+ => NP (Aliased (Expression relation grouping params)) (Nulls fields)
340+ -> Expression relation grouping params (nullity ('PGcomposite fields))
341+row exprs = UnsafeExpression $ "ROW" <> parenthesized
342+ (renderCommaSeparated (\ (expr `As` _) -> renderExpression expr) exprs)
343+
344+instance Has field fields ty => IsLabel field
345+ ( Expression relation grouping params (nullity ('PGcomposite fields))
346+ -> Expression relation grouping params ('Null ty) ) where
347+ fromLabel expr = UnsafeExpression $
348+ parenthesized (renderExpression expr) <> "." <>
349+ fromString (symbolVal (Proxy @field))
350+
326instance Monoid
351instance Monoid
327 (Expression relations grouping params (nullity ('PGvararray ty))) where
352 (Expression relations grouping params (nullity ('PGvararray ty))) where
328 mempty = array []
353 mempty = array []