git.iko.soy/squeal
on dev help sign in
enum and composite pieces

* label - enum construction * row - composite construction * composite access * enum encoding

commite7e969307c43355605f4288d957948b37e2c4f89 authorEitan Chatav <eitan.chatav@gmail.com> dateMon 16 Apr 2018, 17:01 (9 years ago) parent3148d41
2 files changed+36−2
compare with dev
unifiedsplit
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+11−2 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+25
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+11−2
@@ -60,7 +60,7 @@ import Network.IP.Addr
6060import Text.Read (readMaybe)
6161
6262import 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)
6464import qualified Data.Text.Lazy as Lazy
6565import qualified Data.Text as Strict
6666import qualified Data.Vector as Vector
@@ -123,7 +123,16 @@ instance (HasOid pg, ToParam x pg)
123123 => ToParam (Vector (Maybe x)) ('PGvararray pg) where
124124 toParam = K . Encoding.nullableArray_vector
125125 (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
127136-- | A `ToColumnParam` constraint lifts the `ToParam` encoding
128137-- of a `Type` to a `ColumnType`, encoding `Maybe`s to `Null`s. You should
129138-- not define instances of `ToColumnParam`, just use the provided instances.
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+25
@@ -323,6 +323,31 @@ array
323323array xs = UnsafeExpression $
324324 "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]"
325325
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+
326351instance Monoid
327352 (Expression relations grouping params (nullity ('PGvararray ty))) where
328353 mempty = array []