0eafb54 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

column numbers and type expressions

0eafb54Eitan Chatav9 years ago

squeel-postgresql/exe/Example.hs+5−4

compare with dev

unifiedsplit

@@ -4,6 +4,7 @@

4 , OverloadedLabels

5 , OverloadedStrings

6 , ScopedTypeVariables

7+ , TypeApplications

7 , TypeOperators

8 , TypeOperators

8#-}

9#-}

@@ -42,10 +43,10 @@ main = do

42 connection2 <- flip execPQ connection1 $ do

43 connection2 <- flip execPQ connection1 $ do

43 Just result <- pqExecNil $ select $ starFrom #table1

44 Just result <- pqExecNil $ select $ starFrom #table1

44 runMaybeT . runExceptT . flip runValue result $ do

45 runMaybeT . runExceptT . flip runValue result $ do

45− value00 <- getValue (RowNumber 0) colNum0

46+ value00 <- getValue (RowNumber 0) (columnNumber @0)

46− value01 <- getValue (RowNumber 0) colNum1

47+ value01 <- getValue (RowNumber 0) (columnNumber @1)

47− value10 <- getValue (RowNumber 1) colNum0

48+ value10 <- getValue (RowNumber 1) (columnNumber @0)

48− value11 <- getValue (RowNumber 1) colNum1

49+ value11 <- getValue (RowNumber 1) (columnNumber @1)

49 row0 <- getRow (RowNumber 0)

50 row0 <- getRow (RowNumber 0)

50 row1 <- getRow (RowNumber 1)

51 row1 <- getRow (RowNumber 1)

51 liftBase $ do

52 liftBase $ do

squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+8−17

@@ -195,28 +195,19 @@ newtype Result (xs :: [(Symbol,ColumnType)])

195

196newtype RowNumber = RowNumber { unRowNumber :: LibPQ.Row }

197

198−newtype ColumnNumber cs c = ColumnNumber { unColumnNumber :: LibPQ.Column }

198+newtype ColumnNumber n cs c =

199+ UnsafeColumnNumber { getColumnNumber :: LibPQ.Column }

199

200

200−class KnownNat n => HasColumnNumber (n :: Nat) columns column

201+class KnownNat n => HasColumnNumber n columns column

201 | n columns -> column where

202 | n columns -> column where

202− colNum :: Proxy# n -> ColumnNumber columns column

203+ columnNumber :: ColumnNumber n columns column

204+ columnNumber =

203− colNum p = ColumnNumber . fromIntegral $ natVal' p

205+ UnsafeColumnNumber . fromIntegral $ natVal' (proxy# :: Proxy# n)

