hpqtypes-extras 1.10.3.0 → 1.10.4.0

raw patch · 7 files changed

+400/−82 lines, 7 filesdep +QuickCheckdep +deepseqdep +extradep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, deepseq, extra, tasty-bench, time

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• benchmark/Main.hs +79/−0
• hpqtypes-extras.cabal +44/−22
• src/Database/PostgreSQL/PQTypes/Deriving.hs +208/−0
• src/Database/PostgreSQL/PQTypes/Model/ColumnType.hs +0/−1
• src/Database/PostgreSQL/PQTypes/SQL/Builder.hs +63/−58
• test/Main.hs +2/−1

@@ -1,3 +1,7 @@+# hpqtypes-extra-1.10.4.0 (2021-02-04)+* Generate valid INSERT SELECT query with data modifying WITH clauses+* Add DerivingVia helpers for enums+ # hpqtypes-extra-1.10.3.0 (2020-11-16) * Include LIMIT clause in UNION subqueries of the select 

@@ -0,0 +1,79 @@+module Main where++import Control.DeepSeq+import Data.Int+import Test.Tasty.Bench++import Database.PostgreSQL.PQTypes.Deriving++main :: IO ()+main = defaultMain+  [ bgroup "enum"+    [ bench "encode" $ nf (encodeEnum @T) T42+    , bench "decode" $ nf (decodeEnum @T) 42+    ]+  , bgroup "enum-text"+    [ bench "encode" $ nf (encodeEnumAsText @S) S42+    , bench "decode" $ nf (decodeEnumAsText @S) "text_42"+    ]+  ]++data T = T01 | T02 | T03 | T04 | T05 | T06 | T07 | T08 | T09 | T10+       | T11 | T12 | T13 | T14 | T15 | T16 | T17 | T18 | T19 | T20+       | T21 | T22 | T23 | T24 | T25 | T26 | T27 | T28 | T29 | T30+       | T31 | T32 | T33 | T34 | T35 | T36 | T37 | T38 | T39 | T40+       | T41 | T42 | T43 | T44 | T45 | T46 | T47 | T48 | T49 | T50+  deriving (Eq, Show, Enum, Bounded)++instance NFData T where+  rnf = (`seq` ())++-- | Enum encoding for 'T'.+--+-- >>> isInjective (encodeEnum @T)+-- True+instance EnumEncoding T where+   type EnumBase T = Int16+   encodeEnum = \case+     T01 -> 1;  T02 -> 2;  T03 -> 3;  T04 -> 4;  T05 -> 5+     T06 -> 6;  T07 -> 7;  T08 -> 8;  T09 -> 9;  T10 -> 10+     T11 -> 11; T12 -> 12; T13 -> 13; T14 -> 14; T15 -> 15+     T16 -> 16; T17 -> 17; T18 -> 18; T19 -> 19; T20 -> 20+     T21 -> 21; T22 -> 22; T23 -> 23; T24 -> 24; T25 -> 25+     T26 -> 26; T27 -> 27; T28 -> 28; T29 -> 29; T30 -> 30+     T31 -> 31; T32 -> 32; T33 -> 33; T34 -> 34; T35 -> 35+     T36 -> 36; T37 -> 37; T38 -> 38; T39 -> 39; T40 -> 40+     T41 -> 41; T42 -> 42; T43 -> 43; T44 -> 44; T45 -> 45+     T46 -> 46; T47 -> 47; T48 -> 48; T49 -> 49; T50 -> 50++----------------------------------------++data S = S01 | S02 | S03 | S04 | S05 | S06 | S07 | S08 | S09 | S10+       | S11 | S12 | S13 | S14 | S15 | S16 | S17 | S18 | S19 | S20+       | S21 | S22 | S23 | S24 | S25 | S26 | S27 | S28 | S29 | S30+       | S31 | S32 | S33 | S34 | S35 | S36 | S37 | S38 | S39 | S40+       | S41 | S42 | S43 | S44 | S45 | S46 | S47 | S48 | S49 | S50+  deriving (Eq, Show, Enum, Bounded)++instance NFData S where+  rnf = (`seq` ())++-- | Enum encoding for 'S'.+--+-- >>> isInjective (encodeEnumAsText @S)+-- True+instance EnumAsTextEncoding S where+  encodeEnumAsText = \case+    S01 -> "text_01"; S02 -> "text_02"; S03 -> "text_03"; S04 -> "text_04"+    S05 -> "text_05"; S06 -> "text_06"; S07 -> "text_07"; S08 -> "text_08"+    S09 -> "text_09"; S10 -> "text_10"; S11 -> "text_11"; S12 -> "text_12"+    S13 -> "text_13"; S14 -> "text_14"; S15 -> "text_15"; S16 -> "text_16"+    S17 -> "text_17"; S18 -> "text_18"; S19 -> "text_19"; S20 -> "text_20"+    S21 -> "text_21"; S22 -> "text_22"; S23 -> "text_23"; S24 -> "text_24"+    S25 -> "text_25"; S26 -> "text_26"; S27 -> "text_27"; S28 -> "text_28"+    S29 -> "text_29"; S30 -> "text_30"; S31 -> "text_31"; S32 -> "text_32"+    S33 -> "text_33"; S34 -> "text_34"; S35 -> "text_35"; S36 -> "text_36"+    S37 -> "text_37"; S38 -> "text_38"; S39 -> "text_39"; S40 -> "text_40"+    S41 -> "text_41"; S42 -> "text_42"; S43 -> "text_43"; S44 -> "text_44"+    S45 -> "text_45"; S46 -> "text_46"; S47 -> "text_47"; S48 -> "text_48"+    S49 -> "text_49"; S50 -> "text_50";

