f57b03b · squeal · git.iko.soy

git.iko.soy/squeal

Merge branch 'dev' into dev-index

commitf57b03b0bdb3b10aca85f50b5645f06de2bd4b0c authorEitan Chatav <eitan@EEM109LMBP-1.local> dateFri 30 Aug 2019, 14:56 (7 years ago) parent4149bd1 75661c1

6 files changed+70−61

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+35−34 squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs+6 squeal-postgresql/src/Squeal/PostgreSQL/List.hs+1−1 squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+26−13 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+1 squeal-postgresql/test/Doc.hs+1−13

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+35−34

@@ -274,11 +274,9 @@ class ToParam (x :: Type) (pg :: PGType) where

274274 toParam :: x -> K Encoding.Encoding pg

275275instance ToParam Bool 'PGbool where toParam = K . Encoding.bool

276276instance ToParam Int16 'PGint2 where toParam = K . Encoding.int2_int16

277−instance ToParam Word16 'PGint2 where toParam = K . Encoding.int2_word16

278277instance ToParam Int32 'PGint4 where toParam = K . Encoding.int4_int32

279−instance ToParam Word32 'PGint4 where toParam = K . Encoding.int4_word32

280278instance ToParam Int64 'PGint8 where toParam = K . Encoding.int8_int64

281−instance ToParam Word64 'PGint8 where toParam = K . Encoding.int8_word64

279+instance ToParam Oid 'PGoid where toParam = K . Encoding.int4_word32 . getOid

282280instance ToParam Float 'PGfloat4 where toParam = K . Encoding.float4

283281instance ToParam Double 'PGfloat8 where toParam = K . Encoding.float8

284282instance ToParam Scientific 'PGnumeric where toParam = K . Encoding.numeric

@@ -314,21 +312,23 @@ instance Aeson.ToJSON x => ToParam (Jsonb x) 'PGjsonb where

314312instance (ToNullityParam x ty, ty ~ nullity pg, HasOid pg)

315313 => ToParam (VarArray [x]) ('PGvararray ty) where

316314 toParam = K

317− . Encoding.array_foldable (oid @pg) (unK . toNullityParam @x @ty)

315+ . Encoding.array_foldable

316+ (getOid (oidOf @pg)) (unK . toNullityParam @x @ty)

318317 . getVarArray

319318instance (ToParam x pg, HasOid pg)

320319 => ToParam (VarArray (Vector x)) ('PGvararray ('NotNull pg)) where

321320 toParam = K

322− . Encoding.array_vector (oid @pg) (unK . toParam @x @pg)

321+ . Encoding.array_vector (getOid (oidOf @pg)) (unK . toParam @x @pg)

323322 . getVarArray

324323instance (ToParam x pg, HasOid pg)

325324 => ToParam (VarArray (Vector (Maybe x))) ('PGvararray ('Null pg)) where

326325 toParam = K

327− . Encoding.nullableArray_vector (oid @pg) (unK . toParam @x @pg)

326+ . Encoding.nullableArray_vector

327+ (getOid (oidOf @pg)) (unK . toParam @x @pg)

328328 . getVarArray

329329instance (ToFixArray x dims ty, ty ~ nullity pg, HasOid pg)

