@@ -5,7 +5,7 @@ import Prelude.List
55-- |
66-- Module : sqlexpr
77-- Copyright : (c) The University of St Andrews, 2012
8−--
8+--
99-- Implementations for SQLite query data type.
1010--
1111-----------------------------------------------------------------------------
@@ -14,24 +14,24 @@ import Prelude.List
1414-----------------------------------------------------------
1515-- | SQL data type
1616-----------------------------------------------------------
17−
17+
1818data Value = VInt Int
19− |VStr String
20− |VFloat Float
21− |VCol String
22− |VNULL
23−
24−--Perhaps could extend this by adding
25−-- a dot operator to allow mapping
26−-- between table and column and
27−-- comparing different table columns.
19+ | VStr String
20+ | VFloat Float
21+ | VCol String
22+ | VNULL
23+
24+--Perhaps could extend this by adding
25+-- a dot operator to allow mapping
26+-- between table and column and
27+-- comparing different table columns.
2828
2929data Cond = Equals Value Value
30− |MkGT Value Value
31− |MkGTE Value Value
32− |MkLT Value Value
33− |MkLTE Value Value
34− |MkNULL Value
30+ | MkGT Value Value
31+ | MkGTE Value Value
32+ | MkLT Value Value
33+ | MkLTE Value Value
34+ | MkNULL Value
3535
3636data SelVar = Cols (List String)
3737 | ALL
@@ -68,50 +68,50 @@ mutual
6868 | CREATE SQL (List (Value, ColType , Constr))
6969
7070-- remember to remove these funcs later
71−-- foldr1 : (a -> a -> a) -> List a -> a
71+-- foldr1 : (a -> a -> a) -> List a -> a
7272-- foldr1 f [x] = x
7373-- foldr1 f (x::xs) = f x (foldr1 f xs)
7474
7575
7676-- unwords' : List (List Char) -> List Char
77−-- unwords' [] = []
77+-- unwords' [] = []
7878-- unwords' ws = (foldr1 addSpace ws)
7979-- where
8080-- addSpace : List Char -> List Char -> List Char
81−-- addSpace w s = w ++ (' ' :: s)
82−--
83−--
81+-- addSpace w s = w ++ (' ' :: s)
82+--
83+--
8484-- unwords : List String -> String
8585-- unwords = pack . unwords' . map unpack
8686
8787-----------------------------------------------------------
8888-- | This function replaces values with question mark
89−-- following by an index number. It then puts the value
89+-- following by an index number. It then puts the value
9090-- replaced, in the list.
9191-----------------------------------------------------------
9292
93−valString : List (Maybe(Int, Value)) -> Value -> (String, List (Maybe(Int, Value)))
94−valString xs (VInt x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VInt x))])
95−valString xs (VStr x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VStr x))])
96−valString xs (VFloat x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VFloat x))])
97−valString xs (VCol n) = (n, xs)
93+valString : List (Maybe (Int, Value)) -> Value -> (String, List (Maybe (Int, Value)))
94+valString xs (VInt x) = ("?" ++ show (cast (length xs) + 1), xs ++ [Just (cast ((length xs) + 1), (VInt x))])
95+valString xs (VStr x) = ("?" ++ show (cast (length xs) + 1), xs ++ [Just (cast ((length xs) + 1), (VStr x))])
96+valString xs (VFloat x) = ("?" ++ show (cast (length xs) + 1), xs ++ [Just (cast ((length xs) + 1), (VFloat x))])
97+valString xs (VCol n) = (n, xs)
9898
9999-----------------------------------------------------------
100100-- | This function calls valString on a list of Values
101101-- and separates the values by commas.
102102-----------------------------------------------------------
103103
104−listVal : List (Maybe(Int, Value)) -> List Value -> (String, List (Maybe(Int, Value)))
105−listVal xs [] = ("", xs)
104+listVal : List (Maybe (Int, Value)) -> List Value -> (String, List (Maybe (Int, Value)))
105+listVal xs [] = ("", xs)
106106listVal xs (v::vs) = let (str, newxs) = (valString xs v) in
107− let (str', newxs') = listVal newxs vs in
108− ((unwords(intersperse "," (words(str) ++ words (str')))), newxs')
107+ let (str', newxs') = listVal newxs vs in
108+ (unwords (intersperse "," (words (str) ++ words (str'))), newxs')
109109
110110-----------------------------------------------------------
111111-- | Parses the type of column to be created.
112112-----------------------------------------------------------
113−
114−getColType : List (Maybe(Int, Value)) -> ColType -> (String, List (Maybe(Int, Value)))
113+
114+getColType : List (Maybe (Int, Value)) -> ColType -> (String, List (Maybe (Int, Value)))
115115getColType xs (CInt x) = ("int", xs)
116116getColType xs (Varchar str) = ("varchar(255)", xs)
117117
@@ -119,14 +119,14 @@ getColType xs (Varchar str) = ("varchar(255)", xs)
119119-- | CREATE Constraints
120120-----------------------------------------------------------
121121
122−getConstr : List (Maybe(Int, Value)) -> Constr -> (String, List (Maybe(Int, Value)))
123−getConstr xs (NOTNULL) = ("NOT NULL", xs)
122+getConstr : List (Maybe (Int, Value)) -> Constr -> (String, List (Maybe (Int, Value)))
123+getConstr xs (NOTNULL) = ("NOT NULL", xs)
124124getConstr xs (UNIQUE constr) = ("NOT NULL UNIQUE", xs)
125−getConstr xs (PRIMARYKEY) = ("PRIMARY KEY", xs)
126−getConstr xs (FOREIGNKEY) = ("FOREIGN KEY", xs)
127−getConstr xs (CHECK) = ("CHECK", xs)
128−getConstr xs (DEFAULT) = ("DEFAULT", xs)
129−getConstr xs (None) = ("", xs)
125+getConstr xs (PRIMARYKEY) = ("PRIMARY KEY", xs)
126+getConstr xs (FOREIGNKEY) = ("FOREIGN KEY", xs)
127+getConstr xs (CHECK) = ("CHECK", xs)
128+getConstr xs (DEFAULT) = ("DEFAULT", xs)
129+getConstr xs (None) = ("", xs)
130130
131131putBrackets : String -> String
132132putBrackets str = "(" ++ str ++ ")"
@@ -136,141 +136,143 @@ putBrackets str = "(" ++ str ++ ")"
136136-- This function is used for bracketing the nested queries.
137137-----------------------------------------------------------
138138complexType : SQL -> Bool
139−complexType (TBL tbl) = False
139+complexType (TBL tbl) = False
140140complexType (SELECT vars sql c) = True
141−
141+
142142-----------------------------------------------------------
143143-- | Used in CREATE
144−-----------------------------------------------------------
145−
146−listValType : List (Maybe(Int, Value)) -> List (Value, ColType , Constr) -> (String, List (Maybe(Int, Value)))
144+-----------------------------------------------------------
145+
146+listValType : List (Maybe (Int, Value)) -> List (Value, ColType , Constr) -> (String, List (Maybe (Int, Value)))
147147listValType xs [] = ("", xs)
148−listValType xs ((val, types, constr) :: vs) = let (str , newxs) = valString xs val in
149− let (str' , newxs') = getColType newxs types in
150− let (str'', newxs'') = getConstr newxs' constr in
151− let (finalstr, finalxs) = listValType newxs'' vs in
152− ((unwords(intersperse " " (words(str) ++ words(str') ++ words(str'') ++ words(finalstr)))) , finalxs)
148+listValType xs ((val, types, constr) :: vs) =
149+ let (str , newxs) = valString xs val in
150+ let (str' , newxs') = getColType newxs types in
151+ let (str'', newxs'') = getConstr newxs' constr in
152+ let (finalstr, finalxs) = listValType newxs'' vs in
153+ (unwords (intersperse " " (words str ++ words str' ++ words str'' ++ words finalstr)) , finalxs)
153154
154155
155156-----------------------------------------------------------
156157-- | Evaluates a conditional WHERE clause
157−-----------------------------------------------------------
158+-----------------------------------------------------------
158159
159−evalCond : List (Maybe(Int, Value)) -> Cond -> (String, List (Maybe(Int, Value)))
160+evalCond : List (Maybe (Int, Value)) -> Cond -> (String, List (Maybe (Int, Value)))
160161evalCond xs (Equals val1 val2) = let (restring , newxs ) = valString xs val1 in
161162 let (restring2, newxs') = valString newxs val2 in
162− (restring ++ " = " ++ restring2, newxs')
163−
163+ (restring ++ " = " ++ restring2, newxs')
164+
164165evalCond xs (MkGT val1 val2) = let (restring , newxs ) = valString xs val1 in
165− let (restring2, newxs') = valString newxs val2 in
166− (restring ++ " > " ++ restring2, newxs')
166+ let (restring2, newxs') = valString newxs val2 in
167+ (restring ++ " > " ++ restring2, newxs')
167168
168169evalCond xs (MkGTE val1 val2) = let (restring , newxs ) = valString xs val1 in
169− let (restring2, newxs') = valString newxs val2 in
170− (restring ++ " >= " ++ restring2, newxs')
170+ let (restring2, newxs') = valString newxs val2 in
171+ (restring ++ " >= " ++ restring2, newxs')
171172
172173evalCond xs (MkLT val1 val2) = let (restring , newxs ) = valString xs val1 in
173− let (restring2, newxs') = valString newxs val2 in
174− (restring ++ " < " ++ restring2, newxs')
175−
174+ let (restring2, newxs') = valString newxs val2 in
175+ (restring ++ " < " ++ restring2, newxs')
176+
176177evalCond xs (MkLTE val1 val2) = let (restring , newxs ) = valString xs val1 in
177− let (restring2, newxs') = valString newxs val2 in
178− (restring ++ " =< " ++ restring2, newxs')
179−
178+ let (restring2, newxs') = valString newxs val2 in
179+ (restring ++ " =< " ++ restring2, newxs')
180+
180181evalCond xs (MkNULL val) = let (restring , newxs ) = valString xs val in
181− (restring ++ " IS NULL " , newxs)
182+ (restring ++ " IS NULL " , newxs)
183+
182184
183−-----------------------------------------------------------
184−-- | Evaluates queries by calling the other functions
185−-- on each part of the query
186−-----------------------------------------------------------
187−evalSQL : List (Maybe(Int, Value)) -> SQL -> ( String, List (Maybe(Int, Value)))
188185-----------------------------------------------------------
189186-- | Evaluates clauses
190187-- Supports WHERE Clause
191188-- WHERE Clause And Another-Clause
192189-- WHERE Clause Or Another-Clause
193−-----------------------------------------------------------
194−clauseString : List (Maybe(Int, Value)) -> Clause -> (String, List (Maybe(Int, Value)))
190+-----------------------------------------------------------
191+clauseString : List (Maybe (Int, Value)) -> Clause -> (String, List (Maybe (Int, Value)))
195192
196193clauseString xs (Empty) = ("" , []) -- No condition
197194clauseString xs (MkCond cond') = let (condstr, newxs) = evalCond xs cond' in
198− (condstr , newxs)
195+ (condstr , newxs)
199196
200197clauseString xs (AND c1 c2) = let (clausestr, newxs) = clauseString xs c1 in
201198 let (clausestr2, newxs') = clauseString newxs c2 in
202− (clausestr ++ " AND " ++clausestr2 , newxs')
203−
204−clauseString xs (OR c1 c2) = let (clausestr, newxs) = clauseString xs c1 in
205− let (clausestr2, newxs') = clauseString newxs c2 in
206− (clausestr ++ " OR " ++clausestr2 , newxs')
207−
199+ (clausestr ++ " AND " ++ clausestr2 , newxs')
200+
201+clauseString xs (OR c1 c2) = let (clausestr, newxs) = clauseString xs c1 in
202+ let (clausestr2, newxs') = clauseString newxs c2 in
203+ (clausestr ++ " OR " ++ clausestr2 , newxs')
204+
208205
209206-----------------------------------------------------------
210207-- | Evaluates conditional clauses.
211208-----------------------------------------------------------
212−
213−condClauseStr : List (Maybe(Int, Value)) -> condClause -> (String, List (Maybe(Int, Value)))
209+
210+condClauseStr : List (Maybe (Int, Value)) -> condClause -> (String, List (Maybe (Int, Value)))
214211condClauseStr xs (SET setcl) = let (condstr, newxs) = clauseString xs setcl in
215− (" SET " ++ condstr, newxs)
216−
212+ (" SET " ++ condstr, newxs)
213+
217214condClauseStr xs (WHERE setcl1 setcl2) = let (condstr, newxs) = condClauseStr xs setcl1 in
218215 let (condstr', newxs') = clauseString newxs setcl2 in
219− ( condstr ++ " WHERE " ++ condstr', newxs')
220−
221−-- SELECT data from tbl1 where num > (SELECT num from tbl1 where num = 24)
222−-- evalSQL [] ((SELECT ALL)(TBL "tbl")(MkSQL ((SELECT ALL) (TBL "tbl")(MkCond (VCol "))))
223−-- NTBF
216+ ( condstr ++ " WHERE " ++ condstr', newxs')
217+
218+
219+-----------------------------------------------------------
220+-- | Evaluates queries by calling the other functions
221+-- on each part of the query
222+-----------------------------------------------------------
223+evalSQL : List (Maybe (Int, Value)) -> SQL -> (String, List (Maybe (Int, Value)))
224+-- SELECT data from tbl1 where num > (SELECT num from tbl1 where num = 24)
225+-- evalSQL [] ((SELECT ALL)(TBL "tbl")(MkSQL ((SELECT ALL) (TBL "tbl")(MkCond (VCol "))))
226+-- NTBF
224227--clauseString xs (MkSQL sql) = (evalSQL xs sql)
225228
226−-- Separate list of tables
229+-- Separate list of tables
227230-- For complex type, return list returned by evalSQL
228−-- And add brackets
229−evalSQL xs (TBL tbl) = ((unwords (intersperse "," ( tbl))), xs)
230−evalSQL xs (SELECT vars sql' c) = let (sqlstring, newxs) = evalSQL xs sql' in
231− let (csstring, newxs') = clauseString newxs c in
232− case c of
233− Empty => case vars of
234− (ALL ) => if complexType sql' then ("SELECT " ++ "*" ++ " FROM "
235− ++ (putBrackets sqlstring) ++ csstring, newxs)
236−
237− else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring
238− ++ csstring, newxs')
239−
240− (Cols selvar) => if complexType sql' then ("SELECT " ++ (unwords selvar) ++
241− " FROM " ++ (putBrackets sqlstring) ++ csstring, newxs)
242−
243− else ("SELECT " ++ (unwords selvar )++ " FROM " ++ sqlstring
244− ++ csstring, newxs')
245−
246− _ => case vars of
247− (ALL ) => if complexType sql' then ("SELECT " ++ "*" ++ " FROM "
248− ++ " WHERE " ++ csstring , newxs)
249− else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring
250− ++ " WHERE " ++ csstring , newxs')
251−
252− (Cols selvar) => if complexType sql' then ("SELECT " ++ (unwords selvar) ++ " FROM " ++
253− (putBrackets sqlstring) ++ " WHERE "
254− ++ csstring , newxs)
255−
256− else ("SELECT " ++ (unwords selvar) ++ " FROM " ++ sqlstring
257− ++ " WHERE " ++ csstring , newxs')
258−
259−
260−evalSQL xs (INSERT sql vals) = let (tblname, newvals) = evalSQL xs sql in
261− let (str, newxs ) = listVal newvals vals in
262− ("INSERT INTO " ++ tblname ++ " VALUES (" ++ str ++ ")" , newxs)
263−
264−evalSQL xs (INSERTC sql cols vals) = let (tblname, newvals) = evalSQL xs sql in
231+-- And add brackets
232+evalSQL xs (TBL tbl) = (unwords (intersperse "," ( tbl)), xs)
233+evalSQL xs (SELECT vars sql' c) =
234+ let (sqlstring, newxs) = evalSQL xs sql' in
235+ let (csstring, newxs') = clauseString newxs c in
236+ case c of
237+ Empty => case vars of
238+ ALL => if complexType sql'
239+ then ("SELECT " ++ "*" ++ " FROM " ++
240+ putBrackets sqlstring ++ csstring, newxs)
241+ else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring ++
242+ csstring, newxs')
243+ Cols selvar => if complexType sql'
244+ then ("SELECT " ++ unwords selvar ++
245+ " FROM " ++ putBrackets sqlstring ++ csstring, newxs)
246+ else ("SELECT " ++ unwords selvar ++ " FROM " ++ sqlstring ++
247+ csstring, newxs')
248+ _ => case vars of
249+ ALL => if complexType sql'
250+ then ("SELECT " ++ "*" ++ " FROM " ++
251+ " WHERE " ++ csstring, newxs)
252+ else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring
253+ ++ " WHERE " ++ csstring, newxs')
254+ Cols selvar => if complexType sql'
255+ then ("SELECT " ++ (unwords selvar) ++ " FROM " ++
256+ putBrackets sqlstring ++ " WHERE " ++
257+ csstring , newxs)
258+ else ("SELECT " ++ (unwords selvar) ++ " FROM " ++ sqlstring ++
259+ " WHERE " ++ csstring, newxs')
260+
261+
262+evalSQL xs (INSERT sql vals) = let (tblname, newvals) = evalSQL xs sql in
263+ let (str, newxs ) = listVal newvals vals in
264+ ("INSERT INTO " ++ tblname ++ " VALUES (" ++ str ++ ")", newxs)
265+
266+evalSQL xs (INSERTC sql cols vals) = let (tblname, newvals) = evalSQL xs sql in
265267 let (strcol, newcol) = listVal newvals cols in
266268 let (strval, newcolval) = listVal newcol vals in
267− ("INSERT INTO " ++ tblname ++ "(" ++ strcol ++ ")" ++ "VALUES (" ++ strval ++ ")", newcolval)
269+ ("INSERT INTO " ++ tblname ++ "(" ++ strcol ++ ")" ++ "VALUES (" ++ strval ++ ")", newcolval)
268270
269271
270272evalSQL xs (UPDATE sql cl) = let (tblname, newxs) = evalSQL xs sql in
271− let (csstring, newxs') = condClauseStr newxs cl in
272− ("UPDATE " ++ tblname ++ csstring, newxs')
273+ let (csstring, newxs') = condClauseStr newxs cl in
274+ ("UPDATE " ++ tblname ++ csstring, newxs')
273275
274276evalSQL xs (CREATE sql details) = let (sqlstring, newxs) = evalSQL xs sql in
275277 let (csstring, newxs') = listValType newxs details in
276− ("CREATE TABLE " ++ sqlstring ++ "(" ++ csstring ++ ")", newxs')
278+ ("CREATE TABLE " ++ sqlstring ++ "(" ++ csstring ++ ")", newxs')