372edd2 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

fix tests

372edd2Eitan Chatav8 years ago

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+37−53

compare with dev

unifiedsplit

@@ -24,9 +24,7 @@ to encode Haskell values into statement parameters.

25>>> :{

26let

27− query :: Query '[]

27+ query :: Query '[] (TuplePG Row) (RowPG Row)

28− '[ 'NotNull 'PGint2, 'NotNull 'PGtext]

29− '["col1" ::: 'NotNull 'PGint2, "col2" ::: 'NotNull 'PGtext]

30 query = values_ (param @1 `as` #col1 :* param @2 `as` #col2)

28 query = values_ (param @1 `as` #col1 :* param @2 `as` #col2)

31:}

29:}

@@ -43,23 +41,9 @@ let

43True

41True

45In addition to being able to encode and decode basic Haskell types like `Int16` and `Text`,

43In addition to being able to encode and decode basic Haskell types like `Int16` and `Text`,

46−Squeal permits you to encode and decode Haskell types which are equivalent to

44+Squeal permits you to encode and decode Haskell types to

47Postgres array, enumerated and composite types.

45Postgres array, enumerated and composite types.

49−>>> :{

50−let

51− query :: Query '[]

52− '[ 'NotNull ('PGvararray ('NotNull 'PGint2))

53− , 'NotNull ('PGfixarray 2 ('Null 'PGint2))

54− , 'NotNull ('PGfixarray 3 ('NotNull ('PGfixarray 2 ('NotNull 'PGint2))))

55− ]

56− '[ "v1" ::: 'NotNull ('PGvararray ('NotNull 'PGint2))

57− , "v2" ::: 'NotNull ('PGfixarray 2 ('Null 'PGint2))

58− , "v3" ::: 'NotNull ('PGfixarray 3 ('NotNull ('PGfixarray 2 ('NotNull 'PGint2))))

59− ]

60− query = values_ (param @1 `as` #v1 :* param @2 `as` #v2 :* param @3 `as` #v3)

61−:}

62−

