6e3d875 · squeal · git.iko.soy

git.iko.soy/squeal

fixes and tests

commit6e3d875962a55f8438311a04cb5cbcc2860d0415 authorEitan Chatav <eitan.chatav@gmail.com> dateThu 21 Jun 2018, 15:41 (8 years ago) parent6e5f5f5

3 files changed+66−50

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+38−26 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+10−6 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+18−18

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+38−26

@@ -7,10 +7,15 @@ Stability: experimental

88Binary encoding and decoding between Haskell and PostgreSQL types.

10−Instances are governed by the `Generic` and `HasDatatype` typeclasses.

10+Instances are governed by the `Generic` and `HasDatatypeInfo` typeclasses.

11+

12+Let's see an example of a round trip, inserting a row containing an value of enumerated type

13+and a value of composite type by encoding Haskell values into Postgres binary format

14+and then decoding them back into Haskell.

1115

1216>>> import Control.Monad

1317>>> import Control.Monad.Base

18+>>> import Data.Text

1419

1520>>> import Squeal.PostgreSQL

1621>>> import qualified Squeal.PostgreSQL as SQL

@@ -19,46 +24,52 @@ Instances are governed by the `Generic` and `HasDatatype` typeclasses.

1924>>> instance Generic Schwarma

2025>>> instance HasDatatypeInfo Schwarma

2126

22−>>> let q = values_ (label @"Beef" `As` #fromOnly :* Nil) :: Query '[] '[] '["fromOnly" ::: 'NotNull (EnumWith Schwarma)]

23−

24−>>> :{

25−void . withConnection "host=localhost port=5432 dbname=exampledb" $ do

26− result <- runQuery q

27− Just (Only schwarma) <- firstRow result

28− liftBase $ print (schwarma :: Schwarma)

29−:}

30−Beef

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

28+>>> instance Generic Person

29+>>> instance HasDatatypeInfo Person

3130

3231>>> :set -XTypeFamilies -XTypeInType -XUndecidableInstances

3332>>> :{

3433type family Schema :: SchemaType where

3534 Schema =

3635 '[ "schwarma" ::: 'Typedef (EnumWith Schwarma)

37− , "tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull (EnumWith Schwarma)])

36+ , "person" ::: 'Typedef (CompositeWith Person)

37+ , "tab" ::: 'Table ('[] :=>

38+ '[ "col1" ::: 'NoDef :=> 'NotNull (EnumWith Schwarma)

39+ , "col2" ::: 'NoDef :=> 'NotNull (CompositeWith Person)

40+ ])

3841 ]

3942:}

4043

4144>>> :{

4245let

46+ setup :: Definition '[] Schema

4347 setup =

4448 createTypeEnumWith @Schwarma #schwarma >>>

45− createTable #tab (#schwarma `As` #col :* Nil) Nil

46− :: Definition '[] Schema

47− teardown =

48− dropTable #tab >>>

49− dropType #schwarma

50− :: Definition Schema '[]

49+ createTypeCompositeWith @Person #person >>>

50+ createTable #tab (

51+ notNullable #schwarma `As` #col1 :*

52+ notNullable #person `As` #col2 :* Nil

53+ ) Nil

54+ teardown :: Definition Schema '[]

55+ teardown = dropTable #tab >>> dropType #schwarma >>> dropType #person

56+ manip :: Manipulation Schema '[ 'NotNull (EnumWith Schwarma), 'NotNull (CompositeWith Person)] '[]

5157 manip =

52− insertRow_ #tab (Set (param @1) `As` #col :* Nil)

53− :: Manipulation Schema '[ 'NotNull (EnumWith Schwarma)] '[]

54− qry =

