d240b73 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

replace example

d240b73Eitan Chatav9 years ago

squeal-postgresql/exe/Example.hs+73−45

compare with dev

unifiedsplit

@@ -12,31 +12,85 @@

12 , TypeSynonymInstances

13#-}

15−module Main (main,col1,col2) where

15+module Main (main) where

17import Control.Category ((>>>))

18import Control.Monad.Base

19import Data.Function ((&))

20import Data.Int

21import Data.Monoid

22−import Generics.SOP hiding (from)

22+import Data.Text hiding (zip)

23import Squeal.PostgreSQL

25import qualified Data.ByteString.Char8 as Char8

26+import qualified Generics.SOP as SOP

26import qualified GHC.Generics as GHC

27import qualified GHC.Generics as GHC

28type Schema =

29type Schema =

30+ '[ "users" :::

31+ '[ "id" ::: 'Optional ('NotNull 'PGint4)

29− '[ "students" ::: '["name" ::: 'Required ('NotNull 'PGtext)]

32+ , "name" ::: 'Required ('NotNull 'PGtext)

30− , "table1" :::

33+ ]

34+ , "emails" :::

31− '[ "col1" ::: 'Required ('NotNull 'PGint4)

35+ '[ "id" ::: 'Optional ('NotNull 'PGint4)

32− , "col2" ::: 'Required ('NotNull 'PGint4)

36+ , "user_id" ::: 'Required ('NotNull 'PGint4)

37+ , "email" ::: 'Required ('Null 'PGtext)

33 ]

38 ]

34 ]

39 ]

36−data Row = Row { col1 :: Int32, col2 :: Int32 }

41+setup :: Definition '[] Schema

42+setup =

43+ createTable #users

