git.iko.soy/squeal
on dev help sign in
remove default instances and modify params
f258d52Eitan Chatav
squeel-postgresql/exe/Example.hs+26−29
compare with dev
unifiedsplit
@@ -30,32 +30,29 @@ main = do
30 "host=localhost port=5432 dbname=exampledb"
30 "host=localhost port=5432 dbname=exampledb"
31 Char8.putStrLn $ "connecting to " <> connectionString
31 Char8.putStrLn $ "connecting to " <> connectionString
32 connection0 <- connectdb connectionString
32 connection0 <- connectdb connectionString
33− Char8.putStrLn "setting up database"
33+ Char8.putStrLn "setting up schema"
34 connection1 <- runPQ (connection0 :: Connection '[]) $ pqExec $
34 connection1 <- runPQ (connection0 :: Connection '[]) $ pqExec $
35− createTable #students
35+ createTable #students ((text & notNull) `As` #name :* Nil ) []
36− ( (text & notNull) `As` #name
37− :* Nil ) []
38 >>>
36 >>>
39 createTable #table1
37 createTable #table1
40− ( (int4 & notNull) `As` #col1
38+ ((int4 & notNull) `As` #col1 :* (int4 & notNull) `As` #col2 :* Nil) []
41− :* (int4 & notNull) `As` #col2
42− :* Nil ) []
43− Char8.putStrLn "querying"
44− connection2 <- runPQ (connection1 :: Connection Tables) $ do
39+ connection2 <- runPQ (connection1 :: Connection Schema) $ do
45 let
40 let
46− statement :: Manipulation Tables
41+ manipulation :: Manipulation Schema
47 '[ 'Required ('NotNull 'PGInt4)
42 '[ 'Required ('NotNull 'PGInt4)
48 , 'Required ('NotNull 'PGInt4)
43 , 'Required ('NotNull 'PGInt4)
49 , 'Required ('NotNull 'PGInt4)
44 , 'Required ('NotNull 'PGInt4)
50 , 'Required ('NotNull 'PGInt4)
45 , 'Required ('NotNull 'PGInt4)
51 ] '[]
46 ] '[]
52− statement =
47+ manipulation =
53 insertInto #table1
48 insertInto #table1
54− (Values
49+ ( Values
55− (param1 `As` #col1 :* param2 `As` #col2 :* Nil)
50+ (param (Proxy @1) `As` #col1 :* param (Proxy @2) `As` #col2 :* Nil)
56− [param3 `As` #col1 :* param4 `As` #col2 :* Nil] )
51+ [param (Proxy @3) `As` #col1 :* param (Proxy @4) `As` #col2 :* Nil]
57− Conflict ReturningNil
52+ ) Conflict ReturningNil
53+ liftBase $ Char8.putStrLn "manipulating"
58− _ <- pqExecParams statement (1::Int32,2::Int32,3::Int32,4::Int32)
54+ _ <- pqExecParams manipulation (1::Int32,2::Int32,3::Int32,4::Int32)
55+ liftBase $ Char8.putStrLn "querying"
59 Just result <- pqExecNil . query $
56 Just result <- pqExecNil . query $
60 selectStar (from (Table (#table1 `As` #table1)))
57 selectStar (from (Table (#table1 `As` #table1)))
61 value00 <- getValue (RowNumber 0) (columnNumber @0) result
58 value00 <- getValue (RowNumber 0) (columnNumber @0) result
@@ -69,21 +66,21 @@ main = do
69 print (value01 :: Int32)
66 print (value01 :: Int32)
70 print (value10 :: Int32)
67 print (value10 :: Int32)
71 print (value11 :: Int32)
68 print (value11 :: Int32)
72− print (row0 :: ColumnsRecord)
69+ print (row0 :: Table1Row)
73− print (row1 :: ColumnsRecord)
70+ print (row1 :: Table1Row)
74− Char8.putStrLn "tearing down database"
71+ Char8.putStrLn "tearing down schema"
75− connection3 <- runPQ (connection2 :: Connection Tables) $ pqExec $
72+ connection3 <- runPQ (connection2 :: Connection Schema) $ pqExec $
76 dropTable #table1 >>> dropTable #students
73 dropTable #table1 >>> dropTable #students
77 finish (connection3 :: Connection '[])
74 finish (connection3 :: Connection '[])
78
75
79−type Columns =
80− '[ "col1" ::: 'Required ('NotNull 'PGInt4)
81− , "col2" ::: 'Required ('NotNull 'PGInt4)
82− ]
83−data ColumnsRecord = ColumnsRecord { col1 :: Int32, col2 :: Int32 }
76+data Table1Row = Table1Row { col1 :: Int32, col2 :: Int32 }
84 deriving (Show, GHC.Generic)
77 deriving (Show, GHC.Generic)
85−instance Generic ColumnsRecord
78+instance Generic Table1Row
86−instance FromRow Columns ColumnsRecord
87
79
80+type Schema =
88−type StudentsColumns = '["name" ::: 'Required ('NotNull 'PGText)]
81+ '[ "students" ::: '["name" ::: 'Required ('NotNull 'PGText)]
89−type Tables = '["students" ::: StudentsColumns, "table1" ::: Columns]
82+ , "table1" :::
83+ '[ "col1" ::: 'Required ('NotNull 'PGInt4)
84+ , "col2" ::: 'Required ('NotNull 'PGInt4)
85+ ]
86+ ]
squeel-postgresql/src/Squeel/PostgreSQL/Binary2.hs+12−31
@@ -10,6 +10,7 @@
10 , ScopedTypeVariables
10 , ScopedTypeVariables
11 , TypeApplications
11 , TypeApplications
12 , TypeOperators
12 , TypeOperators
13+ , UndecidableInstances
13#-}
14#-}
14
15
15module Squeel.PostgreSQL.Binary2 where
16module Squeel.PostgreSQL.Binary2 where
@@ -76,32 +77,13 @@ instance ToParam x pg => ToColumnParam (Maybe x) ('Optional (nullity pg)) where
76
77
77class SListI tys => ToParams x (tys :: [ColumnType]) where
78class SListI tys => ToParams x (tys :: [ColumnType]) where
78 toParams :: x -> NP (K (Maybe Strict.ByteString)) tys
79 toParams :: x -> NP (K (Maybe Strict.ByteString)) tys
79− default toParams
80− :: (IsProductType x xs, AllZip ToColumnParam xs tys)
81− => x -> NP (K (Maybe Strict.ByteString)) tys
82− toParams
83− = htrans (Proxy @ToColumnParam) (toColumnParam . unI)
84− . unZ . unSOP . from
85−instance ToParams () '[]
86instance ToColumnParam x ty => ToParams x '[ty] where
80instance ToColumnParam x ty => ToParams x '[ty] where
87 toParams x = toColumnParam x :* Nil
81 toParams x = toColumnParam x :* Nil
88−instance (ToColumnParam x1 ty1, ToColumnParam x2 ty2)
82+instance (SListI tys, IsProductType x xs, AllZip ToColumnParam xs tys)
89− => ToParams (x1,x2) '[ty1,ty2]
90−instance (ToColumnParam x1 ty1, ToColumnParam x2 ty2, ToColumnParam x3 ty3)
91− => ToParams (x1,x2,x3) '[ty1,ty2,ty3]
83+ => ToParams x tys where
92−instance
84+ toParams
93− ( ToColumnParam x1 ty1
94− , ToColumnParam x2 ty2
95− , ToColumnParam x3 ty3
96− , ToColumnParam x4 ty4
85+ = htrans (Proxy @ToColumnParam) (toColumnParam . unI)
97− ) => ToParams (x1,x2,x3,x4) '[ty1,ty2,ty3,ty4]
86+ . unZ . unSOP . from
98−instance
99− ( ToColumnParam x1 ty1
100− , ToColumnParam x2 ty2
101− , ToColumnParam x3 ty3
102− , ToColumnParam x4 ty4
103− , ToColumnParam x5 ty5
104− ) => ToParams (x1,x2,x3,x4,x5) '[ty1,ty2,ty3,ty4,ty5]
105
87
106class FromValue (pg :: PGType) y where
88class FromValue (pg :: PGType) y where
107 fromValue :: proxy pg -> Decoding.Value y
89 fromValue :: proxy pg -> Decoding.Value y
@@ -161,12 +143,11 @@ instance FromValue pg y
161
143
162class SListI columns => FromRow (columns :: [(Symbol,ColumnType)]) y where
144class SListI columns => FromRow (columns :: [(Symbol,ColumnType)]) y where
163 fromRow :: NP (K (Maybe Strict.ByteString)) columns -> y
145 fromRow :: NP (K (Maybe Strict.ByteString)) columns -> y
164− default fromRow
165− :: (IsProductType y ys, AllZip FromColumnValue columns ys)
166− => NP (K (Maybe Strict.ByteString)) columns -> y
167− fromRow
168− = to . SOP . Z
169− . htrans (Proxy @FromColumnValue) (I . fromColumnValue)
170−instance FromRow '[] ()
171instance FromColumnValue ty y => FromRow '[ty] y where
146instance FromColumnValue ty y => FromRow '[ty] y where
172 fromRow (y :* Nil) = fromColumnValue y
147 fromRow (y :* Nil) = fromColumnValue y
148+instance
149+ ( SListI columns, IsProductType y ys
150+ , AllZip FromColumnValue columns ys
151+ ) => FromRow columns y where
152+ fromRow
153+ = to . SOP . Z . htrans (Proxy @FromColumnValue) (I . fromColumnValue)
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+4
@@ -30,6 +30,7 @@ module Squeel.PostgreSQL.Schema
30 , NullifyColumns
30 , NullifyColumns
31 , NullifyTables
31 , NullifyTables
32 , ColumnType (..)
32 , ColumnType (..)
33+ , BaseType
33 , Create
34 , Create
34 , Drop
35 , Drop
35 , Alter
36 , Alter
@@ -134,6 +135,9 @@ data NullityType = Null PGType | NotNull PGType
134
135
135data ColumnType = Optional NullityType | Required NullityType
136data ColumnType = Optional NullityType | Required NullityType
136
137
138+type family BaseType (ty :: ColumnType) where
139+ BaseType (optionality (nullity pg)) = pg
140+
137type family NullifyType (ty :: ColumnType) where
141type family NullifyType (ty :: ColumnType) where
138 NullifyType (optionality ('Null ty)) = optionality ('Null ty)
142 NullifyType (optionality ('Null ty)) = optionality ('Null ty)
139 NullifyType (optionality ('NotNull ty)) = optionality ('Null ty)
143 NullifyType (optionality ('NotNull ty)) = optionality ('Null ty)
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+9−15
@@ -49,24 +49,18 @@ newtype Expression
49 = UnsafeExpression { renderExpression :: ByteString }
49 = UnsafeExpression { renderExpression :: ByteString }
50 deriving (Show,Eq)
50 deriving (Show,Eq)
51
51
52+class (PGTyped (BaseType ty), KnownNat n)
52−class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
53+ => HasParameter (n :: Nat) params ty | n params -> ty where
53− param :: Proxy# n -> Expression params tables grouping ty
54+ param :: proxy n -> Expression params tables grouping ty
54− param p = UnsafeExpression $ ("$" <>) $ fromString $ show $ natVal' p
55+ param _ = UnsafeExpression $ parenthesized $
56+ "$" <> paramNum <+> "::" <+> renderTypeExpression (pgtype @(BaseType ty))
57+ where
58+ paramNum = fromString $ show $ natVal (Proxy @n)
59+instance {-# OVERLAPPING #-} PGTyped (BaseType ty1)
55−instance {-# OVERLAPPING #-} HasParameter 1 (ty1:tys) ty1
60+ => HasParameter 1 (ty1:tys) ty1
56instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)
61instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)
57 => HasParameter n (ty' : params) ty
62 => HasParameter n (ty' : params) ty
58
63
59−param1 :: Expression (ty1:tys) tables grouping ty1
60−param1 = param (proxy# :: Proxy# 1)
61−param2 :: Expression (ty1:ty2:tys) tables grouping ty2
62−param2 = param (proxy# :: Proxy# 2)
63−param3 :: Expression (ty1:ty2:ty3:tys) tables grouping ty3
64−param3 = param (proxy# :: Proxy# 3)
65−param4 :: Expression (ty1:ty2:ty3:ty4:tys) tables grouping ty4
66−param4 = param (proxy# :: Proxy# 4)
67−param5 :: Expression (ty1:ty2:ty3:ty4:ty5:tys) tables grouping ty5
68−param5 = param (proxy# :: Proxy# 5)
69−
70class KnownSymbol column => HasColumn column columns ty
64class KnownSymbol column => HasColumn column columns ty
71 | column columns -> ty where
65 | column columns -> ty where
72 getColumn
66 getColumn