55− select (#col `As` #fromOnly :* Nil) (SQL.from (table #tab))

56− :: Query Schema '[] '["fromOnly" ::: 'NotNull (EnumWith Schwarma)]

58+ insertRow_ #tab (

59+ Set (parameter @1 #schwarma) `As` #col1 :*

60+ Set (parameter @2 #person) `As` #col2 :* Nil)

61+ qry1 :: Query Schema '[] '["fromOnly" ::: 'NotNull (EnumWith Schwarma)]

62+ qry1 = select (#col1 `As` #fromOnly :* Nil) (SQL.from (table #tab))

63+ qry2 :: Query Schema '[] '["fromOnly" ::: 'NotNull (CompositeWith Person)]

64+ qry2 = select (#col2 `As` #fromOnly :* Nil) (SQL.from (table #tab))

5765 session = do

58− manipulateParams manip (Only Chicken)

59− result <- runQuery qry

60− Just (Only schwarma) <- firstRow result

61− liftBase $ print (schwarma :: Schwarma)

66+ manipulateParams manip (Chicken, Person (Just "Faisal") (Just 24))

67+ result1 <- runQuery qry1

68+ Just (Only schwarma) <- firstRow result1

69+ liftBase $ print (schwarma :: Schwarma)

70+ result2 <- runQuery qry2

71+ Just (Only person) <- firstRow result2

72+ liftBase $ print (person :: Person)

6273:}

6374

6475>>> :{

@@ -68,6 +79,7 @@ void . withConnection "host=localhost port=5432 dbname=exampledb" $

6879 & pqThen (define teardown)

6980:}

7081Chicken

82+Person {name = Just "Faisal", age = Just 24}

7183-}

7284

7385{-# LANGUAGE

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

@@ -807,7 +807,7 @@ dropView v = UnsafeDefinition $ "DROP VIEW" <+> renderAlias v <> ";"

807807-- | Enumerated types are created using the `createTypeEnum` command, for example

808808--

809809-- >>> renderDefinition $ createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy" :* Nil)

810−-- "CREATE TYPE \"mood\" AS ('sad', 'ok', 'happy');"

810+-- "CREATE TYPE \"mood\" AS ENUM ('sad', 'ok', 'happy');"

811811createTypeEnum

812812 :: (KnownSymbol enum, SOP.All KnownSymbol labels)

813813 => Alias enum

@@ -816,7 +816,7 @@ createTypeEnum

816816 -- ^ labels of the enumerated type

817817 -> Definition schema (Create enum ('Typedef ('PGenum labels)) schema)

818818createTypeEnum enum labels = UnsafeDefinition $

819− "CREATE" <+> "TYPE" <+> renderAlias enum <+> "AS" <+>

819+ "CREATE" <+> "TYPE" <+> renderAlias enum <+> "AS" <+> "ENUM" <+>

820820 parenthesized (commaSeparated (renderLabels labels)) <> ";"

821821

822822-- | Enumerated types can also be generated from a Haskell type, for example

@@ -825,7 +825,7 @@ createTypeEnum enum labels = UnsafeDefinition $

825825-- >>> instance SOP.Generic Schwarma

826826-- >>> instance SOP.HasDatatypeInfo Schwarma

827827-- >>> renderDefinition $ createTypeEnumWith @Schwarma #schwarma

828−-- "CREATE TYPE \"schwarma\" AS ('Beef', 'Lamb', 'Chicken');"

828+-- "CREATE TYPE \"schwarma\" AS ENUM ('Beef', 'Lamb', 'Chicken');"

829829createTypeEnumWith

830830 :: forall hask enum schema.

831831 ( SOP.Generic hask

@@ -842,7 +842,7 @@ createTypeEnumWith enum = createTypeEnum enum

842842-- specified by a list of attribute names and data types.

843843--

844844-- >>> renderDefinition $ createTypeComposite #complex (float8 `As` #real :* float8 `As` #imaginary :* Nil)

845−-- "CREATE TYPE \"complex\" AS (float8 AS \"real\", float8 AS \"imaginary\");"

845+-- "CREATE TYPE \"complex\" AS (\"real\" float8, \"imaginary\" float8);"

846846createTypeComposite

847847 :: (KnownSymbol ty, SOP.SListI fields)

848848 => Alias ty

@@ -852,7 +852,11 @@ createTypeComposite

852852 -> Definition schema (Create ty ('Typedef ('PGcomposite fields)) schema)

853853createTypeComposite ty fields = UnsafeDefinition $

854854 "CREATE" <+> "TYPE" <+> renderAlias ty <+> "AS" <+> parenthesized

855− (renderCommaSeparated (renderAliasedAs renderTypeExpression) fields) <> ";"

855+ (renderCommaSeparated renderField fields) <> ";"

856+ where

857+ renderField :: Aliased (TypeExpression schema) x -> ByteString

858+ renderField (typ `As` field) =

859+ renderAlias field <+> renderTypeExpression typ

856860

857861-- | Composite types can also be generated from a Haskell type, for example

858862--

@@ -860,7 +864,7 @@ createTypeComposite ty fields = UnsafeDefinition $

860864-- >>> instance SOP.Generic Complex

861865-- >>> instance SOP.HasDatatypeInfo Complex

862866-- >>> renderDefinition $ createTypeCompositeWith @Complex #complex

863−-- "CREATE TYPE \"complex\" AS (float8 AS \"real\", float8 AS \"imaginary\");"

867+-- "CREATE TYPE \"complex\" AS (\"real\" float8, \"imaginary\" float8);"

864868createTypeCompositeWith

865869 :: forall hask ty schema.

866870 ( ZipAliased (FieldNamesWith hask) (FieldTypesWith hask)

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+18−18

@@ -352,7 +352,7 @@ matchNull y f x = ifThenElse (isNull x) y

352352-- `nullIf` gives @NULL@.

353353--

354354-- >>> :set -XTypeApplications -XDataKinds

355−-- >>> renderExpression @_ @_ @'[_] $ fromNull false (nullIf false (param @1))

355+-- >>> renderExpression @'[] @_ @_ @'[_] $ fromNull false (nullIf false (param @1))

356356-- "COALESCE(NULL IF (FALSE, ($1 :: bool)), FALSE)"

357357nullIf

358358 :: Expression schema relations grouping params ('NotNull ty)

@@ -380,7 +380,7 @@ instance (KnownSymbol label, label `In` labels) => IsPGlabel label

380380-- (also called a composite value) using values for its member fields.

381381--

382382-- >>> type Complex = PGcomposite '["real" ::: 'PGfloat8, "imaginary" ::: 'PGfloat8]

383−-- >>> let i = row (0 `As` #real :* 1 `As` #imaginary :* Nil) :: Expression '[] 'Ungrouped '[] ('NotNull Complex)

383+-- >>> let i = row (0 `As` #real :* 1 `As` #imaginary :* Nil) :: Expression '[] '[] 'Ungrouped '[] ('NotNull Complex)

384384-- >>> renderExpression i

385385-- "ROW(0, 1)"

386386row

@@ -407,7 +407,7 @@ instance Monoid

407407 mempty = array []

408408 mappend = (<>)

409409

410−-- | >>> renderExpression @_ @_ @'[_] $ greatest currentTimestamp [param @1]

410+-- | >>> renderExpression @'[] @_ @_ @'[_] $ greatest currentTimestamp [param @1]

411411-- "GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))"

412412greatest

413413 :: Expression schema relations grouping params (nullty)

@@ -870,7 +870,7 @@ unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat

870870

871871-- | >>> :{

872872-- let

873−-- expression :: Expression '[tab ::: '["col" ::: 'Null 'PGnumeric]] ('Grouped bys) params ('Null 'PGnumeric)

873+-- expression :: Expression schema '[tab ::: '["col" ::: 'Null 'PGnumeric]] ('Grouped bys) params ('Null 'PGnumeric)

874874-- expression = sum_ #col

875875-- in renderExpression expression

876876-- :}

@@ -884,7 +884,7 @@ sum_ = unsafeAggregate "sum"

884884

885885-- | >>> :{

886886-- let

887−-- expression :: Expression '[tab ::: '["col" ::: nullity 'PGnumeric]] ('Grouped bys) params (nullity 'PGnumeric)

887+-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGnumeric]] ('Grouped bys) params (nullity 'PGnumeric)

888888-- expression = sumDistinct #col

889889-- in renderExpression expression

890890-- :}

@@ -915,7 +915,7 @@ instance PGAvg 'PGinterval 'PGinterval

915915

916916-- | >>> :{

917917-- let

918−-- expression :: Expression '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)

918+-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)

919919-- expression = bitAnd #col

920920-- in renderExpression expression

921921-- :}

@@ -929,7 +929,7 @@ bitAnd = unsafeAggregate "bit_and"

929929

930930-- | >>> :{

931931-- let

932−-- expression :: Expression '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)

932+-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)

933933-- expression = bitOr #col

934934-- in renderExpression expression

935935-- :}

@@ -943,7 +943,7 @@ bitOr = unsafeAggregate "bit_or"

943943

944944-- | >>> :{

945945-- let

946−-- expression :: Expression '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)

946+-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)

947947-- expression = bitAndDistinct #col

948948-- in renderExpression expression

949949-- :}

@@ -957,7 +957,7 @@ bitAndDistinct = unsafeAggregateDistinct "bit_and"

957957

958958-- | >>> :{

959959-- let

960−-- expression :: Expression '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)

960+-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)

961961-- expression = bitOrDistinct #col

962962-- in renderExpression expression

963963-- :}

@@ -971,7 +971,7 @@ bitOrDistinct = unsafeAggregateDistinct "bit_or"

971971

972972-- | >>> :{

973973-- let

974−-- expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

974+-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

975975-- expression = boolAnd #col

976976-- in renderExpression expression

977977-- :}

@@ -984,7 +984,7 @@ boolAnd = unsafeAggregate "bool_and"

984984

985985-- | >>> :{

986986-- let

987−-- expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

987+-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

988988-- expression = boolOr #col

989989-- in renderExpression expression

990990-- :}

@@ -997,7 +997,7 @@ boolOr = unsafeAggregate "bool_or"

997997

998998-- | >>> :{

999999-- let

1000−-- expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

1000+-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

10011001-- expression = boolAndDistinct #col

10021002-- in renderExpression expression

10031003-- :}

@@ -1010,7 +1010,7 @@ boolAndDistinct = unsafeAggregateDistinct "bool_and"

10101010

10111011-- | >>> :{

10121012-- let

1013−-- expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

1013+-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

10141014-- expression = boolOrDistinct #col

10151015-- in renderExpression expression

10161016-- :}

@@ -1031,7 +1031,7 @@ countStar = UnsafeExpression $ "count(*)"

10311031

10321032-- | >>> :{

10331033-- let

1034−-- expression :: Expression '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8)

1034+-- expression :: Expression schema '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8)

10351035-- expression = count #col

10361036-- in renderExpression expression

10371037-- :}

@@ -1044,7 +1044,7 @@ count = unsafeAggregate "count"

10441044

10451045-- | >>> :{

10461046-- let

1047−-- expression :: Expression '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8)

1047+-- expression :: Expression schema '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8)

10481048-- expression = countDistinct #col

10491049-- in renderExpression expression

10501050-- :}

@@ -1059,7 +1059,7 @@ countDistinct = unsafeAggregateDistinct "count"

10591059--

10601060-- >>> :{

10611061-- let

1062−-- expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

1062+-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

10631063-- expression = every #col

10641064-- in renderExpression expression

10651065-- :}

@@ -1074,7 +1074,7 @@ every = unsafeAggregate "every"

10741074--

10751075-- >>> :{

10761076-- let

1077−-- expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

1077+-- expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)

10781078-- expression = everyDistinct #col

10791079-- in renderExpression expression

10801080-- :}

@@ -1204,7 +1204,7 @@ fixarray p ty = UnsafeTypeExpression $

12041204 renderTypeExpression ty <> "[" <> renderNat p <> "]"

12051205

12061206-- | `pgtype` is a demoted version of a `PGType`

1207−class PGTyped schema (ty :: PGType) where pgtype :: TypeExpression schema ty

1207+class PGTyped schema (ty :: PGType) where pgtype :: TypeExpression schema ty

12081208instance PGTyped schema 'PGbool where pgtype = bool

12091209instance PGTyped schema 'PGint2 where pgtype = int2

12101210instance PGTyped schema 'PGint4 where pgtype = int4