44+ ( serial `As` #id :*

45+ (text & notNull) `As` #name :* Nil )

46+ [ primaryKey (Column #id :* Nil) ]

47+ >>>

48+ createTable #emails

49+ ( serial `As` #id :*

50+ (int & notNull) `As` #user_id :*

51+ text `As` #email :* Nil )

52+ [ primaryKey (Column #id :* Nil)

53+ , foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)

54+ OnDeleteCascade OnUpdateCascade ]

55+

56+teardown :: Definition Schema '[]

57+teardown = dropTable #emails >>> dropTable #users

58+

59+insertUser :: Manipulation Schema

60+ '[ 'Required ('NotNull 'PGtext)]

61+ '[ "fromOnly" ::: 'Required ('NotNull 'PGint4) ]

62+insertUser = insertInto #users

63+ ( Values (def `As` #id :* param @1 `As` #name :* Nil) [] )

64+ OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))

65+

66+insertEmail :: Manipulation Schema

67+ '[ 'Required ('NotNull 'PGint4), 'Required ('Null 'PGtext)] '[]

68+insertEmail = insertInto #emails ( Values

69+ ( def `As` #id :*

70+ param @1 `As` #user_id :*

71+ param @2 `As` #email :* Nil) [] )

72+ OnConflictDoNothing (Returning Nil)

73+

74+getUsers :: Query Schema '[]

75+ '[ "userName" ::: 'Required ('NotNull 'PGtext)

76+ , "userEmail" ::: 'Required ('Null 'PGtext) ]

77+getUsers = select

78+ (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* Nil)

79+ ( from (Table (#users `As` #u)

80+ & InnerJoin (Table (#emails `As` #e))

81+ (#u ! #id .== #e ! #user_id)) )

82+

83+data User = User { userName :: Text, userEmail :: Maybe Text }

37 deriving (Show, GHC.Generic)

84 deriving (Show, GHC.Generic)

38−instance Generic Row

85+instance SOP.Generic User

39−instance HasDatatypeInfo Row

86+instance SOP.HasDatatypeInfo User

87+

88+users :: [User]

89+users =

90+ [ User "Alice" (Just "alice@gmail.com")

91+ , User "Bob" Nothing

92+ , User "Carole" (Just "carole@hotmail.com")

93+ ]

41main :: IO ()

95main :: IO ()

42main = do

96main = do

@@ -46,42 +100,16 @@ main = do

46 Char8.putStrLn $ "connecting to " <> connectionString

100 Char8.putStrLn $ "connecting to " <> connectionString

47 connection0 <- connectdb connectionString

101 connection0 <- connectdb connectionString

48 Char8.putStrLn "setting up schema"

102 Char8.putStrLn "setting up schema"

49− connection1 <- flip execPQ (connection0 :: Connection '[]) $ define $

103+ connection1 <- execPQ (define setup) connection0

50− createTable #students ((text & notNull) `As` #name :* Nil ) []

51− >>>

52− createTable #table1

53− ((int4 & notNull) `As` #col1 :* (int4 & notNull) `As` #col2 :* Nil) []

54− connection2 <- flip execPQ (connection1 :: Connection Schema) $ do

104+ connection2 <- flip execPQ connection1 $ do

55− let

56− insert :: Manipulation Schema '[_,_,_,_] '[]

57− insert =

58− insertInto #table1

59− ( Values

60− (param @1 `As` #col1 :* param @2 `As` #col2 :* Nil)

61− [param @3 `As` #col1 :* param @4 `As` #col2 :* Nil]

62− ) OnConflictDoNothing (Returning Nil)

63 liftBase $ Char8.putStrLn "manipulating"

105 liftBase $ Char8.putStrLn "manipulating"

64− _insertResult <- manipulateParams insert

106+ idResults <- traversePrepared insertUser (Only . userName <$> users)

65− (1::Int32,2::Int32,3::Int32,4::Int32)

107+ ids <- traverse (fmap fromOnly . getRow (RowNumber 0)) idResults

108+ traversePrepared_ insertEmail (zip (ids :: [Int32]) (userEmail <$> users))

66 liftBase $ Char8.putStrLn "querying"

109 liftBase $ Char8.putStrLn "querying"

67− result <- runQuery $

110+ usersResult <- runQuery getUsers

68− selectStar (from (Table (#table1 `As` #table1)))

111+ usersRows <- getRows usersResult

69− value00 <- getValue (RowNumber 0) (columnNumber @0) result

70− value01 <- getValue (RowNumber 0) (columnNumber @1) result

71− value10 <- getValue (RowNumber 1) (columnNumber @0) result

72− value11 <- getValue (RowNumber 1) (columnNumber @1) result

73− row0 <- getRow (RowNumber 0) result

74− row1 <- getRow (RowNumber 1) result

75− rows <- getRows result

76− liftBase $ do

112+ liftBase $ print (usersRows :: [User])

77− print (value00 :: Int32)

78− print (value01 :: Int32)

79− print (value10 :: Int32)

80− print (value11 :: Int32)

81− print (row0 :: Row)

82− print (row1 :: Row)

83− print (rows :: [Row])

84 Char8.putStrLn "tearing down schema"

113 Char8.putStrLn "tearing down schema"

85− connection3 <- flip execPQ (connection2 :: Connection Schema) $ define $

114+ connection3 <- execPQ (define teardown) connection2

86− dropTable #table1 >>> dropTable #students

87− finish (connection3 :: Connection '[])

115+ finish connection3

squeal-postgresql/squeal-postgresql.cabal+1

@@ -88,5 +88,6 @@ executable squeal-postgresql-example

88 , generics-sop >= 0.3.1.0 && < 1

89 , mtl >= 2.2.1 && < 3

90 , squeal-postgresql

91+ , text >= 1.2.2.2 && < 2

91 , transformers >= 0.5.2.0 && < 1

92 , transformers >= 0.5.2.0 && < 1

92 , transformers-base >= 0.4.4 && < 1

93 , transformers-base >= 0.4.4 && < 1

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+10−4

@@ -115,7 +115,8 @@ instance ToParam Value 'PGjson where toParam = K . Encoding.json_ast

115instance ToParam Value 'PGjsonb where toParam = K . Encoding.jsonb_ast

116

117-- | A `ToColumnParam` constraint lifts the `ToParam` encoding

118−-- of a `Type` to a `ColumnType`, encoding `Maybe`s to `Null`s.

118+-- of a `Type` to a `ColumnType`, encoding `Maybe`s to `Null`s. You should

119+-- not define instances of `ToColumnParam`, just use the provided instances.

119class ToColumnParam (x :: Type) (ty :: ColumnType) where

120class ToColumnParam (x :: Type) (ty :: ColumnType) where

120 -- | >>> toColumnParam @Int16 @('Required ('NotNull 'PGint2)) 0

121 -- | >>> toColumnParam @Int16 @('Required ('NotNull 'PGint2)) 0

121 -- K (Just "\NUL\NUL")

122 -- K (Just "\NUL\NUL")

@@ -132,7 +133,9 @@ instance ToParam x pg => ToColumnParam (Maybe x) (optionality ('Null pg)) where

132 toColumnParam = K . fmap (Encoding.encodingBytes . unK . toParam @x @pg)

133 toColumnParam = K . fmap (Encoding.encodingBytes . unK . toParam @x @pg)

133

134

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

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

135−-- of the fields of a tuple or record to a row of `ColumnType`s.

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

137+-- not define instances of `ToParams`. Instead define `Generic` instances

138+-- which in turn provide `ToParams` instances.

136class SListI tys => ToParams (x :: Type) (tys :: [ColumnType]) where

139class SListI tys => ToParams (x :: Type) (tys :: [ColumnType]) where

137 -- | >>> type PGparams = '[ 'Required ('NotNull 'PGbool), 'Required ('Null 'PGint2)]

140 -- | >>> type PGparams = '[ 'Required ('NotNull 'PGbool), 'Required ('Null 'PGint2)]

138 -- >>> toParams @(Bool, Maybe Int16) @PGparams (False, Just 0)

141 -- >>> toParams @(Bool, Maybe Int16) @PGparams (False, Just 0)

@@ -187,7 +190,8 @@ instance FromValue 'PGjsonb Value where fromValue _ = Decoding.jsonb_ast

187

190

188-- | A `FromColumnValue` constraint lifts the `FromValue` parser

191-- | A `FromColumnValue` constraint lifts the `FromValue` parser

189-- to a decoding of a `(Symbol,ColumnType)` to a `Type`,

192-- to a decoding of a `(Symbol,ColumnType)` to a `Type`,

190−-- decoding `Null`s to `Maybe`s.

193+-- decoding `Null`s to `Maybe`s. You should not define instances for

194+-- `FromColumnValue`, just use the provided instances.

191class FromColumnValue (colty :: (Symbol,ColumnType)) (y :: Type) where

195class FromColumnValue (colty :: (Symbol,ColumnType)) (y :: Type) where

192 -- | >>> :set -XTypeOperators -XOverloadedStrings

196 -- | >>> :set -XTypeOperators -XOverloadedStrings

193 -- >>> newtype Id = Id { getId :: Int16 } deriving Show

197 -- >>> newtype Id = Id { getId :: Int16 } deriving Show

@@ -220,7 +224,9 @@ instance FromValue pg y

220

224

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

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

222-- of a `ColumnsType` into the fields of a record `Type` provided they have

226-- of a `ColumnsType` into the fields of a record `Type` provided they have

223−-- the same field names.

227+-- the same field names. You should not define instances of `FromRow`.

228+-- Instead define `Generic` and `HasDatatypeInfo` instances which in turn

229+-- provide `FromRow` instances.

224class SListI results => FromRow (results :: ColumnsType) y where

230class SListI results => FromRow (results :: ColumnsType) y where

225 -- | >>> :set -XOverloadedStrings

231 -- | >>> :set -XOverloadedStrings

226 -- >>> import Data.Text

232 -- >>> import Data.Text

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

@@ -237,7 +237,7 @@ primaryKey columns = UnsafeTableConstraint $

237foreignKey

238 :: ( HasTable reftable schema refcolumns

239 , SameTypes subcolumns refsubcolumns

240− , NotAllNull subcolumns

240+ , AllNotNull subcolumns

241 , SOP.SListI subcolumns

242 , SOP.SListI refsubcolumns)

243 => NP (Column columns) subcolumns

squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+4−4

@@ -298,13 +298,13 @@ class Monad pq => MonadPQ schema pq | pq -> schema where

298

299 traversePrepared_

300 :: (ToParams x params, Foldable list)

301− => Manipulation schema params ys

301+ => Manipulation schema params '[]

302 -- ^ `insertInto`, `update` or `deleteFrom`

303 -> list x -> pq ()

304 default traversePrepared_

305 :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)

306 => (ToParams x params, Foldable list)

307− => Manipulation schema params ys

307+ => Manipulation schema params '[]

308 -- ^ `insertInto`, `update` or `deleteFrom`

309 -> list x -> pq ()

310 traversePrepared_ manipulation params = lift $

@@ -313,7 +313,7 @@ class Monad pq => MonadPQ schema pq | pq -> schema where

313 forPrepared_

314 :: (ToParams x params, Traversable list)

315 => list x

316− -> Manipulation schema params ys

316+ -> Manipulation schema params '[]

317 -- ^ `insertInto`, `update` or `deleteFrom`

318 -> pq ()

319 forPrepared_ = flip traversePrepared_

@@ -370,7 +370,7 @@ instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where

370 return (results, Connection conn)

371

372 traversePrepared_

373− (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =

373+ (UnsafeManipulation q :: Manipulation schema xs '[]) (list :: list x) =

374 PQ $ \ (Connection conn) -> liftBase $ do

375 let temp = "temporary_statement"

376 prepResultMaybe <- LibPQ.prepare conn temp q Nothing