git.iko.soy/squeal
on d319f10 help sign in
ddc9847
swap
0 ahead, 5 behind
12 files changed+208−289
since splitsnapshots
unifiedsplit
squeal-postgresql/squeal-postgresql.cabal+1 squeal-postgresql/src/Squeal/PostgreSQL.hs+1 squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+40−130 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+26 squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hs+1−1 squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hs+105 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs+4−101 squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+1 squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+10−3 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+17−41 squeal-postgresql/test/Property.hs+2−2 squeal-postgresql/test/Spec.hs−11
squeal-postgresql/squeal-postgresql.cabal+1
@@ -28,6 +28,7 @@ library
2828 Squeal.PostgreSQL.Definition.Function
2929 Squeal.PostgreSQL.Definition.Index
3030 Squeal.PostgreSQL.Definition.Table
31+ Squeal.PostgreSQL.Definition.Table.Column
3132 Squeal.PostgreSQL.Definition.Table.Constraint
3233 Squeal.PostgreSQL.Definition.Type
3334 Squeal.PostgreSQL.Definition.Schema
squeal-postgresql/src/Squeal/PostgreSQL.hs+1
@@ -199,6 +199,7 @@ import Squeal.PostgreSQL.Definition.Function as X
199199import Squeal.PostgreSQL.Definition.Index as X
200200import Squeal.PostgreSQL.Definition.Schema as X
201201import Squeal.PostgreSQL.Definition.Table as X
202+import Squeal.PostgreSQL.Definition.Table.Column as X
202203import Squeal.PostgreSQL.Definition.Table.Constraint as X
203204import Squeal.PostgreSQL.Definition.Type as X
204205import Squeal.PostgreSQL.Definition.View as X
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+40−130
@@ -216,9 +216,8 @@ module Squeal.PostgreSQL.Binary
216216 -- * Only
217217 , Only (..)
218218 -- * Oid
219− , OidOf (..)
220− , OidOfParam (..)
221− , OidOfField (..)
219+ , HasOid (..)
220+ , HasAliasedOid (..)
222221 ) where
223222
224223import BinaryParser
@@ -232,7 +231,6 @@ import Data.Time
232231import Data.UUID.Types
233232import Data.Vector (Vector)
234233import Data.Word
235−import Foreign.C.Types (CUInt(CUInt))
236234import Generics.SOP
237235import Generics.SOP.Record
238236import GHC.TypeLits
@@ -246,7 +244,6 @@ import qualified Data.Text.Lazy as Lazy (Text)
246244import qualified Data.Text as Strict (Text)
247245import qualified Data.Text as Strict.Text
248246import qualified Data.Vector as Vector
249−import qualified Database.PostgreSQL.LibPQ as LibPQ
250247import qualified GHC.Generics as GHC
251248import qualified PostgreSQL.Binary.Decoding as Decoding
252249import qualified PostgreSQL.Binary.Encoding as Encoding
@@ -312,24 +309,24 @@ instance Aeson.ToJSON x => ToParam (Json x) 'PGjson where
312309instance Aeson.ToJSON x => ToParam (Jsonb x) 'PGjsonb where
313310 toParam = K . Encoding.jsonb_bytes
314311 . Lazy.ByteString.toStrict . Aeson.encode . getJsonb
315−instance (ToNullityParam x ty, ty ~ nullity pg, OidOf pg)
312+instance (ToNullityParam x ty, ty ~ nullity pg, HasOid pg)
316313 => ToParam (VarArray [x]) ('PGvararray ty) where
317314 toParam = K
318315 . Encoding.array_foldable
319316 (getOid (oidOf @pg)) (unK . toNullityParam @x @ty)
320317 . getVarArray
321−instance (ToParam x pg, OidOf pg)
318+instance (ToParam x pg, HasOid pg)
322319 => ToParam (VarArray (Vector x)) ('PGvararray ('NotNull pg)) where
323320 toParam = K
324321 . Encoding.array_vector (getOid (oidOf @pg)) (unK . toParam @x @pg)
325322 . getVarArray
326−instance (ToParam x pg, OidOf pg)
323+instance (ToParam x pg, HasOid pg)
327324 => ToParam (VarArray (Vector (Maybe x))) ('PGvararray ('Null pg)) where
328325 toParam = K
329326 . Encoding.nullableArray_vector
330327 (getOid (oidOf @pg)) (unK . toParam @x @pg)
331328 . getVarArray
332−instance (ToFixArray x dims ty, ty ~ nullity pg, OidOf pg)
329+instance (ToFixArray x dims ty, ty ~ nullity pg, HasOid pg)
333330 => ToParam (FixArray x) ('PGfixarray dims ty) where
334331 toParam = K . Encoding.array (getOid (oidOf @pg))
335332 . unK . unK . toFixArray @x @dims @ty . getFixArray
@@ -356,7 +353,7 @@ instance
356353 ( SListI fields
357354 , IsRecord x xs
358355 , AllZip ToField xs fields
359− , All OidOfField fields
356+ , All HasAliasedOid fields
360357 ) => ToParam (Composite x) ('PGcomposite fields) where
361358 toParam =
362359 let
@@ -364,7 +361,7 @@ instance
364361 encoders = htrans (Proxy @ToField) toField
365362
366363 composite
367− :: All OidOfField row
364+ :: All HasAliasedOid row
368365 => NP (K (Maybe Encoding.Encoding)) row
369366 -> K Encoding.Encoding ('PGcomposite row)
370367 composite fields = K $
@@ -381,18 +378,18 @@ instance
381378 int32BE (fromIntegral (lengthSList (Proxy @xs))) <>
382379 let
383380 each
384− :: OidOfField field
381+ :: HasAliasedOid field
385382 => K (Maybe Encoding.Encoding) field
386383 -> Encoding.Encoding
387384 each (K field :: K (Maybe Encoding.Encoding) field) =
388− word32BE (getOid (oidOfField @field))
385+ word32BE (getOid (aliasedOid @field))
389386 <> case field of
390387 Nothing -> int64BE (-1)
391388 Just value ->
392389 int32BE (fromIntegral (builderLength value))
393390 <> value
394391 in
395− hcfoldMap (Proxy @OidOfField) each fields
392+ hcfoldMap (Proxy @HasAliasedOid) each fields
396393
397394 in
398395 composite . encoders . toRecord . getComposite
@@ -401,119 +398,35 @@ instance
401398--
402399-- >>> :set -XTypeApplications
403400-- >>> oidOf @'PGbool
404−-- Oid 16
405−class OidOf (ty :: PGType) where oidOf :: LibPQ.Oid
406−instance OidOf 'PGbool where oidOf = LibPQ.Oid 16
407−instance OidOf ('PGfixarray ns (null 'PGbool)) where oidOf = LibPQ.Oid 1000
408−instance OidOf ('PGvararray (null 'PGbool)) where oidOf = LibPQ.Oid 1000
409−instance OidOf 'PGint2 where oidOf = LibPQ.Oid 21
410−instance OidOf ('PGfixarray ns (null 'PGint2)) where oidOf = LibPQ.Oid 1005
411−instance OidOf ('PGvararray (null 'PGint2)) where oidOf = LibPQ.Oid 1005
412−instance OidOf 'PGint4 where oidOf = LibPQ.Oid 23
413−instance OidOf ('PGfixarray ns (null 'PGint4)) where oidOf = LibPQ.Oid 1007
414−instance OidOf ('PGvararray (null 'PGint4)) where oidOf = LibPQ.Oid 1007
415−instance OidOf 'PGint8 where oidOf = LibPQ.Oid 20
416−instance OidOf ('PGfixarray ns (null 'PGint8)) where oidOf = LibPQ.Oid 1016
417−instance OidOf ('PGvararray (null 'PGint8)) where oidOf = LibPQ.Oid 1016
418−instance OidOf 'PGnumeric where oidOf = LibPQ.Oid 1700
419−instance OidOf ('PGfixarray ns (null 'PGnumeric)) where oidOf = LibPQ.Oid 1231
420−instance OidOf ('PGvararray (null 'PGnumeric)) where oidOf = LibPQ.Oid 1231
421−instance OidOf 'PGfloat4 where oidOf = LibPQ.Oid 700
422−instance OidOf ('PGfixarray ns (null 'PGfloat4)) where oidOf = LibPQ.Oid 1021
423−instance OidOf ('PGvararray (null 'PGfloat4)) where oidOf = LibPQ.Oid 1021
424−instance OidOf 'PGfloat8 where oidOf = LibPQ.Oid 701
425−instance OidOf ('PGfixarray ns (null 'PGfloat8)) where oidOf = LibPQ.Oid 1022
426−instance OidOf ('PGvararray (null 'PGfloat8)) where oidOf = LibPQ.Oid 1022
427−instance OidOf 'PGmoney where oidOf = LibPQ.Oid 790
428−instance OidOf ('PGfixarray ns (null 'PGmoney)) where oidOf = LibPQ.Oid 791
429−instance OidOf ('PGvararray (null 'PGmoney)) where oidOf = LibPQ.Oid 791
430−instance OidOf ('PGchar n) where oidOf = LibPQ.Oid 18
431−instance OidOf ('PGfixarray ns (null ('PGchar n))) where oidOf = LibPQ.Oid 1002
432−instance OidOf ('PGvararray (null ('PGchar n))) where oidOf = LibPQ.Oid 1002
433−instance OidOf ('PGvarchar n) where oidOf = LibPQ.Oid 1043
434−instance OidOf ('PGfixarray ns (null ('PGvarchar n))) where oidOf = LibPQ.Oid 1015
435−instance OidOf ('PGvararray (null ('PGvarchar n))) where oidOf = LibPQ.Oid 1015
436−instance OidOf 'PGtext where oidOf = LibPQ.Oid 25
437−instance OidOf ('PGfixarray ns (null 'PGtext)) where oidOf = LibPQ.Oid 1009
438−instance OidOf ('PGvararray (null 'PGtext)) where oidOf = LibPQ.Oid 1009
439−instance OidOf 'PGbytea where oidOf = LibPQ.Oid 17
440−instance OidOf ('PGfixarray ns (null 'PGbytea)) where oidOf = LibPQ.Oid 1001
441−instance OidOf ('PGvararray (null 'PGbytea)) where oidOf = LibPQ.Oid 1001
442−instance OidOf 'PGtimestamp where oidOf = LibPQ.Oid 1114
443−instance OidOf ('PGfixarray ns (null 'PGtimestamp)) where oidOf = LibPQ.Oid 1115
444−instance OidOf ('PGvararray (null 'PGtimestamp)) where oidOf = LibPQ.Oid 1115
445−instance OidOf 'PGtimestamptz where oidOf = LibPQ.Oid 1184
446−instance OidOf ('PGfixarray ns (null 'PGtimestamptz)) where oidOf = LibPQ.Oid 1185
447−instance OidOf ('PGvararray (null 'PGtimestamptz)) where oidOf = LibPQ.Oid 1185
448−instance OidOf 'PGdate where oidOf = LibPQ.Oid 1082
449−instance OidOf ('PGfixarray ns (null 'PGdate)) where oidOf = LibPQ.Oid 1182
450−instance OidOf ('PGvararray (null 'PGdate)) where oidOf = LibPQ.Oid 1182
451−instance OidOf 'PGtime where oidOf = LibPQ.Oid 1083
452−instance OidOf ('PGfixarray ns (null 'PGtime)) where oidOf = LibPQ.Oid 1183
453−instance OidOf ('PGvararray (null 'PGtime)) where oidOf = LibPQ.Oid 1183
454−instance OidOf 'PGtimetz where oidOf = LibPQ.Oid 1266
455−instance OidOf ('PGfixarray ns (null 'PGtimetz)) where oidOf = LibPQ.Oid 1270
456−instance OidOf ('PGvararray (null 'PGtimetz)) where oidOf = LibPQ.Oid 1270
457−instance OidOf 'PGinterval where oidOf = LibPQ.Oid 1186
458−instance OidOf ('PGfixarray ns (null 'PGinterval)) where oidOf = LibPQ.Oid 1187
459−instance OidOf ('PGvararray (null 'PGinterval)) where oidOf = LibPQ.Oid 1187
460−instance OidOf 'PGuuid where oidOf = LibPQ.Oid 2950
461−instance OidOf ('PGfixarray ns (null 'PGuuid)) where oidOf = LibPQ.Oid 2951
462−instance OidOf ('PGvararray (null 'PGuuid)) where oidOf = LibPQ.Oid 2951
463−instance OidOf 'PGinet where oidOf = LibPQ.Oid 869
464−instance OidOf ('PGfixarray ns (null 'PGinet)) where oidOf = LibPQ.Oid 1041
465−instance OidOf ('PGvararray (null 'PGinet)) where oidOf = LibPQ.Oid 1041
466−instance OidOf 'PGjson where oidOf = LibPQ.Oid 114
467−instance OidOf ('PGfixarray ns (null 'PGjson)) where oidOf = LibPQ.Oid 199
468−instance OidOf ('PGvararray (null 'PGjson)) where oidOf = LibPQ.Oid 199
469−instance OidOf 'PGjsonb where oidOf = LibPQ.Oid 3802
470−instance OidOf ('PGfixarray ns (null 'PGjsonb)) where oidOf = LibPQ.Oid 3807
471−instance OidOf ('PGvararray (null 'PGjsonb)) where oidOf = LibPQ.Oid 3807
472−instance OidOf 'PGtsvector where oidOf = LibPQ.Oid 3614
473−instance OidOf ('PGfixarray ns (null 'PGtsvector)) where oidOf = LibPQ.Oid 3643
474−instance OidOf ('PGvararray (null 'PGtsvector)) where oidOf = LibPQ.Oid 3643
475−instance OidOf 'PGtsquery where oidOf = LibPQ.Oid 3615
476−instance OidOf ('PGfixarray ns (null 'PGtsquery)) where oidOf = LibPQ.Oid 3645
477−instance OidOf ('PGvararray (null 'PGtsquery)) where oidOf = LibPQ.Oid 3645
478−instance OidOf 'PGoid where oidOf = LibPQ.Oid 26
479−instance OidOf ('PGfixarray ns (null 'PGoid)) where oidOf = LibPQ.Oid 1028
480−instance OidOf ('PGvararray (null 'PGoid)) where oidOf = LibPQ.Oid 1028
481−instance OidOf ('PGrange 'PGint4) where oidOf = LibPQ.Oid 3904
482−instance OidOf ('PGfixarray ns (null ('PGrange 'PGint4))) where oidOf = LibPQ.Oid 3905
483−instance OidOf ('PGvararray (null ('PGrange 'PGint4))) where oidOf = LibPQ.Oid 3905
484−instance OidOf ('PGrange 'PGint8) where oidOf = LibPQ.Oid 3926
485−instance OidOf ('PGfixarray ns (null ('PGrange 'PGint8))) where oidOf = LibPQ.Oid 3927
486−instance OidOf ('PGvararray (null ('PGrange 'PGint8))) where oidOf = LibPQ.Oid 3927
487−instance OidOf ('PGrange 'PGnumeric) where oidOf = LibPQ.Oid 3906
488−instance OidOf ('PGfixarray ns (null ('PGrange 'PGnumeric))) where oidOf = LibPQ.Oid 3907
489−instance OidOf ('PGvararray (null ('PGrange 'PGnumeric))) where oidOf = LibPQ.Oid 3907
490−instance OidOf ('PGrange 'PGtimestamp) where oidOf = LibPQ.Oid 3908
491−instance OidOf ('PGfixarray ns (null ('PGrange 'PGtimestamp))) where oidOf = LibPQ.Oid 3909
492−instance OidOf ('PGvararray (null ('PGrange 'PGtimestamp))) where oidOf = LibPQ.Oid 3909
493−instance OidOf ('PGrange 'PGtimestamptz) where oidOf = LibPQ.Oid 3910
494−instance OidOf ('PGfixarray ns (null ('PGrange 'PGtimestamptz))) where oidOf = LibPQ.Oid 3911
495−instance OidOf ('PGvararray (null ('PGrange 'PGtimestamptz))) where oidOf = LibPQ.Oid 3911
496−instance OidOf ('PGrange 'PGdate) where oidOf = LibPQ.Oid 3912
497−instance OidOf ('PGfixarray ns (null ('PGrange 'PGdate))) where oidOf = LibPQ.Oid 3913
498−instance OidOf ('PGvararray (null ('PGrange 'PGdate))) where oidOf = LibPQ.Oid 3913
499−instance {-# OVERLAPPABLE #-} OidOf ('PGrange ty) where oidOf = LibPQ.invalidOid
500−instance {-# OVERLAPPABLE #-} OidOf ('PGfixarray ns (null ('PGrange ty))) where oidOf = LibPQ.invalidOid
501−instance {-# OVERLAPPABLE #-} OidOf ('PGvararray (null ('PGrange ty))) where oidOf = LibPQ.invalidOid
502−instance {-# OVERLAPPABLE #-} OidOf ('PGcomposite row) where oidOf = LibPQ.invalidOid
503−instance {-# OVERLAPPABLE #-} OidOf ('PGfixarray ns (null ('PGcomposite row))) where oidOf = LibPQ.invalidOid
504−instance {-# OVERLAPPABLE #-} OidOf ('PGvararray (null ('PGcomposite row))) where oidOf = LibPQ.invalidOid
505−instance {-# OVERLAPPABLE #-} OidOf ('PGenum labels) where oidOf = LibPQ.invalidOid
506−instance {-# OVERLAPPABLE #-} OidOf ('PGfixarray ns (null ('PGenum labels))) where oidOf = LibPQ.invalidOid
507−instance {-# OVERLAPPABLE #-} OidOf ('PGvararray (null ('PGenum labels))) where oidOf = LibPQ.invalidOid
508−
509−class OidOfParam (ty :: NullityType) where oidOfParam :: Oid
510−instance OidOf ty => OidOfParam (null ty) where oidOfParam = oidOf @ty
511−
512−-- | Lifts a `OidOf` constraint to a field.
513−class OidOfField (field :: (Symbol, NullityType)) where
514− oidOfField :: Oid
515−instance OidOf ty => OidOfField (alias ::: nullity ty) where
516− oidOfField = oidOf @ty
401+-- Oid {getOid = 16}
402+class HasOid (ty :: PGType) where oidOf :: Oid
403+instance HasOid 'PGbool where oidOf = Oid 16
404+instance HasOid 'PGint2 where oidOf = Oid 21
405+instance HasOid 'PGint4 where oidOf = Oid 23
406+instance HasOid 'PGint8 where oidOf = Oid 20
407+instance HasOid 'PGnumeric where oidOf = Oid 1700
408+instance HasOid 'PGfloat4 where oidOf = Oid 700
409+instance HasOid 'PGfloat8 where oidOf = Oid 701
410+instance HasOid ('PGchar n) where oidOf = Oid 18
411+instance HasOid ('PGvarchar n) where oidOf = Oid 1043
412+instance HasOid 'PGtext where oidOf = Oid 25
413+instance HasOid 'PGbytea where oidOf = Oid 17
414+instance HasOid 'PGtimestamp where oidOf = Oid 1114
415+instance HasOid 'PGtimestamptz where oidOf = Oid 1184
416+instance HasOid 'PGdate where oidOf = Oid 1082
417+instance HasOid 'PGtime where oidOf = Oid 1083
418+instance HasOid 'PGtimetz where oidOf = Oid 1266
419+instance HasOid 'PGinterval where oidOf = Oid 1186
420+instance HasOid 'PGuuid where oidOf = Oid 2950
421+instance HasOid 'PGinet where oidOf = Oid 869
422+instance HasOid 'PGjson where oidOf = Oid 114
423+instance HasOid 'PGjsonb where oidOf = Oid 3802
424+
425+-- | Lifts a `HasOid` constraint to a field.
426+class HasAliasedOid (field :: (Symbol, NullityType)) where
427+ aliasedOid :: Oid
428+instance HasOid ty => HasAliasedOid (alias ::: nullity ty) where
429+ aliasedOid = oidOf @ty
517430
518431-- | A `ToNullityParam` constraint gives an encoding of a Haskell `Type` into
519432-- into the binary format of a PostgreSQL `NullityType`.
@@ -843,6 +756,3 @@ replicateMN
843756 => m x -> m (NP I xs)
844757replicateMN mx = hsequence' $
845758 hcpure (Proxy :: Proxy ((~) x)) (Comp (I <$> mx))
846−
847−getOid :: LibPQ.Oid -> Word32
848−getOid (LibPQ.Oid (CUInt oid)) = oid
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+26
@@ -35,6 +35,8 @@ module Squeal.PostgreSQL.Definition
3535 Definition (..)
3636 , (>>>)
3737 , manipDefinition
38+ , PGNullityTyped (..)
39+ , hask
3840 ) where
3941
4042import Control.Category
@@ -45,7 +47,10 @@ import Prelude hiding ((.), id)
4547
4648import qualified GHC.Generics as GHC
4749
50+import Squeal.PostgreSQL.Definition.Table.Column
51+import Squeal.PostgreSQL.Expression.Type
4852import Squeal.PostgreSQL.Manipulation
53+import Squeal.PostgreSQL.PG
4954import Squeal.PostgreSQL.Render
5055import Squeal.PostgreSQL.Schema
5156
@@ -80,3 +85,24 @@ manipDefinition
8085 -- ^ no input or output
8186 -> Definition schemas schemas
8287manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
88+
89+-- | Like @PGTyped@ but also accounts for nullity.
90+class PGNullityTyped schemas (nullty :: NullityType) where
91+ pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty)
92+
93+instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where
94+ pgNullityType = nullable (pgtype @_ @('Null ty))
95+
96+instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where
97+ pgNullityType = notNullable (pgtype @_ @('NotNull ty))
98+
99+-- | Allow you to specify pg column types in relation to haskell types.
100+-- >>> printSQL $ hask @(Maybe String)
101+-- text NULL
102+--
103+-- >>> printSQL $ hask @Double
104+-- float8 NOT NULL
105+hask
106+ :: forall h schemas. PGNullityTyped schemas (NullPG h)
107+ => ColumnTypeExpression schemas ('NoDef :=> NullPG h)
108+hask = pgNullityType
squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hs+1−1
@@ -62,9 +62,9 @@ import qualified GHC.Generics as GHC
6262
6363import Squeal.PostgreSQL.Alias
6464import Squeal.PostgreSQL.Definition
65+import Squeal.PostgreSQL.Definition.Table.Column
6566import Squeal.PostgreSQL.Definition.Table.Constraint
6667import Squeal.PostgreSQL.Expression
67−import Squeal.PostgreSQL.Expression.Type
6868import Squeal.PostgreSQL.List
6969import Squeal.PostgreSQL.Render
7070import Squeal.PostgreSQL.Schema
squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hsnew file+105
@@ -0,0 +1,105 @@
1+{-|
2+Module: Squeal.PostgreSQL.Definition.Table.Column
3+Description: Column type expressions
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Column type expressions.
9+-}
10+
11+{-# LANGUAGE
12+ AllowAmbiguousTypes
13+ , ConstraintKinds
14+ , DeriveAnyClass
15+ , DeriveGeneric
16+ , DerivingStrategies
17+ , FlexibleContexts
18+ , FlexibleInstances
19+ , GADTs
20+ , LambdaCase
21+ , MultiParamTypeClasses
22+ , OverloadedLabels
23+ , OverloadedStrings
24+ , RankNTypes
25+ , ScopedTypeVariables
26+ , TypeApplications
27+ , TypeInType
28+ , TypeOperators
29+ , UndecidableSuperClasses
30+#-}
31+
32+module Squeal.PostgreSQL.Definition.Table.Column
33+ ( ColumnTypeExpression (..)
34+ , nullable
35+ , notNullable
36+ , default_
37+ , serial2
38+ , smallserial
39+ , serial4
40+ , serial
41+ , serial8
42+ , bigserial
43+ ) where
44+
45+import Control.DeepSeq
46+import Data.ByteString
47+
48+import qualified GHC.Generics as GHC
49+
50+import Squeal.PostgreSQL.Alias
51+import Squeal.PostgreSQL.Expression
52+import Squeal.PostgreSQL.Expression.Type
53+import Squeal.PostgreSQL.Render
54+import Squeal.PostgreSQL.Schema
55+
56+-- $setup
57+-- >>> import Squeal.PostgreSQL
58+
59+-- | `ColumnTypeExpression`s are used in `createTable` commands.
60+newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
61+ = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
62+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
63+instance RenderSQL (ColumnTypeExpression schemas ty) where
64+ renderSQL = renderColumnTypeExpression
65+
66+-- | used in `createTable` commands as a column constraint to note that
67+-- @NULL@ may be present in a column
68+nullable
69+ :: TypeExpression schemas (nullity ty)
70+ -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
71+nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
72+
73+-- | used in `createTable` commands as a column constraint to ensure
74+-- @NULL@ is not present in a column
75+notNullable
76+ :: TypeExpression schemas (nullity ty)
77+ -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
78+notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
79+
80+-- | used in `createTable` commands as a column constraint to give a default
81+default_
82+ :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty
83+ -> ColumnTypeExpression schemas ('NoDef :=> ty)
84+ -> ColumnTypeExpression schemas ('Def :=> ty)
85+default_ x ty = UnsafeColumnTypeExpression $
86+ renderSQL ty <+> "DEFAULT" <+> renderExpression x
87+
88+-- | not a true type, but merely a notational convenience for creating
89+-- unique identifier columns with type `PGint2`
90+serial2, smallserial
91+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
92+serial2 = UnsafeColumnTypeExpression "serial2"
93+smallserial = UnsafeColumnTypeExpression "smallserial"
94+-- | not a true type, but merely a notational convenience for creating
95+-- unique identifier columns with type `PGint4`
96+serial4, serial
97+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
98+serial4 = UnsafeColumnTypeExpression "serial4"
99+serial = UnsafeColumnTypeExpression "serial"
100+-- | not a true type, but merely a notational convenience for creating
101+-- unique identifier columns with type `PGint8`
102+serial8, bigserial
103+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
104+serial8 = UnsafeColumnTypeExpression "serial8"
105+bigserial = UnsafeColumnTypeExpression "bigserial"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs+4−101
@@ -23,16 +23,15 @@ Type expressions.
2323 , ScopedTypeVariables
2424 , TypeApplications
2525 , TypeOperators
26− , UndecidableInstances
2726#-}
2827
2928module Squeal.PostgreSQL.Expression.Type
30− ( -- * type casting
31− cast
29+ ( TypeExpression (..)
30+ , cast
3231 , astype
3332 , inferredtype
34− -- * type expressions
35− , TypeExpression (..)
33+ , PGTyped (..)
34+ , FieldTyped (..)
3635 , typedef
3736 , typetable
3837 , typeview
@@ -79,22 +78,6 @@ module Squeal.PostgreSQL.Expression.Type
7978 , tsrange
8079 , tstzrange
8180 , daterange
82− -- * column type definitions
83− , ColumnTypeExpression (..)
84− , nullable
85− , notNullable
86− , default_
87− , serial2
88− , smallserial
89− , serial4
90− , serial
91− , serial8
92− , bigserial
93− , hask
94− -- * type inference
95− , PGTyped (..)
96− , PGNullityTyped (..)
97− , FieldTyped (..)
9881 ) where
9982
10083import Control.DeepSeq
@@ -108,7 +91,6 @@ import qualified Generics.SOP as SOP
10891
10992import Squeal.PostgreSQL.Alias
11093import Squeal.PostgreSQL.Expression
111−import Squeal.PostgreSQL.PG
11294import Squeal.PostgreSQL.Render
11395import Squeal.PostgreSQL.Schema
11496
@@ -150,7 +132,6 @@ astype = cast
150132inferredtype
151133 :: PGTyped schemas ty
152134 => Expression outer common grp schemas params from ty
153− -- ^ value
154135 -> Expression outer common grp schemas params from ty
155136inferredtype = astype pgtype
156137
@@ -170,7 +151,6 @@ instance RenderSQL (TypeExpression schemas ty) where
170151typedef
171152 :: (Has sch schemas schema, Has td schema ('Typedef ty))
172153 => QualifiedAlias sch td
173− -- ^ type alias
174154 -> TypeExpression schemas (null ty)
175155typedef = UnsafeTypeExpression . renderSQL
176156
@@ -179,7 +159,6 @@ typedef = UnsafeTypeExpression . renderSQL
179159typetable
180160 :: (Has sch schemas schema, Has tab schema ('Table table))
181161 => QualifiedAlias sch tab
182− -- ^ table alias
183162 -> TypeExpression schemas (null ('PGcomposite (TableToRow table)))
184163typetable = UnsafeTypeExpression . renderSQL
185164
@@ -188,7 +167,6 @@ typetable = UnsafeTypeExpression . renderSQL
188167typeview
189168 :: (Has sch schemas schema, Has vw schema ('View view))
190169 => QualifiedAlias sch vw
191− -- ^ view alias
192170 -> TypeExpression schemas (null ('PGcomposite view))
193171typeview = UnsafeTypeExpression . renderSQL
194172
@@ -362,12 +340,6 @@ instance (SOP.All KnownNat dims, PGTyped schemas ty)
362340instance PGTyped schemas (null 'PGtsvector) where pgtype = tsvector
363341instance PGTyped schemas (null 'PGtsquery) where pgtype = tsquery
364342instance PGTyped schemas (null 'PGoid) where pgtype = oid
365−instance PGTyped schemas (null ('PGrange 'PGint4)) where pgtype = int4range
366−instance PGTyped schemas (null ('PGrange 'PGint8)) where pgtype = int8range
367−instance PGTyped schemas (null ('PGrange 'PGnumeric)) where pgtype = numrange
368−instance PGTyped schemas (null ('PGrange 'PGtimestamp)) where pgtype = tsrange
369−instance PGTyped schemas (null ('PGrange 'PGtimestamptz)) where pgtype = tstzrange
370−instance PGTyped schemas (null ('PGrange 'PGdate)) where pgtype = daterange
371343
372344-- | Lift `PGTyped` to a field
373345class FieldTyped schemas ty where
@@ -375,72 +347,3 @@ class FieldTyped schemas ty where
375347instance (KnownSymbol alias, PGTyped schemas ty)
376348 => FieldTyped schemas (alias ::: ty) where
377349 fieldtype = pgtype `As` Alias
378−
379−-- | `ColumnTypeExpression`s are used in `createTable` commands.
380−newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
381− = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
382− deriving (GHC.Generic,Show,Eq,Ord,NFData)
383−instance RenderSQL (ColumnTypeExpression schemas ty) where
384− renderSQL = renderColumnTypeExpression
385−
386−-- | used in `createTable` commands as a column constraint to note that
387−-- @NULL@ may be present in a column
388−nullable
389− :: TypeExpression schemas (nullity ty)
390− -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
391−nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
392−
393−-- | used in `createTable` commands as a column constraint to ensure
394−-- @NULL@ is not present in a column
395−notNullable
396− :: TypeExpression schemas (nullity ty)
397− -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
398−notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
399−
400−-- | used in `createTable` commands as a column constraint to give a default
401−default_
402− :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty
403− -> ColumnTypeExpression schemas ('NoDef :=> ty)
404− -> ColumnTypeExpression schemas ('Def :=> ty)
405−default_ x ty = UnsafeColumnTypeExpression $
406− renderSQL ty <+> "DEFAULT" <+> renderExpression x
407−
408−-- | not a true type, but merely a notational convenience for creating
409−-- unique identifier columns with type `PGint2`
410−serial2, smallserial
411− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
412−serial2 = UnsafeColumnTypeExpression "serial2"
413−smallserial = UnsafeColumnTypeExpression "smallserial"
414−-- | not a true type, but merely a notational convenience for creating
415−-- unique identifier columns with type `PGint4`
416−serial4, serial
417− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
418−serial4 = UnsafeColumnTypeExpression "serial4"
419−serial = UnsafeColumnTypeExpression "serial"
420−-- | not a true type, but merely a notational convenience for creating
421−-- unique identifier columns with type `PGint8`
422−serial8, bigserial
423− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
424−serial8 = UnsafeColumnTypeExpression "serial8"
425−bigserial = UnsafeColumnTypeExpression "bigserial"
426−
427−-- | Like @PGTyped@ but also accounts for nullity.
428−class PGNullityTyped schemas (nullty :: NullityType) where
429− pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty)
430−
431−instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where
432− pgNullityType = nullable (pgtype @_ @('Null ty))
433−
434−instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where
435− pgNullityType = notNullable (pgtype @_ @('NotNull ty))
436−
437−-- | Allow you to specify pg column types in relation to haskell types.
438−-- >>> printSQL $ hask @(Maybe String)
439−-- text NULL
440−--
441−-- >>> printSQL $ hask @Double
442−-- float8 NOT NULL
443−hask
444− :: forall hask schemas. PGNullityTyped schemas (NullPG hask)
445− => ColumnTypeExpression schemas ('NoDef :=> NullPG hask)
446−hask = pgNullityType
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+1
@@ -168,6 +168,7 @@ import Squeal.PostgreSQL.Alias
168168import Squeal.PostgreSQL.Binary
169169import Squeal.PostgreSQL.Definition
170170import Squeal.PostgreSQL.Definition.Table
171+import Squeal.PostgreSQL.Definition.Table.Column
171172import Squeal.PostgreSQL.Definition.Table.Constraint
172173import Squeal.PostgreSQL.Expression.Comparison
173174import Squeal.PostgreSQL.Expression.Parameter
squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+10−3
@@ -47,7 +47,7 @@ module Squeal.PostgreSQL.PG
4747 , Enumerated (..)
4848 , VarArray (..)
4949 , FixArray (..)
50− , LibPQ.Oid (..)
50+ , Oid (..)
5151 -- * Type families
5252 , LabelsPG
5353 , DimPG
@@ -66,6 +66,7 @@ import Data.Int (Int16, Int32, Int64)
6666import Data.Scientific (Scientific)
6767import Data.Time (Day, DiffTime, LocalTime, TimeOfDay, TimeZone, UTCTime)
6868import Data.Vector (Vector)
69+import Data.Word (Word32)
6970import Data.UUID.Types (UUID)
7071import GHC.TypeLits
7172import Network.IP.Addr (NetAddr, IP)
@@ -74,7 +75,6 @@ import qualified Data.ByteString.Lazy as Lazy (ByteString)
7475import qualified Data.ByteString as Strict (ByteString)
7576import qualified Data.Text.Lazy as Lazy (Text)
7677import qualified Data.Text as Strict (Text)
77−import qualified Database.PostgreSQL.LibPQ as LibPQ
7878import qualified GHC.Generics as GHC
7979import qualified Generics.SOP as SOP
8080import qualified Generics.SOP.Record as SOP
@@ -108,7 +108,7 @@ type instance PG Int32 = 'PGint4
108108-- | `PGint8`
109109type instance PG Int64 = 'PGint8
110110-- | `PGint2`
111−type instance PG LibPQ.Oid = 'PGoid
111+type instance PG Oid = 'PGoid
112112-- | `PGnumeric`
113113type instance PG Scientific = 'PGnumeric
114114-- | `PGfloat4`
@@ -386,3 +386,10 @@ newtype FixArray arr = FixArray {getFixArray :: arr}
386386 deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)
387387-- | `PGfixarray` @(@`DimPG` @hask) (@`FixPG` @hask)@
388388type instance PG (FixArray hask) = 'PGfixarray (DimPG hask) (FixPG hask)
389+
390+{- | Object identifiers (`Oid`s) are used internally by PostgreSQL
391+as primary keys for various system tables.
392+-}
393+newtype Oid = Oid { getOid :: Word32 }
394+ deriving stock (Eq, Ord, Show, Read, GHC.Generic)
395+ deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)
squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+17−41
@@ -78,7 +78,6 @@ import UnliftIO (MonadUnliftIO (..), bracket, catch, handle, try)
7878import Data.ByteString (ByteString)
7979import Data.Foldable
8080import Data.Function ((&))
81−import Data.Functor ((<&>))
8281import Data.Kind
8382import Data.Text (pack, Text)
8483import Data.Traversable
@@ -87,7 +86,6 @@ import PostgreSQL.Binary.Encoding (encodingBytes)
8786
8887import qualified Control.Monad.Fail as Fail
8988import qualified Database.PostgreSQL.LibPQ as LibPQ
90−import qualified PostgreSQL.Binary.Encoding as Encoding
9189
9290import Squeal.PostgreSQL.Binary
9391import Squeal.PostgreSQL.Definition
@@ -317,13 +315,13 @@ a default instance.
317315-}
318316class Monad pq => MonadPQ schemas pq | pq -> schemas where
319317 manipulateParams
320− :: (ToParams x params, All OidOfParam params)
318+ :: ToParams x params
321319 => Manipulation '[] schemas params ys
322320 -- ^ `insertInto`, `update` or `deleteFrom`
323321 -> x -> pq (K LibPQ.Result ys)
324322 default manipulateParams
325323 :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)
326− => (ToParams x params, All OidOfParam params)
324+ => ToParams x params
327325 => Manipulation '[] schemas params ys
328326 -- ^ `insertInto`, `update` or `deleteFrom`
329327 -> x -> pq (K LibPQ.Result ys)
@@ -331,7 +329,7 @@ class Monad pq => MonadPQ schemas pq | pq -> schemas where
331329 manipulateParams manipulation params
332330
333331 manipulateParams_
334− :: (ToParams x params, All OidOfParam params)
332+ :: ToParams x params
335333 => Manipulation '[] schemas params '[]
336334 -- ^ `insertInto`, `update` or `deleteFrom`
337335 -> x -> pq ()
@@ -344,7 +342,7 @@ class Monad pq => MonadPQ schemas pq | pq -> schemas where
344342 manipulate_ = void . manipulate
345343
346344 runQueryParams
347− :: (ToParams x params, All OidOfParam params)
345+ :: ToParams x params
348346 => Query '[] '[] schemas params ys
349347 -- ^ `select` and friends
350348 -> x -> pq (K LibPQ.Result ys)
@@ -357,19 +355,19 @@ class Monad pq => MonadPQ schemas pq | pq -> schemas where
357355 runQuery q = runQueryParams q ()
358356
359357 traversePrepared
360− :: (ToParams x params, Traversable list, All OidOfParam params)
358+ :: (ToParams x params, Traversable list)
361359 => Manipulation '[] schemas params ys
362360 -- ^ `insertInto`, `update`, or `deleteFrom`, and friends
363361 -> list x -> pq (list (K LibPQ.Result ys))
364362 default traversePrepared
365363 :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)
366− => (ToParams x params, Traversable list, All OidOfParam params)
364+ => (ToParams x params, Traversable list)
367365 => Manipulation '[] schemas params ys -> list x -> pq (list (K LibPQ.Result ys))
368366 traversePrepared manipulation params = lift $
369367 traversePrepared manipulation params
370368
371369 forPrepared
372− :: (ToParams x params, Traversable list, All OidOfParam params)
370+ :: (ToParams x params, Traversable list)
373371 => list x
374372 -> Manipulation '[] schemas params ys
375373 -- ^ `insertInto`, `update` or `deleteFrom`
@@ -377,13 +375,13 @@ class Monad pq => MonadPQ schemas pq | pq -> schemas where
377375 forPrepared = flip traversePrepared
378376
379377 traversePrepared_
380− :: (ToParams x params, Foldable list, All OidOfParam params)
378+ :: (ToParams x params, Foldable list)
381379 => Manipulation '[] schemas params '[]
382380 -- ^ `insertInto`, `update` or `deleteFrom`
383381 -> list x -> pq ()
384382 default traversePrepared_
385383 :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)
386− => (ToParams x params, Foldable list, All OidOfParam params)
384+ => (ToParams x params, Foldable list)
387385 => Manipulation '[] schemas params '[]
388386 -- ^ `insertInto`, `update` or `deleteFrom`
389387 -> list x -> pq ()
@@ -391,7 +389,7 @@ class Monad pq => MonadPQ schemas pq | pq -> schemas where
391389 traversePrepared_ manipulation params
392390
393391 forPrepared_
394− :: (ToParams x params, Foldable list, All OidOfParam params)
392+ :: (ToParams x params, Foldable list)
395393 => list x
396394 -> Manipulation '[] schemas params '[]
397395 -- ^ `insertInto`, `update` or `deleteFrom`
@@ -411,17 +409,9 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)
411409 (UnsafeManipulation q :: Manipulation '[] schemas ps ys) (params :: x) =
412410 PQ $ \ (K conn) -> do
413411 let
414− paramSet
415− :: forall param. OidOfParam param
416− => K (Maybe Encoding.Encoding) param
417− -> K (Maybe (LibPQ.Oid, ByteString, LibPQ.Format)) param
418− paramSet (K maybeEncoding) = K $
419− maybeEncoding <&> \encoding ->
420− (oidOfParam @param, encodingBytes encoding, LibPQ.Binary)
421− params'
422− = hcollapse
423− . hcmap (Proxy @OidOfParam) paramSet
424− $ toParams @x @ps params
412+ toParam' encoding =
413+ (LibPQ.invalidOid, encodingBytes encoding, LibPQ.Binary)
414+ params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))
425415 q' = q <> ";"
426416 resultMaybe <- liftIO $ LibPQ.execParams conn q' params' LibPQ.Binary
427417 case resultMaybe of
@@ -434,15 +424,8 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)
434424 traversePrepared
435425 (UnsafeManipulation q :: Manipulation '[] schemas xs ys) (list :: list x) =
436426 PQ $ \ (K conn) -> liftIO $ do
437− let
438− temp = "temporary_statement"
439− paramOid :: forall p. OidOfParam p => K LibPQ.Oid p
440− paramOid = K (oidOfParam @p)
441− paramOids :: NP (K LibPQ.Oid) xs
442− paramOids = hcpure (Proxy @OidOfParam) paramOid
443− paramOids' :: [LibPQ.Oid]
444− paramOids' = hcollapse paramOids
445− prepResultMaybe <- LibPQ.prepare conn temp q (Just paramOids')
427+ let temp = "temporary_statement"
428+ prepResultMaybe <- LibPQ.prepare conn temp q Nothing
446429 case prepResultMaybe of
447430 Nothing -> throw $ ResultException
448431 "traversePrepared: LibPQ.prepare returned no results"
@@ -468,15 +451,8 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)
468451 traversePrepared_
469452 (UnsafeManipulation q :: Manipulation '[] schemas xs '[]) (list :: list x) =
470453 PQ $ \ (K conn) -> liftIO $ do
471− let
472− temp = "temporary_statement"
473− paramOid :: forall p. OidOfParam p => K LibPQ.Oid p
474− paramOid = K (oidOfParam @p)
475− paramOids :: NP (K LibPQ.Oid) xs
476− paramOids = hcpure (Proxy @OidOfParam) paramOid
477− paramOids' :: [LibPQ.Oid]
478− paramOids' = hcollapse paramOids
479− prepResultMaybe <- LibPQ.prepare conn temp q (Just paramOids')
454+ let temp = "temporary_statement"
455+ prepResultMaybe <- LibPQ.prepare conn temp q Nothing
480456 case prepResultMaybe of
481457 Nothing -> throw $ ResultException
482458 "traversePrepared_: LibPQ.prepare returned no results"
squeal-postgresql/test/Property.hs+2−2
@@ -92,14 +92,14 @@ roundtrips = Group "roundtrips"
9292 -- genTimeWithZone = (,) <$> genTimeOfDay <*> genTimeZone
9393
9494roundtrip
95− :: (OidOf ty, ToParam x ty, FromValue ty x, Show x, Eq x)
95+ :: (ToParam x ty, FromValue ty x, Show x, Eq x)
9696 => TypeExpression schemas ('NotNull ty)
9797 -> Gen x
9898 -> (PropertyName, Property)
9999roundtrip = roundtripOn id
100100
101101roundtripOn
102− :: (OidOf ty, ToParam x ty, FromValue ty x, Show x, Eq x)
102+ :: (ToParam x ty, FromValue ty x, Show x, Eq x)
103103 => (x -> x)
104104 -> TypeExpression schemas ('NotNull ty)
105105 -> Gen x
squeal-postgresql/test/Spec.hs−11
@@ -123,14 +123,3 @@ spec = before_ setupDB . after_ dropDB $ do
123123 getRows =<< runQuery query
124124 (fromOnly <$> rangesOut :: [Range Int32]) `shouldBe`
125125 [ atLeast 3, 3 <=..< 5, Empty, whole ]
126−
127− describe "Parameters" $ do
128−
129− it "should run queries that don't reference all their parameters" $ do
130−
131− out <- withConnection connectionString $ do
132− let
133− query :: Query_ (Public '[]) (Char,Int32) (Only Int32)
134− query = values_ (param @2 `as` #fromOnly)
135− firstRow =<< runQueryParams query ('a', 3 :: Int32)
136− (fromOnly <$> out :: Maybe Int32) `shouldBe` Just 3