on dev help sign in
fix tests
commit372edd24dd8148290de6fc1cda2ddbfa3af769f2 authorEitan Chatav <eitan.chatav@gmail.com> dateFri 31 Aug 2018, 11:08 (8 years ago) parent0485612
3 files changed+43−54
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+37−53 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+1−1 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+5
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+37−53
@@ -24,9 +24,7 @@ to encode Haskell values into statement parameters.
2424
2525>>> :{
2626let
27− query :: Query '[]
28− '[ 'NotNull 'PGint2, 'NotNull 'PGtext]
29− '["col1" ::: 'NotNull 'PGint2, "col2" ::: 'NotNull 'PGtext]
27+ query :: Query '[] (TuplePG Row) (RowPG Row)
3028 query = values_ (param @1 `as` #col1 :* param @2 `as` #col2)
3129:}
3230
@@ -43,23 +41,9 @@ let
4341True
4442
4543In 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
4745Postgres array, enumerated and composite types.
4846
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−
6347>>> :{
6448data VRow = VRow
6549 { v1 :: Vector Int16
@@ -73,6 +57,12 @@ data VRow = VRow
7357>>> :set -XOverloadedLists
7458>>> let vparams = VRow [1,2] (Just 1,Nothing) ((1,2), (3,4), (5,6))
7559
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+
7666>>> :{
7767let
7868 roundtrip :: IO ()
@@ -90,7 +80,7 @@ They are equivalent to Haskell algebraic data types whose constructors are nulla
9080An example of an enum type might be the days of the week,
9181or a set of status values for a piece of data.
9282
93−>>> data Schwarma = Beef | Lamb | Chicken deriving (Show, GHC.Generic)
83+>>> data Schwarma = Beef | Lamb | Chicken deriving (Eq, Show, GHC.Generic)
9484>>> instance Generic Schwarma
9585>>> instance HasDatatypeInfo Schwarma
9686
@@ -99,20 +89,17 @@ it is essentially just a list of field names and their data types. They are almo
9989equivalent to Haskell record types. However, because of the potential presence of @NULL@
10090all the record fields must be `Maybe`s of basic types.
10191
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)
10393>>> instance Generic Person
10494>>> instance HasDatatypeInfo Person
10595
10696We can create the equivalent Postgres types directly from their Haskell types. First,
10797define a type instances for `PG`.
10898
109−>>> type instance PG Schwarma = PG (Composite Schwarma)
110−>>> type instance PG Person = PG (Enumerated Person)
111−
11299>>> :{
113100type Schema =
114− '[ "schwarma" ::: 'Typedef (PG Schwarma)
115− , "person" ::: 'Typedef (PG Person)
101+ '[ "schwarma" ::: 'Typedef (PG (Enumerated Schwarma))
102+ , "person" ::: 'Typedef (PG (Composite Person))
116103 ]
117104:}
118105
@@ -127,15 +114,22 @@ let
127114Then we can perform roundtrip queries;
128115
129116>>> :{
130−let
131− querySchwarma :: Query Schema (TuplePG (Only Schwarma)) (RowPG (Only Schwarma))
132− querySchwarma = values_ (parameter @1 (typedef #schwarma) `as` #fromOnly)
117+data TRow = TRow
118+ { schwarma :: Enumerated Schwarma
119+ , person :: Composite Person
120+ } deriving (Eq, GHC.Generic)
133121:}
134122
123+>>> instance Generic TRow
124+>>> instance HasDatatypeInfo TRow
125+>>> let tparams = TRow (Enumerated Chicken) (Composite (Person "Faisal" 24))
126+
135127>>> :{
136128let
137− queryPerson :: Query Schema (TuplePG (Only Person)) (RowPG (Only Person))
138− queryPerson = values_ (parameter @1 (typedef #person) `as` #fromOnly)
129+ query :: Query Schema (TuplePG TRow) (RowPG TRow)
130+ query = values_
131+ ( parameter @1 (typedef #schwarma) `as` #schwarma :*
132+ parameter @2 (typedef #person) `as` #person)
139133:}
140134
141135And finally drop the types.
@@ -151,20 +145,16 @@ Now let's run it.
151145>>> :{
152146let
153147 session = do
154− result1 <- runQueryParams querySchwarma (Only Chicken)
155− Just (Only schwarma) <- firstRow result1
156− liftBase $ print (schwarma :: Schwarma)
157− result2 <- runQueryParams queryPerson (Only (Person (Just "Faisal") (Just 24)))
158− Just (Only person) <- firstRow result2
159− liftBase $ print (person :: Person)
148+ result1 <- runQueryParams query tparams
149+ Just row <- firstRow result1
150+ liftBase . print $ row == tparams
160151in
161152 void . withConnection "host=localhost port=5432 dbname=exampledb" $
162153 define setup
163154 & pqThen session
164155 & pqThen (define teardown)
165156:}
166−Chicken
167−Person {name = Just "Faisal", age = Just 24}
157+True
168158-}
169159
170160{-# LANGUAGE
@@ -294,13 +284,11 @@ instance ToArray x ('NotNull ('PGfixarray n ty))
294284 toParam
295285 = K . Encoding.array (baseOid @x @('NotNull ('PGfixarray n ty)))
296286 . unK . toArray @x @('NotNull ('PGfixarray n ty))
297−instance ToParam x pg => ToParam (Enumerated x) pg where
298− toParam = toParam . getEnumerated
299287instance
300288 ( IsEnumType x
301289 , HasDatatypeInfo x
302290 , LabelsFrom x ~ labels
303− ) => ToParam x ('PGenum labels) where
291+ ) => ToParam (Enumerated x) ('PGenum labels) where
304292 toParam =
305293 let
306294 gshowConstructor :: NP ConstructorInfo xss -> SOP I xss -> String
@@ -314,14 +302,13 @@ instance
314302 . Strict.Text.pack
315303 . gshowConstructor (constructorInfo (datatypeInfo (Proxy @x)))
316304 . from
317−instance ToParam x pg => ToParam (Composite x) pg where
318− toParam = toParam . getComposite
305+ . getEnumerated
319306instance
320307 ( SListI fields
321308 , IsRecord x xs
322309 , AllZip ToField xs fields
323310 , All HasAliasedOid fields
324− ) => ToParam x ('PGcomposite fields) where
311+ ) => ToParam (Composite x) ('PGcomposite fields) where
325312 toParam =
326313 let
327314
@@ -359,7 +346,7 @@ instance
359346 hcfoldMap (Proxy @HasAliasedOid) each fields
360347
361348 in
362− composite . encoders . toRecord
349+ composite . encoders . toRecord . getComposite
363350
364351class HasAliasedOid (field :: (Symbol, NullityType)) where
365352 aliasedOid :: Word32
@@ -474,13 +461,11 @@ instance FromArray ('NotNull ('PGvararray ty)) y
474461instance FromArray ('NotNull ('PGfixarray n ty)) y
475462 => FromValue ('PGfixarray n ty) y where
476463 fromValue = Decoding.array (fromArray @('NotNull ('PGfixarray n ty)) @y)
477−instance FromValue pg y => FromValue pg (Enumerated y) where
478− fromValue = Enumerated <$> fromValue @pg
479464instance
480465 ( IsEnumType y
481466 , HasDatatypeInfo y
482467 , LabelsFrom y ~ labels
483− ) => FromValue ('PGenum labels) y where
468+ ) => FromValue ('PGenum labels) (Enumerated y) where
484469 fromValue =
485470 let
486471 greadConstructor
@@ -494,15 +479,14 @@ instance
494479 then Just (SOP (Z Nil))
495480 else SOP . S . unSOP <$> greadConstructor constructors name
496481 in
497− Decoding.enum
482+ fmap Enumerated
483+ . Decoding.enum
498484 $ fmap to
499485 . greadConstructor (constructorInfo (datatypeInfo (Proxy @y)))
500486 . Strict.Text.unpack
501−instance FromValue pg y => FromValue pg (Composite y) where
502− fromValue = Composite <$> fromValue @pg
503487instance
504488 ( FromRow fields y
505− ) => FromValue ('PGcomposite fields) y where
489+ ) => FromValue ('PGcomposite fields) (Composite y) where
506490 fromValue =
507491 let
508492 -- <number of fields: 4 bytes>
@@ -524,7 +508,7 @@ instance
524508 then return (K Nothing)
525509 else K . Just <$> bytesOfSize len
526510 in
527− Decoding.fn (fromRow @fields <=< composite)
511+ fmap Composite (Decoding.fn (fromRow @fields <=< composite))
528512
529513-- | A `FromField` constraint lifts the `FromValue` parser
530514-- 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)
928928-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
929929-- >>> instance SOP.Generic Schwarma
930930-- >>> instance SOP.HasDatatypeInfo Schwarma
931−-- >>> printSQL (dropType #schwarma :: Definition '["schwarma" ::: 'Typedef (EnumFrom Schwarma)] '[])
931+-- >>> printSQL (dropType #schwarma :: Definition '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))] '[])
932932-- DROP TYPE "schwarma";
933933dropType
934934 :: Has tydef schema ('Typedef ty)
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+5
@@ -115,6 +115,7 @@ module Squeal.PostgreSQL.Schema
115115 , Composite (..)
116116 , Enumerated (..)
117117 , NullPG
118+ , TuplePG
118119 , LabelsFrom
119120 , RowPG
120121 , RowOf
@@ -723,9 +724,13 @@ type instance PG (Composite hask) = 'PGcomposite (RowOf (RecordCodeOf hask))
723724type instance PG (Enumerated hask) = 'PGenum (LabelsFrom hask)
724725
725726newtype Json hask = Json {getJson :: hask}
727+ deriving (Eq, Ord, Show, Read, GHC.Generic)
726728newtype Jsonb hask = Jsonb {getJsonb :: hask}
729+ deriving (Eq, Ord, Show, Read, GHC.Generic)
727730newtype Composite record = Composite {getComposite :: record}
731+ deriving (Eq, Ord, Show, Read, GHC.Generic)
728732newtype Enumerated enum = Enumerated {getEnumerated :: enum}
733+ deriving (Eq, Ord, Show, Read, GHC.Generic)
729734
730735-- | The `LabelsFrom` type family calculates the constructors of a
731736-- Haskell enum type.