squeal-postgresql 0.8.1.1 → 0.9.0.0

raw patch · 23 files changed

+882/−325 lines, 23 filesdep +hashablePVP ok

version bump matches the API change (PVP)

Dependencies added: hashable

API changes (from Hackage documentation)

Files

• squeal-postgresql.cabal +7/−5
• src/Squeal/PostgreSQL/Expression.hs +2/−2
• src/Squeal/PostgreSQL/Expression/Array.hs +2/−2
• src/Squeal/PostgreSQL/Expression/Composite.hs +8/−6
• src/Squeal/PostgreSQL/Expression/Inline.hs +57/−36
• src/Squeal/PostgreSQL/Expression/Json.hs +12/−12
• src/Squeal/PostgreSQL/Expression/Null.hs +10/−3
• src/Squeal/PostgreSQL/Expression/Parameter.hs +5/−2
• src/Squeal/PostgreSQL/Expression/Range.hs +2/−2
• src/Squeal/PostgreSQL/Expression/Type.hs +36/−7
• src/Squeal/PostgreSQL/Query.hs +1/−1
• src/Squeal/PostgreSQL/Session.hs +52/−83
• src/Squeal/PostgreSQL/Session/Encode.hs +158/−21
• src/Squeal/PostgreSQL/Session/Indexed.hs +2/−2
• src/Squeal/PostgreSQL/Session/Monad.hs +149/−39
• src/Squeal/PostgreSQL/Session/Oid.hs +30/−28
• src/Squeal/PostgreSQL/Session/Statement.hs +122/−7
• src/Squeal/PostgreSQL/Session/Transaction.hs +7/−7
• src/Squeal/PostgreSQL/Type/Alias.hs +8/−5
• src/Squeal/PostgreSQL/Type/List.hs +18/−13
• src/Squeal/PostgreSQL/Type/Schema.hs +101/−33
• test/Property.hs +92/−8
• test/Spec.hs +1/−1

@@ -1,17 +1,17 @@+cabal-version: 2.2 name: squeal-postgresql-version: 0.8.1.1+version: 0.9.0.0 synopsis: Squeal PostgreSQL Library description: Squeal is a type-safe embedding of PostgreSQL in Haskell homepage: https://github.com/morphismtech/squeal bug-reports: https://github.com/morphismtech/squeal/issues-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Eitan Chatav maintainer: eitan.chatav@gmail.com-copyright: Copyright (c) 2021 Morphism, LLC+copyright: Copyright (c) 2022 Morphism, LLC category: Database build-type: Simple-cabal-version: >=1.18 extra-doc-files: README.md  source-repository head@@ -98,6 +98,7 @@     , exceptions >= 0.10.3     , free-categories >= 0.2.0.0     , generics-sop >= 0.5.1.0+    , hashable >= 1.3.0.0     , mmorph >= 1.1.3     , monad-control >= 1.0.2.3     , mtl >= 2.2.2@@ -125,7 +126,8 @@   build-depends:       base >= 4.12.0.0 && < 5.0     , doctest >= 0.16.3-    , squeal-postgresql+  if impl(ghc >= 9.0.0)+    buildable: False  test-suite properties   default-language: Haskell2010

@@ -342,7 +342,7 @@   :: (Has sch db schema, Has fun schema ('Function ('[x] :=> 'Returns y)))   => QualifiedAlias sch fun -- ^ function name   -> Fun db x y-function = unsafeFunction . renderSQL+function f = unsafeFunction $ renderSQL f  -- | >>> printSQL $ unsafeFunctionN "f" (currentTime :* localTimestamp :* false *: inline 'a') -- f(CURRENT_TIME, LOCALTIMESTAMP, FALSE, (E'a' :: char(1)))@@ -369,7 +369,7 @@      , SListI xs )   => QualifiedAlias sch fun -- ^ function alias   -> FunN db xs y-functionN = unsafeFunctionN . renderSQL+functionN f = unsafeFunctionN $ renderSQL f  instance   Num (Expression grp lat with db params from (null 'PGint2)) where

