26457dd · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

Merge pull request #91 from morphismtech/dev-array

26457ddEitan Chatav8 years ago

squeal-postgresql/exe/Example.hs+4−4

compare with dev

unifiedsplit

@@ -82,16 +82,16 @@ getUsers = select_

82 & innerJoin (table (#emails `as` #e))

83 (#u ! #id .== #e ! #user_id)) )

85−data User = User { userName :: Text, userEmail :: Maybe Text, userVec :: Vector (Maybe Int16) }

85+data User = User { userName :: Text, userEmail :: Maybe Text, userVec :: VarArray (Vector (Maybe Int16)) }

86 deriving (Show, GHC.Generic)

87instance SOP.Generic User

88instance SOP.HasDatatypeInfo User

90users :: [User]

91users =

92− [ User "Alice" (Just "alice@gmail.com") [Nothing, Just 1]

92+ [ User "Alice" (Just "alice@gmail.com") (VarArray [Nothing, Just 1])

93− , User "Bob" Nothing [Just 2, Nothing]

93+ , User "Bob" Nothing (VarArray [Just 2, Nothing])

94− , User "Carole" (Just "carole@hotmail.com") [Just 3]

94+ , User "Carole" (Just "carole@hotmail.com") (VarArray [Just 3])

95 ]

97session :: (MonadBase IO pq, MonadPQ Schemas pq) => pq ()

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+163−97

@@ -1,3 +1,7 @@

1+{-# LANGUAGE

2+ TypeFamilies

3+#-}

1{-|

5{-|

2Module: Squeal.PostgreSQL.Binary

6Module: Squeal.PostgreSQL.Binary

3Description: Binary encoding and decoding

7Description: Binary encoding and decoding

@@ -55,9 +59,9 @@ create multi-dimensional fixed length arrays.

56>>> :{

60>>> :{

57data Row = Row

61data Row = Row

58− { col1 :: Vector Int16

62+ { col1 :: VarArray (Vector Int16)

59− , col2 :: (Maybe Int16,Maybe Int16)

63+ , col2 :: FixArray (Maybe Int16,Maybe Int16)

60− , col3 :: ((Int16,Int16),(Int16,Int16),(Int16,Int16))

64+ , col3 :: FixArray ((Int16,Int16),(Int16,Int16),(Int16,Int16))

61 } deriving (Eq, GHC.Generic)

65 } deriving (Eq, GHC.Generic)

62:}

66:}

@@ -70,13 +74,13 @@ Once again, we define a simple round trip query.

70let

74let

71 roundTrip :: Query_ (Public '[]) Row Row

75 roundTrip :: Query_ (Public '[]) Row Row

72 roundTrip = values_ $

76 roundTrip = values_ $

73− parameter @1 (int2 & vararray) `as` #col1 :*

77+ parameter @1 (int2 & vararray) `as` #col1 :*

74− parameter @2 (int2 & fixarray @2) `as` #col2 :*

78+ parameter @2 (int2 & fixarray @'[2]) `as` #col2 :*

75− parameter @3 (int2 & fixarray @2 & fixarray @3) `as` #col3

79+ parameter @3 (int2 & fixarray @'[3,2]) `as` #col3

76:}

80:}

78>>> :set -XOverloadedLists

82>>> :set -XOverloadedLists

79−>>> let input = Row [1,2] (Just 1,Nothing) ((1,2),(3,4),(5,6))

83+>>> let input = Row (VarArray [1,2]) (FixArray (Just 1,Nothing)) (FixArray ((1,2),(3,4),(5,6)))

80>>> :{

84>>> :{

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

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

82 result <- runQueryParams roundTrip input

86 result <- runQueryParams roundTrip input

@@ -200,8 +204,13 @@ True

200#-}

204#-}

201

205

202module Squeal.PostgreSQL.Binary

206module Squeal.PostgreSQL.Binary

207+ ( Json (..)

208+ , Jsonb (..)

209+ , Composite (..)

210+ , Enumerated (..)

211+ , VarArray (..)

203− ( -- * Encoding

212+ -- * Encoding

204− ToParam (..)

213+ , ToParam (..)

205 , ToParams (..)

214 , ToParams (..)

206 -- * Decoding

215 -- * Decoding

207 , FromValue (..)

216 , FromValue (..)

@@ -297,16 +306,25 @@ instance Aeson.ToJSON x => ToParam (Json x) 'PGjson where

297instance Aeson.ToJSON x => ToParam (Jsonb x) 'PGjsonb where

306instance Aeson.ToJSON x => ToParam (Jsonb x) 'PGjsonb where

298 toParam = K . Encoding.jsonb_bytes

307 toParam = K . Encoding.jsonb_bytes

299 . Lazy.ByteString.toStrict . Aeson.encode . getJsonb

308 . Lazy.ByteString.toStrict . Aeson.encode . getJsonb

300−instance ToArray x ('NotNull ('PGvararray ty))

309+instance (ToNullityParam x ty, ty ~ nullity pg, HasOid pg)

301− => ToParam x ('PGvararray ty) where

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

302− toParam

311+ toParam = K

303− = K . Encoding.array (baseOid @x @('NotNull ('PGvararray ty)))

312+ . Encoding.array_foldable (oid @pg) (unK . toNullityParam @x @ty)

304− . unK . toArray @x @('NotNull ('PGvararray ty))

313+ . getVarArray

305−instance ToArray x ('NotNull ('PGfixarray n ty))

314+instance (ToParam x pg, HasOid pg)

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

316+ toParam = K

317+ . Encoding.array_vector (oid @pg) (unK . toParam @x @pg)

318+ . getVarArray

319+instance (ToParam x pg, HasOid pg)

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

321+ toParam = K

322+ . Encoding.nullableArray_vector (oid @pg) (unK . toParam @x @pg)

323+ . getVarArray

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

306− => ToParam x ('PGfixarray n ty) where

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

307− toParam

326+ toParam = K . Encoding.array (oid @pg)

308− = K . Encoding.array (baseOid @x @('NotNull ('PGfixarray n ty)))

327+ . unK . unK . toFixArray @x @dims @ty . getFixArray

309− . unK . toArray @x @('NotNull ('PGfixarray n ty))

310instance

328instance

311 ( IsEnumType x

329 ( IsEnumType x

312 , HasDatatypeInfo x

330 , HasDatatypeInfo x

@@ -388,46 +406,19 @@ class ToField (x :: (Symbol, Type)) (field :: (Symbol, NullityType)) where

388instance ToNullityParam x ty => ToField (alias ::: x) (alias ::: ty) where

406instance ToNullityParam x ty => ToField (alias ::: x) (alias ::: ty) where

389 toField (P x) = K . unK $ toNullityParam @x @ty x

407 toField (P x) = K . unK $ toNullityParam @x @ty x

390

408

391−class ToArray (x :: Type) (array :: NullityType) where

409+class ToFixArray (x :: Type) (dims :: [Nat]) (array :: NullityType) where

392− toArray :: x -> K Encoding.Array array

410+ toFixArray :: x -> K (K Encoding.Array dims) array

393− baseOid :: Word32

411+instance ToNullityParam x ty => ToFixArray x '[] ty where

394− default baseOid :: HasOid (PGTypeOf array) => Word32

395− baseOid = oid @(PGTypeOf array)

396−instance {-# OVERLAPPABLE #-} (HasOid pg, ToParam x pg)

397− => ToArray x ('NotNull pg) where

398− toArray = K . Encoding.encodingArray . unK . toParam @x @pg

399−instance {-# OVERLAPPABLE #-} (HasOid pg, ToParam x pg)

400− => ToArray (Maybe x) ('Null pg) where

401− toArray = K . maybe Encoding.nullArray

402− (Encoding.encodingArray . unK . toParam @x @pg)

403−instance {-# OVERLAPPING #-} ToArray x array

404− => ToArray (Vector x) ('NotNull ('PGvararray array)) where

405− toArray = K . Encoding.dimensionArray Vector.foldl'

406− (unK . toArray @x @array)

407− baseOid = baseOid @x @array

408−instance {-# OVERLAPPING #-} ToArray x array

409− => ToArray (Maybe (Vector x)) ('Null ('PGvararray array)) where

410− toArray = K . maybe Encoding.nullArray

412+ toFixArray = K . K . maybe Encoding.nullArray Encoding.encodingArray . unK

411− (Encoding.dimensionArray Vector.foldl' (unK . toArray @x @array))

413+ . toNullityParam @x @ty

412− baseOid = baseOid @x @array

413−instance {-# OVERLAPPING #-}

414− ( IsProductType product xs

415− , Length xs ~ n

416− , All ((~) x) xs

417− , ToArray x array )

418− => ToArray product ('NotNull ('PGfixarray n array)) where

419− toArray = K . Encoding.dimensionArray foldlN

420− (unK . toArray @x @array) . unZ . unSOP . from

421− baseOid = baseOid @x @array

422−instance {-# OVERLAPPING #-}

414+instance

423 ( IsProductType product xs

415 ( IsProductType product xs

424− , Length xs ~ n

416+ , Length xs ~ dim

425 , All ((~) x) xs

417 , All ((~) x) xs

426− , ToArray x array )

418+ , ToFixArray x dims ty )

427− => ToArray (Maybe product) ('Null ('PGfixarray n array)) where

419+ => ToFixArray product (dim ': dims) ty where

428− toArray = K . maybe Encoding.nullArray

429− (Encoding.dimensionArray foldlN (unK . toArray @x @array) . unZ . unSOP . from)

420+ toFixArray = K . K . Encoding.dimensionArray foldlN

430− baseOid = baseOid @x @array

421+ (unK . unK . toFixArray @x @dims @ty) . unZ . unSOP . from

431

422

432-- | A `ToParams` constraint generically sequences the encodings of `Type`s

423-- | A `ToParams` constraint generically sequences the encodings of `Type`s

433-- of the fields of a tuple or record to a row of `ColumnType`s. You should

424-- of the fields of a tuple or record to a row of `ColumnType`s. You should

@@ -492,12 +483,41 @@ instance Aeson.FromJSON x => FromValue 'PGjson (Json x) where

492instance Aeson.FromJSON x => FromValue 'PGjsonb (Jsonb x) where

483instance Aeson.FromJSON x => FromValue 'PGjsonb (Jsonb x) where

493 fromValue = Jsonb <$>

484 fromValue = Jsonb <$>

494 Decoding.jsonb_bytes (left Strict.Text.pack . Aeson.eitherDecodeStrict)

485 Decoding.jsonb_bytes (left Strict.Text.pack . Aeson.eitherDecodeStrict)

495−instance FromArray ('NotNull ('PGvararray ty)) y

486+instance FromValue pg y

487+ => FromValue ('PGvararray ('NotNull pg)) (VarArray (Vector y)) where

488+ fromValue =

489+ let

490+ rep n x = VarArray <$> Vector.replicateM n x

491+ in

492+ Decoding.array $ Decoding.dimensionArray rep

493+ (fromFixArray @'[] @('NotNull pg))

494+instance FromValue pg y

496− => FromValue ('PGvararray ty) y where

495+ => FromValue ('PGvararray ('Null pg)) (VarArray (Vector (Maybe y))) where

497− fromValue = Decoding.array (fromArray @('NotNull ('PGvararray ty)) @y)

496+ fromValue =

498−instance FromArray ('NotNull ('PGfixarray n ty)) y

497+ let

498+ rep n x = VarArray <$> Vector.replicateM n x

499+ in

500+ Decoding.array $ Decoding.dimensionArray rep

501+ (fromFixArray @'[] @('Null pg))

502+instance FromValue pg y

503+ => FromValue ('PGvararray ('NotNull pg)) (VarArray [y]) where

504+ fromValue =

505+ let

506+ rep n x = VarArray <$> replicateM n x

507+ in

508+ Decoding.array $ Decoding.dimensionArray rep

509+ (fromFixArray @'[] @('NotNull pg))

510+instance FromValue pg y

499− => FromValue ('PGfixarray n ty) y where

511+ => FromValue ('PGvararray ('Null pg)) (VarArray [Maybe y]) where

500− fromValue = Decoding.array (fromArray @('NotNull ('PGfixarray n ty)) @y)

512+ fromValue =

513+ let

514+ rep n x = VarArray <$> replicateM n x

515+ in

516+ Decoding.array $ Decoding.dimensionArray rep

517+ (fromFixArray @'[] @('Null pg))

518+instance FromFixArray dims ty y

519+ => FromValue ('PGfixarray dims ty) (FixArray y) where

520+ fromValue = FixArray <$> Decoding.array (fromFixArray @dims @ty @y)

501instance

521instance

502 ( IsEnumType y

522 ( IsEnumType y

503 , HasDatatypeInfo y

523 , HasDatatypeInfo y

@@ -568,44 +588,23 @@ instance FromValue pg y

568 K (Just bytestring) -> P . Just <$>

588 K (Just bytestring) -> P . Just <$>

569 Decoding.valueParser (fromValue @pg) bytestring

589 Decoding.valueParser (fromValue @pg) bytestring

570

590

571−class FromArray (ty :: NullityType) (y :: Type) where

591+class FromFixArray (dims :: [Nat]) (ty :: NullityType) (y :: Type) where

572− fromArray :: Decoding.Array y

592+ fromFixArray :: Decoding.Array y

573−instance {-# OVERLAPPABLE #-} FromValue pg y

593+instance FromValue pg y => FromFixArray '[] ('NotNull pg) y where

574− => FromArray ('NotNull pg) y where

575− fromArray = Decoding.valueArray (fromValue @pg @y)

594+ fromFixArray = Decoding.valueArray (fromValue @pg @y)

576−instance {-# OVERLAPPABLE #-} FromValue pg y

595+instance FromValue pg y => FromFixArray '[] ('Null pg) (Maybe y) where

577− => FromArray ('Null pg) (Maybe y) where

578− fromArray = Decoding.nullableValueArray (fromValue @pg @y)

596+ fromFixArray = Decoding.nullableValueArray (fromValue @pg @y)

579−instance {-# OVERLAPPING #-} FromArray array y

597+instance

580− => FromArray ('NotNull ('PGvararray array)) (Vector y) where

581− fromArray =

582− Decoding.dimensionArray Vector.replicateM (fromArray @array @y)

583−instance {-# OVERLAPPING #-} FromArray array y

584− => FromArray ('Null ('PGvararray array)) (Maybe (Vector y)) where

585− fromArray = Just <$>

586− Decoding.dimensionArray Vector.replicateM (fromArray @array @y)

587−instance {-# OVERLAPPING #-}

588− ( FromArray array y

589− , All ((~) y) ys

590− , SListI ys

591− , IsProductType product ys )

598+ ( IsProductType product ys

592− => FromArray ('NotNull ('PGfixarray n array)) product where

599+ , Length ys ~ dim

593− fromArray =

594− let

595− rep _ = fmap (to . SOP . Z) . replicateMN

596− in

597− Decoding.dimensionArray rep (fromArray @array @y)

598−instance {-# OVERLAPPING #-}

599− ( FromArray array y

600 , All ((~) y) ys

601− , SListI ys

601+ , FromFixArray dims ty y )

602− , IsProductType product ys )

602+ => FromFixArray (dim ': dims) ty product where

603− => FromArray ('Null ('PGfixarray n array)) (Maybe product) where

603+ fromFixArray =

604− fromArray =

605 let

604 let

606 rep _ = fmap (to . SOP . Z) . replicateMN

605 rep _ = fmap (to . SOP . Z) . replicateMN

607 in

606 in

608− Just <$> Decoding.dimensionArray rep (fromArray @array @y)

607+ Decoding.dimensionArray rep (fromFixArray @dims @ty @y)

609

608

610-- | A `FromRow` constraint generically sequences the parsings of the columns

609-- | A `FromRow` constraint generically sequences the parsings of the columns

611-- of a `RowType` into the fields of a record `Type` provided they have

610-- of a `RowType` into the fields of a record `Type` provided they have

@@ -660,3 +659,70 @@ replicateMN

660 => m x -> m (NP I xs)

659 => m x -> m (NP I xs)

661replicateMN mx = hsequence' $

660replicateMN mx = hsequence' $

662 hcpure (Proxy :: Proxy ((~) x)) (Comp (I <$> mx))

661 hcpure (Proxy :: Proxy ((~) x)) (Comp (I <$> mx))

662+

663+{- | The `Json` newtype is an indication that the Haskell

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

665+-}

666+newtype Json hask = Json {getJson :: hask}

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

668+type instance PG (Json hask) = 'PGjson

669+

670+{- | The `Jsonb` newtype is an indication that the Haskell

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

672+-}

673+newtype Jsonb hask = Jsonb {getJsonb :: hask}

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

675+type instance PG (Jsonb hask) = 'PGjsonb

676+

677+{- | The `Composite` newtype is an indication that the Haskell

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

679+-}

680+newtype Composite record = Composite {getComposite :: record}

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

682+type instance PG (Composite hask) = 'PGcomposite (RowPG hask)

683+

684+{- | The `Enumerated` newtype is an indication that the Haskell

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

686+-}

687+newtype Enumerated enum = Enumerated {getEnumerated :: enum}

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

689+type instance PG (Enumerated hask) = 'PGenum (LabelsPG hask)

690+

691+{- | The `VarArray` newtype is an indication that the Haskell

692+type it's applied to should be stored as a `PGvararray`.

693+-}

694+newtype VarArray arr = VarArray {getVarArray :: arr}

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

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

697+

698+{- | The `FixArray` newtype is an indication that the Haskell

699+type it's applied to should be stored as a `PGfixarray`.

700+-}

701+newtype FixArray arr = FixArray {getFixArray :: arr}

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

703+type instance PG (FixArray x) = 'PGfixarray (DimPG x) (FixPG x)

704+

705+type family DimPG (hask :: Type) :: [Nat] where

706+ DimPG (x,x) = 2 ': DimPG x

707+ DimPG (x,x,x) = 3 ': DimPG x

708+ DimPG (x,x,x,x) = 4 ': DimPG x

709+ DimPG (x,x,x,x,x) = 5 ': DimPG x

710+ DimPG (x,x,x,x,x,x) = 6 ': DimPG x

711+ DimPG (x,x,x,x,x,x,x) = 7 ': DimPG x

712+ DimPG (x,x,x,x,x,x,x,x) = 8 ': DimPG x

713+ DimPG (x,x,x,x,x,x,x,x,x) = 9 ': DimPG x

714+ DimPG (x,x,x,x,x,x,x,x,x,x) = 10 ': DimPG x

715+ DimPG x = '[]

716+

717+type family FixPG (hask :: Type) :: NullityType where

718+ FixPG (x,x) = FixPG x

719+ FixPG (x,x,x) = FixPG x

720+ FixPG (x,x,x,x) = FixPG x

721+ FixPG (x,x,x,x,x) = FixPG x

722+ FixPG (x,x,x,x,x,x) = FixPG x

723+ FixPG (x,x,x,x,x,x,x) = FixPG x

724+ FixPG (x,x,x,x,x,x,x,x) = FixPG x

725+ FixPG (x,x,x,x,x,x,x,x,x) = FixPG x

726+ FixPG (x,x,x,x,x,x,x,x,x,x) = FixPG x

727+ FixPG (x,x,x,x,x,x,x,x,x,x,x) = FixPG x

728+ FixPG x = NullPG x

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

@@ -95,6 +95,7 @@ import Prelude hiding ((.), id)

95import qualified Generics.SOP as SOP

96import qualified GHC.Generics as GHC

98+import Squeal.PostgreSQL.Binary

98import Squeal.PostgreSQL.Expression

99import Squeal.PostgreSQL.Expression

99import Squeal.PostgreSQL.Query

100import Squeal.PostgreSQL.Query

100import Squeal.PostgreSQL.Render

101import Squeal.PostgreSQL.Render

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

@@ -198,6 +198,7 @@ import GHC.OverloadedLabels

198import GHC.TypeLits

199import Prelude hiding (id, (.))

200

201+import qualified Data.ByteString as ByteString

201import qualified GHC.Generics as GHC

202import qualified GHC.Generics as GHC

202

203

203import Squeal.PostgreSQL.Render

204import Squeal.PostgreSQL.Render

@@ -1738,14 +1739,24 @@ vararray

1738vararray ty = UnsafeTypeExpression $ renderSQL ty <> "[]"

1739vararray ty = UnsafeTypeExpression $ renderSQL ty <> "[]"

1739-- | fixed length array

1740-- | fixed length array

1740--

1741--

1741−-- >>> renderSQL (fixarray @2 json)

1742+-- >>> renderSQL (fixarray @'[2] json)

1742-- "json[2]"

1743-- "json[2]"

1743fixarray

1744fixarray

1744− :: forall n schemas nullity pg. KnownNat n

1745+ :: forall dims schemas nullity pg. All KnownNat dims

1745 => TypeExpression schemas pg

1746 => TypeExpression schemas pg

1746− -> TypeExpression schemas (nullity ('PGfixarray n pg))

1747+ -> TypeExpression schemas (nullity ('PGfixarray dims pg))

1747fixarray ty = UnsafeTypeExpression $

1748fixarray ty = UnsafeTypeExpression $

1748− renderSQL ty <> "[" <> renderNat @n <> "]"

1749+ renderSQL ty <> renderDims @dims

1750+ where

1751+ renderDims :: forall ns. All KnownNat ns => ByteString

1752+ renderDims =

1753+ ("[" <>)

1754+ . (<> "]")

1755+ . ByteString.intercalate "]["

1756+ . hcollapse

1757+ $ hcmap (Proxy @KnownNat)

1758+ (K . fromString . show . natVal)

1759+ (hpure Proxy :: NP Proxy ns)

1749

1760

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

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

1751class PGTyped schemas (ty :: NullityType) where

1762class PGTyped schemas (ty :: NullityType) where

@@ -1775,6 +1786,6 @@ instance PGTyped schemas (nullity 'PGjsonb) where pgtype = jsonb

1775instance PGTyped schemas ty

1786instance PGTyped schemas ty

1776 => PGTyped schemas (nullity ('PGvararray ty)) where

1787 => PGTyped schemas (nullity ('PGvararray ty)) where

1777 pgtype = vararray (pgtype @schemas @ty)

1788 pgtype = vararray (pgtype @schemas @ty)

1778−instance (KnownNat n, PGTyped schemas ty)

1789+instance (All KnownNat dims, PGTyped schemas ty)

1779− => PGTyped schemas (nullity ('PGfixarray n ty)) where

1790+ => PGTyped schemas (nullity ('PGfixarray dims ty)) where

1780− pgtype = fixarray @n (pgtype @schemas @ty)

1791+ pgtype = fixarray @dims (pgtype @schemas @ty)

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

@@ -103,8 +103,7 @@ renderSymbol :: forall s. KnownSymbol s => ByteString

103renderSymbol = fromString (symbolVal' (proxy# :: Proxy# s))

104

105-- | A class for rendering SQL

106−class RenderSQL sql where

106+class RenderSQL sql where renderSQL :: sql -> ByteString

107− renderSQL :: sql -> ByteString

108

107

109-- | Print SQL.

108-- | Print SQL.

110printSQL :: (RenderSQL sql, MonadBase IO io) => sql -> io ()

109printSQL :: (RenderSQL sql, MonadBase IO io) => sql -> io ()

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

@@ -44,10 +44,6 @@ module Squeal.PostgreSQL.Schema

44 , NullPG

45 , TuplePG

46 , RowPG

47− , Json (..)

48− , Jsonb (..)

49− , Composite (..)

50− , Enumerated (..)

51 -- * Schema Types

47 -- * Schema Types

52 , ColumnType

48 , ColumnType

53 , ColumnsType

49 , ColumnsType

@@ -137,7 +133,6 @@ import Data.Time

137import Data.Word (Word16, Word32, Word64)

133import Data.Word (Word16, Word32, Word64)

138import Data.Type.Bool

134import Data.Type.Bool

139import Data.UUID.Types (UUID)

135import Data.UUID.Types (UUID)

140−import Data.Vector (Vector)

141import Generics.SOP

136import Generics.SOP

142import Generics.SOP.Record

137import Generics.SOP.Record

143import GHC.OverloadedLabels

138import GHC.OverloadedLabels

@@ -180,7 +175,7 @@ data PGType

180 | PGjson -- ^ textual JSON data

175 | PGjson -- ^ textual JSON data

181 | PGjsonb -- ^ binary JSON data, decomposed

176 | PGjsonb -- ^ binary JSON data, decomposed

182 | PGvararray NullityType -- ^ variable length array

177 | PGvararray NullityType -- ^ variable length array

183− | PGfixarray Nat NullityType -- ^ fixed length array

178+ | PGfixarray [Nat] NullityType -- ^ fixed length array

184 | PGenum [Symbol] -- ^ enumerated (enum) types are data types that comprise a static, ordered set of values.

179 | PGenum [Symbol] -- ^ enumerated (enum) types are data types that comprise a static, ordered set of values.

185 | 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.

180 | 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.

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

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

@@ -755,49 +750,6 @@ type instance PG DiffTime = 'PGinterval

755type instance PG UUID = 'PGuuid

750type instance PG UUID = 'PGuuid

756type instance PG (NetAddr IP) = 'PGinet

751type instance PG (NetAddr IP) = 'PGinet

757type instance PG Value = 'PGjson

752type instance PG Value = 'PGjson

758−type instance PG (Json hask) = 'PGjson

759−type instance PG (Jsonb hask) = 'PGjsonb

760−type instance PG (Vector hask) = 'PGvararray (NullPG hask)

761−type instance PG (hask, hask) = 'PGfixarray 2 (NullPG hask)

762−type instance PG (hask, hask, hask) = 'PGfixarray 3 (NullPG hask)

763−type instance PG (hask, hask, hask, hask) = 'PGfixarray 4 (NullPG hask)

764−type instance PG (hask, hask, hask, hask, hask) = 'PGfixarray 5 (NullPG hask)

765−type instance PG (hask, hask, hask, hask, hask, hask)

766− = 'PGfixarray 6 (NullPG hask)

767−type instance PG (hask, hask, hask, hask, hask, hask, hask)

768− = 'PGfixarray 7 (NullPG hask)

769−type instance PG (hask, hask, hask, hask, hask, hask, hask, hask)

770− = 'PGfixarray 8 (NullPG hask)

771−type instance PG (hask, hask, hask, hask, hask, hask, hask, hask, hask)

772− = 'PGfixarray 9 (NullPG hask)

773−type instance PG (hask, hask, hask, hask, hask, hask, hask, hask, hask, hask)

774− = 'PGfixarray 10 (NullPG hask)

775−type instance PG (Composite hask) = 'PGcomposite (RowPG hask)

776−type instance PG (Enumerated hask) = 'PGenum (LabelsPG hask)

777−

778−{- | The `Json` newtype is an indication that the Haskell

779−type it's applied to should be stored as `PGjson`.

780−-}

781−newtype Json hask = Json {getJson :: hask}

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

783−

784−{- | The `Jsonb` newtype is an indication that the Haskell

785−type it's applied to should be stored as `PGjsonb`.

786−-}

787−newtype Jsonb hask = Jsonb {getJsonb :: hask}

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

789−

790−{- | The `Composite` newtype is an indication that the Haskell

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

792−-}

793−newtype Composite record = Composite {getComposite :: record}

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

795−

796−{- | The `Enumerated` newtype is an indication that the Haskell

797−type it's applied to should be stored as `PGenum`.

798−-}

799−newtype Enumerated enum = Enumerated {getEnumerated :: enum}

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

801

753

802{-| The `LabelsPG` type family calculates the constructors of a

754{-| The `LabelsPG` type family calculates the constructors of a

803Haskell enum type.

755Haskell enum type.

squeal-postgresql/test/Specs/ExceptionHandling.hs+2−2

@@ -51,7 +51,7 @@ type Schemas = Public Schema

51data User =

52 User { userName :: Text

53 , userEmail :: Maybe Text

54− , userVec :: Vector (Maybe Int16) }

54+ , userVec :: VarArray (Vector (Maybe Int16)) }

55 deriving (Show, GHC.Generic)

56instance SOP.Generic User

57instance SOP.HasDatatypeInfo User

@@ -101,7 +101,7 @@ connectionString :: Char8.ByteString

101connectionString = "host=localhost port=5432 dbname=exampledb"

102

103testUser :: User

104−testUser = User "TestUser" Nothing []

104+testUser = User "TestUser" Nothing (VarArray [])

105

106newUser :: (MonadBase IO m, MonadPQ Schemas m) => User -> m ()

107newUser u = void $ manipulateParams insertUser (userName u, userVec u)