@@ -1,6 +1,6 @@-cabal-version:       1.18+cabal-version:       2.2 name:                hpqtypes-extras-version:             1.10.3.0+version:             1.10.4.0 synopsis:            Extra utilities for hpqtypes library description:         The following extras for hpqtypes library:                      .@@ -10,7 +10,7 @@                        of a database schema.  homepage:            https://github.com/scrive/hpqtypes-extras-license:             BSD3+license:             BSD-3-Clause license-file:        LICENSE extra-source-files:  CHANGELOG.md, README.md author:              Scrive AB@@ -20,18 +20,40 @@ copyright:           Scrive AB category:            Database build-type:          Simple-tested-with:         GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.3 || ==8.10.1+tested-with:         GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.3  Source-repository head   Type:     git   Location: https://github.com/scrive/hpqtypes-extras.git +common common-stanza+  Default-Language: Haskell2010+  Default-Extensions: BangPatterns+                    , DeriveDataTypeable+                    , ExistentialQuantification+                    , FlexibleContexts+                    , GeneralizedNewtypeDeriving+                    , LambdaCase+                    , MultiWayIf+                    , OverloadedStrings+                    , RankNTypes+                    , RecordWildCards+                    , ScopedTypeVariables+                    , StandaloneDeriving+                    , TupleSections+                    , TypeApplications+                    , TypeFamilies+                    , UndecidableInstances+                    , ViewPatterns+ library+  Import: common-stanza   hs-source-dirs: src    ghc-options: -Wall    exposed-modules: Database.PostgreSQL.PQTypes.Checks+                 , Database.PostgreSQL.PQTypes.Deriving                  , Database.PostgreSQL.PQTypes.ExtrasOptions                  , Database.PostgreSQL.PQTypes.Migrate                  , Database.PostgreSQL.PQTypes.Model@@ -52,11 +74,12 @@    build-depends: base              >= 4.9     && < 5                , hpqtypes          >= 1.8.0.0 && < 2.0.0.0-               , base16-bytestring >= 0.1     && < 0.2+               , base16-bytestring >= 0.1     && < 1.0.1.0                , bytestring        >= 0.10    && < 0.11                , containers        >= 0.5     && < 0.7                , cryptohash        >= 0.11    && < 0.12                , exceptions        >= 0.10    && < 0.11+               , extra             >= 1.6.17  && < 1.8.0                , mtl               >= 2.2     && < 2.3                , fields-json       >= 0.4     && < 0.5                , text              >= 1.2     && < 1.3@@ -68,26 +91,11 @@                , safe              >= 0.3     && < 0.4    default-language: Haskell2010-  default-extensions: BangPatterns-                    , DeriveDataTypeable-                    , ExistentialQuantification-                    , FlexibleContexts-                    , GeneralizedNewtypeDeriving-                    , LambdaCase-                    , MultiWayIf-                    , OverloadedStrings-                    , RankNTypes-                    , RecordWildCards-                    , ScopedTypeVariables-                    , StandaloneDeriving-                    , TupleSections-                    , TypeFamilies-                    , UndecidableInstances-                    , ViewPatterns+  default-extensions:   other-extensions:   CPP-                    , TypeApplications  test-suite  hpqtypes-extras-tests+  Import:             common-stanza   type:               exitcode-stdio-1.0   hs-source-dirs:     test   main-is:            Main.hs@@ -100,6 +108,7 @@                     , ScopedTypeVariables   ghc-options:        -Wall   build-depends:      base,+                      QuickCheck,                       exceptions,                       hpqtypes,                       hpqtypes-extras,@@ -109,5 +118,18 @@                       tasty,                       tasty-hunit,                       text,+                      time,                       transformers,                       uuid-types++benchmark bench+  Import:             common-stanza+  type:               exitcode-stdio-1.0+  hs-source-dirs:     benchmark+  main-is:            Main.hs++  ghc-options:        -Wall+  build-depends:      base+                    , deepseq+                    , hpqtypes-extras+                    , tasty-bench