@@ -207,7 +207,7 @@ arrAll   :: Expression grp lat with db params from ty1 -- ^ expression   -> Operator ty1 ty2 ('Null 'PGbool) -- ^ operator-  -> Expression grp lat with db params from ('Null ('PGvararray ty2)) -- ^ array+  -> Expression grp lat with db params from (null ('PGvararray ty2)) -- ^ array   -> Condition grp lat with db params from arrAll x (?) xs = x ? (UnsafeExpression $ "ALL" <+> parenthesized (renderSQL xs)) @@ -237,6 +237,6 @@ arrAny   :: Expression grp lat with db params from ty1 -- ^ expression   -> Operator ty1 ty2 ('Null 'PGbool) -- ^ operator-  -> Expression grp lat with db params from ('Null ('PGvararray ty2)) -- ^ array+  -> Expression grp lat with db params from (null ('PGvararray ty2)) -- ^ array   -> Condition grp lat with db params from arrAny x (?) xs = x ? (UnsafeExpression $ "ANY" <+> parenthesized (renderSQL xs))

@@ -81,13 +81,15 @@ -- >>> printSQL $ i & field #complex #imaginary -- (ROW((0.0 :: float8), (1.0 :: float8))::"complex")."imaginary" field-  :: ( Has sch db schema-     , Has tydef schema ('Typedef ('PGcomposite row))-     , Has field row ty)-  => QualifiedAlias sch tydef -- ^ row type+  :: ( relss ~ DbRelations db+     , Has sch relss rels+     , Has rel rels row+     , Has field row ty+     )+  => QualifiedAlias sch rel -- ^ row type   -> Alias field -- ^ field name   -> Expression grp lat with db params from ('NotNull ('PGcomposite row))   -> Expression grp lat with db params from ty-field td fld expr = UnsafeExpression $-  parenthesized (renderSQL expr <> "::" <> renderSQL td)+field rel fld expr = UnsafeExpression $+  parenthesized (renderSQL expr <> "::" <> renderSQL rel)     <> "." <> renderSQL fld

@@ -39,7 +39,6 @@ import Data.ByteString.Lazy (toStrict) import Data.ByteString.Builder (doubleDec, floatDec, int16Dec, int32Dec, int64Dec) import Data.ByteString.Builder.Scientific (scientificBuilder)-import Data.Coerce (coerce) import Data.Functor.Const (Const(Const)) import Data.Functor.Constant (Constant(Constant)) import Data.Int (Int16, Int32, Int64)@@ -101,29 +100,41 @@     True -> true     False -> false instance JSON.ToJSON x => Inline (Json x) where-  inline = inferredtype . UnsafeExpression-    . singleQuotedUtf8 . toStrict . JSON.encode . getJson+  inline (Json x)+    = inferredtype+    . UnsafeExpression+    . singleQuotedUtf8+    . toStrict+    . JSON.encode+    $ x instance JSON.ToJSON x => Inline (Jsonb x) where-  inline = inferredtype . UnsafeExpression-    . singleQuotedUtf8 . toStrict . JSON.encode . getJsonb+  inline (Jsonb x)+    = inferredtype+    . UnsafeExpression+    . singleQuotedUtf8+    . toStrict+    . JSON.encode+    $ x instance Inline Char where   inline chr = inferredtype . UnsafeExpression $     "E\'" <> fromString (escape chr) <> "\'"-instance Inline String where inline = fromString+instance Inline String where inline x = fromString x instance Inline Int16 where-  inline+  inline x     = inferredtype     . UnsafeExpression     . toStrict     . toLazyByteString     . int16Dec+    $ x instance Inline Int32 where-  inline+  inline x     = inferredtype     . UnsafeExpression     . toStrict     . toLazyByteString     . int32Dec+    $ x instance Inline Int64 where   inline x =     if x == minBound@@ -151,29 +162,33 @@     where       decimal = toStrict . toLazyByteString . doubleDec instance Inline Scientific where-  inline+  inline x     = inferredtype     . UnsafeExpression     . toStrict     . toLazyByteString     . scientificBuilder-instance Inline Text where inline = fromString . Text.unpack-instance Inline Lazy.Text where inline = fromString . Lazy.Text.unpack+    $ x+instance Inline Text where inline x = fromString . Text.unpack $ x+instance Inline Lazy.Text where inline x = fromString . Lazy.Text.unpack $ x instance (KnownNat n, 1 <= n) => Inline (VarChar n) where-  inline+  inline x     = inferredtype     . UnsafeExpression     . escapeQuotedText     . getVarChar+    $ x instance (KnownNat n, 1 <= n) => Inline (FixChar n) where-  inline+  inline x     = inferredtype     . UnsafeExpression     . escapeQuotedText     . getFixChar-instance Inline x => Inline (Const x tag) where inline = inline @x . coerce-instance Inline x => Inline (SOP.K x tag) where inline = inline @x . coerce-instance Inline x => Inline (Constant x tag) where inline = inline @x . coerce+    $ x+instance Inline x => Inline (Const x tag) where inline (Const x) = inline x+instance Inline x => Inline (SOP.K x tag) where inline (SOP.K x) = inline x+instance Inline x => Inline (Constant x tag) where+  inline (Constant x) = inline x instance Inline DiffTime where   inline dt =     let@@ -185,58 +200,64 @@         interval_ (fromIntegral secs) Seconds         +! interval_ (fromIntegral microsecs) Microseconds instance Inline Day where-  inline+  inline x     = inferredtype     . UnsafeExpression     . singleQuotedUtf8     . fromString     . iso8601Show+    $ x instance Inline UTCTime where-  inline+  inline x     = inferredtype     . UnsafeExpression     . singleQuotedUtf8     . fromString     . iso8601Show+    $ x instance Inline (TimeOfDay, TimeZone) where-  inline+  inline x     = inferredtype     . UnsafeExpression     . singleQuotedUtf8     . fromString     . formatShow (timeOfDayAndOffsetFormat ExtendedFormat)+    $ x instance Inline TimeOfDay where-  inline+  inline x     = inferredtype     . UnsafeExpression     . singleQuotedUtf8     . fromString-    . iso8601Show +    . iso8601Show+    $ x instance Inline LocalTime where-  inline+  inline x     = inferredtype     . UnsafeExpression     . singleQuotedUtf8     . fromString     . iso8601Show+    $ x instance Inline (Range Int32) where-  inline = range int4range . fmap inline+  inline x = range int4range . fmap (\y -> inline y) $ x instance Inline (Range Int64) where-  inline = range int8range . fmap inline+  inline x = range int8range . fmap (\y -> inline y) $ x instance Inline (Range Scientific) where-  inline = range numrange . fmap inline+  inline x = range numrange . fmap (\y -> inline y) $ x instance Inline (Range LocalTime) where-  inline = range tsrange . fmap inline+  inline x = range tsrange . fmap (\y -> inline y) $ x instance Inline (Range UTCTime) where-  inline = range tstzrange . fmap inline+  inline x = range tstzrange . fmap (\y -> inline y) $ x instance Inline (Range Day) where-  inline = range daterange . fmap inline+  inline x = range daterange . fmap (\y -> inline y) $ x instance Inline UUID where-  inline+  inline x     = inferredtype     . UnsafeExpression     . singleQuotedUtf8     . toASCIIBytes+    $ x instance Inline Money where   inline moolah = inferredtype . UnsafeExpression $     fromString (show dollars)@@ -245,17 +266,17 @@       (dollars,pennies) = cents moolah `divMod` 100 instance InlineParam x (NullPG x)   => Inline (VarArray [x]) where-    inline (VarArray xs) = array (inlineParam <$> xs)+    inline (VarArray xs) = array ((\x -> inlineParam x) <$> xs) instance InlineParam x (NullPG x)   => Inline (VarArray (Vector x)) where-    inline (VarArray xs) = array (inlineParam <$> toList xs)+    inline (VarArray xs) = array ((\x -> inlineParam x) <$> toList xs) instance Inline Oid where   inline (Oid o) = inferredtype . UnsafeExpression . fromString $ show o instance   ( SOP.IsEnumType x   , SOP.HasDatatypeInfo x   ) => Inline (Enumerated x) where-    inline =+    inline (Enumerated x) =       let         gshowConstructor           :: NP SOP.ConstructorInfo xss@@ -273,22 +294,22 @@         . gshowConstructor             (SOP.constructorInfo (SOP.datatypeInfo (SOP.Proxy @x)))         . SOP.from-        . getEnumerated+        $ x instance   ( SOP.IsRecord x xs   , SOP.AllZip InlineField xs (RowPG x)   ) => Inline (Composite x) where-    inline+    inline (Composite x)       = row       . SOP.htrans (SOP.Proxy @InlineField) inlineField       . SOP.toRecord-      . getComposite+      $ x  -- | Lifts `Inline` to `NullType`s. class InlineParam x ty where inlineParam :: x -> Expr ty instance (Inline x, pg ~ PG x) => InlineParam x ('NotNull pg) where inlineParam = inline instance (Inline x, pg ~ PG x) => InlineParam (Maybe x) ('Null pg) where-  inlineParam = maybe null_ inline+  inlineParam x = maybe null_ (\y -> inline y) x  -- | Lifts `Inline` to fields. class InlineField

@@ -336,8 +336,8 @@  {- | Expands the outermost JSON object into a set of key/value pairs. ->>> printSQL (select Star (from (jsonEach (inline (Json (object ["a" .= "foo", "b" .= "bar"]))))))-SELECT * FROM json_each(('{"a":"foo","b":"bar"}' :: json))+>>> printSQL (select Star (from (jsonEach (inline (Json (object ["a" .= "foo"]))))))+SELECT * FROM json_each(('{"a":"foo"}' :: json)) -} jsonEach :: null 'PGjson -|->   ("json_each" ::: '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjson])@@ -345,8 +345,8 @@  {- | Expands the outermost binary JSON object into a set of key/value pairs. ->>> printSQL (select Star (from (jsonbEach (inline (Jsonb (object ["a" .= "foo", "b" .= "bar"]))))))-SELECT * FROM jsonb_each(('{"a":"foo","b":"bar"}' :: jsonb))+>>> printSQL (select Star (from (jsonbEach (inline (Jsonb (object ["a" .= "foo"]))))))+SELECT * FROM jsonb_each(('{"a":"foo"}' :: jsonb)) -} jsonbEach   :: null 'PGjsonb -|->@@ -355,8 +355,8 @@  {- | Expands the outermost JSON object into a set of key/value pairs. ->>> printSQL (select Star (from (jsonEachText (inline (Json (object ["a" .= "foo", "b" .= "bar"]))))))-SELECT * FROM json_each_text(('{"a":"foo","b":"bar"}' :: json))+>>> printSQL (select Star (from (jsonEachText (inline (Json (object ["a" .= "foo"]))))))+SELECT * FROM json_each_text(('{"a":"foo"}' :: json)) -} jsonEachText   :: null 'PGjson -|->@@ -375,8 +375,8 @@  {- | Expands the outermost binary JSON object into a set of key/value pairs. ->>> printSQL (select Star (from (jsonbEachText (inline (Jsonb (object ["a" .= "foo", "b" .= "bar"]))))))-SELECT * FROM jsonb_each_text(('{"a":"foo","b":"bar"}' :: jsonb))+>>> printSQL (select Star (from (jsonbEachText (inline (Jsonb (object ["a" .= "foo"]))))))+SELECT * FROM jsonb_each_text(('{"a":"foo"}' :: jsonb)) -} jsonbEachText   :: null 'PGjsonb -|->@@ -385,8 +385,8 @@  {- | Returns set of keys in the outermost JSON object. ->>> printSQL (jsonObjectKeys (inline (Json (object ["a" .= "foo", "b" .= "bar"]))))-json_object_keys(('{"a":"foo","b":"bar"}' :: json))+>>> printSQL (jsonObjectKeys (inline (Json (object ["a" .= "foo"]))))+json_object_keys(('{"a":"foo"}' :: json)) -} jsonObjectKeys   :: null 'PGjson -|->@@ -395,8 +395,8 @@  {- | Returns set of keys in the outermost JSON object. ->>> printSQL (jsonbObjectKeys (inline (Jsonb (object ["a" .= "foo", "b" .= "bar"]))))-jsonb_object_keys(('{"a":"foo","b":"bar"}' :: jsonb))+>>> printSQL (jsonbObjectKeys (inline (Jsonb (object ["a" .= "foo"]))))+jsonb_object_keys(('{"a":"foo"}' :: jsonb)) -} jsonbObjectKeys   :: null 'PGjsonb -|->

@@ -20,7 +20,7 @@ module Squeal.PostgreSQL.Expression.Null   ( -- * Null     null_-  , notNull+  , just_   , unsafeNotNull   , monoNotNull   , coalesce@@ -30,6 +30,8 @@   , matchNull   , nullIf   , CombineNullity+    -- deprecated+  , notNull   ) where  import Squeal.PostgreSQL.Expression@@ -49,8 +51,13 @@  -- | analagous to `Just` ----- >>> printSQL $ notNull true+-- >>> printSQL $ just_ true -- TRUE+just_ :: 'NotNull ty --> 'Null ty+just_ = UnsafeExpression . renderSQL++-- | analagous to `Just`+{-# DEPRECATED notNull "use just_ instead" #-} notNull :: 'NotNull ty --> 'Null ty notNull = UnsafeExpression . renderSQL @@ -68,7 +75,7 @@   :: (forall null. Expression grp lat with db params from (null ty))   -- ^ null polymorphic   -> Expression grp lat with db params from ('NotNull ty)-monoNotNull = id+monoNotNull x = x  -- | return the leftmost value which is not NULL --

@@ -30,6 +30,10 @@   ( -- * Parameter     HasParameter (parameter)   , param+    -- * Parameter Internals+  , HasParameter'+  , ParamOutOfBoundsError+  , ParamTypeMismatchError   ) where  import Data.Kind (Constraint)@@ -74,8 +78,7 @@ instance {-# OVERLAPS #-} (KnownNat ix, HasParameter' ix params ix params x) => HasParameter ix params x  -- | @HasParameter'@ is an implementation detail of 'HasParameter' allowing us to--- include the full parameter list in our errors. Generally speaking it shouldn't leak to users--- of the library+-- include the full parameter list in our errors. class KnownNat ix => HasParameter'   (originalIx :: Nat)   (allParams :: [NullType])

@@ -147,11 +147,11 @@ whole = NonEmpty Infinite Infinite  -- | range is contained by-(.<@) :: Operator ('NotNull ty) (null ('PGrange ty)) ('Null 'PGbool)+(.<@) :: Operator (null0 ty) (null1 ('PGrange ty)) ('Null 'PGbool) (.<@) = unsafeBinaryOp "<@"  -- | contains range-(@>.) :: Operator (null ('PGrange ty)) ('NotNull ty) ('Null 'PGbool)+(@>.) :: Operator (null0 ('PGrange ty)) (null1 ty) ('Null 'PGbool) (@>.) = unsafeBinaryOp "@>"  -- | strictly left of,