63>>> :{

47>>> :{

64data VRow = VRow

48data VRow = VRow

65 { v1 :: Vector Int16

49 { v1 :: Vector Int16

@@ -73,6 +57,12 @@ data VRow = VRow

73>>> :set -XOverloadedLists

57>>> :set -XOverloadedLists

74>>> let vparams = VRow [1,2] (Just 1,Nothing) ((1,2), (3,4), (5,6))

58>>> let vparams = VRow [1,2] (Just 1,Nothing) ((1,2), (3,4), (5,6))

60+>>> :{

61+let

62+ query :: Query '[] (TuplePG VRow) (RowPG VRow)

63+ query = values_ (param @1 `as` #v1 :* param @2 `as` #v2 :* param @3 `as` #v3)

64+:}

65+

76>>> :{

66>>> :{

77let

67let

78 roundtrip :: IO ()

68 roundtrip :: IO ()

@@ -90,7 +80,7 @@ They are equivalent to Haskell algebraic data types whose constructors are nulla

90An example of an enum type might be the days of the week,

80An example of an enum type might be the days of the week,

91or a set of status values for a piece of data.

81or a set of status values for a piece of data.

93−>>> data Schwarma = Beef | Lamb | Chicken deriving (Show, GHC.Generic)

83+>>> data Schwarma = Beef | Lamb | Chicken deriving (Eq, Show, GHC.Generic)

94>>> instance Generic Schwarma

84>>> instance Generic Schwarma

95>>> instance HasDatatypeInfo Schwarma

85>>> instance HasDatatypeInfo Schwarma

@@ -99,20 +89,17 @@ it is essentially just a list of field names and their data types. They are almo

99equivalent to Haskell record types. However, because of the potential presence of @NULL@

89equivalent to Haskell record types. However, because of the potential presence of @NULL@

100all the record fields must be `Maybe`s of basic types.

90all the record fields must be `Maybe`s of basic types.

101

102−>>> data Person = Person {name :: Maybe Text, age :: Maybe Int32} deriving (Show, GHC.Generic)

92+>>> data Person = Person {name :: Text, age :: Int32} deriving (Eq, Show, GHC.Generic)

103>>> instance Generic Person

93>>> instance Generic Person

104>>> instance HasDatatypeInfo Person

94>>> instance HasDatatypeInfo Person

105

106We can create the equivalent Postgres types directly from their Haskell types. First,

96We can create the equivalent Postgres types directly from their Haskell types. First,

107define a type instances for `PG`.

97define a type instances for `PG`.

108

109−>>> type instance PG Schwarma = PG (Composite Schwarma)

110−>>> type instance PG Person = PG (Enumerated Person)

111−

112>>> :{

99>>> :{

113type Schema =

100type Schema =

114− '[ "schwarma" ::: 'Typedef (PG Schwarma)

101+ '[ "schwarma" ::: 'Typedef (PG (Enumerated Schwarma))

115− , "person" ::: 'Typedef (PG Person)

102+ , "person" ::: 'Typedef (PG (Composite Person))

116 ]

103 ]

117:}

104:}

118

105

@@ -127,15 +114,22 @@ let

127Then we can perform roundtrip queries;

114Then we can perform roundtrip queries;

128

115

129>>> :{

116>>> :{

130−let

117+data TRow = TRow

131− querySchwarma :: Query Schema (TuplePG (Only Schwarma)) (RowPG (Only Schwarma))

118+ { schwarma :: Enumerated Schwarma

132− querySchwarma = values_ (parameter @1 (typedef #schwarma) `as` #fromOnly)

119+ , person :: Composite Person

120+ } deriving (Eq, GHC.Generic)

133:}

121:}

134

122

123+>>> instance Generic TRow

124+>>> instance HasDatatypeInfo TRow

125+>>> let tparams = TRow (Enumerated Chicken) (Composite (Person "Faisal" 24))

126+

135>>> :{

127>>> :{

136let

128let

137− queryPerson :: Query Schema (TuplePG (Only Person)) (RowPG (Only Person))

129+ query :: Query Schema (TuplePG TRow) (RowPG TRow)

138− queryPerson = values_ (parameter @1 (typedef #person) `as` #fromOnly)

130+ query = values_

131+ ( parameter @1 (typedef #schwarma) `as` #schwarma :*

132+ parameter @2 (typedef #person) `as` #person)

139:}

133:}

140

134

141And finally drop the types.

135And finally drop the types.

@@ -151,20 +145,16 @@ Now let's run it.

151>>> :{

145>>> :{

152let

146let

153 session = do

147 session = do

154− result1 <- runQueryParams querySchwarma (Only Chicken)

148+ result1 <- runQueryParams query tparams

155− Just (Only schwarma) <- firstRow result1

149+ Just row <- firstRow result1

156− liftBase $ print (schwarma :: Schwarma)

150+ liftBase . print $ row == tparams

157− result2 <- runQueryParams queryPerson (Only (Person (Just "Faisal") (Just 24)))

158− Just (Only person) <- firstRow result2

159− liftBase $ print (person :: Person)

160in

151in

161 void . withConnection "host=localhost port=5432 dbname=exampledb" $

152 void . withConnection "host=localhost port=5432 dbname=exampledb" $

162 define setup

153 define setup

163 & pqThen session

154 & pqThen session

164 & pqThen (define teardown)

155 & pqThen (define teardown)

165:}

156:}

166−Chicken

157+True

167−Person {name = Just "Faisal", age = Just 24}

168-}

158-}

169

159

170{-# LANGUAGE

160{-# LANGUAGE

@@ -294,13 +284,11 @@ instance ToArray x ('NotNull ('PGfixarray n ty))

294 toParam

284 toParam

295 = K . Encoding.array (baseOid @x @('NotNull ('PGfixarray n ty)))

285 = K . Encoding.array (baseOid @x @('NotNull ('PGfixarray n ty)))

296 . unK . toArray @x @('NotNull ('PGfixarray n ty))

286 . unK . toArray @x @('NotNull ('PGfixarray n ty))

297−instance ToParam x pg => ToParam (Enumerated x) pg where

298− toParam = toParam . getEnumerated

299instance

287instance

300 ( IsEnumType x

288 ( IsEnumType x

301 , HasDatatypeInfo x

289 , HasDatatypeInfo x

302 , LabelsFrom x ~ labels

290 , LabelsFrom x ~ labels

303− ) => ToParam x ('PGenum labels) where

291+ ) => ToParam (Enumerated x) ('PGenum labels) where

304 toParam =

292 toParam =

305 let

293 let

306 gshowConstructor :: NP ConstructorInfo xss -> SOP I xss -> String

294 gshowConstructor :: NP ConstructorInfo xss -> SOP I xss -> String

@@ -314,14 +302,13 @@ instance

314 . Strict.Text.pack

302 . Strict.Text.pack

315 . gshowConstructor (constructorInfo (datatypeInfo (Proxy @x)))

303 . gshowConstructor (constructorInfo (datatypeInfo (Proxy @x)))

316 . from

304 . from

317−instance ToParam x pg => ToParam (Composite x) pg where

305+ . getEnumerated

318− toParam = toParam . getComposite

319instance

306instance

320 ( SListI fields

307 ( SListI fields

321 , IsRecord x xs

308 , IsRecord x xs

322 , AllZip ToField xs fields

309 , AllZip ToField xs fields

323 , All HasAliasedOid fields

310 , All HasAliasedOid fields

324− ) => ToParam x ('PGcomposite fields) where

311+ ) => ToParam (Composite x) ('PGcomposite fields) where

325 toParam =

312 toParam =

326 let

313 let

327

314

@@ -359,7 +346,7 @@ instance

359 hcfoldMap (Proxy @HasAliasedOid) each fields

346 hcfoldMap (Proxy @HasAliasedOid) each fields

360

347

361 in

348 in

362− composite . encoders . toRecord

349+ composite . encoders . toRecord . getComposite

363

350

364class HasAliasedOid (field :: (Symbol, NullityType)) where

351class HasAliasedOid (field :: (Symbol, NullityType)) where

365 aliasedOid :: Word32

352 aliasedOid :: Word32

@@ -474,13 +461,11 @@ instance FromArray ('NotNull ('PGvararray ty)) y

474instance FromArray ('NotNull ('PGfixarray n ty)) y

461instance FromArray ('NotNull ('PGfixarray n ty)) y

475 => FromValue ('PGfixarray n ty) y where

462 => FromValue ('PGfixarray n ty) y where

476 fromValue = Decoding.array (fromArray @('NotNull ('PGfixarray n ty)) @y)

463 fromValue = Decoding.array (fromArray @('NotNull ('PGfixarray n ty)) @y)

477−instance FromValue pg y => FromValue pg (Enumerated y) where

478− fromValue = Enumerated <$> fromValue @pg

479instance

464instance

480 ( IsEnumType y

465 ( IsEnumType y

481 , HasDatatypeInfo y

466 , HasDatatypeInfo y

482 , LabelsFrom y ~ labels

467 , LabelsFrom y ~ labels

483− ) => FromValue ('PGenum labels) y where

468+ ) => FromValue ('PGenum labels) (Enumerated y) where

484 fromValue =

469 fromValue =

485 let

470 let

486 greadConstructor

471 greadConstructor

@@ -494,15 +479,14 @@ instance

494 then Just (SOP (Z Nil))

479 then Just (SOP (Z Nil))

495 else SOP . S . unSOP <$> greadConstructor constructors name

480 else SOP . S . unSOP <$> greadConstructor constructors name

496 in

481 in

482+ fmap Enumerated

497− Decoding.enum

483+ . Decoding.enum

498 $ fmap to

484 $ fmap to

499 . greadConstructor (constructorInfo (datatypeInfo (Proxy @y)))

485 . greadConstructor (constructorInfo (datatypeInfo (Proxy @y)))

500 . Strict.Text.unpack

486 . Strict.Text.unpack

501−instance FromValue pg y => FromValue pg (Composite y) where

502− fromValue = Composite <$> fromValue @pg

503instance

487instance

504 ( FromRow fields y

488 ( FromRow fields y

505− ) => FromValue ('PGcomposite fields) y where

489+ ) => FromValue ('PGcomposite fields) (Composite y) where

506 fromValue =

490 fromValue =

507 let

491 let

508 -- <number of fields: 4 bytes>

492 -- <number of fields: 4 bytes>

@@ -524,7 +508,7 @@ instance

524 then return (K Nothing)

508 then return (K Nothing)

525 else K . Just <$> bytesOfSize len

509 else K . Just <$> bytesOfSize len

526 in

510 in

527− Decoding.fn (fromRow @fields <=< composite)

511+ fmap Composite (Decoding.fn (fromRow @fields <=< composite))

528

512

529-- | A `FromField` constraint lifts the `FromValue` parser

513-- | A `FromField` constraint lifts the `FromValue` parser

530-- to a decoding of a @(Symbol, NullityType)@ to a `Type`,

514-- to a decoding of a @(Symbol, NullityType)@ to a `Type`,

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+1−1

@@ -928,7 +928,7 @@ instance (KnownSymbol alias, PGTyped schema ty)

928-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic

929-- >>> instance SOP.Generic Schwarma

930-- >>> instance SOP.HasDatatypeInfo Schwarma

931−-- >>> printSQL (dropType #schwarma :: Definition '["schwarma" ::: 'Typedef (EnumFrom Schwarma)] '[])

931+-- >>> printSQL (dropType #schwarma :: Definition '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))] '[])

932-- DROP TYPE "schwarma";

933dropType

934 :: Has tydef schema ('Typedef ty)

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+5

@@ -115,6 +115,7 @@ module Squeal.PostgreSQL.Schema

115 , Composite (..)

116 , Enumerated (..)

117 , NullPG

118+ , TuplePG

118 , LabelsFrom

119 , LabelsFrom

119 , RowPG

120 , RowPG

120 , RowOf

121 , RowOf

@@ -723,9 +724,13 @@ type instance PG (Composite hask) = 'PGcomposite (RowOf (RecordCodeOf hask))

723type instance PG (Enumerated hask) = 'PGenum (LabelsFrom hask)

724type instance PG (Enumerated hask) = 'PGenum (LabelsFrom hask)

724

725

725newtype Json hask = Json {getJson :: hask}

726newtype Json hask = Json {getJson :: hask}

727+ deriving (Eq, Ord, Show, Read, GHC.Generic)

726newtype Jsonb hask = Jsonb {getJsonb :: hask}

728newtype Jsonb hask = Jsonb {getJsonb :: hask}

729+ deriving (Eq, Ord, Show, Read, GHC.Generic)

727newtype Composite record = Composite {getComposite :: record}

730newtype Composite record = Composite {getComposite :: record}

731+ deriving (Eq, Ord, Show, Read, GHC.Generic)

728newtype Enumerated enum = Enumerated {getEnumerated :: enum}

732newtype Enumerated enum = Enumerated {getEnumerated :: enum}

733+ deriving (Eq, Ord, Show, Read, GHC.Generic)

729

734

730-- | The `LabelsFrom` type family calculates the constructors of a

735-- | The `LabelsFrom` type family calculates the constructors of a

731-- Haskell enum type.

736-- Haskell enum type.