9c9395f · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

tests, limits & offsets

9c9395fEitan Chatav10 years ago

squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+53−11

compare with dev

unifiedsplit

@@ -3,9 +3,7 @@

3 , FlexibleContexts

4 , FlexibleInstances

5 , GADTs

6− , MagicHash

7 , MultiParamTypeClasses

6 , MultiParamTypeClasses

8− , OverloadedLabels

9 , OverloadedStrings

7 , OverloadedStrings

10 , PolyKinds

8 , PolyKinds

11 , RankNTypes

9 , RankNTypes

@@ -35,7 +33,7 @@ class HasField label xs x where

35instance {-# OVERLAPPING #-} KnownSymbol label

33instance {-# OVERLAPPING #-} KnownSymbol label

36 => HasField label ('(label, x) ': xs) x where

34 => HasField label ('(label, x) ': xs) x where

37 fieldName _ _ _ = Char8.pack (symbolVal (Proxy @label))

35 fieldName _ _ _ = Char8.pack (symbolVal (Proxy @label))

38−instance {-# OVERLAPPABLE #-} HasField label xs y

36+instance HasField label xs y

39 => HasField label (x ': xs) y where

37 => HasField label (x ': xs) y where

40 fieldName _ _ _ = fieldName (Proxy @label) (Proxy @xs) (Proxy @y)

38 fieldName _ _ _ = fieldName (Proxy @label) (Proxy @xs) (Proxy @y)

@@ -76,7 +74,7 @@ instance (KnownSymbol label, AllAliased (x' ': xs))

76 (x :& xs :: Rec (Aliased obj) ('(label, x) ': x' : xs)) =

74 (x :& xs :: Rec (Aliased obj) ('(label, x) ': x' : xs)) =

77 renderAliased render x <> ", " <> renderAllAliased render xs

75 renderAliased render x <> ", " <> renderAllAliased render xs

79−newtype Expression ps xs y =

77+newtype Expression ps (xs :: [(Symbol,PGType)]) y =

80 UnsafeExpression { renderExpression :: ByteString }

78 UnsafeExpression { renderExpression :: ByteString }

82param1 :: Expression (p1:ps) cols p1

80param1 :: Expression (p1:ps) cols p1

@@ -97,6 +95,14 @@ instance HasField label xs x => IsLabel label (Expression ps xs x) where

97instance IsString (Expression ps xs 'PGText) where

95instance IsString (Expression ps xs 'PGText) where

98 fromString str = UnsafeExpression $ "\'" <> fromString str <> "\'"

96 fromString str = UnsafeExpression $ "\'" <> fromString str <> "\'"

98+instance Num (Expression ps xs 'PGInt2) where

99+ fromInteger n = UnsafeExpression . fromString $ show n

100+ x + y = UnsafeExpression $ renderExpression x <> "+" <> renderExpression y

101+ x * y = UnsafeExpression $ renderExpression x <> "*" <> renderExpression y

102+ UnsafeExpression x - UnsafeExpression y = UnsafeExpression $ x <> "+" <> y

103+ abs (UnsafeExpression x) = UnsafeExpression $ "@" <> x

104+ signum (UnsafeExpression x) = UnsafeExpression $ "sign(" <> x <> ")"

105+

100instance Num (Expression ps xs 'PGInt4) where

106instance Num (Expression ps xs 'PGInt4) where

101 fromInteger n = UnsafeExpression . fromString $ show n

107 fromInteger n = UnsafeExpression . fromString $ show n

102 x + y = UnsafeExpression $ renderExpression x <> "+" <> renderExpression y

108 x + y = UnsafeExpression $ renderExpression x <> "+" <> renderExpression y

@@ -105,6 +111,14 @@ instance Num (Expression ps xs 'PGInt4) where

105 abs (UnsafeExpression x) = UnsafeExpression $ "@" <> x

111 abs (UnsafeExpression x) = UnsafeExpression $ "@" <> x

106 signum (UnsafeExpression x) = UnsafeExpression $ "sign(" <> x <> ")"

112 signum (UnsafeExpression x) = UnsafeExpression $ "sign(" <> x <> ")"

107

113

114+instance Num (Expression ps xs 'PGInt8) where

115+ fromInteger n = UnsafeExpression . fromString $ show n

116+ x + y = UnsafeExpression $ renderExpression x <> "+" <> renderExpression y

117+ x * y = UnsafeExpression $ renderExpression x <> "*" <> renderExpression y

118+ UnsafeExpression x - UnsafeExpression y = UnsafeExpression $ x <> "+" <> y

119+ abs (UnsafeExpression x) = UnsafeExpression $ "@" <> x

120+ signum (UnsafeExpression x) = UnsafeExpression $ "sign(" <> x <> ")"

121+

108instance Boolean (Expression ps xs 'PGBool) where

122instance Boolean (Expression ps xs 'PGBool) where

109 true = UnsafeExpression "TRUE"

123 true = UnsafeExpression "TRUE"

110 false = UnsafeExpression "FALSE"

124 false = UnsafeExpression "FALSE"

@@ -118,11 +132,10 @@ type instance BooleanOf (Expression ps xs y) = Expression ps xs 'PGBool

118

132

119instance IfB (Expression ps xs y) where

133instance IfB (Expression ps xs y) where

120 ifB predicate then_ else_ = UnsafeExpression $ mconcat

134 ifB predicate then_ else_ = UnsafeExpression $ mconcat

121− [ "CASE"

122− , "\n WHEN ",renderExpression predicate

135+ [ "CASE WHEN ",renderExpression predicate

123− , "\n THEN ",renderExpression then_

136+ , " THEN ",renderExpression then_

124− , "\n ELSE ",renderExpression else_

137+ , " ELSE ",renderExpression else_

125− , "\nEND"

138+ , " END"

126 ]

139 ]

127

140

128instance EqB (Expression ps xs y) where

141instance EqB (Expression ps xs y) where

@@ -153,11 +166,16 @@ data Tabulation ps xss xs = UnsafeTabulation

153data Relation ps xss xs = Relation

166data Relation ps xss xs = Relation

154 { tabulation :: Tabulation ps xss xs

167 { tabulation :: Tabulation ps xss xs

155 , restriction :: Maybe (Expression ps xs 'PGBool)

168 , restriction :: Maybe (Expression ps xs 'PGBool)

169+ , limitation :: Maybe (Expression ps '[] 'PGInt8)

170+ , offsetting :: Maybe (Expression ps '[] 'PGInt8)

156 }

171 }

157

172

158renderRelation :: Relation ps xss xs -> ByteString

173renderRelation :: Relation ps xss xs -> ByteString

159−renderRelation (Relation tab wh) =

174+renderRelation (Relation tab wh lim off) =

175+ renderTabulation tab

160− renderTabulation tab <> maybe "" ((" WHERE " <>) . renderExpression) wh

176+ <> maybe "" ((" WHERE " <>) . renderExpression) wh

177+ <> maybe "" ((" LIMIT " <>) . renderExpression) lim

178+ <> maybe "" ((" OFFSET " <>) . renderExpression) off

161

179

162where_

180where_

163 :: Relation ps xss xs

181 :: Relation ps xss xs

@@ -169,12 +187,34 @@ ys `where_` condition = ys

169 Just conditions -> Just (conditions &&* condition)

187 Just conditions -> Just (conditions &&* condition)

170 }

188 }

171

189

190+limit

191+ :: Relation ps xss xs

192+ -> Expression ps '[] 'PGInt8

193+ -> Relation ps xss xs

194+ys `limit` n = ys

195+ { limitation = case limitation ys of

196+ Nothing -> Just n

197+ Just n' -> Just (n' `minB` n)

198+ }

199+

200+offset

201+ :: Relation ps xss xs

202+ -> Expression ps '[] 'PGInt8

203+ -> Relation ps xss xs

204+ys `offset` n = ys

205+ { offsetting = case offsetting ys of

206+ Nothing -> Just n

207+ Just n' -> Just (n' + n)

208+ }

209+

172instance HasField label xss xs

210instance HasField label xss xs

173 => IsLabel label (Relation ps xss xs) where

211 => IsLabel label (Relation ps xss xs) where

174 fromLabel _ = Relation

212 fromLabel _ = Relation

175 { tabulation = UnsafeTabulation $

213 { tabulation = UnsafeTabulation $

176 fieldName (Proxy @label) (Proxy @xss) (Proxy @xs)

214 fieldName (Proxy @label) (Proxy @xss) (Proxy @xs)

177 , restriction = Nothing

215 , restriction = Nothing

216+ , limitation = Nothing

217+ , offsetting = Nothing

178 }

218 }

179

219

180newtype Selection ps xss ys = UnsafeSelection

220newtype Selection ps xss ys = UnsafeSelection

@@ -188,6 +228,8 @@ subselect :: Selection ps xss ys -> Relation ps xss ys

188subselect selection = Relation

228subselect selection = Relation

189 { tabulation = UnsafeTabulation $ "SELECT " <> renderSelection selection

229 { tabulation = UnsafeTabulation $ "SELECT " <> renderSelection selection

190 , restriction = Nothing

230 , restriction = Nothing

231+ , limitation = Nothing

232+ , offsetting = Nothing

191 }

233 }

192

234

193newtype Query ps xss yss zs = UnsafeQuery { renderQuery :: ByteString }

235newtype Query ps xss yss zs = UnsafeQuery { renderQuery :: ByteString }

squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs+24

@@ -27,6 +27,27 @@ spec = 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+ it "does LIMIT clauses" $ do

31+ renderQuery (select (star `from` (table1 `limit` 1)))

32+ `shouldBe`

33+ "SELECT * FROM table1 LIMIT 1;"

34+ it "should use the minimum of given LIMITs" $ do

35+ renderQuery (select (star `from` (table1 `limit` 1 `limit` 2)))

36+ `shouldBe`

37+ "SELECT * FROM table1 LIMIT CASE WHEN 1<=2 THEN 1 ELSE 2 END;"

38+ it "should render parameters using $ signs" $ do

39+ renderQuery (select (star `from` (parameterizedTable1 `limit` param1)))

40+ `shouldBe`

41+ "SELECT * FROM table1 LIMIT $1;"

42+ it "does OFFSET clauses" $ do

43+ renderQuery (select (star `from` (table1 `offset` 1)))

44+ `shouldBe`

45+ "SELECT * FROM table1 OFFSET 1;"

46+ it "should use the sum of given OFFSETs" $ do

47+ renderQuery (select (star `from` (table1 `offset` 1 `offset` 2)))

48+ `shouldBe`

49+ "SELECT * FROM table1 OFFSET 1+2;"

50+

31type Columns =

52type Columns =

32 '[ '("col1", 'PGInt4)

53 '[ '("col1", 'PGInt4)

@@ -41,3 +62,6 @@ sumAndCol1 = project ((#col1 + #col2) `As` #sum :& #col1 :& RNil)

42table1 :: Relation '[] '[ '("table1", Columns)] Columns

63table1 :: Relation '[] '[ '("table1", Columns)] Columns

43table1 = #table1

64table1 = #table1

65+

66+parameterizedTable1 :: Relation '[ 'PGInt8] '[ '("table1", Columns)] Columns

67+parameterizedTable1 = #table1