git.iko.soy/squeal
on dev help sign in
Merge pull request #2 from echatav/tabulate
43185ccEitan Chatav
squeel-postgresql/squeel-postgresql.cabal+2
compare with dev
unifiedsplit
@@ -51,8 +51,10 @@ test-suite blockapps-data-test
51 Squeel.PostgreSQL.TypeSpec
51 Squeel.PostgreSQL.TypeSpec
52 Squeel.PostgreSQL.ValueSpec
52 Squeel.PostgreSQL.ValueSpec
53 build-depends: base
53 build-depends: base
54+ , Boolean
54 , hspec
55 , hspec
55 , squeel-postgresql
56 , squeel-postgresql
57+ , vinyl
56
58
57source-repository head
59source-repository head
58 type: git
60 type: git
squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+87−84
@@ -1,8 +1,11 @@
1{-# LANGUAGE
1{-# LANGUAGE
2 DataKinds
2 DataKinds
3+ , FlexibleContexts
3 , FlexibleInstances
4 , FlexibleInstances
4 , GADTs
5 , GADTs
6+ , MagicHash
5 , MultiParamTypeClasses
7 , MultiParamTypeClasses
8+ , OverloadedLabels
6 , OverloadedStrings
9 , OverloadedStrings
7 , PolyKinds
10 , PolyKinds
8 , RankNTypes
11 , RankNTypes
@@ -20,82 +23,77 @@ import Data.Monoid
20import Data.Proxy
23import Data.Proxy
21import Data.String
24import Data.String
22import Data.Vinyl
25import Data.Vinyl
23−-- import Data.Vinyl.Functor
26+import GHC.OverloadedLabels
24import GHC.TypeLits
27import GHC.TypeLits
25
28
26−-- import qualified Data.ByteString as ByteString
27import qualified Data.ByteString.Char8 as Char8
29import qualified Data.ByteString.Char8 as Char8
28
30
29import Squeel.PostgreSQL.Type
31import Squeel.PostgreSQL.Type
30
32
31−newtype Expression ps xs y =
32− UnsafeExpression { renderExpression :: ByteString }
33−
34−param1 :: Expression (p1:ps) cols p1
35−param1 = UnsafeExpression "$1"
36−param2 :: Expression (p1:p2:ps) cols p2
37−param2 = UnsafeExpression "$2"
38−param3 :: Expression (p1:p2:p3:ps) cols p3
39−param3 = UnsafeExpression "$3"
40−param4 :: Expression (p1:p2:p3:p4:ps) cols p4
41−param4 = UnsafeExpression "$4"
42−param5 :: Expression (p1:p2:p3:p4:p5:ps) cols p5
43−param5 = UnsafeExpression "$5"
44−
45−class HasField ident xs x where
33+class HasField label xs x where
46− fieldName :: Proxy ident -> Proxy xs -> Proxy x -> ByteString
34+ fieldName :: Proxy label -> Proxy xs -> Proxy x -> ByteString
35+instance {-# OVERLAPPING #-} KnownSymbol label
47−instance KnownSymbol name => HasField '[name] ((name ':= x) ': xs) x where
36+ => HasField label ('(label, x) ': xs) x where
48− fieldName _ _ _ = Char8.pack (symbolVal (Proxy @name))
37+ fieldName _ _ _ = Char8.pack (symbolVal (Proxy @label))
38+instance {-# OVERLAPPABLE #-} HasField label xs y
49−instance HasField ident xs x => HasField ident (y ': xs) x where
39+ => HasField label (x ': xs) y where
50− fieldName _ _ _ = fieldName (Proxy @ident) (Proxy @xs) (Proxy @x)
40+ fieldName _ _ _ = fieldName (Proxy @label) (Proxy @xs) (Proxy @y)
51−instance (KnownSymbol name, HasField names xs x)
41+
52− => HasField (name ': names) ((name ':= xs) ': xss) x where
42+data Alias label = Alias
53− fieldName _ _ _ = Char8.pack (symbolVal (Proxy @name))
43+data Aliased obj labeled where
54− <> "." <> fieldName (Proxy @names) (Proxy @xs) (Proxy @x)
44+ As :: obj x -> Alias label -> Aliased obj '(label, x)
55−
45+instance IsLabel label (Alias label) where fromLabel _ = Alias
56−column_
46+instance IsLabel label (obj x)
57− :: forall ident xs x ps
47+ => IsLabel label (Aliased obj '(label, x)) where
58− . HasField ident xs x
48+ fromLabel p = fromLabel p `As` fromLabel p
59− => Proxy ident
49+
60− -> Expression ps xs x
50+alias :: Aliased obj '(label, x) -> Alias label
61−column_ (_ :: Proxy ident) = UnsafeExpression $
51+alias _ = Alias
62− fieldName (Proxy @ident) (Proxy @xs) (Proxy @x)
52+
63−
64−data Identified ident x = (:=) ident x
65−data Aliased obj named where AS :: obj x -> Aliased obj (name ':= x)
66−
67−unalias :: Aliased obj (name ':= x) -> obj x
53+unalias :: Aliased obj '(label, x) -> obj x
68−unalias (AS obj) = obj
54+unalias (obj `As` _) = obj
69−
70−column
71− :: forall ident xs x ps
72− . HasField ident xs x
73− => Aliased (Expression ps xs) (ident ':= x)
74−column = AS $ column_ (Proxy @ident)
75
55
76renderAliased
56renderAliased
77− :: KnownSymbol name
57+ :: KnownSymbol label
78 => (obj x -> ByteString)
58 => (obj x -> ByteString)
79− -> Aliased obj (name ':= x)
59+ -> Aliased obj '(label, x)
80 -> ByteString
60 -> ByteString
81−renderAliased render (AS obj :: Aliased obj (name ':= x)) =
61+renderAliased render (obj `As` label) =
82− render obj <> " AS " <> Char8.pack (symbolVal (Proxy @name))
62+ render obj <> " AS " <> Char8.pack (symbolVal label)
83
63
84class AllAliased xs where
64class AllAliased xs where
85 renderAllAliased
65 renderAllAliased
86 :: (forall x. obj x -> ByteString)
66 :: (forall x. obj x -> ByteString)
87 -> Rec (Aliased obj) xs
67 -> Rec (Aliased obj) xs
88 -> ByteString
68 -> ByteString
89−instance KnownSymbol name => AllAliased '[name ':= x] where
69+instance KnownSymbol label => AllAliased '[ '(label, x)] where
90 renderAllAliased render
70 renderAllAliased render
91− (aliased :& RNil :: Rec (Aliased obj) '[name ':= x]) =
71+ (aliased :& RNil :: Rec (Aliased obj) '[ '(label, x)]) =
92 renderAliased render aliased
72 renderAliased render aliased
93−instance (KnownSymbol name, AllAliased xs)
73+instance (KnownSymbol label, AllAliased (x' ': xs))
94− => AllAliased ((name ':= x) ': xs) where
74+ => AllAliased ('(label, x) ': (x' ': xs)) where
95 renderAllAliased render
75 renderAllAliased render
96− (x :& xs :: Rec (Aliased obj) ((name ':= x) ': xs)) =
76+ (x :& xs :: Rec (Aliased obj) ('(label, x) ': x' : xs)) =
97 renderAliased render x <> ", " <> renderAllAliased render xs
77 renderAliased render x <> ", " <> renderAllAliased render xs
98
78
79+newtype Expression ps xs y =
80+ UnsafeExpression { renderExpression :: ByteString }
81+
82+param1 :: Expression (p1:ps) cols p1
83+param1 = UnsafeExpression "$1"
84+param2 :: Expression (p1:p2:ps) cols p2
85+param2 = UnsafeExpression "$2"
86+param3 :: Expression (p1:p2:p3:ps) cols p3
87+param3 = UnsafeExpression "$3"
88+param4 :: Expression (p1:p2:p3:p4:ps) cols p4
89+param4 = UnsafeExpression "$4"
90+param5 :: Expression (p1:p2:p3:p4:p5:ps) cols p5
91+param5 = UnsafeExpression "$5"
92+
93+instance HasField label xs x => IsLabel label (Expression ps xs x) where
94+ fromLabel _ = UnsafeExpression $
95+ fieldName (Proxy @label) (Proxy @xs) (Proxy @x)
96+
99instance IsString (Expression ps xs 'PGText) where
97instance IsString (Expression ps xs 'PGText) where
100 fromString str = UnsafeExpression $ "\'" <> fromString str <> "\'"
98 fromString str = UnsafeExpression $ "\'" <> fromString str <> "\'"
101
99
@@ -149,47 +147,52 @@ project
149 -> Projection ps xs ys
147 -> Projection ps xs ys
150project = UnsafeProjection . renderAllAliased renderExpression
148project = UnsafeProjection . renderAllAliased renderExpression
151
149
152−newtype Relation ps xss ys = UnsafeRelation
150+data Tabulation ps xss xs = UnsafeTabulation
153− { renderRelation :: ByteString }
151+ { renderTabulation :: ByteString }
154
152
155−table_
153+data Relation ps xss xs = Relation
156− :: forall ident xss xs ps
154+ { tabulation :: Tabulation ps xss xs
157− . HasField ident xss xs
158− => Proxy ident
159− -> Relation ps xss xs
160−table_ (_ :: Proxy ident) = UnsafeRelation $
161− fieldName (Proxy @ident) (Proxy @xss) (Proxy @xs)
162−
163−table
164− :: forall ident xss xs ps
165− . HasField ident xss xs
166− => Aliased (Relation ps xss) (ident ':= xs)
167−table = AS $ table_ (Proxy @ident)
168−
169−data Selection ps xss xs ys = Selection
170− { projection :: Projection ps xs ys
171− , relation :: Relation ps xss xs
172 , restriction :: Maybe (Expression ps xs 'PGBool)
155 , restriction :: Maybe (Expression ps xs 'PGBool)
173 }
156 }
174
157
175−renderSelection :: Selection ps xss xs ys -> ByteString
158+renderRelation :: Relation ps xss xs -> ByteString
176−renderSelection (Selection xs ys wh) =
159+renderRelation (Relation tab wh) =
177− renderProjection xs <> " FROM " <> renderRelation ys
178− <> maybe "" ((" WHERE " <>) . renderExpression) wh
160+ renderTabulation tab <> maybe "" ((" WHERE " <>) . renderExpression) wh
179−
180−from :: Projection ps xs ys -> Relation ps xss xs -> Selection ps xss xs ys
181−ys `from` xs = Selection ys xs Nothing
182
161
183where_
162where_
184− :: Selection ps xss xs ys
163+ :: Relation ps xss xs
185 -> Expression ps xs 'PGBool
164 -> Expression ps xs 'PGBool
186− -> Selection ps xss xs ys
165+ -> Relation ps xss xs
187ys `where_` condition = ys
166ys `where_` condition = ys
188 { restriction = case restriction ys of
167 { restriction = case restriction ys of
189 Nothing -> Just condition
168 Nothing -> Just condition
190− Just conditions -> Just (condition &&* conditions)
169+ Just conditions -> Just (conditions &&* condition)
170+ }
171+
172+instance HasField label xss xs
173+ => IsLabel label (Relation ps xss xs) where
174+ fromLabel _ = Relation
175+ { tabulation = UnsafeTabulation $
176+ fieldName (Proxy @label) (Proxy @xss) (Proxy @xs)
177+ , restriction = Nothing
178+ }
179+
180+newtype Selection ps xss ys = UnsafeSelection
181+ { renderSelection :: ByteString }
182+
183+from :: Projection ps xs ys -> Relation ps xss xs -> Selection ps xss ys
184+ys `from` xs = UnsafeSelection $
185+ renderProjection ys <> " FROM " <> renderRelation xs
186+
187+subselect :: Selection ps xss ys -> Relation ps xss ys
188+subselect selection = Relation
189+ { tabulation = UnsafeTabulation $ "SELECT " <> renderSelection selection
190+ , restriction = Nothing
191 }
191 }
192
192
193newtype Query ps xss yss zs = UnsafeQuery { renderQuery :: ByteString }
193newtype Query ps xss yss zs = UnsafeQuery { renderQuery :: ByteString }
194newtype PreparedQuery ps xss yss zs =
194newtype PreparedQuery ps xss yss zs =
195 UnsafePreparedQuery { renderPreparedQuery :: ByteString }
195 UnsafePreparedQuery { renderPreparedQuery :: ByteString }
196+
197+select :: Selection ps xss ys -> Query ps xss xss ys
198+select selection = UnsafeQuery $ "SELECT " <> renderSelection selection <> ";"
squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs+38−1
@@ -1,6 +1,43 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , OverloadedLabels
4+ , OverloadedStrings
5+#-}
6+
1module Squeel.PostgreSQL.QuerySpec where
7module Squeel.PostgreSQL.QuerySpec where
2
8
9+import Data.Boolean
10+import Data.Vinyl
3import Test.Hspec
11import Test.Hspec
4
12
13+import Squeel.PostgreSQL.Query
14+import Squeel.PostgreSQL.Type
15+
5spec :: Spec
16spec :: Spec
6−spec = return ()
17+spec = do
18+ it "correctly renders a simple SELECT query" $ do
19+ renderQuery (select (sumAndCol1 `from` (table1 `where_` true)))
20+ `shouldBe`
21+ "SELECT col1+col2 AS sum, col1 AS col1 FROM table1 WHERE TRUE;"
22+ it "combines WHEREs using AND" $ do
23+ renderQuery (select (sumAndCol1 `from` (table1 `where_` true `where_` false)))
24+ `shouldBe`
25+ "SELECT col1+col2 AS sum, col1 AS col1 FROM table1 WHERE TRUE AND FALSE;"
26+ it "performs subSELECTs" $ do
27+ renderQuery (select (star `from` subselect (sumAndCol1 `from` table1)))
28+ `shouldBe`
29+ "SELECT * FROM SELECT col1+col2 AS sum, col1 AS col1 FROM table1;"
30+
31+type Columns =
32+ '[ '("col1", 'PGInt4)
33+ , '("col2", 'PGInt4)
34+ ]
35+
36+sumAndCol1 :: Projection '[] Columns
37+ '[ '("sum", 'PGInt4)
38+ , '("col1", 'PGInt4)
39+ ]
40+sumAndCol1 = project ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
41+
42+table1 :: Relation '[] '[ '("table1", Columns)] Columns
43+table1 = #table1