@@ -4,6 +4,7 @@
44 , FlexibleContexts
55 , OverloadedLabels
66 , OverloadedStrings
7+ , OverloadedLists
78 , TypeApplications
89 , TypeOperators
910#-}
@@ -12,9 +13,10 @@ module Main (main, main2) where
1213
1314import Control.Monad (void)
1415import Control.Monad.Base (liftBase, MonadBase)
15−import Data.Int (Int32)
16+import Data.Int (Int16, Int32)
1617import Data.Monoid ((<>))
1718import Data.Text (Text)
19+import Data.Vector (Vector)
1820
1921import Squeal.PostgreSQL
2022
@@ -27,6 +29,7 @@ type Schema =
2729 '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
2830 '[ "id" ::: 'Def :=> 'NotNull 'PGint4
2931 , "name" ::: 'NoDef :=> 'NotNull 'PGtext
32+ , "vec" ::: 'NoDef :=> 'NotNull ('PGarray 'PGint2)
3033 ]
3134 , "emails" :::
3235 '[ "pk_emails" ::: 'PrimaryKey '["id"]
@@ -42,7 +45,8 @@ setup :: Definition '[] Schema
4245setup =
4346 createTable #users
4447 ( serial `As` #id :*
45− (text & notNull) `As` #name :* Nil )
48+ (text & notNull) `As` #name :*
49+ (array int2 & notNull) `As` #vec :* Nil )
4650 ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil )
4751 >>>
4852 createTable #emails
@@ -56,10 +60,10 @@ setup =
5660teardown :: Definition Schema '[]
5761teardown = dropTable #emails >>> dropTable #users
5862
59−insertUser :: Manipulation Schema '[ 'NotNull 'PGtext]
63+insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'NotNull ('PGarray 'PGint2)]
6064 '[ "fromOnly" ::: 'NotNull 'PGint4 ]
6165insertUser = insertRows #users
62− (Default `As` #id :* Set (param @1) `As` #name :* Nil) []
66+ (Default `As` #id :* Set (param @1) `As` #name :* Set (param @2) `As` #vec :* Nil) []
6367 OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))
6468
6569insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
@@ -71,29 +75,30 @@ insertEmail = insertRows #emails
7175
7276getUsers :: Query Schema '[]
7377 '[ "userName" ::: 'NotNull 'PGtext
74− , "userEmail" ::: 'Null 'PGtext ]
78+ , "userEmail" ::: 'Null 'PGtext
79+ , "userVec" ::: 'NotNull ('PGarray 'PGint2)]
7580getUsers = select
76− (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* Nil)
81+ (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* #u ! #vec `As` #userVec :* Nil)
7782 ( from (Table (#users `As` #u)
7883 & InnerJoin (Table (#emails `As` #e))
7984 (#u ! #id .== #e ! #user_id)) )
8085
81−data User = User { userName :: Text, userEmail :: Maybe Text }
86+data User = User { userName :: Text, userEmail :: Maybe Text, userVec :: Vector (Maybe Int16) }
8287 deriving (Show, GHC.Generic)
8388instance SOP.Generic User
8489instance SOP.HasDatatypeInfo User
8590
8691users :: [User]
8792users =
88− [ User "Alice" (Just "alice@gmail.com")
89− , User "Bob" Nothing
90− , User "Carole" (Just "carole@hotmail.com")
93+ [ User "Alice" (Just "alice@gmail.com") [Nothing, Just 1]
94+ , User "Bob" Nothing [Just 2, Nothing]
95+ , User "Carole" (Just "carole@hotmail.com") [Just 3]
9196 ]
9297
9398session :: (MonadBase IO pq, MonadPQ Schema pq) => pq ()
9499session = do
95100 liftBase $ Char8.putStrLn "manipulating"
96− idResults <- traversePrepared insertUser (Only . userName <$> users)
101+ idResults <- traversePrepared insertUser ([(userName user, userVec user) | user <- users])
97102 ids <- traverse (fmap fromOnly . getRow (RowNumber 0)) idResults
98103 traversePrepared_ insertEmail (zip (ids :: [Int32]) (userEmail <$> users))
99104 liftBase $ Char8.putStrLn "querying"