0eafb54 · squeal · git.iko.soy

git.iko.soy/squeal

column numbers and type expressions

commit0eafb5491b7b5dd0d8f095060507998b0bd405ea authorEitan Chatav <eitan.chatav@gmail.com> dateWed 5 Jul 2017, 00:04 (9 years ago) parent19da6d3

3 files changed+46−37

compare with dev

unifiedsplit

squeel-postgresql/exe/Example.hs+5−4 squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+8−17 squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+33−16

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

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

44 , OverloadedLabels

55 , OverloadedStrings

66 , ScopedTypeVariables

7+ , TypeApplications

78 , TypeOperators

89#-}

910

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

4243 connection2 <- flip execPQ connection1 $ do

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

4445 runMaybeT . runExceptT . flip runValue result $ do

45− value00 <- getValue (RowNumber 0) colNum0

46− value01 <- getValue (RowNumber 0) colNum1

47− value10 <- getValue (RowNumber 1) colNum0

48− value11 <- getValue (RowNumber 1) colNum1

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

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

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

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

4950 row0 <- getRow (RowNumber 0)

5051 row1 <- getRow (RowNumber 1)

5152 liftBase $ do

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

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

195195

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

197197

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

198+newtype ColumnNumber n cs c =

199+ UnsafeColumnNumber { getColumnNumber :: LibPQ.Column }

199200

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

201+class KnownNat n => HasColumnNumber n columns column

201202 | n columns -> column where

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

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

203+ columnNumber :: ColumnNumber n columns column

204+ columnNumber =

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

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

205207instance {-# OVERLAPPABLE #-}

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

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

208210

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−

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

221212 deriving (Functor)

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

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

235226getValue

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

237228 => RowNumber

238− -> ColumnNumber pgs pg

229+ -> ColumnNumber n pgs pg

239230 -> 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) =

241232 Value $ \ (Result result) -> do

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

243234 case maybeBytestring of

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

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

88 , MagicHash

99 , OverloadedStrings

1010 , ScopedTypeVariables

11+ , TypeApplications

1112 , TypeFamilies

1213 , TypeOperators

1314 , UndecidableInstances

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

613614serial8 = UnsafeTypeExpression "serial8"

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

615616bigserial = UnsafeTypeExpression "bigserial"

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

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

617618money = UnsafeTypeExpression "money"

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

619620text = UnsafeTypeExpression "text"

620621char

621622 :: KnownNat n

622623 => proxy n

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

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

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

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

626627character

627628 :: KnownNat n

628629 => proxy n

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

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

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

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

632633varchar

633634 :: KnownNat n

634635 => proxy n

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

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

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

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

638639characterVarying

639640 :: KnownNat n

640641 => proxy n

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

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

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

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

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

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

645646bytea = UnsafeTypeExpression "bytea"

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

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

647648timestamp = UnsafeTypeExpression "timestamp"

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

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

649650timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

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

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

651652date = UnsafeTypeExpression "date"

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

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

653654time = UnsafeTypeExpression "time"

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

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

655656timeWithTimeZone = UnsafeTypeExpression "time with time zone"

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

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

657658interval = UnsafeTypeExpression "interval"

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

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

659660uuid = UnsafeTypeExpression "uuid"

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

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

661662json = UnsafeTypeExpression "json"

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

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

663664jsonb = UnsafeTypeExpression "jsonb"

664665

665666notNull

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

675676

676677class PGTyped (ty :: PGType) where

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

679+instance PGTyped 'PGBool where pgtype = bool

678680instance PGTyped 'PGInt2 where pgtype = int2

679681instance PGTyped 'PGInt4 where pgtype = int4

680682instance 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

682687instance 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

683700

684701createTable

685702 :: (KnownSymbol table, SListI columns)