@@ -0,0 +1,208 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+module Database.PostgreSQL.PQTypes.Deriving (+  -- * Helpers, to be used with @deriving via@ (@-XDerivingVia@).+    SQLEnum(..)+  , EnumEncoding(..)+  , SQLEnumAsText(..)+  , EnumAsTextEncoding(..)+    -- * For use in doctests.+  , isInjective+  ) where++import Control.Exception (SomeException(..), throwIO)+import Data.List.Extra (enumerate, nubSort)+import Data.Map.Strict (Map)+import Data.Text (Text)+import Data.Typeable+import Database.PostgreSQL.PQTypes+import qualified Data.Map.Strict as Map++-- | Helper newtype to be used with @deriving via@ to derive @(PQFormat, ToSQL,+-- FromSQL)@ instances for enums, given an instance of 'EnumEncoding'.+--+-- /Hint:/ non-trivial 'Enum' instances can be derived using the 'generic-data'+-- package!+--+-- >>> :{+-- data Colours = Blue | Black | Red | Mauve | Orange+--   deriving (Eq, Show, Enum, Bounded)+-- instance EnumEncoding Colours where+--   type EnumBase Colours = Int16+--   encodeEnum = \case+--     Blue   -> 1+--     Black  -> 7+--     Red    -> 2+--     Mauve  -> 6+--     Orange -> 3+-- :}+--+-- /Note:/ To get SQL-specific instances use @DerivingVia@:+--+-- @+-- data Colours = ...+--   ...+--   deriving (PQFormat, ToSQL, FromSQL) via SQLEnum Colours+-- @+--+-- >>> isInjective (encodeEnum @Colours)+-- True+--+-- >>> decodeEnum @Colours 7+-- Right Black+--+-- >>> decodeEnum @Colours 42+-- Left [(1,3),(6,7)]+newtype SQLEnum a = SQLEnum a++class+  ( -- The semantic type needs to be finitely enumerable.+    Enum a+  , Bounded a+    -- The base type needs to be enumerable and ordered.+  , Enum (EnumBase a)+  , Ord (EnumBase a)+  ) => EnumEncoding a where+  type EnumBase a+  -- | Encode @a@ as a base type.+  encodeEnum :: a -> EnumBase a++  -- | Decode base type to an @a@. If the conversion fails, a list of valid+  -- ranges is returned instead.+  --+  -- /Note:/ The default implementation looks up values in 'decodeEnumMap' and+  -- can be overwritten for performance if necessary.+  decodeEnum :: EnumBase a -> Either [(EnumBase a, EnumBase a)] a+  decodeEnum b = maybe (Left . intervals $ Map.keys (decodeEnumMap @a)) Right+               $ Map.lookup b (decodeEnumMap @a)++  -- | Include the inverse map as a top-level part of the 'EnumEncoding'+  -- instance to ensure it is only computed once by GHC.+  decodeEnumMap :: Map (EnumBase a) a+  decodeEnumMap = Map.fromList [ (encodeEnum a, a) | a <- enumerate ]++instance PQFormat (EnumBase a) => PQFormat (SQLEnum a) where+  pqFormat = pqFormat @(EnumBase a)++instance+  ( EnumEncoding a+  , PQFormat (EnumBase a)+  , ToSQL (EnumBase a)+  ) => ToSQL (SQLEnum a) where+  type PQDest (SQLEnum a) = PQDest (EnumBase a)+  toSQL (SQLEnum a) = toSQL $ encodeEnum a++instance+  ( EnumEncoding a+  , PQFormat (EnumBase a)+  , FromSQL (EnumBase a)+  , Show (EnumBase a)+  , Typeable (EnumBase a)+  ) => FromSQL (SQLEnum a) where+  type PQBase (SQLEnum a) = PQBase (EnumBase a)+  fromSQL base = do+    b <- fromSQL base+    case decodeEnum b of+      Left validRange -> throwIO $ SomeException RangeError+        { reRange = validRange+        , reValue = b+        }+      Right a -> return $ SQLEnum a++-- | A special case of 'SQLEnum', where the enum is to be encoded as text+-- ('SQLEnum' can't be used because of the 'Enum' constraint on the domain of+-- 'encodeEnum').+--+-- >>> :{+-- data Person = Alfred | Bertrand | Charles+--   deriving (Eq, Show, Enum, Bounded)+-- instance EnumAsTextEncoding Person where+--   encodeEnumAsText = \case+--     Alfred   -> "alfred"+--     Bertrand -> "bertrand"+--     Charles  -> "charles"+-- :}+--+-- /Note:/ To get SQL-specific instances use @DerivingVia@:+--+-- @+-- data Person = ...+--   ...+--   deriving (PQFormat, ToSQL, FromSQL) via SQLEnumAsText Person+-- @+--+-- >>> isInjective (encodeEnumAsText @Person)+-- True+--+-- >>> decodeEnumAsText @Person "bertrand"+-- Right Bertrand+--+-- >>> decodeEnumAsText @Person "batman"+-- Left ["alfred","bertrand","charles"]+newtype SQLEnumAsText a = SQLEnumAsText a++class (Enum a, Bounded a) => EnumAsTextEncoding a where+  -- | Encode @a@ as 'Text'.+  encodeEnumAsText :: a -> Text++  -- | Decode 'Text' to an @a@. If the conversion fails, a list of valid values+  -- is returned instead.+  --+  -- /Note:/ The default implementation looks up values in 'decodeEnumAsTextMap'+  -- and can be overwritten for performance if necessary.+  decodeEnumAsText :: Text -> Either [Text] a+  decodeEnumAsText text = maybe (Left $ Map.keys (decodeEnumAsTextMap @a)) Right+                        $ Map.lookup text (decodeEnumAsTextMap @a)++  -- | Include the inverse map as a top-level part of the 'SQLEnumTextEncoding'+  -- instance to ensure it is only computed once by GHC.+  decodeEnumAsTextMap :: Map Text a+  decodeEnumAsTextMap = Map.fromList [ (encodeEnumAsText a, a) | a <- enumerate ]++instance EnumAsTextEncoding a => PQFormat (SQLEnumAsText a) where+  pqFormat = pqFormat @Text++instance EnumAsTextEncoding a => ToSQL (SQLEnumAsText a) where+  type PQDest (SQLEnumAsText a) = PQDest Text+  toSQL (SQLEnumAsText a) = toSQL $ encodeEnumAsText a++instance EnumAsTextEncoding a => FromSQL (SQLEnumAsText a) where+  type PQBase (SQLEnumAsText a) = PQBase Text+  fromSQL base = do+    text <- fromSQL base+    case decodeEnumAsText text of+      Left validValues -> throwIO $ SomeException InvalidValue+        { ivValue       = text+        , ivValidValues = Just validValues+        }+      Right a -> return $ SQLEnumAsText a++-- | To be used in doctests to prove injectivity of encoding functions.+--+-- >>> isInjective (id :: Bool -> Bool)+-- True+--+-- >>> isInjective (\(_ :: Bool) -> False)+-- False+isInjective :: (Enum a, Bounded a, Eq a, Eq b) => (a -> b) -> Bool+isInjective f = null [ (a, b) | a <- enumerate, b <- enumerate, a /= b, f a == f b ]++-- | Internal helper: given a list of values, decompose it into a list of+-- intervals.+--+-- >>> intervals [42,2,1,0,3,88,-1,43,42]+-- [(-1,3),(42,43),(88,88)]+--+-- prop> nubSort xs == concatMap (\(l,r) -> [l .. r]) (intervals xs)+intervals :: forall  a . (Enum a, Ord a) => [a] -> [(a, a)]+intervals as = case nubSort as of+  [] -> []+  (first : ascendingRest) -> accumIntervals (first, first) ascendingRest+  where+    accumIntervals :: (a, a) -> [a] -> [(a, a)]+    accumIntervals (lower, upper) [] = [(lower, upper)]+    accumIntervals (lower, upper) (first' : ascendingRest') = if succ upper == first'+      then accumIntervals (lower, first') ascendingRest'+      else (lower, upper) : accumIntervals (first', first') ascendingRest'++-- $setup+-- >>> import Data.Int

@@ -1,4 +1,3 @@-{-# LANGUAGE TypeApplications #-} module Database.PostgreSQL.PQTypes.Model.ColumnType (     ColumnType(..)   , columnTypeToSQL

@@ -4,27 +4,28 @@ monadic DSL for building SQL statements on the fly. Some examples:  >>> :{->>> | sqlSelect "documents" $ do->>> |  sqlResult "id"->>> |  sqlResult "title"->>> |  sqlResult "mtime"->>> |  sqlOrderBy "documents.mtime DESC"->>> |  sqlWhereILike "documents.title" "%pattern%"->>> :}-SQL " SELECT  id, title, mtime FROM documents WHERE (documents.title ILIKE <\"%pattern%\">)   ORDER BY documents.mtime DESC  "+sqlSelect "documents" $ do+  sqlResult "id"+  sqlResult "title"+  sqlResult "mtime"+  sqlOrderBy "documents.mtime DESC"+  sqlWhereILike "documents.title" "%pattern%"+:}+SQL " SELECT  id, title, mtime FROM documents WHERE (documents.title ILIKE <\"%pattern%\">)    ORDER BY documents.mtime DESC  "  @SQL.Builder@ supports SELECT as 'sqlSelect' and data manipulation using 'sqlInsert', 'sqlInsertSelect', 'sqlDelete' and 'sqlUpdate'. ->>> import Data.Time.Clock->>> now <- getCurrentTime+>>> import Data.Time+>>> let title = "title" :: String+>>> let ctime  = read "2020-01-01 00:00:00 UTC" :: UTCTime >>> :{->>> | sqlInsert "documents" $ do->>> |   sqlSet "title" title->>> |   sqlSet "ctime" now->>> |   sqlResult "id"->>> :}-SQL " INSERT INTO documents (title, ctime) VALUES (<\"title\">, <\"2017-02-01 17:56:20.324894547 UTC\">) RETURNING id"+sqlInsert "documents" $ do+  sqlSet "title" title+  sqlSet "ctime" ctime+  sqlResult "id"+:}+SQL " INSERT INTO documents (title, ctime) VALUES (<\"title\">, <2020-01-01 00:00:00 UTC>)  RETURNING id"  The 'sqlInsertSelect' is particulary interesting as it supports INSERT of values taken from a SELECT clause from same or even different@@ -38,12 +39,12 @@ element.  >>> :{->>> | sqlInsert "documents" $ do->>> |   sqlSet "ctime" now->>> |   sqlSetList "title" ["title1", "title2", "title3"]->>> |   sqlResult "id"->>> :}-SQL " INSERT INTO documents (ctime, title) VALUES (<\"2017-02-01 17:56:20.324894547 UTC\">, <\"title1\">) , (<\"2017-02-01 17:56:20.324894547 UTC\">, <\"title2\">) , (<\"2017-02-01 17:56:20.324894547 UTC\">, <\"title3\">) RETURNING id"+sqlInsert "documents" $ do+  sqlSet "ctime" ctime+  sqlSetList "title" ["title1", "title2", "title3"]+  sqlResult "id"+:}+SQL " INSERT INTO documents (ctime, title) VALUES (<2020-01-01 00:00:00 UTC>, <\"title1\">) , (<2020-01-01 00:00:00 UTC>, <\"title2\">) , (<2020-01-01 00:00:00 UTC>, <\"title3\">)  RETURNING id"  The above will insert 3 new documents. @@ -51,17 +52,17 @@ 'sqlOrderBy', @GROUP BY@ as 'sqlGroupBy'.  >>> :{->>> | sqlSelect "documents" $ do->>> |   sqlResult "id"->>> |   sqlResult "title"->>> |   sqlResult "mtime"->>> |   sqlOrderBy "documents.mtime DESC"->>> |   sqlOrderBy "documents.title"->>> |   sqlGroupBy "documents.status"->>> |   sqlJoinOn "users" "documents.user_id = users.id"->>> |   sqlWhere $ mkSQL "documents.title ILIKE" <?> "%pattern%"->>> :}-SQL " SELECT  id, title, mtime FROM documents  JOIN  users  ON  documents.user_id = users.id WHERE (documents.title ILIKE <\"%pattern%\">) GROUP BY documents.status  ORDER BY documents.mtime DESC, documents.title  "+sqlSelect "documents" $ do+  sqlResult "id"+  sqlResult "title"+  sqlResult "mtime"+  sqlOrderBy "documents.mtime DESC"+  sqlOrderBy "documents.title"+  sqlGroupBy "documents.status"+  sqlJoinOn "users" "documents.user_id = users.id"+  sqlWhere $ mkSQL "documents.title ILIKE" <?> "%pattern%"+:}+SQL " SELECT  id, title, mtime FROM documents  JOIN  users  ON  documents.user_id = users.id WHERE (documents.title ILIKE <\"%pattern%\">)  GROUP BY documents.status  ORDER BY documents.mtime DESC, documents.title  "  Joins are done by 'sqlJoinOn', 'sqlLeftJoinOn', 'sqlRightJoinOn', 'sqlJoinOn', 'sqlFullJoinOn'. If everything fails use 'sqlJoin' and@@ -69,16 +70,16 @@ some kind of abstract syntax data type is lacking.  >>> :{->>> | sqlDelete "mails" $ do->>> |   sqlWhere "id > 67"->>> :}+sqlDelete "mails" $ do+  sqlWhere "id > 67"+:} SQL " DELETE FROM mails  WHERE (id > 67) "  >>> :{->>> | sqlUpdate "document_tags" $ do->>> |   sqlSet "value" (123 :: Int)->>> |   sqlWhere "name = 'abc'"->>> :}+sqlUpdate "document_tags" $ do+  sqlSet "value" (123 :: Int)+  sqlWhere "name = 'abc'"+:} SQL " UPDATE document_tags SET value=<123>  WHERE (name = 'abc') "  Exception returning and 'kWhyNot' are a subsystem for querying why a@@ -123,8 +124,7 @@  -} --- TODO: clean this up and fix the mess with--- "randomly" wrapping stuff in parentheses.+-- TODO: clean this up, add more documentation.  module Database.PostgreSQL.PQTypes.SQL.Builder   ( sqlWhere@@ -484,22 +484,27 @@      makeLongEnough (Many x)   = take longest (x ++ repeat "DEFAULT")  instance Sqlable SqlInsertSelect where-  toSQLCommand cmd =-    "INSERT INTO" <+> sqlInsertSelectWhat cmd <+>-    parenthesize (sqlConcatComma (map fst (sqlInsertSelectSet cmd))) <+>-    parenthesize (toSQLCommand (SqlSelect { sqlSelectFrom    = sqlInsertSelectFrom cmd-                                          , sqlSelectUnion   = []-                                          , sqlSelectDistinct = sqlInsertSelectDistinct cmd-                                          , sqlSelectResult  = fmap snd $ sqlInsertSelectSet cmd-                                          , sqlSelectWhere   = sqlInsertSelectWhere cmd-                                          , sqlSelectOrderBy = sqlInsertSelectOrderBy cmd-                                          , sqlSelectGroupBy = sqlInsertSelectGroupBy cmd-                                          , sqlSelectHaving  = sqlInsertSelectHaving cmd-                                          , sqlSelectOffset  = sqlInsertSelectOffset cmd-                                          , sqlSelectLimit   = sqlInsertSelectLimit cmd-                                          , sqlSelectWith    = sqlInsertSelectWith cmd-                                          })) <+>-    emitClausesSepComma "RETURNING" (sqlInsertSelectResult cmd)+  toSQLCommand cmd = smconcat+    -- WITH clause needs to be at the top level, so we emit it here and not+    -- include it in the SqlSelect below.+    [ emitClausesSepComma "WITH" $+      map (\(name,command) -> name <+> "AS" <+> parenthesize command) (sqlInsertSelectWith cmd)+    , "INSERT INTO" <+> sqlInsertSelectWhat cmd+    , parenthesize . sqlConcatComma . map fst $ sqlInsertSelectSet cmd+    , parenthesize . toSQLCommand $ SqlSelect { sqlSelectFrom    = sqlInsertSelectFrom cmd+                                              , sqlSelectUnion   = []+                                              , sqlSelectDistinct = sqlInsertSelectDistinct cmd+                                              , sqlSelectResult  = fmap snd $ sqlInsertSelectSet cmd+                                              , sqlSelectWhere   = sqlInsertSelectWhere cmd+                                              , sqlSelectOrderBy = sqlInsertSelectOrderBy cmd+                                              , sqlSelectGroupBy = sqlInsertSelectGroupBy cmd+                                              , sqlSelectHaving  = sqlInsertSelectHaving cmd+                                              , sqlSelectOffset  = sqlInsertSelectOffset cmd+                                              , sqlSelectLimit   = sqlInsertSelectLimit cmd+                                              , sqlSelectWith    = []+                                              }+    , emitClausesSepComma "RETURNING" $ sqlInsertSelectResult cmd+    ]  instance Sqlable SqlUpdate where   toSQLCommand cmd =

@@ -34,7 +34,8 @@  instance IsOption ConnectionString where   defaultValue = ConnectionString-                 "postgresql://postgres@localhost/travis_ci_test"+    -- For GitHub Actions CI+    "host=postgres user=postgres password=postgres"   parseValue   = Just . ConnectionString   optionName   = return "connection-string"   optionHelp   = return "Postgres connection string"