git.iko.soy/squeal
on dev help sign in
query work
502816aEitan Chatav
squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+184−1
compare with dev
unifiedsplit
@@ -1,11 +1,194 @@
1{-# LANGUAGE
1{-# LANGUAGE
2 PolyKinds
2 PolyKinds
3+ , DataKinds
4+ , FlexibleContexts
5+ , FlexibleInstances
6+ , GADTs
7+ , KindSignatures
8+ , LambdaCase
9+ , OverloadedStrings
10+ , RankNTypes
11+ , ScopedTypeVariables
12+ , TypeApplications
13+ , TypeInType
14+ , TypeOperators
3#-}
15#-}
4
16
17+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
18+
5module Squeel.PostgreSQL.Query where
19module Squeel.PostgreSQL.Query where
6
20
7import Data.ByteString (ByteString)
21import Data.ByteString (ByteString)
22+import Data.Monoid
23+import Data.Proxy
24+import Data.String
25+-- import Data.Vinyl
26+import GHC.TypeLits
27+
28+import qualified Data.ByteString.Char8 as Char8
29+
30+import Squeel.PostgreSQL.Type
31+
32+data Expression (ps :: [PGType]) (cols :: [Column]) (x :: PGType) =
33+ Expression { unExpression :: ByteString } deriving Show
34+
35+param1 :: Expression (p1:ps) cols p1
36+param1 = Expression "$1"
37+
38+param2 :: Expression (p1:p2:ps) cols p2
39+param2 = Expression "$2"
40+
41+param3 :: Expression (p1:p2:p3:ps) cols p3
42+param3 = Expression "$3"
43+
44+param4 :: Expression (p1:p2:p3:p4:ps) cols p4
45+param4 = Expression "$4"
46+
47+param5 :: Expression (p1:p2:p3:p4:p5:ps) cols p5
48+param5 = Expression "$5"
49+
50+whenThen :: (Expression ps cols x,Expression ps cols y) -> ByteString
51+whenThen (Expression when_,Expression then_) = mconcat
52+ [" WHEN ",when_," THEN ",then_,"\n"]
53+
54+case_
55+ :: [(Expression ps cols ('PGType "bool"),Expression ps cols x)]
56+ -> Expression ps cols x
57+ -> Expression ps cols x
58+case_ whens (Expression else_) = Expression $ mconcat
59+ [ "CASE\n"
60+ , mconcat (map whenThen whens)
61+ , " ELSE ",else_
62+ , "\nEND"
63+ ]
64+
65+caseSwitch
66+ :: Expression ps cols x
67+ -> [(Expression ps cols x,Expression ps cols y)]
68+ -> Expression ps cols y
69+ -> Expression ps cols y
70+caseSwitch (Expression val) whens (Expression else_) = Expression $ mconcat
71+ [ "CASE ",val,"\n"
72+ , mconcat (map whenThen whens)
73+ , " ELSE ",else_
74+ ,"\nEND"
75+ ]
76+
77+column
78+ :: forall colName colType params columns
79+ . Alias (Expression params columns) (colName ':= colType)
80+ -> Expression params columns colType
81+column = \case
82+ As x -> x
83+ Elem -> Expression $ Char8.pack (symbolVal (Proxy @colName))
84+
85+true :: Expression ps cols ('PGType "bool")
86+true = Expression "true"
87+
88+false :: Expression ps cols ('PGType "bool")
89+false = Expression "false"
90+
91+(.==)
92+ :: Expression ps cols x
93+ -> Expression ps cols x
94+ -> Expression ps cols ('PGType "bool")
95+(.==) (Expression x1) (Expression x2) = Expression $ x1 <> "=" <> x2
96+
97+(./=)
98+ :: Expression ps cols x
99+ -> Expression ps cols x
100+ -> Expression ps cols ('PGType "bool")
101+(./=) (Expression x1) (Expression x2) = Expression $ x1 <> "<>" <> x2
102+
103+(.>)
104+ :: Expression ps cols x
105+ -> Expression ps cols x
106+ -> Expression ps cols ('PGType "bool")
107+(.>) (Expression x1) (Expression x2) = Expression $ x1 <> ">" <> x2
108+
109+(.<)
110+ :: Expression ps cols x
111+ -> Expression ps cols x
112+ -> Expression ps cols ('PGType "bool")
113+(.<) (Expression x1) (Expression x2) = Expression $ x1 <> "<" <> x2
114+
115+(.>=)
116+ :: Expression ps cols x
117+ -> Expression ps cols x
118+ -> Expression ps cols ('PGType "bool")
119+(.>=) (Expression x1) (Expression x2) = Expression $ x1 <> ">=" <> x2
120+
121+(.<=)
122+ :: Expression ps cols x
123+ -> Expression ps cols x
124+ -> Expression ps cols ('PGType "bool")
125+(.<=) (Expression x1) (Expression x2) = Expression $ x1 <> "<=" <> x2
126+
127+instance IsString (Expression ps cols ('PGType "text")) where
128+ fromString str = Expression $ "\'" <> fromString str <> "\'"
129+
130+instance Num (Expression ps cols ('PGType "int4")) where
131+ fromInteger n = Expression . fromString $ show n
132+ Expression x + Expression y = Expression $ x <> "+" <> y
133+ Expression x * Expression y = Expression $ x <> "*" <> y
134+ Expression x - Expression y = Expression $ x <> "+" <> y
135+ abs (Expression x) = Expression $ "@" <> x
136+ signum (Expression x) = Expression $ "sign(" <> x <> ")"
137+
138+data Relation
139+ (ps :: [PGType])
140+ (xs :: [Column])
141+ (db :: [Table])
142+ (ys :: [Column])
143+ = Relation { unRelation :: ByteString }
144+
145+-- star :: Relation db params xs xs
146+-- star = Relation "SELECT * FROM "
147+
148+-- table
149+-- :: forall tableName tableCols db params.
150+-- ( KnownSymbol tableName
151+-- , (tableName ':= tableCols) `Elem` Unnamed db ~ 'True
152+-- ) => Proxy tableName -> Relation db params '[] tableCols
153+-- table (_ :: Proxy tableName) = Relation $
154+-- "SELECT * FROM " <> Char8.pack (symbolVal (Proxy @tableName))
155+
156+starFrom
157+ :: forall tableName tableCols db params columns
158+ . Alias (Relation params columns db) (tableName ':= tableCols)
159+ -> Relation params columns db tableCols
160+starFrom = \case
161+ As x -> x
162+ Elem -> Relation $
163+ "SELECT * FROM " <> Char8.pack (symbolVal (Proxy @tableName))
164+
165+-- from
166+-- :: Relation db params ys zs
167+-- -> Relation db params xs ys
168+-- -> Relation db params xs zs
169+-- from (Relation rel1) (Relation rel2) = Relation $ rel1 <> rel2
170+
171+-- project :: Rec (Alias (Expression ps xs)) ys -> Relation db params xs ys
172+-- project exprs = Relation $
173+-- "SELECT " <> Char8.intercalate "," (exprStrings exprs) <> " FROM "
174+-- where
175+-- exprStrings :: Rec (Alias (Expression ps xs)) ys -> [ByteString]
176+-- exprStrings = \case
177+-- RNil -> []
178+-- (As (Expression expr) :: Alias (Expression _ _) (exprName ':= _))
179+-- :& exprs ->
180+-- (expr <> " As " <> Char8.pack (symbolVal (Proxy @exprName)))
181+-- : expressionStrings exprs
182+
183+newtype Query
184+ (db0 :: [Table])
185+ (db1 :: [Table])
186+ (ps :: [PGType])
187+ (xs :: [Column])
188+ = Query { unQuery :: ByteString }
8
189
9−newtype Query db0 db1 ps xs = Query { unQuery :: ByteString }
10newtype PreparedQuery db0 db1 ps xs
190newtype PreparedQuery db0 db1 ps xs
11 = PreparedQuery { unPreparedQuery :: ByteString }
191 = PreparedQuery { unPreparedQuery :: ByteString }
192+
193+select :: Relation ps ('[] :: [Column]) db xs -> Query db db ps xs
194+select (Relation x) = Query x
squeel-postgresql/src/Squeel/PostgreSQL/Query/Expression.hsdeleted−112
@@ -1,112 +0,0 @@
1−{-# LANGUAGE
2− DataKinds
3− , FlexibleInstances
4− , GADTs
5− , LambdaCase
6− , OverloadedStrings
7− , PolyKinds
8− , RankNTypes
9− , ScopedTypeVariables
10− , TypeApplications
11− , TypeOperators
12−#-}
13−
14−module Squeel.PostgreSQL.Query.Expression where
15−
16−import Data.ByteString (ByteString)
17−import Data.Monoid
18−import Data.String
19−
20−import Squeel.PostgreSQL.Type
21−
22−data Expression (ps :: [PGType]) (cols :: [Column]) (x :: PGType) =
23− Expression { unExpression :: ByteString } deriving Show
24−
25−param1 :: Expression (p1:ps) cols p1
26−param1 = Expression "$1"
27−
28−param2 :: Expression (p1:p2:ps) cols p2
29−param2 = Expression "$2"
30−
31−param3 :: Expression (p1:p2:p3:ps) cols p3
32−param3 = Expression "$3"
33−
34−param4 :: Expression (p1:p2:p3:p4:ps) cols p4
35−param4 = Expression "$4"
36−
37−param5 :: Expression (p1:p2:p3:p4:p5:ps) cols p5
38−param5 = Expression "$5"
39−
40−whenThen :: (Expression ps cols x,Expression ps cols y) -> ByteString
41−whenThen (Expression when_,Expression then_) = mconcat
42− [" WHEN ",when_," THEN ",then_,"\n"]
43−
44−case_
45− :: [(Expression ps cols ('PGType "bool"),Expression ps cols x)]
46− -> Expression ps cols x
47− -> Expression ps cols x
48−case_ whens (Expression else_) = Expression $ mconcat
49− [ "CASE\n"
50− , mconcat (map whenThen whens)
51− , " ELSE ",else_
52− , "\nEND"
53− ]
54−
55−caseSwitch
56− :: Expression ps cols x
57− -> [(Expression ps cols x,Expression ps cols y)]
58− -> Expression ps cols y
59− -> Expression ps cols y
60−caseSwitch (Expression val) whens (Expression else_) = Expression $ mconcat
61− [ "CASE ",val,"\n"
62− , mconcat (map whenThen whens)
63− , " ELSE ",else_
64− ,"\nEND"
65− ]
66−
67−(.==)
68− :: Expression ps cols x
69− -> Expression ps cols x
70− -> Expression ps cols ('PGType "bool")
71−(.==) (Expression x1) (Expression x2) = Expression $ x1 <> "=" <> x2
72−
73−(./=)
74− :: Expression ps cols x
75− -> Expression ps cols x
76− -> Expression ps cols ('PGType "bool")
77−(./=) (Expression x1) (Expression x2) = Expression $ x1 <> "<>" <> x2
78−
79−(.>)
80− :: Expression ps cols x
81− -> Expression ps cols x
82− -> Expression ps cols ('PGType "bool")
83−(.>) (Expression x1) (Expression x2) = Expression $ x1 <> ">" <> x2
84−
85−(.<)
86− :: Expression ps cols x
87− -> Expression ps cols x
88− -> Expression ps cols ('PGType "bool")
89−(.<) (Expression x1) (Expression x2) = Expression $ x1 <> "<" <> x2
90−
91−(.>=)
92− :: Expression ps cols x
93− -> Expression ps cols x
94− -> Expression ps cols ('PGType "bool")
95−(.>=) (Expression x1) (Expression x2) = Expression $ x1 <> ">=" <> x2
96−
97−(.<=)
98− :: Expression ps cols x
99− -> Expression ps cols x
100− -> Expression ps cols ('PGType "bool")
101−(.<=) (Expression x1) (Expression x2) = Expression $ x1 <> "<=" <> x2
102−
103−instance IsString (Expression ps cols ('PGType "text")) where
104− fromString str = Expression $ "\'" <> fromString str <> "\'"
105−
106−instance Num (Expression ps cols ('PGType "int4")) where
107− fromInteger n = Expression . fromString $ show n
108− Expression x + Expression y = Expression $ x <> "+" <> y
109− Expression x * Expression y = Expression $ x <> "*" <> y
110− Expression x - Expression y = Expression $ x <> "+" <> y
111− abs (Expression x) = Expression $ "@" <> x
112− signum (Expression x) = Expression $ "sign(" <> x <> ")"
squeel-postgresql/src/Squeel/PostgreSQL/Query/Relation.hsdeleted−15
@@ -1,15 +0,0 @@
1−{-# LANGUAGE
2− DataKinds
3− , GADTs
4− , KindSignatures
5− , RankNTypes
6−#-}
7−
8−module Squeel.PostgreSQL.Query.Relation where
9−
10−import Data.ByteString (ByteString)
11−
12−import Squeel.PostgreSQL.Type
13−
14−data Relation (ps::[PGType]) (xs::[Column]) (ys::[Column]) =
15− Relation { unRelation :: ByteString }
squeel-postgresql/src/Squeel/PostgreSQL/Type.hs+21−37
@@ -1,5 +1,6 @@
1{-# LANGUAGE
1{-# LANGUAGE
2 DataKinds
2 DataKinds
3+ , GADTs
3 , PolyKinds
4 , PolyKinds
4 , ScopedTypeVariables
5 , ScopedTypeVariables
5 , TypeApplications
6 , TypeApplications
@@ -14,43 +15,26 @@ import qualified Database.PostgreSQL.LibPQ as LibPQ
14import GHC.TypeLits
15import GHC.TypeLits
15
16
16newtype PGType = PGType Symbol
17newtype PGType = PGType Symbol
18+data Named x = (:=) Symbol x
19+type family Unnamed named where Unnamed (name ':= x) = x
20+type family Name x where Name (name ':= x) = name
17−data Column = Column Symbol PGType
21+type Column = Named PGType
18−data Table = Table Symbol [Column]
22+type Table = Named [Column]
19−data Database = Database Symbol [Table]
23+type Database = Named [Table]
20−data Schema = Schema Symbol [Database]
24+type Schema = Named [Database]
21−
25+data Alias (obj :: k -> *) (named :: Named k) where
22−type family HasColumn table column where
26+ As :: KnownSymbol name => obj x -> Alias obj (name ':= x)
23− HasColumn ('Table table '[]) column = 'False
27+ Elem
24− HasColumn ('Table table (column ': columns)) column = 'True
28+ :: (KnownSymbol name, (name ':= x) `Elem` list ~ 'True)
25− HasColumn ('Table table (column ': columns)) column'
29+ => Alias (obj list) (name ':= x)
26− = HasColumn ('Table table columns) column'
30+
27−
28−type family HasTable database table where
29− HasTable ('Database database '[]) table = 'False
30− HasTable ('Database database (table ': tables)) table = 'True
31− HasTable ('Database database (table ': tables)) table'
32− = HasTable ('Database database tables) table'
33−
34−type family HasDatabase schema database where
31+type family Elem x xs where
35− HasDatabase ('Schema schema '[]) database = 'False
32+ x `Elem` '[] = 'False
36− HasDatabase ('Schema schema (database ': databases)) database = 'True
33+ x `Elem` (x ': xs) = 'True
37− HasDatabase ('Schema schema (database ': databases)) database'
34+ x `Elem` (x' ': xs) = x `Elem` xs
38− = HasDatabase ('Schema schema databases) database'
35+
39−
40−type family TableColumns table where
41− TableColumns ('Table table columns) = columns
42−
43−type family DatabaseTables database where
44− DatabaseTables ('Database database tables) = tables
45−
46−type family SchemaDatabases schema where
47− SchemaDatabases ('Schema schema databases) = databases
48−
49−class ToOid pg where
50− toOid :: Proxy pg -> LibPQ.Oid
36+class ToOid pg where toOid :: Proxy pg -> LibPQ.Oid
51−
52−class ToOids pgs where
53− toOids :: Proxy pgs -> [LibPQ.Oid]
37+class ToOids pgs where toOids :: Proxy pgs -> [LibPQ.Oid]
54instance ToOids '[] where toOids _ = []
38instance ToOids '[] where toOids _ = []
55instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where
39instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where
56 toOids (_ :: Proxy (pg ': pgs)) = toOid (Proxy @pg) : toOids (Proxy @pgs)
40 toOids (_ :: Proxy (pg ': pgs)) = toOid (Proxy @pg) : toOids (Proxy @pgs)