4110e02 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

use default in select

4110e02Eitan Chatav8 years ago

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

compare with dev

unifiedsplit

@@ -12,7 +12,7 @@ First, we need some language extensions because Squeal uses modern GHC

12features.

14>>> :set -XDataKinds -XDeriveGeneric -XOverloadedLabels

15−>>> :set -XOverloadedStrings -XTypeApplications -XTypeOperators

15+>>> :set -XOverloadedStrings -XTypeApplications -XTypeOperators -XGADTs

17We'll need some imports.

@@ -117,25 +117,18 @@ of our inserts.

117

118>>> :{

119let

120− insertUser :: Manipulation Schema '[ 'NotNull 'PGtext ] '[ "fromOnly" ::: 'NotNull 'PGint4 ]

120+ insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'Null 'PGtext ] '[]

121− insertUser = insertInto #users

121+ insertUser = with (u `as` #u) e

122− (Values_ (defaultAs #id :* param @1 `as` #name))

122+ where

123− (OnConflict (OnConstraint #pk_users) DoNothing) (Returning (#id `as` #fromOnly))

124−:}

125−

126−>>> :{

127−let

128− insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]

129− insertEmail = insertInto #emails

123+ u = insertInto #users

124+ (Values_ (defaultAs #id :* param @1 `as` #name))

125+ OnConflictDoRaise (Returning (#id :* param @2 `as` #email))

126+ e = insertInto_ #emails

130− (Values_ (defaultAs #id :* param @1 `as` #user_id :* param @2 `as` #email))

127+ (Select (defaultAs #id :* #u ! #id `as` #user_id :* #u ! #email) (from (view #u)))

131− (OnConflict (OnConstraint #pk_emails) DoNothing) (Returning Nil)

132:}

128:}

133

129

134>>> printSQL insertUser

130>>> printSQL insertUser

135−INSERT INTO "users" ("id", "name") VALUES (DEFAULT, ($1 :: text)) ON CONFLICT ON CONSTRAINT "pk_users" DO NOTHING RETURNING "id" AS "fromOnly"

131+WITH "u" AS (INSERT INTO "users" ("id", "name") VALUES (DEFAULT, ($1 :: text)) RETURNING "id" AS "id", ($2 :: text) AS "email") INSERT INTO "emails" ("user_id", "email") SELECT "u"."id", "u"."email" FROM "u" AS "u"

136−

137−>>> printSQL insertEmail

138−INSERT INTO "emails" ("id", "user_id", "email") VALUES (DEFAULT, ($1 :: int4), ($2 :: text)) ON CONFLICT ON CONSTRAINT "pk_emails" DO NOTHING

139

132

140Next we write a `Query` to retrieve users from the database. We're not

133Next we write a `Query` to retrieve users from the database. We're not

141interested in the ids here, just the usernames and email addresses. We

134interested in the ids here, just the usernames and email addresses. We

@@ -191,9 +184,7 @@ transformer and when the schema doesn't change we can use `Monad` and

191let

184let

192 session :: PQ Schema Schema IO ()

185 session :: PQ Schema Schema IO ()

193 session = do

186 session = do

194− idResults <- traversePrepared insertUser (Only . userName <$> users)

195− ids <- traverse (fmap fromOnly . getRow 0) idResults

196− traversePrepared_ insertEmail (zip (ids :: [Int32]) (userEmail <$> users))

187+ _ <- traversePrepared_ insertUser users

197 usersResult <- runQuery getUsers

188 usersResult <- runQuery getUsers

198 usersRows <- getRows usersResult

189 usersRows <- getRows usersResult

199 liftBase $ print (usersRows :: [User])

190 liftBase $ print (usersRows :: [User])

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

@@ -318,12 +318,20 @@ renderQueryClause = \case

318 ( parenthesized

319 . renderCommaSeparated renderValuePart <$> row0 : rows )

320 Select row0 tab ->

321− parenthesized (renderCommaSeparated renderAliasPart row0)

321+ parenthesized (renderCommaSeparatedMaybe renderAliasPartMaybe row0)

322 <+> "SELECT"

323− <+> renderCommaSeparated renderValuePart row0

323+ <+> renderCommaSeparatedMaybe renderValuePartMaybe row0

324 <+> renderTableExpression tab

325 Subquery qry -> renderQuery qry

326 where

327+ renderAliasPartMaybe, renderValuePartMaybe

328+ :: ColumnExpression schema from grp params column -> Maybe ByteString

329+ renderAliasPartMaybe = \case

330+ DefaultAs _ -> Nothing

331+ Specific (_ `As` name) -> Just $ renderAlias name

332+ renderValuePartMaybe = \case

333+ DefaultAs _ -> Nothing

334+ Specific (value `As` _) -> Just $ renderExpression value

327 renderAliasPart, renderValuePart

335 renderAliasPart, renderValuePart

328 :: ColumnExpression schema from grp params column -> ByteString

336 :: ColumnExpression schema from grp params column -> ByteString

329 renderAliasPart = \case

337 renderAliasPart = \case

squeal-postgresql/src/Squeal/PostgreSQL/Render.hs+14

@@ -27,6 +27,7 @@ module Squeal.PostgreSQL.Render

27 , singleQuotedText

28 , singleQuotedUtf8

29 , renderCommaSeparated

30+ , renderCommaSeparatedMaybe

30 , renderNat

31 , renderNat

31 , renderSymbol

32 , renderSymbol

32 , RenderSQL (..)

33 , RenderSQL (..)

@@ -35,6 +36,7 @@ module Squeal.PostgreSQL.Render

36import Control.Monad.Base

37import Control.Monad.Base

37import Data.ByteString (ByteString)

38import Data.ByteString (ByteString)

39+import Data.Maybe (catMaybes)

38import Data.Monoid ((<>))

40import Data.Monoid ((<>))

39import Data.Text (Text)

41import Data.Text (Text)

40import Generics.SOP

42import Generics.SOP

@@ -80,6 +82,18 @@ renderCommaSeparated render

80 . hcollapse

82 . hcollapse

81 . hmap (K . render)

83 . hmap (K . render)

85+-- | Comma separate the `Maybe` renderings of a heterogeneous list, dropping

86+-- `Nothing`s.

87+renderCommaSeparatedMaybe

88+ :: SListI xs

89+ => (forall x. expression x -> Maybe ByteString)

90+ -> NP expression xs -> ByteString

91+renderCommaSeparatedMaybe render

92+ = commaSeparated

93+ . catMaybes

94+ . hcollapse

95+ . hmap (K . render)

96+

83-- | Render a promoted `Nat`.

97-- | Render a promoted `Nat`.

84renderNat :: forall n. KnownNat n => ByteString

98renderNat :: forall n. KnownNat n => ByteString

85renderNat = fromString (show (natVal' (proxy# :: Proxy# n)))

99renderNat = fromString (show (natVal' (proxy# :: Proxy# n)))