330330 => ToParam (FixArray x) ('PGfixarray dims ty) where

331− toParam = K . Encoding.array (oid @pg)

331+ toParam = K . Encoding.array (getOid (oidOf @pg))

332332 . unK . unK . toFixArray @x @dims @ty . getFixArray

333333instance

334334 ( IsEnumType x

@@ -382,7 +382,7 @@ instance

382382 => K (Maybe Encoding.Encoding) field

383383 -> Encoding.Encoding

384384 each (K field :: K (Maybe Encoding.Encoding) field) =

385− word32BE (aliasedOid @field)

385+ word32BE (getOid (aliasedOid @field))

386386 <> case field of

387387 Nothing -> int64BE (-1)

388388 Just value ->

@@ -397,36 +397,36 @@ instance

397397-- | The object identifier of a `PGType`.

398398--

399399-- >>> :set -XTypeApplications

400−-- >>> oid @'PGbool

401−-- 16

402−class HasOid (ty :: PGType) where oid :: Word32

403−instance HasOid 'PGbool where oid = 16

404−instance HasOid 'PGint2 where oid = 21

405−instance HasOid 'PGint4 where oid = 23

406−instance HasOid 'PGint8 where oid = 20

407−instance HasOid 'PGnumeric where oid = 1700

408−instance HasOid 'PGfloat4 where oid = 700

409−instance HasOid 'PGfloat8 where oid = 701

410−instance HasOid ('PGchar n) where oid = 18

411−instance HasOid ('PGvarchar n) where oid = 1043

412−instance HasOid 'PGtext where oid = 25

413−instance HasOid 'PGbytea where oid = 17

414−instance HasOid 'PGtimestamp where oid = 1114

415−instance HasOid 'PGtimestamptz where oid = 1184

416−instance HasOid 'PGdate where oid = 1082

417−instance HasOid 'PGtime where oid = 1083

418−instance HasOid 'PGtimetz where oid = 1266

419−instance HasOid 'PGinterval where oid = 1186

420−instance HasOid 'PGuuid where oid = 2950

421−instance HasOid 'PGinet where oid = 869

422−instance HasOid 'PGjson where oid = 114

423−instance HasOid 'PGjsonb where oid = 3802

400+-- >>> oidOf @'PGbool

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

424424

425425-- | Lifts a `HasOid` constraint to a field.

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

427− aliasedOid :: Word32

427+ aliasedOid :: Oid

428428instance HasOid ty => HasAliasedOid (alias ::: nullity ty) where

429− aliasedOid = oid @ty

429+ aliasedOid = oidOf @ty

430430

431431-- | A `ToNullityParam` constraint gives an encoding of a Haskell `Type` into

432432-- into the binary format of a PostgreSQL `NullityType`.

@@ -495,6 +495,7 @@ instance FromValue 'PGbool Bool where fromValue = Decoding.bool

495495instance FromValue 'PGint2 Int16 where fromValue = Decoding.int

496496instance FromValue 'PGint4 Int32 where fromValue = Decoding.int

497497instance FromValue 'PGint8 Int64 where fromValue = Decoding.int

498+instance FromValue 'PGoid Word32 where fromValue = Decoding.int

498499instance FromValue 'PGfloat4 Float where fromValue = Decoding.float4

499500instance FromValue 'PGfloat8 Double where fromValue = Decoding.float8

500501instance FromValue 'PGnumeric Scientific where fromValue = Decoding.numeric

squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs+6

@@ -70,6 +70,7 @@ module Squeal.PostgreSQL.Expression.Type

7070 , fixarray

7171 , tsvector

7272 , tsquery

73+ , oid

7374 , int4range

7475 , int8range

7576 , numrange

@@ -280,6 +281,10 @@ tsvector = UnsafeTypeExpression "tsvector"

280281-- | text search document

281282tsquery :: TypeExpression schemas (null 'PGtsquery)

282283tsquery = UnsafeTypeExpression "tsquery"

284+-- | Object identifiers (OIDs) are used internally by PostgreSQL

285+-- as primary keys for various system tables.

286+oid :: TypeExpression schemas (null 'PGoid)

287+oid = UnsafeTypeExpression "oid"

283288-- | Range of integer

284289int4range :: TypeExpression schemas (null ('PGrange 'PGint4))

285290int4range = UnsafeTypeExpression "int4range"

@@ -333,3 +338,4 @@ instance (SOP.All KnownNat dims, PGTyped schemas ty)

333338 pgtype = fixarray @dims (pgtype @schemas @ty)

334339instance PGTyped schemas (null 'PGtsvector) where pgtype = tsvector

335340instance PGTyped schemas (null 'PGtsquery) where pgtype = tsquery

341+instance PGTyped schemas (null 'PGoid) where pgtype = oid

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

@@ -128,7 +128,7 @@ type family Elem x xs where

128128-- | @In x xs@ is a constraint that proves that @x@ is in @xs@.

129129type family In x xs :: Constraint where

130130 In x xs = If (Elem x xs) (() :: Constraint)

131− (TypeError ('ShowType x ':<>: 'Text "is not in " ':<>: 'ShowType xs))

131+ (TypeError ('ShowType x ':<>: 'Text " is not in " ':<>: 'ShowType xs))

132132

133133{- | Calculate the `Length` of a type level list

134134

squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+26−13

@@ -10,10 +10,12 @@ Stability: experimental

1010-}

1111{-# LANGUAGE

1212 AllowAmbiguousTypes

13+ , DeriveAnyClass

1314 , DeriveFoldable

1415 , DeriveFunctor

1516 , DeriveGeneric

1617 , DeriveTraversable

18+ , DerivingStrategies

1719 , DefaultSignatures

1820 , FlexibleContexts

1921 , FlexibleInstances

@@ -45,6 +47,7 @@ module Squeal.PostgreSQL.PG

4547 , Enumerated (..)

4648 , VarArray (..)

4749 , FixArray (..)

50+ , Oid (..)

4851 -- * Type families

4952 , LabelsPG

5053 , DimPG

@@ -63,7 +66,7 @@ import Data.Int (Int16, Int32, Int64)

6366import Data.Scientific (Scientific)

6467import Data.Time (Day, DiffTime, LocalTime, TimeOfDay, TimeZone, UTCTime)

6568import Data.Vector (Vector)

66−import Data.Word (Word16, Word32, Word64)

69+import Data.Word (Word32)

6770import Data.UUID.Types (UUID)

6871import GHC.TypeLits

6972import Network.IP.Addr (NetAddr, IP)

@@ -105,11 +108,7 @@ type instance PG Int32 = 'PGint4

105108-- | `PGint8`

106109type instance PG Int64 = 'PGint8

107110-- | `PGint2`

108−type instance PG Word16 = 'PGint2

109−-- | `PGint4`

110−type instance PG Word32 = 'PGint4

111−-- | `PGint8`

112−type instance PG Word64 = 'PGint8

111+type instance PG Oid = 'PGoid

113112-- | `PGnumeric`

114113type instance PG Scientific = 'PGnumeric

115114-- | `PGfloat4`

@@ -303,7 +302,8 @@ withConnection "host=localhost port=5432 dbname=exampledb" $ do

303302True

304303-}

305304newtype Money = Money { cents :: Int64 }

306− deriving (Eq, Ord, Show, Read, GHC.Generic)

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

306+ deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)

307307-- | `PGmoney`

308308type instance PG Money = 'PGmoney

309309

@@ -311,7 +311,8 @@ type instance PG Money = 'PGmoney

311311type it's applied to should be stored as a `PGjson`.

312312-}

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

314− deriving (Eq, Ord, Show, Read, GHC.Generic)

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

315+ deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)

315316-- | `PGjson`

316317type instance PG (Json hask) = 'PGjson

317318

@@ -319,7 +320,8 @@ type instance PG (Json hask) = 'PGjson

319320type it's applied to should be stored as a `PGjsonb`.

320321-}

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

322− deriving (Eq, Ord, Show, Read, GHC.Generic)

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

324+ deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)

323325-- | `PGjsonb`

324326type instance PG (Jsonb hask) = 'PGjsonb

325327

@@ -327,7 +329,8 @@ type instance PG (Jsonb hask) = 'PGjsonb

327329type it's applied to should be stored as a `PGcomposite`.

328330-}

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

330− deriving (Eq, Ord, Show, Read, GHC.Generic)

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

333+ deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)

331334-- | `PGcomposite` @(@`RowPG` @hask)@

332335type instance PG (Composite hask) = 'PGcomposite (RowPG hask)

333336

@@ -335,7 +338,8 @@ type instance PG (Composite hask) = 'PGcomposite (RowPG hask)

335338type it's applied to should be stored as a `PGenum`.

336339-}

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

338− deriving (Eq, Ord, Show, Read, GHC.Generic)

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

342+ deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)

339343-- | `PGenum` @(@`LabelsPG` @hask)@

340344type instance PG (Enumerated hask) = 'PGenum (LabelsPG hask)

341345

@@ -347,7 +351,8 @@ PG (VarArray (Vector Double)) :: PGType

347351= 'PGvararray ('NotNull 'PGfloat8)

348352-}

349353newtype VarArray arr = VarArray {getVarArray :: arr}

350− deriving (Eq, Ord, Show, Read, GHC.Generic)

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

355+ deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)

351356-- | `PGvararray` @(@`NullPG` @hask)@

352357type instance PG (VarArray (Vector hask)) = 'PGvararray (NullPG hask)

353358type instance PG (VarArray [hask]) = 'PGvararray (NullPG hask)

@@ -360,6 +365,14 @@ PG (FixArray ((Double, Double), (Double, Double))) :: PGType

360365= 'PGfixarray '[2, 2] ('NotNull 'PGfloat8)

361366-}

362367newtype FixArray arr = FixArray {getFixArray :: arr}

363− deriving (Eq, Ord, Show, Read, GHC.Generic)

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

369+ deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)