204instance {-# OVERLAPPING #-} HasColumnNumber 0 (column1:columns) column1

206instance {-# OVERLAPPING #-} HasColumnNumber 0 (column1:columns) column1

205instance {-# OVERLAPPABLE #-}

207instance {-# OVERLAPPABLE #-}

206 (KnownNat n, HasColumnNumber (n-1) columns column)

208 (KnownNat n, HasColumnNumber (n-1) columns column)

207 => HasColumnNumber n (column' : columns) column

209 => HasColumnNumber n (column' : columns) column

208

210

209−colNum0 :: ColumnNumber (c0:cs) c0

210−colNum0 = colNum (proxy# :: Proxy# 0)

211−colNum1 :: ColumnNumber (c0:c1:cs) c1

212−colNum1 = colNum (proxy# :: Proxy# 1)

213−colNum2 :: ColumnNumber (c0:c1:c2:cs) c2

214−colNum2 = colNum (proxy# :: Proxy# 2)

215−colNum3 :: ColumnNumber (c0:c1:c2:c3:cs) c3

216−colNum3 = colNum (proxy# :: Proxy# 3)

217−colNum4 :: ColumnNumber (c0:c1:c2:c3:c4:cs) c4

218−colNum4 = colNum (proxy# :: Proxy# 4)

219−

220newtype Value pgs m x = Value { runValue :: Result pgs -> m x }

211newtype Value pgs m x = Value { runValue :: Result pgs -> m x }

221 deriving (Functor)

212 deriving (Functor)

222instance Applicative m => Applicative (Value pgs m) where

213instance Applicative m => Applicative (Value pgs m) where

@@ -235,9 +226,9 @@ instance MonadBase b m => MonadBase b (Value pgs m) where

235getValue

226getValue

236 :: (HasDecoding pg x, MonadBase IO io)

227 :: (HasDecoding pg x, MonadBase IO io)

237 => RowNumber

228 => RowNumber

238− -> ColumnNumber pgs pg

229+ -> ColumnNumber n pgs pg

239 -> Value pgs (ExceptT Text (MaybeT io)) x

230 -> Value pgs (ExceptT Text (MaybeT io)) x

240−getValue (RowNumber r) (ColumnNumber c :: ColumnNumber pgs pg) =

231+getValue (RowNumber r) (UnsafeColumnNumber c :: ColumnNumber n pgs pg) =

241 Value $ \ (Result result) -> do

232 Value $ \ (Result result) -> do

242 maybeBytestring <- liftBase $ LibPQ.getvalue result r c

233 maybeBytestring <- liftBase $ LibPQ.getvalue result r c

243 case maybeBytestring of

234 case maybeBytestring of

squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+33−16

@@ -8,6 +8,7 @@

8 , MagicHash

9 , OverloadedStrings

10 , ScopedTypeVariables

11+ , TypeApplications

11 , TypeFamilies

12 , TypeFamilies

12 , TypeOperators

13 , TypeOperators

13 , UndecidableInstances

14 , UndecidableInstances

@@ -613,53 +614,53 @@ serial8 :: TypeExpression ('Optional ('NotNull 'PGInt8))

613serial8 = UnsafeTypeExpression "serial8"

614serial8 = UnsafeTypeExpression "serial8"

614bigserial :: TypeExpression ('Optional ('NotNull 'PGInt8))

615bigserial :: TypeExpression ('Optional ('NotNull 'PGInt8))

615bigserial = UnsafeTypeExpression "bigserial"

616bigserial = UnsafeTypeExpression "bigserial"

616−money :: TypeExpression ('Optional ('NotNull 'PGMoney))

617+money :: TypeExpression ('Required ('Null 'PGMoney))

617money = UnsafeTypeExpression "money"

618money = UnsafeTypeExpression "money"

618text :: TypeExpression ('Required ('Null 'PGText))

619text :: TypeExpression ('Required ('Null 'PGText))

619text = UnsafeTypeExpression "text"

620text = UnsafeTypeExpression "text"

620char

621char

621 :: KnownNat n

622 :: KnownNat n

622 => proxy n

623 => proxy n

623− -> TypeExpression ('Optional ('NotNull ('PGChar n)))

624+ -> TypeExpression ('Required ('Null ('PGChar n)))

624char (_ :: proxy n) = UnsafeTypeExpression $

625char (_ :: proxy n) = UnsafeTypeExpression $

625 "char(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

626 "char(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

626character

627character

627 :: KnownNat n

628 :: KnownNat n

628 => proxy n

629 => proxy n

629− -> TypeExpression ('Optional ('NotNull ('PGChar n)))

630+ -> TypeExpression ('Required ('Null ('PGChar n)))

630character (_ :: proxy n) = UnsafeTypeExpression $

631character (_ :: proxy n) = UnsafeTypeExpression $

631 "character(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

632 "character(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

632varchar

633varchar

633 :: KnownNat n

634 :: KnownNat n

634 => proxy n

635 => proxy n

635− -> TypeExpression ('Optional ('NotNull ('PGVarChar n)))

636+ -> TypeExpression ('Required ('Null ('PGVarChar n)))

636varchar (_ :: proxy n) = UnsafeTypeExpression $

637varchar (_ :: proxy n) = UnsafeTypeExpression $

637 "varchar(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

638 "varchar(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

638characterVarying

639characterVarying

639 :: KnownNat n

640 :: KnownNat n

640 => proxy n

641 => proxy n

641− -> TypeExpression ('Optional ('NotNull ('PGVarChar n)))

642+ -> TypeExpression ('Required ('Null ('PGVarChar n)))

642characterVarying (_ :: proxy n) = UnsafeTypeExpression $

643characterVarying (_ :: proxy n) = UnsafeTypeExpression $

643 "character varying(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

644 "character varying(" <> fromString (show (natVal' (proxy# :: Proxy# n))) <> ")"

644−bytea :: TypeExpression ('Optional ('NotNull ('PGBytea)))

645+bytea :: TypeExpression ('Required ('Null ('PGBytea)))

645bytea = UnsafeTypeExpression "bytea"

646bytea = UnsafeTypeExpression "bytea"

646−timestamp :: TypeExpression ('Optional ('NotNull ('PGTimestamp)))

647+timestamp :: TypeExpression ('Required ('Null ('PGTimestamp)))

647timestamp = UnsafeTypeExpression "timestamp"

648timestamp = UnsafeTypeExpression "timestamp"

648−timestampWithTimeZone :: TypeExpression ('Optional ('NotNull ('PGTimestampTZ)))

649+timestampWithTimeZone :: TypeExpression ('Required ('Null ('PGTimestampTZ)))

649timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

650timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

650−date :: TypeExpression ('Optional ('NotNull ('PGDate)))

651+date :: TypeExpression ('Required ('Null ('PGDate)))

651date = UnsafeTypeExpression "date"

652date = UnsafeTypeExpression "date"

652−time :: TypeExpression ('Optional ('NotNull ('PGTime)))

653+time :: TypeExpression ('Required ('Null ('PGTime)))

653time = UnsafeTypeExpression "time"

654time = UnsafeTypeExpression "time"

654−timeWithTimeZone :: TypeExpression ('Optional ('NotNull ('PGTimeTZ)))

655+timeWithTimeZone :: TypeExpression ('Required ('Null ('PGTimeTZ)))

655timeWithTimeZone = UnsafeTypeExpression "time with time zone"

656timeWithTimeZone = UnsafeTypeExpression "time with time zone"

656−interval :: TypeExpression ('Optional ('NotNull ('PGInterval)))

657+interval :: TypeExpression ('Required ('Null ('PGInterval)))

657interval = UnsafeTypeExpression "interval"

658interval = UnsafeTypeExpression "interval"

658−uuid :: TypeExpression ('Optional ('NotNull ('PGUuid)))

659+uuid :: TypeExpression ('Required ('Null ('PGUuid)))

659uuid = UnsafeTypeExpression "uuid"

660uuid = UnsafeTypeExpression "uuid"

660−json :: TypeExpression ('Optional ('NotNull ('PGJson)))

661+json :: TypeExpression ('Required ('Null ('PGJson)))

661json = UnsafeTypeExpression "json"

662json = UnsafeTypeExpression "json"

662−jsonb :: TypeExpression ('Optional ('NotNull ('PGJsonb)))

663+jsonb :: TypeExpression ('Required ('Null ('PGJsonb)))

663jsonb = UnsafeTypeExpression "jsonb"

664jsonb = UnsafeTypeExpression "jsonb"

664

665

665notNull

666notNull

@@ -675,11 +676,27 @@ default_ x ty = UnsafeTypeExpression $

675

676

676class PGTyped (ty :: PGType) where

677class PGTyped (ty :: PGType) where

677 pgtype :: TypeExpression ('Required ('Null ty))

678 pgtype :: TypeExpression ('Required ('Null ty))

679+instance PGTyped 'PGBool where pgtype = bool

678instance PGTyped 'PGInt2 where pgtype = int2

680instance PGTyped 'PGInt2 where pgtype = int2

679instance PGTyped 'PGInt4 where pgtype = int4

681instance PGTyped 'PGInt4 where pgtype = int4

680instance PGTyped 'PGInt8 where pgtype = int8

682instance PGTyped 'PGInt8 where pgtype = int8

681−instance PGTyped 'PGBool where pgtype = bool

683+instance PGTyped 'PGNumeric where pgtype = numeric

684+instance PGTyped 'PGFloat4 where pgtype = float4

685+instance PGTyped 'PGFloat8 where pgtype = float8

686+instance PGTyped 'PGMoney where pgtype = money

682instance PGTyped 'PGText where pgtype = text

687instance PGTyped 'PGText where pgtype = text

688+instance KnownNat n => PGTyped ('PGChar n) where pgtype = char (Proxy @n)

689+instance KnownNat n => PGTyped ('PGVarChar n) where pgtype = varchar (Proxy @n)

690+instance PGTyped 'PGBytea where pgtype = bytea

691+instance PGTyped 'PGTimestamp where pgtype = timestamp

692+instance PGTyped 'PGTimestampTZ where pgtype = timestampWithTimeZone

693+instance PGTyped 'PGDate where pgtype = date

694+instance PGTyped 'PGTime where pgtype = time

695+instance PGTyped 'PGTimeTZ where pgtype = timeWithTimeZone

696+instance PGTyped 'PGInterval where pgtype = interval

697+instance PGTyped 'PGUuid where pgtype = uuid

698+instance PGTyped 'PGJson where pgtype = json

699+instance PGTyped 'PGJsonb where pgtype = jsonb

683

700

684createTable

701createTable

685 :: (KnownSymbol table, SListI columns)

702 :: (KnownSymbol table, SListI columns)