@@ -34,6 +34,8 @@   , inferredtype     -- * Type Expression   , TypeExpression (..)+  , typerow+  , typeenum   , typedef   , typetable   , typeview@@ -172,6 +174,31 @@ instance RenderSQL (TypeExpression db ty) where   renderSQL = renderTypeExpression +-- | The composite type corresponding to a relation can be expressed+-- by its alias. A relation is either a composite type, a table or a view.+-- It subsumes `typetable` and `typeview` and partly overlaps `typedef`.+typerow+  :: ( relss ~ DbRelations db+     , Has sch relss rels+     , Has rel rels row+     )+  => QualifiedAlias sch rel+  -- ^ type alias+  -> TypeExpression db (null ('PGcomposite row))+typerow = UnsafeTypeExpression . renderSQL++-- | An enumerated type can be expressed by its alias.+-- `typeenum` is subsumed by `typedef`.+typeenum+  :: ( enumss ~ DbEnums db+     , Has sch enumss enums+     , Has enum enums labels+     )+  => QualifiedAlias sch enum+  -- ^ type alias+  -> TypeExpression db (null ('PGenum labels))+typeenum = UnsafeTypeExpression . renderSQL+ -- | The enum or composite type in a `Typedef` can be expressed by its alias. typedef   :: (Has sch db schema, Has td schema ('Typedef ty))@@ -181,7 +208,7 @@ typedef = UnsafeTypeExpression . renderSQL  -- | The composite type corresponding to a `Table` definition can be expressed--- by its alias.+-- by its alias. It is subsumed by `typerow` typetable   :: (Has sch db schema, Has tab schema ('Table table))   => QualifiedAlias sch tab@@ -190,7 +217,7 @@ typetable = UnsafeTypeExpression . renderSQL  -- | The composite type corresponding to a `View` definition can be expressed--- by its alias.+-- by its alias. It is subsumed by `typerow`. typeview   :: (Has sch db schema, Has vw schema ('View view))   => QualifiedAlias sch vw@@ -377,13 +404,15 @@ instance PGTyped db ('PGrange 'PGtimestamptz) where pgtype = tstzrange instance PGTyped db ('PGrange 'PGdate) where pgtype = daterange instance-  ( UserType db ('PGcomposite row) ~ '(sch,td)-  , Has sch db schema-  , Has td schema ('Typedef ('PGcomposite row))+  ( relss ~ DbRelations db+  , Has sch relss rels+  , Has rel rels row+  , FindQualified "no relation found with row:" relss row ~ '(sch,rel)     ) => PGTyped db ('PGcomposite row) where-    pgtype = typedef (QualifiedAlias @sch @td)+    pgtype = typerow (QualifiedAlias @sch @rel) instance-  ( UserType db ('PGenum labels) ~ '(sch,td)+  ( enums ~ DbEnums db+  , FindQualified "no enum found with labels:" enums labels ~ '(sch,td)   , Has sch db schema   , Has td schema ('Typedef ('PGenum labels))   ) => PGTyped db ('PGenum labels) where

@@ -323,7 +323,7 @@ >>> :{ let   qry :: Query_ (Public Schema) (Int64, Bool) Row-  qry = select Star (from (table #tab) & where_ (#col1 .> param @1 .&& notNull (param @2)))+  qry = select Star (from (table #tab) & where_ (#col1 .> param @1 .&& just_ (param @2)))   stmt :: Statement (Public Schema) (Int64, Bool) Row   stmt = query qry :}

@@ -37,6 +37,7 @@   , withConnection   ) where +import Control.Applicative import Control.Category import Control.Monad.Base (MonadBase(..)) import Control.Monad.Catch@@ -46,10 +47,10 @@ import Control.Monad.Trans.Control (MonadBaseControl(..), MonadTransControl(..)) import UnliftIO (MonadUnliftIO(..)) import Data.ByteString (ByteString)-import Data.Foldable import Data.Functor ((<&>))+import Data.Hashable import Data.Kind-import Data.Traversable+import Data.String import Generics.SOP import PostgreSQL.Binary.Encoding (encodingBytes) import Prelude hiding (id, (.))@@ -60,6 +61,7 @@  import Squeal.PostgreSQL.Definition import Squeal.PostgreSQL.Manipulation+import Squeal.PostgreSQL.Render import Squeal.PostgreSQL.Session.Connection import Squeal.PostgreSQL.Session.Encode import Squeal.PostgreSQL.Session.Exception@@ -155,93 +157,49 @@   executeParams (Query encode decode q) x =     executeParams (Manipulation encode decode (queryStatement q)) x -  executePrepared (Manipulation encode decode (UnsafeManipulation q :: Manipulation '[] db params row)) list =-    PQ $ \ kconn@(K conn) -> liftIO $ do-      let--        temp = "temporary_statement"--        oidOfParam :: forall p. OidOfNull db p => (IO :.: K LibPQ.Oid) p-        oidOfParam = Comp $ K <$> runReaderT (oidOfNull @db @p) kconn-        oidsOfParams :: NP (IO :.: K LibPQ.Oid) params-        oidsOfParams = hcpure (Proxy @(OidOfNull db)) oidOfParam--        prepare = do-          oids <- hcollapse <$> hsequence' oidsOfParams-          prepResultMaybe <- LibPQ.prepare conn temp (q <> ";") (Just oids)-          case prepResultMaybe of-            Nothing -> throwM $ ConnectionException "LibPQ.prepare"-            Just prepResult -> okResult_ prepResult--        deallocate = do-          deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")-          case deallocResultMaybe of-            Nothing -> throwM $ ConnectionException "LibPQ.exec"-            Just deallocResult -> okResult_ deallocResult--        execPrepared = for list $ \ params -> do-          encodedParams <- runReaderT (runEncodeParams encode params) kconn-          let-            formatParam encoding = (encodingBytes encoding, LibPQ.Binary)-            formattedParams =-              [ formatParam <$> maybeParam-              | maybeParam <- hcollapse encodedParams-              ]-          resultMaybe <--            LibPQ.execPrepared conn temp formattedParams LibPQ.Binary-          case resultMaybe of-            Nothing -> throwM $ ConnectionException "LibPQ.execPrepared"-            Just result -> do-              okResult_ result-              return $ Result decode result--      liftIO (K <$> bracket_ prepare deallocate execPrepared)--  executePrepared (Query encode decode q) list =-    executePrepared (Manipulation encode decode (queryStatement q)) list--  executePrepared_ (Manipulation encode _ (UnsafeManipulation q :: Manipulation '[] db params row)) list =-    PQ $ \ kconn@(K conn) -> do-      let--        temp = "temporary_statement"+  prepare (Manipulation encode decode (UnsafeManipulation q :: Manipulation '[] db params row)) = do+    let+      statementNum = fromString $ case show (hash q) of+        '-':num -> "negative_" <> num+        num -> num -        oidOfParam :: forall p. OidOfNull db p => (IO :.: K LibPQ.Oid) p-        oidOfParam = Comp $ K <$> runReaderT (oidOfNull @db @p) kconn-        oidsOfParams :: NP (IO :.: K LibPQ.Oid) params-        oidsOfParams = hcpure (Proxy @(OidOfNull db)) oidOfParam+      prepName = "prepared_statement_" <> statementNum -        prepare = do-          oids <- hcollapse <$> hsequence' oidsOfParams-          prepResultMaybe <- LibPQ.prepare conn temp (q <> ";") (Just oids)-          case prepResultMaybe of-            Nothing -> throwM $ ConnectionException "LibPQ.prepare"-            Just prepResult -> okResult_ prepResult+      prepare' = PQ $ \ kconn@(K conn) -> liftIO $ do+        let+          oidOfParam :: forall p. OidOfNull db p => (IO :.: K LibPQ.Oid) p+          oidOfParam = Comp $ K <$> runReaderT (oidOfNull @db @p) kconn+          oidsOfParams :: NP (IO :.: K LibPQ.Oid) params+          oidsOfParams = hcpure (Proxy @(OidOfNull db)) oidOfParam+        oids <- hcollapse <$> hsequence' oidsOfParams+        prepResultMaybe <- LibPQ.prepare conn prepName (q <> ";") (Just oids)+        case prepResultMaybe of+          Nothing -> throwM $ ConnectionException "LibPQ.prepare"+          Just prepResult -> K <$> okResult_ prepResult -        deallocate = do-          deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")-          case deallocResultMaybe of-            Nothing -> throwM $ ConnectionException "LibPQ.exec"-            Just deallocResult -> okResult_ deallocResult+      deallocate' = manipulate_ . UnsafeManipulation $+        "DEALLOCATE" <+> prepName -        execPrepared_ = for_ list $ \ params -> do-          encodedParams <- runReaderT (runEncodeParams encode params) kconn-          let-            formatParam encoding = (encodingBytes encoding, LibPQ.Binary)-            formattedParams =-              [ formatParam <$> maybeParam-              | maybeParam <- hcollapse encodedParams-              ]-          resultMaybe <--            LibPQ.execPrepared conn temp formattedParams LibPQ.Binary-          case resultMaybe of-            Nothing -> throwM $ ConnectionException "LibPQ.execPrepared"-            Just result -> okResult_ result+      runPrepared' params = PQ $ \ kconn@(K conn) -> liftIO $ do+        encodedParams <- runReaderT (runEncodeParams encode params) kconn+        let+          formatParam encoding = (encodingBytes encoding, LibPQ.Binary)+          formattedParams =+            [ formatParam <$> maybeParam+            | maybeParam <- hcollapse encodedParams+            ]+        resultMaybe <-+          LibPQ.execPrepared conn prepName formattedParams LibPQ.Binary+        case resultMaybe of+          Nothing -> throwM $ ConnectionException "LibPQ.runPrepared"+          Just result -> do+            okResult_ result+            return . K $ Result decode result -      liftIO (K <$> bracket_ prepare deallocate execPrepared_)+    prepare'+    return $ Prepared runPrepared' deallocate' -  executePrepared_ (Query encode decode q) list =-    executePrepared_ (Manipulation encode decode (queryStatement q)) list+  prepare (Query encode decode q) = prepare (Manipulation encode decode (queryStatement q))  instance (Monad m, db0 ~ db1)   => Applicative (PQ db0 db1 m) where@@ -334,6 +292,17 @@  instance (Monad m, Monoid r, db0 ~ db1) => Monoid (PQ db0 db1 m r) where   mempty = pure mempty++instance MonadFix m => MonadFix (PQ db db m) where+  mfix f = PQ $ \conn -> mfix $ \ (K a) -> K <$> evalPQ (f a) conn++instance (Monad m, Alternative m, db0 ~ db1)+  => Alternative (PQ db0 db1 m) where+    empty = lift empty+    altL <|> altR = PQ $ \ conn -> fmap K $+      evalPQ altL conn <|> evalPQ altR conn++instance (MonadPlus m, db0 ~ db1) => MonadPlus (PQ db0 db1 m)  -- | Do `connectdb` and `finish` before and after a computation. withConnection

@@ -36,6 +36,11 @@   , (*.)   , aParam   , appendParams+  , enumParam+  , rowParam+  , genericRowParams+  , (.#)+  , (#.)     -- * Encoding Classes   , ToPG (..)   , ToParam (..)@@ -201,25 +206,7 @@   , SOP.All (OidOfField db) fields   , RowPG x ~ fields   ) => ToPG db (Composite x) where-    toPG (Composite x) = do-      let-        compositeSize-          = int4_int32-          $ fromIntegral-          $ SOP.lengthSList-          $ SOP.Proxy @xs-        each-          :: OidOfField db field-          => SOP.K (Maybe Encoding) field-          -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding-        each (SOP.K field :: SOP.K (Maybe Encoding) field) = do-          oid <- getOid <$> oidOfField @db @field-          return $ int4_word32 oid <> maybe null4 sized field-      fields :: NP (SOP.K (Maybe Encoding)) fields <- hctransverse-        (SOP.Proxy @(ToField db)) (toField @db) (SOP.toRecord x)-      compositePayload <- hcfoldMapM-        (SOP.Proxy @(OidOfField db)) each fields-      return $ compositeSize <> compositePayload+    toPG = rowParam (contramap getComposite genericRowParams) instance ToPG db x => ToPG db (Range x) where   toPG r = do     payload <- case r of@@ -316,7 +303,7 @@  {- | `EncodeParams` describes an encoding of a Haskell `Type`-into a list of parameter `NullType`s.+into a list of parameter `NullType`s or into a `RowType`.  >>> conn <- connectdb @'[] "host=localhost port=5432 dbname=exampledb user=postgres password=postgres" >>> :{@@ -329,11 +316,21 @@ :} K (Just "\NUL\SOH") :* K (Just "a") :* K (Just "foo") :* Nil +>>> :{+let+  encode :: EncodeParams '[]+    '["fst" ::: 'NotNull 'PGint2, "snd" ::: 'NotNull ('PGchar 1)]+    (Int16, Char)+  encode = fst `as` #fst #. snd `as` #snd+in runReaderT (runEncodeParams encode (1,'a')) conn+:}+K (Just "\NUL\SOH") :* K (Just "a") :* Nil+ >>> finish conn -} newtype EncodeParams   (db :: SchemasType)-  (tys :: [NullType])+  (tys :: [k])   (x :: Type) = EncodeParams   { runEncodeParams :: x     -> ReaderT (SOP.K LibPQ.Connection db) IO (NP (SOP.K (Maybe Encoding)) tys) }@@ -463,6 +460,7 @@ aParam   :: forall db x ty. (ToParam db ty x, ty ~ NullPG x)   => EncodeParams db '[ty] x+  -- ^ a single parameter aParam = EncodeParams $   fmap (\param -> SOP.K param :* Nil) . toParam @db @(NullPG x) @@ -488,6 +486,145 @@ appendParams encode0 encode1 = EncodeParams $ \x -> also   <$> runEncodeParams encode1 x   <*> runEncodeParams encode0 x++{- |+>>> :set -XLambdaCase -XFlexibleInstances+>>> :{+data Dir = North | South | East | West+instance IsPG Dir where+  type PG Dir = 'PGenum '["north", "south", "east", "west"]+instance ToPG db Dir where+  toPG = enumParam $ \case+    North -> label @"north"+    South -> label @"south"+    East -> label @"east"+    West -> label @"west"+:}+-}+enumParam+  :: (PG x ~ 'PGenum labels, SOP.All KnownSymbol labels)+  => (x -> SOP.NS PGlabel labels)+  -- ^ match cases with enum `label`s+  -> (x -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding)+enumParam casesOf+  = return+  . text_strict+  . Strict.Text.pack+  . enumCases+  . casesOf+  where+    enumCases+      :: SOP.All KnownSymbol lbls+      => SOP.NS PGlabel lbls+      -> String+    enumCases = \case+      SOP.Z (_ :: PGlabel lbl) -> symbolVal (SOP.Proxy @lbl)+      SOP.S cases -> enumCases cases++{- |+>>> :set -XTypeFamilies -XFlexibleInstances+>>> :{+data Complex = Complex+  { real :: Double+  , imaginary :: Double+  }+instance IsPG Complex where+  type PG Complex = 'PGcomposite '[+    "re" ::: 'NotNull 'PGfloat8,+    "im" ::: 'NotNull 'PGfloat8]+instance ToPG db Complex where+  toPG = rowParam $ real `as` #re #. imaginary `as` #im+:}+-}+rowParam+  :: (PG x ~ 'PGcomposite row, SOP.All (OidOfField db) row)+  => EncodeParams db row x+  -- ^ use `(.#)` and `(#.)` to define a row parameter encoding+  -> (x -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding)+rowParam (enc :: EncodeParams db row x) x = do+  let+    compositeSize+      = int4_int32+      $ fromIntegral+      $ SOP.lengthSList+      $ SOP.Proxy @row+    each+      :: OidOfField db field+      => SOP.K (Maybe Encoding) field+      -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding+    each (SOP.K field :: SOP.K (Maybe Encoding) field) = do+      oid <- getOid <$> oidOfField @db @field+      return $ int4_word32 oid <> maybe null4 sized field+  fields <- runEncodeParams enc x+  compositePayload <- hcfoldMapM+    (SOP.Proxy @(OidOfField db)) each fields+  return $ compositeSize <> compositePayload++{- | Cons a row parameter encoding for `rowParam`. -}+(.#)+  :: forall db x0 fld ty x tys. (ToParam db ty x0, ty ~ NullPG x0)+  => Aliased ((->) x) (fld ::: x0) -- ^ head+  -> EncodeParams db tys x -- ^ tail+  -> EncodeParams db (fld ::: ty ': tys) x+(f `As` _) .# EncodeParams params = EncodeParams $ \x ->+  (:*) <$> (SOP.K <$> toParam @db @ty (f x)) <*> params x+infixr 5 .#++{- | End a row parameter encoding for `rowParam`. -}+(#.)+  :: forall db x x0 fld0 ty0 x1 fld1 ty1+   . ( ToParam db ty0 x0+     , ty0 ~ NullPG x0+     , ToParam db ty1 x1+     , ty1 ~ NullPG x1+     )+  => Aliased ((->) x) (fld0 ::: x0) -- ^ second to last+  -> Aliased ((->) x) (fld1 ::: x1) -- ^ last+  -> EncodeParams db '[fld0 ::: ty0, fld1 ::: ty1] x+f #. g = f .# g .# nilParams+infixl 8 #.++instance (ToParam db ty x, ty ~ NullPG x)+  => IsLabel fld (EncodeParams db '[fld ::: ty] x) where+    fromLabel+      = EncodeParams+      $ fmap (\param -> SOP.K param :* Nil)+      . toParam @db @(NullPG x)++{- |+>>> import GHC.Generics as GHC+>>> :{+data L = L {frst :: Int16, scnd :: Char}+  deriving stock (GHC.Generic, Show)+  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)+data R = R {thrd :: Bool, frth :: Bool}+  deriving stock (GHC.Generic, Show)+  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)+instance IsPG (L,R) where+  type PG (L,R) = 'PGcomposite '[+    "frst" ::: 'NotNull 'PGint2,+    "scnd" ::: 'NotNull ('PGchar 1),+    "thrd" ::: 'NotNull 'PGbool,+    "frth" ::: 'NotNull 'PGbool]+instance ToPG db (L,R) where+  toPG = rowParam $+    contramap fst genericRowParams+    `appendParams`+    contramap snd genericRowParams+:}+-}+genericRowParams+  ::  forall db row x xs.+      ( SOP.IsRecord x xs+      , SOP.AllZip (ToField db) row xs+      )+  => EncodeParams db row x+genericRowParams+  = EncodeParams+  $ hctransverse (SOP.Proxy @(ToField db)) (toField @db)+  . SOP.toRecord++-- helper functions  getOid :: LibPQ.Oid -> Word32 getOid (LibPQ.Oid (CUInt oid)) = oid

@@ -50,8 +50,8 @@ -} class   ( forall i j m. Monad m => Functor (t i j m)-  , forall i j m. (i ~ j, Monad m) => Monad (t i j m)-  , forall i j. i ~ j => MonadTrans (t i j)+  , forall i m. Monad m => Monad (t i i m)+  , forall i. MonadTrans (t i i)   ) => IndexedMonadTrans t where    {-# MINIMAL pqJoin | pqBind #-}

@@ -11,6 +11,7 @@ {-# LANGUAGE     DataKinds   , DefaultSignatures+  , DeriveFunctor   , FlexibleContexts   , FlexibleInstances   , FunctionalDependencies@@ -24,11 +25,33 @@   , UndecidableInstances #-} -module Squeal.PostgreSQL.Session.Monad where+module Squeal.PostgreSQL.Session.Monad+  ( -- * MonadPQ+    MonadPQ (..)+    -- * Manipulate+  , manipulateParams+  , manipulateParams_+  , manipulate+  , manipulate_+    -- * Run Query+  , runQueryParams+  , runQuery+    -- * Prepared+  , executePrepared+  , executePrepared_+  , traversePrepared+  , forPrepared+  , traversePrepared_+  , forPrepared_+  , preparedFor+  ) where  import Control.Category (Category (..)) import Control.Monad import Control.Monad.Morph+import Data.Foldable+import Data.Profunctor.Traversing+import Data.Traversable import Prelude hiding (id, (.))  import Squeal.PostgreSQL.Manipulation@@ -163,13 +186,15 @@     withConnection "host=localhost port=5432 dbname=exampledb user=postgres password=postgres" $ execute_ silence   :}   -}-  execute_ :: Statement db () () -> pq ()+  execute_+    :: Statement db () ()+    -- ^ query or manipulation+    -> pq ()   execute_ = void . execute    {- |-  `executePrepared` runs a `Statement` on a `Traversable`-  container by first preparing the statement, then running the prepared-  statement on each element.+  `prepare` creates a `Prepared` statement. When `prepare` is executed,+  the specified `Statement` is parsed, analyzed, and rewritten.    >>> import Data.Int (Int32, Int64)   >>> import Data.Monoid (Sum(Sum))@@ -182,32 +207,31 @@       ) `as` #getSum   in     withConnection "host=localhost port=5432 dbname=exampledb user=postgres password=postgres" $ do-      results <- executePrepared sumOf [(2,2),(3,3),(4,4)]-      traverse firstRow results+      prepared <- prepare sumOf+      result <- runPrepared prepared (2,2)+      deallocate prepared+      firstRow result   :}-  [Just (Sum {getSum = 4}),Just (Sum {getSum = 6}),Just (Sum {getSum = 8})]+  Just (Sum {getSum = 4})   -}-  executePrepared-    :: Traversable list-    => Statement db x y+  prepare+    :: Statement db x y     -- ^ query or manipulation-    -> list x-    -- ^ list of parameters-    -> pq (list (Result y))-  default executePrepared+    -> pq (Prepared pq x (Result y))+  default prepare     :: (MonadTrans t, MonadPQ db m, pq ~ t m)-    => Traversable list     => Statement db x y     -- ^ query or manipulation-    -> list x-    -- ^ list of parameters-    -> pq (list (Result y))-  executePrepared statement x = lift $ executePrepared statement x+    -> pq (Prepared pq x (Result y))+  prepare statement = do+    prepared <- lift $ prepare statement+    return $ Prepared+      (lift . runPrepared prepared)+      (lift (deallocate prepared))    {- |-  `executePrepared_` runs a returning-free `Statement` on a `Foldable`-  container by first preparing the statement, then running the prepared-  statement on each element.+  `prepare_` creates a `Prepared` statement. When `prepare_` is executed,+  the specified `Statement` is parsed, analyzed, and rewritten.    >>> type Column = 'NoDef :=> 'NotNull 'PGint4   >>> type Columns = '["col1" ::: Column, "col2" ::: Column]@@ -225,31 +249,117 @@       ( notNullable int4 `as` #col1 :*         notNullable int4 `as` #col2       ) Nil+    session :: PQ DB DB IO ()+    session = do+      prepared <- prepare_ insertion+      runPrepared prepared (2,2)+      deallocate prepared     teardown :: Definition DB (Public '[])     teardown = dropTable #tab   in     withConnection "host=localhost port=5432 dbname=exampledb user=postgres password=postgres" $       define setup-      & pqThen (executePrepared_ insertion [(2,2),(3,3),(4,4)])+      & pqThen session       & pqThen (define teardown)   :}   -}-  executePrepared_-    :: Foldable list-    => Statement db x ()-    -- ^ query or manipulation-    -> list x-    -- ^ list of parameters-    -> pq ()-  default executePrepared_-    :: (MonadTrans t, MonadPQ db m, pq ~ t m)-    => Foldable list-    => Statement db x ()+  prepare_+    :: Statement db x ()     -- ^ query or manipulation-    -> list x-    -- ^ list of parameters-    -> pq ()-  executePrepared_ statement x = lift $ executePrepared_ statement x+    -> pq (Prepared pq x ())+  prepare_ = fmap void . prepare++{- |+* `prepare` a statement+* transforming its inputs and outputs with an optic,+  run the `Prepared` statement+* deallocate the `Prepared` statement++>>> :type preparedFor traverse'+preparedFor traverse'+  :: (MonadPQ db pq, Traversable f) =>+     Statement db a b -> f a -> pq (f (Result b))+-}+preparedFor+  :: MonadPQ db pq+  => (Prepared pq a (Result b) -> Prepared pq s t)+  -- ^ transform the input and output+  -> Statement db a b -- ^ query or manipulation+  -> s -> pq t+preparedFor optic statement x' = do+  prepared <- prepare statement+  y' <- runPrepared (optic prepared) x'+  deallocate prepared+  return y'++{- |+`executePrepared` runs a `Statement` on a `Traversable`+container by first preparing the statement, then running the prepared+statement on each element.++>>> import Data.Int (Int32, Int64)+>>> import Data.Monoid (Sum(Sum))+>>> :{+let+  sumOf :: Statement db (Int32, Int32) (Sum Int32)+  sumOf = query $ values_ $+    ( param @1 @('NotNull 'PGint4) ++      param @2 @('NotNull 'PGint4)+    ) `as` #getSum+in+  withConnection "host=localhost port=5432 dbname=exampledb user=postgres password=postgres" $ do+    results <- executePrepared sumOf [(2,2),(3,3),(4,4)]+    traverse firstRow results+:}+[Just (Sum {getSum = 4}),Just (Sum {getSum = 6}),Just (Sum {getSum = 8})]+-}+executePrepared+  :: (MonadPQ db pq, Traversable list)+  => Statement db x y+  -- ^ query or manipulation+  -> list x+  -- ^ list of parameters+  -> pq (list (Result y))+executePrepared = preparedFor traverse'++{- |+`executePrepared_` runs a returning-free `Statement` on a `Foldable`+container by first preparing the statement, then running the prepared+statement on each element.++>>> type Column = 'NoDef :=> 'NotNull 'PGint4+>>> type Columns = '["col1" ::: Column, "col2" ::: Column]+>>> type Schema = '["tab" ::: 'Table ('[] :=> Columns)]+>>> type DB = Public Schema+>>> import Data.Int(Int32)+>>> :{+let+  insertion :: Statement DB (Int32, Int32) ()+  insertion = manipulation $ insertInto_ #tab $ Values_ $+    Set (param @1 @('NotNull 'PGint4)) `as` #col1 :*+    Set (param @2 @('NotNull 'PGint4)) `as` #col2+  setup :: Definition (Public '[]) DB+  setup = createTable #tab+    ( notNullable int4 `as` #col1 :*+      notNullable int4 `as` #col2+    ) Nil+  teardown :: Definition DB (Public '[])+  teardown = dropTable #tab+in+  withConnection "host=localhost port=5432 dbname=exampledb user=postgres password=postgres" $+    define setup+    & pqThen (executePrepared_ insertion [(2,2),(3,3),(4,4)])+    & pqThen (define teardown)+:}+-}+executePrepared_+  :: (MonadPQ db pq, Foldable list)+  => Statement db x ()+  -- ^ query or manipulation+  -> list x+  -- ^ list of parameters+  -> pq ()+executePrepared_ = preparedFor (wander traverse_)  {- | `manipulateParams` runs a `Squeal.PostgreSQL.Manipulation.Manipulation`.

@@ -142,35 +142,38 @@ instance OidOf db ('PGrange 'PGdate) where oidOf = pure $ LibPQ.Oid 3912 instance OidOfArray db ('PGrange 'PGdate) where oidOfArray = pure $ LibPQ.Oid 3913 instance-  ( UserType db ('PGcomposite row) ~ '(sch,td)-  , Has sch db schema-  , Has td schema ('Typedef ('PGcomposite row)) )-  => OidOf db ('PGcomposite row) where-    oidOf = oidOfTypedef (QualifiedAlias @sch @td)+  ( KnownSymbol sch+  , KnownSymbol td+  , rels ~ DbRelations db+  , FindQualified "no relation found with row:" rels row ~ '(sch,td)+  ) => OidOf db ('PGcomposite row) where+    oidOf = oidOfTypedef @sch @td instance-  ( UserType db ('PGcomposite row) ~ '(sch,td)-  , Has sch db schema-  , Has td schema ('Typedef ('PGcomposite row)) )-  => OidOfArray db ('PGcomposite row) where-    oidOfArray = oidOfArrayTypedef (QualifiedAlias @sch @td)+  ( KnownSymbol sch+  , KnownSymbol td+  , rels ~ DbRelations db+  , FindQualified "no relation found with row:" rels row ~ '(sch,td)+  ) => OidOfArray db ('PGcomposite row) where+    oidOfArray = oidOfArrayTypedef @sch @td instance-  ( UserType db ('PGenum labels) ~ '(sch,td)-  , Has sch db schema-  , Has td schema ('Typedef ('PGenum labels)) )-  => OidOf db ('PGenum labels) where-    oidOf = oidOfTypedef (QualifiedAlias @sch @td)+  ( enums ~ DbEnums db+  , FindQualified "no enum found with labels:" enums labels ~ '(sch,td)+  , KnownSymbol sch+  , KnownSymbol td+  ) => OidOf db ('PGenum labels) where+    oidOf = oidOfTypedef @sch @td instance-  ( UserType db ('PGenum labels) ~ '(sch,td)-  , Has sch db schema-  , Has td schema ('Typedef ('PGenum labels)) )-  => OidOfArray db ('PGenum labels) where-    oidOfArray = oidOfArrayTypedef (QualifiedAlias @sch @td)+  ( enums ~ DbEnums db+  , FindQualified "no enum found with labels:" enums labels ~ '(sch,td)+  , KnownSymbol sch+  , KnownSymbol td+  ) => OidOfArray db ('PGenum labels) where+    oidOfArray = oidOfArrayTypedef @sch @td  oidOfTypedef-  :: (Has sch db schema, Has ty schema pg)-  => QualifiedAlias sch ty-  -> ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid-oidOfTypedef (_ :: QualifiedAlias sch ty) = ReaderT $ \(SOP.K conn) -> do+  :: forall sch ty db. (KnownSymbol sch, KnownSymbol ty)+  => ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid+oidOfTypedef = ReaderT $ \(SOP.K conn) -> do   resultMaybe <- LibPQ.execParams conn q [] LibPQ.Binary   case resultMaybe of     Nothing -> throwM $ ConnectionException oidErr@@ -199,10 +202,9 @@       , ";" ]  oidOfArrayTypedef-  :: (Has sch db schema, Has ty schema pg)-  => QualifiedAlias sch ty-  -> ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid-oidOfArrayTypedef (_ :: QualifiedAlias sch ty) = ReaderT $ \(SOP.K conn) -> do+  :: forall sch ty db. (KnownSymbol sch, KnownSymbol ty)+  => ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid+oidOfArrayTypedef = ReaderT $ \(SOP.K conn) -> do   resultMaybe <- LibPQ.execParams conn q [] LibPQ.Binary   case resultMaybe of     Nothing -> throwM $ ConnectionException oidErr

@@ -22,13 +22,24 @@ #-}  module Squeal.PostgreSQL.Session.Statement-  ( Statement (..)+  ( -- * Statement+    Statement (..)   , query   , manipulation+    -- * Prepared+  , Prepared (..)   ) where +import Control.Applicative+import Control.Arrow+import Control.Category+import Control.Monad+import Control.Monad.Fix import Data.Functor.Contravariant-import Data.Profunctor (Profunctor (..))+import Data.Profunctor+import Data.Profunctor.Traversing+import GHC.Generics+import Prelude hiding ((.),id)  import qualified Generics.SOP as SOP @@ -37,13 +48,13 @@ import Squeal.PostgreSQL.Session.Encode import Squeal.PostgreSQL.Session.Oid import Squeal.PostgreSQL.Query-import Squeal.PostgreSQL.Render+import Squeal.PostgreSQL.Render hiding ((<+>))  -- | A `Statement` consists of a `Squeal.PostgreSQL.Statement.Manipulation` -- or a `Squeal.PostgreSQL.Session.Statement.Query` that can be run -- in a `Squeal.PostgreSQL.Session.Monad.MonadPQ`. data Statement db x y where-  -- | Constructor for a data manipulation language statement+  -- | Constructor for a data manipulation language `Statement`   Manipulation     :: (SOP.All (OidOfNull db) params, SOP.SListI row)     => EncodeParams db params x -- ^ encoding of parameters@@ -53,7 +64,7 @@     -- `Squeal.PostgreSQL.Manipulation.Update.update`,     -- or `Squeal.PostgreSQL.Manipulation.Delete.deleteFrom`, ...     -> Statement db x y-  -- | Constructor for a structured query language statement+  -- | Constructor for a structured query language `Statement`   Query     :: (SOP.All (OidOfNull db) params, SOP.SListI row)     => EncodeParams db params x -- ^ encoding of parameters@@ -83,7 +94,7 @@   renderSQL (Manipulation _ _ q) = renderSQL q   renderSQL (Query _ _ q) = renderSQL q --- | Smart constructor for a structured query language statement+-- | Smart constructor for a structured query language `Statement` query ::   ( GenericParams db params x xs   , GenericRow row y ys@@ -93,7 +104,7 @@     -> Statement db x y query = Query genericParams genericRow --- | Smart constructor for a data manipulation language statement+-- | Smart constructor for a data manipulation language `Statement` manipulation ::   ( GenericParams db params x xs   , GenericRow row y ys@@ -103,3 +114,107 @@     -- or `Squeal.PostgreSQL.Manipulation.Delete.deleteFrom`, ...     -> Statement db x y manipulation = Manipulation genericParams genericRow++{- |+`Squeal.PostgreSQL.Session.Monad.prepare` and+`Squeal.PostgreSQL.Session.Monad.prepare_` create a `Prepared` statement.+A `Prepared` statement is a server-side object+that can be used to optimize performance.+When `Squeal.PostgreSQL.Session.Monad.prepare`+or `Squeal.PostgreSQL.Session.Monad.prepare_` is executed,+the specified `Statement` is parsed, analyzed, and rewritten.++When the `runPrepared` command is subsequently issued,+the `Prepared` statement is planned and executed.+This division of labor avoids repetitive parse analysis work,+while allowing the execution plan to+depend on the specific parameter values supplied.++`Prepared` statements only last for the duration+of the current database session.+`Prepared` statements can be manually cleaned up+using the `deallocate` command.+-}+data Prepared m x y = Prepared+  { runPrepared :: x -> m y -- ^ execute a prepared statement+  , deallocate :: m () -- ^ manually clean up a prepared statement+  } deriving (Functor, Generic, Generic1)++instance Applicative m => Applicative (Prepared m x) where+  pure a = Prepared (\_ -> pure a) (pure ())+  p1 <*> p2 = Prepared+    (run2 (<*>) p1 p2)+    (deallocate p1 *> deallocate p2)++instance Alternative m => Alternative (Prepared m x) where+  empty = Prepared (runKleisli empty) empty+  p1 <|> p2 = Prepared+    (run2 (<|>) p1 p2)+    (deallocate p1 *> deallocate p2)++instance Functor m => Profunctor (Prepared m) where+  dimap g f prepared = Prepared+    (fmap f . runPrepared prepared . g)+    (deallocate prepared)++instance Monad m => Strong (Prepared m) where+  first' p = Prepared (run1 first' p) (deallocate p)+  second' p = Prepared (run1 second' p) (deallocate p)++instance Monad m => Choice (Prepared m) where+  left' p = Prepared (run1 left' p) (deallocate p)+  right' p = Prepared (run1 right' p) (deallocate p)++instance MonadFix m => Costrong (Prepared m) where+  unfirst p = Prepared (run1 unfirst p) (deallocate p)+  unsecond p = Prepared (run1 unsecond p) (deallocate p)++instance Monad m => Category (Prepared m) where+  id = Prepared return (return ())+  cd . ab = Prepared+    (runPrepared ab >=> runPrepared cd)+    (deallocate ab >> deallocate cd)++instance Monad m => Arrow (Prepared m) where+  arr ab = Prepared (return . ab) (return ())+  first = first'+  second = second'+  ab *** cd = first ab >>> second cd+  ab &&& ac = Prepared+    (run2 (&&&) ab ac)+    (deallocate ab >> deallocate ac)++instance Monad m => ArrowChoice (Prepared m) where+  left = left'+  right = right'+  ab +++ cd = left ab >>> right cd+  bd ||| cd = Prepared+    (run2 (|||) bd cd)+    (deallocate bd >> deallocate cd)++instance MonadFix m => ArrowLoop (Prepared m) where+  loop p = Prepared (run1 loop p) (deallocate p)++instance MonadPlus m => ArrowZero (Prepared m) where+  zeroArrow = Prepared (runKleisli zeroArrow) (return ())++instance MonadPlus m => ArrowPlus (Prepared m) where+  p1 <+> p2 = Prepared+    (run2 (<+>) p1 p2)+    (deallocate p1 >> deallocate p2)++instance Monad m => Traversing (Prepared m) where+  traverse' p = Prepared (run1 traverse' p) (deallocate p)++-- helper functions++run1+  :: (Kleisli m a b -> Kleisli m c d)+  -> Prepared m a b -> c -> m d+run1 m = runKleisli . m . Kleisli . runPrepared++run2+  :: (Kleisli m a b -> Kleisli m c d -> Kleisli m e f)+  -> Prepared m a b -> Prepared m c d -> e -> m f+run2 (?) p1 p2 = runKleisli $+  Kleisli (runPrepared p1) ? Kleisli (runPrepared p2)

@@ -90,14 +90,14 @@   => TransactionMode   -> Transaction db x -- ^ run inside a transaction   -> tx x-transactionally = Unsafe.transactionally+transactionally mode tx = Unsafe.transactionally mode tx  -- | Run a computation `transactionally_`, in `defaultMode`. transactionally_   :: (MonadMask tx, MonadResult tx, MonadPQ db tx)   => Transaction db x -- ^ run inside a transaction   -> tx x-transactionally_ = Unsafe.transactionally_+transactionally_ tx = Unsafe.transactionally_ tx  {- | `transactionallyRetry` a computation;@@ -114,14 +114,14 @@   => TransactionMode   -> Transaction db x -- ^ run inside a transaction   -> tx x-transactionallyRetry = Unsafe.transactionallyRetry+transactionallyRetry mode tx = Unsafe.transactionallyRetry mode tx  {- | `transactionallyRetry` in `retryMode`. -} transactionallyRetry_   :: (MonadMask tx, MonadResult tx, MonadPQ db tx)   => Transaction db x -- ^ run inside a transaction   -> tx x-transactionallyRetry_ = Unsafe.transactionallyRetry_+transactionallyRetry_ tx = Unsafe.transactionallyRetry_ tx  {- | Run a computation `ephemerally`; Like `transactionally` but always `Unsafe.rollback`, useful in testing.@@ -131,14 +131,14 @@   => TransactionMode   -> Transaction db x -- ^ run inside an ephemeral transaction   -> tx x-ephemerally = Unsafe.ephemerally+ephemerally mode tx = Unsafe.ephemerally mode tx  {- | Run a computation `ephemerally` in `defaultMode`. -} ephemerally_   :: (MonadMask tx, MonadResult tx, MonadPQ db tx)   => Transaction db x -- ^ run inside an ephemeral transaction   -> tx x-ephemerally_ = Unsafe.ephemerally_+ephemerally_ tx = Unsafe.ephemerally_ tx  {- | `withSavepoint`, used in a transaction block, allows a form of nested transactions,@@ -153,4 +153,4 @@   :: ByteString -- ^ savepoint name   -> Transaction db (Either e x)   -> Transaction db (Either e x)-withSavepoint = Unsafe.withSavepoint+withSavepoint sv tx = Unsafe.withSavepoint sv tx

@@ -47,17 +47,20 @@   , HasErr   , HasAll   , HasIn-    -- * Error reporting-  , LookupFailedError-  , PrettyPrintHaystack-  , PrettyPrintInfo(..)-  , MismatchError     -- * Qualified Aliases   , QualifiedAlias (..)   , IsQualified (..)     -- * Grouping   , Grouping (..)   , GroupedBy+    -- * Error reporting+  , LookupFailedError+  , PrettyPrintHaystack+  , PrettyPrintInfo(..)+  , MismatchError+  , LookupFailedError'+  , DefaultPrettyPrinter+  , MismatchError'   ) where  import Control.DeepSeq

@@ -32,19 +32,25 @@     SOP.NP (..)   , (*:)   , one-  , Join-  , disjoin-  , Additional (..)     -- * Path   , Path (..)     -- * Type Level List+  , Join+  , disjoin+  , Additional (..)   , Elem   , In   , Length-  , MapFst-  , Sort   , SubList   , SubsetList+    -- * Type Level Sort+  , Sort+  , MergeSort+  , Twos+  , FoldMerge+  , Merge+  , MergeHelper+  , MapFst   ) where  import Control.Category.Free@@ -177,20 +183,19 @@ type family Merge (ls :: [Symbol]) (rs :: [Symbol]) :: [Symbol] where   Merge '[] r = r   Merge l '[] = l-  Merge (l ': ls) (r ': rs) = If (Leq l r) (l ': Merge ls (r ': rs)) (r ': Merge (l ': ls) rs)+  Merge (l ': ls) (r ': rs) = MergeHelper (l ': ls) (r ': rs) (CmpSymbol l r) +-- | 'MergeHelper' decides whether to take an element from the right or left list next,+-- depending on the result of their comparison+type family MergeHelper (ls :: [Symbol]) (rs :: [Symbol]) (cmp :: Ordering) where+  MergeHelper ls        (r ': rs) 'GT = r ': Merge ls rs+  MergeHelper (l ': ls) rs        leq = l ': Merge ls rs+ -- | 'FoldMerge' folds over a list of sorted lists, merging them into a single sorted list type family FoldMerge (ls :: [[Symbol]]) :: [[Symbol]] where   FoldMerge (x ': y ': rs) = (Merge x y ': FoldMerge rs)   FoldMerge '[x]           = '[x]   FoldMerge '[]            = '[]--type Leq l r = OrderingIsLeq (CmpSymbol l r)--type family OrderingIsLeq (o :: Ordering) :: Bool where-  OrderingIsLeq 'LT = 'True-  OrderingIsLeq 'EQ = 'True-  OrderingIsLeq 'GT = 'False  -- | 'MapFst' takes the first value of each tuple of a type level list of tuples. Useful for getting -- only the names in associatve lists

@@ -49,17 +49,7 @@   , ReturnsType (..)   , SchemaType   , SchemasType-  , PrettyPrintPartitionedSchema   , Public-  , PartitionedSchema(..)-  , PartitionSchema-  , SchemaFunctions-  , SchemaIndexes-  , SchemaProcedures-  , SchemaTables-  , SchemaTypes-  , SchemaUnsafes-  , SchemaViews     -- * Database Subsets   , SubDB   , SubsetDB@@ -109,10 +99,29 @@   , Updatable   , AllUnique   , IsNotElem-    -- * User Types-  , UserType-  , UserTypeName-  , UserTypeNamespace+    -- * User Type Lookup+  , DbEnums+  , SchemaEnums+  , DbRelations+  , SchemaRelations+  , FindQualified+  , FindName+  , FindNamespace+    -- * Schema Error Printing+  , PrettyPrintPartitionedSchema+  , PartitionedSchema(..)+  , PartitionSchema+  , SchemaFunctions+  , SchemaIndexes+  , SchemaProcedures+  , SchemaTables+  , SchemaTypes+  , SchemaUnsafes+  , SchemaViews+  , IntersperseNewlines+  , FilterNonEmpty+  , FieldIfNonEmpty+  , PartitionSchema'   ) where  import Control.Category@@ -608,6 +617,7 @@ -- | @PartitionSchema@ partitions a @SchemaType@ into a @PartitionedSchema@ type PartitionSchema schema = PartitionSchema' schema ('PartitionedSchema '[] '[] '[] '[] '[] '[] '[]) +-- | Utility type family for `PartitionSchema`. type family PartitionSchema' (remaining :: SchemaType) (acc :: PartitionedSchema) :: PartitionedSchema where   PartitionSchema' '[] ps = ps   PartitionSchema' ('(s, 'Table table) ': rest) ('PartitionedSchema tables views types indexes functions procedures unsafe)@@ -661,15 +671,18 @@     , FieldIfNonEmpty "Unsafe schema items" (SchemaUnsafes schema)     ]) +-- | Print field name (if corresponding values are non-empty). type family FieldIfNonEmpty (fieldName :: Symbol) (value :: [(Symbol, k)]) :: ErrorMessage where   FieldIfNonEmpty _ '[] = 'Text ""   FieldIfNonEmpty n xs = 'Text "  " ':<>: 'Text n ':<>: 'Text ":" ':$$: 'Text "    " ':<>: 'ShowType (Sort (MapFst xs)) +-- | Filter out empty error messages. type family FilterNonEmpty (ls :: [ErrorMessage]) :: [ErrorMessage] where   FilterNonEmpty ('Text "" ': rest) = FilterNonEmpty rest   FilterNonEmpty (x ': rest) = x ': FilterNonEmpty rest   FilterNonEmpty '[] = '[] +-- | Vertically concatenate error messages. type family IntersperseNewlines (ls :: [ErrorMessage]) :: ErrorMessage where   IntersperseNewlines (x ': y ': '[]) = x ':$$: y   IntersperseNewlines (x ': xs) = x ':$$: IntersperseNewlines xs@@ -715,6 +728,12 @@   => IsPGlabel label (NP PGlabel labels) where label = PGlabel :* Nil instance IsPGlabel label (y -> K y label) where label = K instance IsPGlabel label (y -> NP (K y) '[label]) where label y = K y :* Nil+instance {-# OVERLAPPING #-}+  IsPGlabel label0 (NS PGlabel (label0 ': labels)) where+    label = Z PGlabel+instance {-# OVERLAPPABLE #-} IsPGlabel label0 (NS PGlabel labels)+  => IsPGlabel label0 (NS PGlabel (label1 ': labels)) where+    label = S (label @label0) -- | A `PGlabel` unit type with an `IsPGlabel` instance data PGlabel (label :: Symbol) = PGlabel instance KnownSymbol label => RenderSQL (PGlabel label) where@@ -750,24 +769,73 @@   , AllUnique columns   , SListI (TableToColumns table) ) --- | Calculate the name of a user defined type.-type family UserTypeName (schema :: SchemaType) (ty :: PGType) where-  UserTypeName '[] ty = 'Nothing-  UserTypeName (td ::: 'Typedef ty ': _) ty = 'Just td-  UserTypeName (_ ': schema) ty = UserTypeName schema ty+{- | Filters a schema down to labels of all enum typedefs.+-}+type family SchemaEnums schema where+  SchemaEnums '[] = '[]+  SchemaEnums (enum ::: 'Typedef ('PGenum labels) ': schema) =+    enum ::: labels ': SchemaEnums schema+  SchemaEnums (_ ': schema) = SchemaEnums schema --- | Helper to calculate the schema of a user defined type.-type family UserTypeNamespace-  (sch :: Symbol)-  (td :: Maybe Symbol)-  (schemas :: SchemasType)-  (ty :: PGType) where-    UserTypeNamespace sch 'Nothing schemas ty = UserType schemas ty-    UserTypeNamespace sch ('Just td) schemas ty = '(sch, td)+{- | Filters schemas down to labels of all enum typedefs.+-}+type family DbEnums db where+  DbEnums '[] = '[]+  DbEnums (sch ::: schema ': schemas) =+    sch ::: SchemaEnums schema ': DbEnums schemas --- | Calculate the schema and name of a user defined type.-type family UserType (db :: SchemasType) (ty :: PGType) where-  UserType '[] ty = TypeError-    ('Text "No such user type: " ':<>: 'ShowType ty)-  UserType (sch ::: schema ': schemas) ty =-    UserTypeNamespace sch (UserTypeName schema ty) schemas ty+{- | Filters a schema down to rows of relations;+all composites, tables and views.+-}+type family SchemaRelations schema where+  SchemaRelations '[] = '[]+  SchemaRelations (ty ::: 'Typedef ('PGcomposite row) ': schema) =+    ty ::: row ': SchemaRelations schema+  SchemaRelations (tab ::: 'Table table ': schema) =+    tab ::: TableToRow table ': SchemaRelations schema+  SchemaRelations (vw ::: 'View row ': schema) =+    vw ::: row ': SchemaRelations schema+  SchemaRelations (_ ': schema) = SchemaRelations schema++{- | Filters schemas down to rows of relations;+all composites, tables and views.+-}+type family DbRelations db where+  DbRelations '[] = '[]+  DbRelations (sch ::: schema ': schemas) =+    sch ::: SchemaRelations schema ': DbRelations schemas++-- | Used in `FindQualified`+type family FindName xs x where+  FindName '[] xs = 'Nothing+  FindName ( '(name, x) ': _) x = 'Just name+  FindName (_ ': xs) x = FindName xs x++-- | Used in `FindQualified`+type family FindNamespace err nsp name xss x where+  FindNamespace err _ 'Nothing xss x = FindQualified err xss x+  FindNamespace _ nsp ('Just name) _ _ = '(nsp, name)++{- | Find fully qualified name with a type error if lookup fails.+This is used to find the qualified name of a user defined type.++>>> :kind! FindQualified "my error message:"+FindQualified "my error message:" :: [(k1, [(k2, k3)])]+                                     -> k3 -> (k1, k2)+= FindQualified "my error message:"++>>> :kind! FindQualified "couldn't find type:" '[ "foo" ::: '["bar" ::: Double]] Double+FindQualified "couldn't find type:" '[ "foo" ::: '["bar" ::: Double]] Double :: (Symbol,+                                                                                 Symbol)+= '("foo", "bar")++>>> :kind! FindQualified "couldn't find type:" '[ "foo" ::: '["bar" ::: Double]] Bool+FindQualified "couldn't find type:" '[ "foo" ::: '["bar" ::: Double]] Bool :: (Symbol,+                                                                               Symbol)+= (TypeError ...)+-}+type family FindQualified err xss x where+  FindQualified err '[] x = TypeError+    ('Text err ':$$: 'ShowType x)+  FindQualified err ( '(nsp, xs) ': xss) x =+    FindNamespace err nsp (FindName xs x) xss x

@@ -5,11 +5,14 @@   , DerivingStrategies   , DerivingVia   , FlexibleContexts+  , FlexibleInstances   , GADTs   , LambdaCase+  , MultiParamTypeClasses   , OverloadedLabels   , OverloadedStrings   , ScopedTypeVariables+  , StandaloneDeriving   , TypeApplications   , TypeOperators   , UndecidableInstances@@ -20,6 +23,9 @@ import Control.Monad.Trans import Data.ByteString (ByteString) import Data.ByteString.Char8 (unpack)+import Data.Function (on)+import Data.Functor.Contravariant (contramap)+import Data.Int (Int16) import Data.Scientific (fromFloatDigits) import Data.Fixed (Fixed(MkFixed), Micro, Pico) import Data.String (IsString(fromString))@@ -32,12 +38,13 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Main as Main import qualified Hedgehog.Range as Range+import Data.List (sort)  main :: IO () main = withUtf8 $ do-  withConnection connectionString $ define createSchwarma+  withConnection connectionString $ define createDB   Main.defaultMain [checkSequential roundtrips]-  withConnection connectionString $ define dropSchwarma+  withConnection connectionString $ define dropDB  roundtrips :: Group roundtrips = Group "roundtrips"@@ -65,6 +72,9 @@   , roundtripOn normalizeIntRange daterange (genRange genDay)   , roundtrip (typedef #schwarma) genSchwarma   , roundtrip (vararray (typedef #schwarma)) genSchwarmaArray+  , roundtrip (typerow #tab) genRow+  , roundtrip (vararray (typetable #tab)) genRowArray+  , ("table insert", roundtripTable)   ]   where     genInt16 = Gen.int16 Range.exponentialBounded@@ -119,6 +129,11 @@     --   , "CDT", "MST", "MDT", "PST", "PDT" ]     genSchwarma = Gen.enumBounded @_ @Schwarma     genSchwarmaArray = VarArray <$> Gen.list (Range.constant 1 10) genSchwarma+    genRow = HaskRow+      <$> genInt16+      <*> Gen.enumBounded+      <*> Gen.bool+    genRowArray = VarArray <$> Gen.list (Range.constant 1 10) genRow  roundtrip   :: forall x@@ -219,14 +234,83 @@       ch -> [ch]  data Schwarma = Chicken | Lamb | Beef-  deriving stock (Eq, Show, Bounded, Enum, GHC.Generic)+  deriving stock (Eq, Ord, Show, Bounded, Enum, GHC.Generic)   deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)   deriving (IsPG, FromPG, ToPG db, Inline) via Enumerated Schwarma -type DB = '["public" ::: '["schwarma" ::: 'Typedef (PG Schwarma)]]+data HaskRow = HaskRow {foo :: Int16, bar :: Schwarma, baz :: Bool}+  deriving stock (Eq, Ord, Show, GHC.Generic)+  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)+  deriving (IsPG, FromPG, Inline) via Composite HaskRow+deriving via Composite HaskRow+  instance db ~ DB => ToPG db HaskRow -createSchwarma :: Definition '["public" ::: '[]] DB-createSchwarma = createTypeEnumFrom @Schwarma #schwarma+type Schema = '[+  "schwarma" ::: 'Typedef (PG Schwarma),+  "tab" ::: 'Table ('[] :=> PGRow)] -dropSchwarma :: Definition DB '["public" ::: '[]]-dropSchwarma = dropType #schwarma+type DB = Public Schema++type DB0 = Public '[]++createDB :: Definition DB0 DB+createDB =+  createTypeEnumFrom @Schwarma #schwarma >>>+  createTable #tab+    ( notNullable int2 `as` #foo :*+      notNullable (typedef #schwarma) `as` #bar :*+      notNullable bool `as` #baz+    ) Nil++dropDB :: Definition DB DB0+dropDB = dropTable #tab >>> dropType #schwarma++type PGRow = '[+  "foo" ::: 'NoDef :=> 'NotNull 'PGint2,+  "bar" ::: 'NoDef :=> 'NotNull (PG Schwarma),+  "baz" ::: 'NoDef :=> 'NotNull 'PGbool]++insertTabInline :: [HaskRow] -> Statement DB () ()+insertTabInline = \case+  [] -> error "needs at least 1 row"+  rw:rows -> manipulation $ insertInto_ #tab (inlineValues rw rows)++insertTabParams :: Statement DB HaskRow ()+insertTabParams = manipulation . insertInto_ #tab . Values_ $+  Set (param @1) `as` #foo :*+  Set (param @2) `as` #bar :*+  Set (param @3) `as` #baz++insertTabUnnest :: Statement DB [HaskRow] ()+insertTabUnnest = Manipulation enc dec sql+  where+    enc = contramap VarArray aParam+    dec = return ()+    sql = insertInto_ #tab unnested+    unnested = Select fields (from (unnest (param @1)))+    fields =+      Set (#unnest & field #tab #foo) `as` #foo :*+      Set (#unnest & field #tab #bar) `as` #bar :*+      Set (#unnest & field #tab #baz) `as` #baz++selectTab :: Statement DB () HaskRow+selectTab = query $ select Star (from (table #tab))++roundtripTable :: Property+roundtripTable = property $ do+  let+    genInt16 = Gen.int16 Range.exponentialBounded+    genRow = HaskRow+      <$> genInt16+      <*> Gen.enumBounded+      <*> Gen.bool+    genRows = Gen.list (Range.constant 1 100) genRow+  rows1 <- forAll genRows+  rows2 <- forAll genRows+  rows3 <- forAll genRows+  tabRows <- lift . withConnection connectionString $ ephemerally_ $ do+    execute_ (insertTabInline rows1)+    executePrepared_ insertTabParams rows2+    executeParams_ insertTabUnnest rows3+    getRows =<< execute selectTab+  ((===) `on` sort) tabRows (rows1 ++ rows2 ++ rows3)

@@ -109,7 +109,7 @@     let       testUser = User "TestUser"       newUser :: User -> Transaction DB ()-      newUser = manipulateParams_ insertUser+      newUser usr = manipulateParams_ insertUser usr       insertUserTwice :: Transaction DB ()       insertUserTwice = newUser testUser >> newUser testUser       err23505 = UniqueViolation $ Char8.unlines