6e3d875 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

fixes and tests

6e3d875Eitan Chatav8 years ago

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

compare with dev

unifiedsplit

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

8Binary 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.

12>>> import Control.Monad

16>>> import Control.Monad

13>>> import Control.Monad.Base

17>>> import Control.Monad.Base

18+>>> import Data.Text

15>>> import Squeal.PostgreSQL

20>>> import Squeal.PostgreSQL

16>>> import qualified Squeal.PostgreSQL as SQL

21>>> import qualified Squeal.PostgreSQL as SQL

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

19>>> instance Generic Schwarma

24>>> instance Generic Schwarma

20>>> instance HasDatatypeInfo Schwarma

25>>> instance HasDatatypeInfo Schwarma

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

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

23−

28+>>> instance Generic Person

24−>>> :{

29+>>> instance HasDatatypeInfo Person

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

32>>> :set -XTypeFamilies -XTypeInType -XUndecidableInstances

31>>> :set -XTypeFamilies -XTypeInType -XUndecidableInstances

33>>> :{

32>>> :{

34type family Schema :: SchemaType where

33type family Schema :: SchemaType where

35 Schema =

34 Schema =

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

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

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

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

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

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

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

40+ ])

38 ]

41 ]

39:}

42:}

41>>> :{

44>>> :{

42let

45let

46+ setup :: Definition '[] Schema

43 setup =

47 setup =

44 createTypeEnumWith @Schwarma #schwarma >>>

48 createTypeEnumWith @Schwarma #schwarma >>>

49+ createTypeCompositeWith @Person #person >>>

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

50+ createTable #tab (

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

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

53+ ) Nil

46− :: Definition '[] Schema

54+ teardown :: Definition Schema '[]

47− teardown =

48− dropTable #tab >>>

49− dropType #schwarma

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

50− :: Definition Schema '[]

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

51 manip =

57 manip =

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

58+ insertRow_ #tab (

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

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

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

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

54− qry =

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

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

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

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

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

57 session = do

65 session = do

58− manipulateParams manip (Only Chicken)

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

59− result <- runQuery qry

67+ result1 <- runQuery qry1

60− Just (Only schwarma) <- firstRow result

68+ Just (Only schwarma) <- firstRow result1

61− liftBase $ print (schwarma :: Schwarma)

69+ liftBase $ print (schwarma :: Schwarma)

70+ result2 <- runQuery qry2

71+ Just (Only person) <- firstRow result2

72+ liftBase $ print (person :: Person)

62:}

73:}

64>>> :{

75>>> :{

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

68 & pqThen (define teardown)

79 & pqThen (define teardown)

69:}

80:}

70Chicken

81Chicken

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

71-}

83-}

73{-# LANGUAGE

85{-# LANGUAGE

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

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

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

808--

809-- >>> 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');"

811createTypeEnum

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

813 => Alias enum

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

816 -- ^ labels of the enumerated type

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

818createTypeEnum enum labels = UnsafeDefinition $

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

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

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

821

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

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

825-- >>> instance SOP.Generic Schwarma

826-- >>> instance SOP.HasDatatypeInfo Schwarma

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

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

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

829createTypeEnumWith

830 :: forall hask enum schema.

831 ( SOP.Generic hask

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

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

843--

844-- >>> 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);"

846createTypeComposite

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

848 => Alias ty

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

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

853createTypeComposite ty fields = UnsafeDefinition $

854 "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

856

860

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

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

858--

862--

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

860-- >>> instance SOP.Generic Complex

864-- >>> instance SOP.Generic Complex

861-- >>> instance SOP.HasDatatypeInfo Complex

865-- >>> instance SOP.HasDatatypeInfo Complex

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

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

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

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

864createTypeCompositeWith

868createTypeCompositeWith

865 :: forall hask ty schema.

869 :: forall hask ty schema.

866 ( ZipAliased (FieldNamesWith hask) (FieldTypesWith hask)

870 ( 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

352-- `nullIf` gives @NULL@.

353--

354-- >>> :set -XTypeApplications -XDataKinds

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

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

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

357nullIf

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

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

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

381--

382-- >>> 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)

384-- >>> renderExpression i

385-- "ROW(0, 1)"

386row

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

407 mempty = array []

408 mappend = (<>)

409

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

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

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

412greatest

413 :: Expression schema relations grouping params (nullty)

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

870

871-- | >>> :{

872-- 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)

874-- expression = sum_ #col

875-- in renderExpression expression

876-- :}

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

884

885-- | >>> :{

886-- 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)

888-- expression = sumDistinct #col

889-- in renderExpression expression

890-- :}

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

915

916-- | >>> :{

917-- 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)

919-- expression = bitAnd #col

920-- in renderExpression expression

921-- :}

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

929

930-- | >>> :{

931-- 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)

933-- expression = bitOr #col

934-- in renderExpression expression

935-- :}

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

943

944-- | >>> :{

945-- 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)

947-- expression = bitAndDistinct #col

948-- in renderExpression expression

949-- :}

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

957

958-- | >>> :{

959-- 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)

961-- expression = bitOrDistinct #col

962-- in renderExpression expression

963-- :}

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

971

972-- | >>> :{

973-- 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)

975-- expression = boolAnd #col

976-- in renderExpression expression

977-- :}

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

984

985-- | >>> :{

986-- 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)

988-- expression = boolOr #col

989-- in renderExpression expression

990-- :}

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

997

998-- | >>> :{

999-- 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)

1001-- expression = boolAndDistinct #col

1002-- in renderExpression expression

1003-- :}

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

1010

1011-- | >>> :{

1012-- 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)

1014-- expression = boolOrDistinct #col

1015-- in renderExpression expression

1016-- :}

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

1031

1032-- | >>> :{

1033-- 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)

1035-- expression = count #col

1036-- in renderExpression expression

1037-- :}

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

1044

1045-- | >>> :{

1046-- 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)

1048-- expression = countDistinct #col

1049-- in renderExpression expression

1050-- :}

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

1059--

1060-- >>> :{

1061-- 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)

1063-- expression = every #col

1064-- in renderExpression expression

1065-- :}

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

1074--

1075-- >>> :{

1076-- 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)

1078-- expression = everyDistinct #col

1079-- in renderExpression expression

1080-- :}

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

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

1205

1206-- | `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

1208instance PGTyped schema 'PGbool where pgtype = bool

1209instance PGTyped schema 'PGint2 where pgtype = int2

1210instance PGTyped schema 'PGint4 where pgtype = int4