@@ -1,11 +1,194 @@
11{-# LANGUAGE
22 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
315#-}
416
17+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
18+
519module Squeel.PostgreSQL.Query where
620
721import 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 }
8189
9−newtype Query db0 db1 ps xs = Query { unQuery :: ByteString }
10190newtype PreparedQuery db0 db1 ps xs
11191 = PreparedQuery { unPreparedQuery :: ByteString }
192+
193+select :: Relation ps ('[] :: [Column]) db xs -> Query db db ps xs
194+select (Relation x) = Query x