364370-- | `PGfixarray` @(@`DimPG` @hask) (@`FixPG` @hask)@

365371type instance PG (FixArray hask) = 'PGfixarray (DimPG hask) (FixPG hask)

372+

373+{- | Object identifiers (`Oid`s) are used internally by PostgreSQL

374+as primary keys for various system tables.

375+-}

376+newtype Oid = Oid { getOid :: Word32 }

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

378+ deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)

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

@@ -133,6 +133,7 @@ data PGType

133133 | PGcomposite RowType -- ^ a composite type represents the structure of a row or record; it is essentially just a list of field names and their data types.

134134 | PGtsvector -- ^ A tsvector value is a sorted list of distinct lexemes, which are words that have been normalized to merge different variants of the same word.

135135 | PGtsquery -- ^ A tsquery value stores lexemes that are to be searched for.

136+ | PGoid -- Object identifiers (OIDs) are used internally by PostgreSQL as primary keys for various system tables.

136137 | PGrange PGType -- ^ Range types are data types representing a range of values of some element type (called the range's subtype).

137138 | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types

138139

squeal-postgresql/test/Doc.hs+1−13

@@ -3,16 +3,4 @@ module Main (main) where

33import Test.DocTest

55main :: IO ()

6−main = doctest

7− [ "-isrc"

8− , "src/Squeal/PostgreSQL.hs"

9− , "src/Squeal/PostgreSQL/Binary.hs"

10− , "src/Squeal/PostgreSQL/Definition.hs"

11− , "src/Squeal/PostgreSQL/Manipulation.hs"

12− , "src/Squeal/PostgreSQL/Query.hs"

13− , "src/Squeal/PostgreSQL/Expression.hs"

14− , "src/Squeal/PostgreSQL/PQ.hs"

15− , "src/Squeal/PostgreSQL/Migration.hs"

16− , "src/Squeal/PostgreSQL/Transaction.hs"

17− , "src/Squeal/PostgreSQL/Pool.hs"

18− ]

6+main = doctest [ "-isrc", "src" ]