git.iko.soy/Idris-dev
on master help sign in
Merge pull request #296 from david-christiansen/sqlite

Sqlite bindings updated to work with latest Idris and on Linux

commitc8ba164bf0dd837eae6743682e17a8fe8c4e6e14 authorEdwin Brady <edwin.brady@gmail.com> dateThu 2 May 2013, 04:39 (13 years ago) parent1f562fc18da492
4 files changed+451−430
compare with master
unifiedsplit
contribs/lib/SQLite3/Makefile+1−1 contribs/lib/SQLite3/Sqlexpr.idr+278 contribs/lib/SQLite3/sqlite3.idr → contribs/lib/SQLite3/Sqlite3.idr+172−155 contribs/lib/SQLite3/sqlexpr.idr−274
contribs/lib/SQLite3/Makefile+1−1
@@ -3,7 +3,7 @@
33
44.PHONY: all
55
6−sqltest : testunit.idr sqlite3.idr sqlite3api.o
6+sqltest : testunit.idr Sqlite3.idr sqlite3api.o
77 idris testunit.idr -o sqltest
88
99sqlite3api.o : sqlite3api.c
contribs/lib/SQLite3/Sqlexpr.idrnew file+278
@@ -0,0 +1,278 @@
1+module Sqlexpr
2+import Prelude.List
3+
4+-----------------------------------------------------------------------------
5+-- |
6+-- Module : sqlexpr
7+-- Copyright : (c) The University of St Andrews, 2012
8+--
9+-- Implementations for SQLite query data type.
10+--
11+-----------------------------------------------------------------------------
12+
13+
14+-----------------------------------------------------------
15+-- | SQL data type
16+-----------------------------------------------------------
17+
18+data 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.
28+
29+data Cond = Equals Value Value
30+ | MkGT Value Value
31+ | MkGTE Value Value
32+ | MkLT Value Value
33+ | MkLTE Value Value
34+ | MkNULL Value
35+
36+data SelVar = Cols (List String)
37+ | ALL
38+
39+data ColType = CInt String -- parsed as string "int"
40+ | Varchar String
41+
42+
43+
44+mutual
45+ data Clause = MkCond Cond
46+ | AND Clause Clause
47+ | OR Clause Clause
48+ | Empty
49+ | MkSQL SQL
50+
51+ data condClause = SET Clause
52+ | WHERE condClause Clause
53+
54+ data Constr = NOTNULL
55+ | UNIQUE Constr
56+ | None
57+ | PRIMARYKEY
58+ | FOREIGNKEY
59+ | CHECK
60+ | DEFAULT
61+
62+
63+ data SQL = SELECT SelVar SQL Clause
64+ | TBL (List String)
65+ | INSERT SQL (List Value)
66+ | INSERTC SQL (List Value) (List Value)
67+ | UPDATE SQL condClause
68+ | CREATE SQL (List (Value, ColType , Constr))
69+
70+-- remember to remove these funcs later
71+-- foldr1 : (a -> a -> a) -> List a -> a
72+-- foldr1 f [x] = x
73+-- foldr1 f (x::xs) = f x (foldr1 f xs)
74+
75+
76+-- unwords' : List (List Char) -> List Char
77+-- unwords' [] = []
78+-- unwords' ws = (foldr1 addSpace ws)
79+-- where
80+-- addSpace : List Char -> List Char -> List Char
81+-- addSpace w s = w ++ (' ' :: s)
82+--
83+--
84+-- unwords : List String -> String
85+-- unwords = pack . unwords' . map unpack
86+
87+-----------------------------------------------------------
88+-- | This function replaces values with question mark
89+-- following by an index number. It then puts the value
90+-- replaced, in the list.
91+-----------------------------------------------------------
92+
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)
98+
99+-----------------------------------------------------------
100+-- | This function calls valString on a list of Values
101+-- and separates the values by commas.
102+-----------------------------------------------------------
103+
104+listVal : List (Maybe (Int, Value)) -> List Value -> (String, List (Maybe (Int, Value)))
105+listVal xs [] = ("", xs)
106+listVal 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')
109+
110+-----------------------------------------------------------
111+-- | Parses the type of column to be created.
112+-----------------------------------------------------------
113+
114+getColType : List (Maybe (Int, Value)) -> ColType -> (String, List (Maybe (Int, Value)))
115+getColType xs (CInt x) = ("int", xs)
116+getColType xs (Varchar str) = ("varchar(255)", xs)
117+
118+-----------------------------------------------------------
119+-- | CREATE Constraints
120+-----------------------------------------------------------
121+
122+getConstr : List (Maybe (Int, Value)) -> Constr -> (String, List (Maybe (Int, Value)))
123+getConstr xs (NOTNULL) = ("NOT NULL", xs)
124+getConstr 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)
130+
131+putBrackets : String -> String
132+putBrackets str = "(" ++ str ++ ")"
133+
134+-----------------------------------------------------------
135+-- | Used to detect a complex type in a nested SQLite query
136+-- This function is used for bracketing the nested queries.
137+-----------------------------------------------------------
138+complexType : SQL -> Bool
139+complexType (TBL tbl) = False
140+complexType (SELECT vars sql c) = True
141+
142+-----------------------------------------------------------
143+-- | Used in CREATE
144+-----------------------------------------------------------
145+
146+listValType : List (Maybe (Int, Value)) -> List (Value, ColType , Constr) -> (String, List (Maybe (Int, Value)))
147+listValType xs [] = ("", xs)
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)
154+
155+
156+-----------------------------------------------------------
157+-- | Evaluates a conditional WHERE clause
158+-----------------------------------------------------------
159+
160+evalCond : List (Maybe (Int, Value)) -> Cond -> (String, List (Maybe (Int, Value)))
161+evalCond xs (Equals val1 val2) = let (restring , newxs ) = valString xs val1 in
162+ let (restring2, newxs') = valString newxs val2 in
163+ (restring ++ " = " ++ restring2, newxs')
164+
165+evalCond xs (MkGT val1 val2) = let (restring , newxs ) = valString xs val1 in
166+ let (restring2, newxs') = valString newxs val2 in
167+ (restring ++ " > " ++ restring2, newxs')
168+
169+evalCond xs (MkGTE val1 val2) = let (restring , newxs ) = valString xs val1 in
170+ let (restring2, newxs') = valString newxs val2 in
171+ (restring ++ " >= " ++ restring2, newxs')
172+
173+evalCond xs (MkLT val1 val2) = let (restring , newxs ) = valString xs val1 in
174+ let (restring2, newxs') = valString newxs val2 in
175+ (restring ++ " < " ++ restring2, newxs')
176+
177+evalCond xs (MkLTE val1 val2) = let (restring , newxs ) = valString xs val1 in
178+ let (restring2, newxs') = valString newxs val2 in
179+ (restring ++ " =< " ++ restring2, newxs')
180+
181+evalCond xs (MkNULL val) = let (restring , newxs ) = valString xs val in
182+ (restring ++ " IS NULL " , newxs)
183+
184+
185+-----------------------------------------------------------
186+-- | Evaluates clauses
187+-- Supports WHERE Clause
188+-- WHERE Clause And Another-Clause
189+-- WHERE Clause Or Another-Clause
190+-----------------------------------------------------------
191+clauseString : List (Maybe (Int, Value)) -> Clause -> (String, List (Maybe (Int, Value)))
192+
193+clauseString xs (Empty) = ("" , []) -- No condition
194+clauseString xs (MkCond cond') = let (condstr, newxs) = evalCond xs cond' in
195+ (condstr , newxs)
196+
197+clauseString xs (AND c1 c2) = let (clausestr, newxs) = clauseString xs c1 in
198+ let (clausestr2, newxs') = clauseString newxs c2 in
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+
205+
206+-----------------------------------------------------------
207+-- | Evaluates conditional clauses.
208+-----------------------------------------------------------
209+
210+condClauseStr : List (Maybe (Int, Value)) -> condClause -> (String, List (Maybe (Int, Value)))
211+condClauseStr xs (SET setcl) = let (condstr, newxs) = clauseString xs setcl in
212+ (" SET " ++ condstr, newxs)
213+
214+condClauseStr xs (WHERE setcl1 setcl2) = let (condstr, newxs) = condClauseStr xs setcl1 in
215+ let (condstr', newxs') = clauseString newxs setcl2 in
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
227+--clauseString xs (MkSQL sql) = (evalSQL xs sql)
228+
229+-- Separate list of tables
230+-- For complex type, return list returned by evalSQL
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
267+ let (strcol, newcol) = listVal newvals cols in
268+ let (strval, newcolval) = listVal newcol vals in
269+ ("INSERT INTO " ++ tblname ++ "(" ++ strcol ++ ")" ++ "VALUES (" ++ strval ++ ")", newcolval)
270+
271+
272+evalSQL xs (UPDATE sql cl) = let (tblname, newxs) = evalSQL xs sql in
273+ let (csstring, newxs') = condClauseStr newxs cl in
274+ ("UPDATE " ++ tblname ++ csstring, newxs')
275+
276+evalSQL xs (CREATE sql details) = let (sqlstring, newxs) = evalSQL xs sql in
277+ let (csstring, newxs') = listValType newxs details in
278+ ("CREATE TABLE " ++ sqlstring ++ "(" ++ csstring ++ ")", newxs')
contribs/lib/SQLite3/sqlite3.idr → contribs/lib/SQLite3/Sqlite3.idrrenamed+172−155
@@ -22,7 +22,7 @@ data DBVal = DBInt Int
2222 | DBText String
2323 | DBFloat Float
2424 | DBNull
25−
25+
2626-- Database pointer
2727data DBPointer = MkDBPointer Ptr
2828-- Table pointer
@@ -30,16 +30,29 @@ data TBPointer = MkTBPointer Ptr
3030-- Statement pointer
3131data StmtPtr = MkStmtPtr Ptr
3232
33−Table : Set
33+Table : Type
3434Table = List (List DBVal)
3535
3636-- ForMap used in to_list_v1
37−forM : Monad m => List a -> (a -> m b) -> m (List b)
38−forM f xs = mapM xs f
37+forM : Applicative f => List a -> (a -> f b) -> f (List b)
38+forM xs f = (sequence (map f xs))
3939
4040-- Neater error handling done using DB
4141data DB a = MkDB (IO (Either String a))
4242
43+instance Functor DB where
44+ fmap f (MkDB action) = MkDB (do res <- action
45+ return (fmap f res))
46+
47+
48+instance Applicative DB where
49+ pure = MkDB . return . Right
50+ (MkDB f) <$> (MkDB x) = MkDB (do f' <- f
51+ case f' of
52+ Left err => return (Left err)
53+ Right op => x >>= (return . fmap op))
54+
55+
4356instance Monad DB where
4457 (MkDB l) >>= k = MkDB (do c <- l
4558 case c of
@@ -63,14 +76,14 @@ runDB : DB a -> IO a
6376runDB (MkDB f) = do f' <- f
6477 case f' of
6578 Right v => return v
66− Left str => ioError str
67−
79+ Left str => ioError str
80+
6881-----------------------------------------------------------------------------
6982-- | Opens an SQLite database file as specified by the String name argument.
7083-----------------------------------------------------------------------------
71−
84+
7285open_db : String -> DB DBPointer
73−open_db name = do x <- liftIO(mkForeign (FFun "sqlite3_open_idr" [FString] FPtr) name)
86+open_db name = do x <- liftIO (mkForeign (FFun "sqlite3_open_idr" [FString] FPtr) name)
7487 return (MkDBPointer x)
7588
7689-----------------------------------------------------------------------------
@@ -78,38 +91,38 @@ open_db name = do x <- liftIO(mkForeign (FFun "sqlite3_open_idr" [FString] FPtr)
7891-----------------------------------------------------------------------------
7992
8093close_db : DBPointer -> DB Int
81−close_db (MkDBPointer pointer) = liftIO (mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt)pointer)
94+close_db (MkDBPointer pointer) = liftIO (mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt) pointer)
8295
8396-----------------------------------------------------------------------------
8497-- | Wrapper around prepare, step and finalize.
8598-----------------------------------------------------------------------------
86−
99+
87100exec_db : DBPointer -> String -> DB Int
88−exec_db (MkDBPointer pointer) stmt = do
89− x <- liftIO(mkForeign (FFun "sqlite3_exec_idr" [FPtr, FString] FInt)pointer stmt)
101+exec_db (MkDBPointer pointer) stmt = do
102+ x <- liftIO (mkForeign (FFun "sqlite3_exec_idr" [FPtr, FString] FInt) pointer stmt)
90103 if (x == 1)
91− then fail "Could not execute."
92− else return x
104+ then fail "Could not execute."
105+ else return x
93106
94107-----------------------------------------------------------------------------
95108-- | Executes a prepared query. Use of this version is recommended.
96109-----------------------------------------------------------------------------
97110
98111exec_db_v2 : StmtPtr -> DB Int
99−exec_db_v2 (MkStmtPtr pointer) = do
112+exec_db_v2 (MkStmtPtr pointer) = do
100113 x <- liftIO (mkForeign (FFun "exec_db" [FPtr] FInt) pointer)
101114 if (x == 21)
102− then fail "No data returned."
103− else return x
104−
115+ then fail "No data returned."
116+ else return x
117+
105118-----------------------------------------------------------------------------
106119-- | Returns the error stored in the buffer by exec_db function.
107120-- This function can only be used with exec_db and get_table.
108121-- Only these functions store any occured error in the buffer array.
109122-----------------------------------------------------------------------------
110−
123+
111124get_error : DBPointer -> IO String
112−get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
125+get_error (MkDBPointer pointer) = mkForeign (FFun "sqlite3_get_error" [FPtr] FString) pointer
113126
114127
115128-----------------------------------------------------------------------------
@@ -117,14 +130,14 @@ get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FStr
117130-- Returns a pointer to a Statement pointer on a successful call.
118131-- Returns a null pointer on a failure.
119132-----------------------------------------------------------------------------
120−
133+
121134prepare_db : DBPointer -> String -> DB StmtPtr
122135prepare_db (MkDBPointer pointer) cmd = do
123− result <- liftIO(mkForeign (FFun "sqlite3_prepare_idr" [FPtr, FString] FPtr)pointer cmd)
124− flag <- liftIO(nullPtr result)
136+ result <- liftIO (mkForeign (FFun "sqlite3_prepare_idr" [FPtr, FString] FPtr) pointer cmd)
137+ flag <- liftIO (nullPtr result)
125138 if flag
126− then fail "Error occured while preparing"
127− else return (MkStmtPtr result)
139+ then fail "Error occured while preparing"
140+ else return (MkStmtPtr result)
128141
129142-----------------------------------------------------------------------------
130143-- | Returns the error stored in the buffer by exec_db function.
@@ -136,81 +149,92 @@ step_db : StmtPtr -> DB Int
136149step_db (MkStmtPtr pointer)= do
137150 x <- liftIO (mkForeign (FFun "sqlite3_step_idr" [FPtr] FInt)pointer)
138151 if ( x == 101)
139− then fail "SQLITE_DONE"
140− else return x
152+ then fail "SQLITE_DONE"
153+ else return x
141154
142155-----------------------------------------------------------------------------
143−-- | Deletes a prepared statement. This function must be called after
156+-- | Deletes a prepared statement. This function must be called after
144157-- prepare function.
145158-----------------------------------------------------------------------------
146159
147160finalize_db : StmtPtr -> DB Int
148−finalize_db (MkStmtPtr pointer) = do
149− x <- liftIO (mkForeign (FFun "sqlite3_finalize_idr" [FPtr] FInt)pointer)
161+finalize_db (MkStmtPtr pointer) = do
162+ x <- liftIO (mkForeign (FFun "sqlite3_finalize_idr" [FPtr] FInt) pointer)
150163 if (x /= 0)
151− then fail "Could not finalize"
152− else return x
164+ then fail "Could not finalize"
165+ else return x
153166
154167-----------------------------------------------------------------------------
155168-- | Resets a prepared statement pointer back to its initial state.
156169-----------------------------------------------------------------------------
157170
158171reset_db : StmtPtr -> DB Int
159−reset_db (MkStmtPtr pointer) = do
160− x <- liftIO(mkForeign (FFun "sqlite3_reset_idr" [FPtr] FInt)pointer)
161− if (x /=0)
162− then fail "Could not reset"
163− else return x
172+reset_db (MkStmtPtr pointer) = do
173+ x <- liftIO (mkForeign (FFun "sqlite3_reset_idr" [FPtr] FInt) pointer)
174+ if (x /= 0)
175+ then fail "Could not reset"
176+ else return x
164177
165178-----------------------------------------------------------------------------
166179-- | These routines obtain column information.
167180-----------------------------------------------------------------------------
168181
169182column_count : DBPointer -> IO (Either String Int)
170−column_count (MkDBPointer pointer) = do
171− x <- mkForeign (FFun "sqlite3_column_count_idr" [FPtr] FInt)pointer
172− if (x == 0 )
173− then return (Left "No Data")
174− else return (Right x)
183+column_count (MkDBPointer pointer) = do
184+ x <- mkForeign (FFun "sqlite3_column_count_idr" [FPtr] FInt) pointer
185+ return $ if (x == 0 )
186+ then Left "No Data"
187+ else (Right x)
175188
176189column_name : DBPointer -> Int -> IO String
177−column_name (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_name_idr" [FPtr, FInt] FString)pointer iCol
178−
190+column_name (MkDBPointer pointer) iCol =
191+ mkForeign (FFun "sqlite3_column_name_idr" [FPtr, FInt] FString) pointer iCol
192+
179193column_decltype : DBPointer -> Int -> IO String
180−column_decltype (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_decltype_idr" [FPtr, FInt] FString)pointer iCol
194+column_decltype (MkDBPointer pointer) iCol =
195+ mkForeign (FFun "sqlite3_column_decltype_idr" [FPtr, FInt] FString) pointer iCol
181196
182197
183198column_bytes : DBPointer -> Int -> IO Int
184−column_bytes (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FInt)pointer iCol
199+column_bytes (MkDBPointer pointer) iCol =
200+ mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FInt) pointer iCol
185201
186202
187203column_blob : DBPointer -> Int -> IO String
188−column_blob (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FString)pointer iCol
204+column_blob (MkDBPointer pointer) iCol =
205+ mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FString) pointer iCol
189206
190207
191208column_text : DBPointer -> Int -> IO String
192−column_text (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_text_idr" [FPtr, FInt] FString)pointer iCol
209+column_text (MkDBPointer pointer) iCol =
210+ mkForeign (FFun "sqlite3_column_text_idr" [FPtr, FInt] FString) pointer iCol
193211
194212
195213column_Int : DBPointer -> Int -> IO Int
196−column_Int (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_int_idr" [FPtr, FInt] FInt)pointer iCol
214+column_Int (MkDBPointer pointer) iCol =
215+ mkForeign (FFun "sqlite3_column_int_idr" [FPtr, FInt] FInt) pointer iCol
197216
198217-----------------------------------------------------------------------------
199218-- | These routines support some of SQLite backup functions.
200219-----------------------------------------------------------------------------
201220
202−backup_init : DBPointer -> String -> DBPointer -> String -> IO DBPointer
203−backup_init (MkDBPointer des_pointer) destName (MkDBPointer src_pointer) srcName = do x <- mkForeign (FFun "sqlite3_backup_init_idr" [FPtr,FString, FPtr, FString] FPtr)des_pointer destName src_pointer srcName
204− return (MkDBPointer x)
221+backup_init : DBPointer -> String -> DBPointer -> String -> IO DBPointer
222+backup_init (MkDBPointer des_pointer) destName (MkDBPointer src_pointer) srcName =
223+ do x <- mkForeign (FFun "sqlite3_backup_init_idr" [FPtr,FString, FPtr, FString] FPtr)
224+ des_pointer destName src_pointer srcName
225+ return (MkDBPointer x)
205226
206227backup_step : DBPointer -> Int -> IO Int
207−backup_step (MkDBPointer pointer) nPage =mkForeign (FFun "sqlite3_backup_step_idr" [FPtr, FInt] FInt)pointer nPage
228+backup_step (MkDBPointer pointer) nPage =
229+ mkForeign (FFun "sqlite3_backup_step_idr" [FPtr, FInt] FInt) pointer nPage
208230
209231backup_finish : DBPointer -> IO Int
210−backup_finish (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_finish_idr" [FPtr] FInt)pointer
232+backup_finish (MkDBPointer pointer) =
233+ mkForeign (FFun "sqlite3_backup_finish_idr" [FPtr] FInt) pointer
211234
212235backup_remaining : DBPointer -> IO Int
213−backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt)pointer
236+backup_remaining (MkDBPointer pointer) =
237+ mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt) pointer
214238
215239
216240-----------------------------------------------------------------------------
@@ -221,104 +245,98 @@ backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remainin
221245-----------------------------------------------------------------------------
222246
223247get_table : DBPointer -> String -> DB TBPointer
224−get_table (MkDBPointer pointer) name = do
225− x <- liftIO(mkForeign (FFun "sqlite3_get_table_idr" [FPtr, FString] FPtr)pointer name)
226− flag <- liftIO(nullPtr x)
248+get_table (MkDBPointer pointer) name = do
249+ x <- liftIO(mkForeign (FFun "sqlite3_get_table_idr" [FPtr, FString] FPtr) pointer name)
250+ flag <- liftIO (nullPtr x)
227251 if flag
228− then do x <- liftIO(get_error_table pointer) ; fail x
229− else return (MkTBPointer x)
252+ then do x <- liftIO(get_error_table pointer) ; fail x
253+ else return (MkTBPointer x)
230254 where
231255 get_error_table : Ptr-> IO String
232− get_error_table pointer = do x <- mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
256+ get_error_table pointer = do x <- mkForeign (FFun "sqlite3_get_error" [FPtr] FString) pointer
233257 return x
234258
235259
236260free_table : TBPointer -> IO ()
237−free_table (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit)pointer
261+free_table (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit) pointer
238262 return ()
239−
263+
240264-----------------------------------------------------------------------------
241265-- | This version of these function obtain the row and column number
242266-- from the Table struct. These functions are only used with get_table.
243267-----------------------------------------------------------------------------
244268
245269num_row : TBPointer -> IO Int
246−num_row (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row" [FPtr] FInt)pointer
247− return (x)
270+num_row (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row" [FPtr] FInt) pointer
271+ return x
248272
249273num_col : TBPointer -> IO Int
250−num_col (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col" [FPtr] FInt)pointer
251− return (x)
252−
274+num_col (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col" [FPtr] FInt) pointer
275+ return x
276+
253277-----------------------------------------------------------------------------
254278-- | This version of these function obtain the row and column number
255279-- from the Database struct.
256280-----------------------------------------------------------------------------
257281
258282num_row_v2 : DBPointer -> IO Int
259−num_row_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row_v2" [FPtr] FInt)pointer
260− return (x)
283+num_row_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row_v2" [FPtr] FInt) pointer
284+ return x
261285
262286num_col_v2 : DBPointer -> IO Int
263−num_col_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col_v2" [FPtr] FInt)pointer
264− return (x)
265−
287+num_col_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col_v2" [FPtr] FInt) pointer
288+ return x
289+
266290-----------------------------------------------------------------------------
267291-- | This function prints the result of a query by checking the type
268292-- of each value returned, it then calls the appropriate function.
269293-- Ther result is one of the DBVal variants.
270294-----------------------------------------------------------------------------
271−
295+
272296get_data : DBPointer -> Int -> Int -> IO DBVal
273297get_data (MkDBPointer pointer) row col = do
274298 ty <- get_data_type pointer row col
275299 helper ty
276− where
277− get_data_type : Ptr ->Int -> Int -> IO Int
278− get_data_type pointer row col =mkForeign (FFun "sqlite3_get_data_type" [FPtr, FInt, FInt] FInt)pointer row col
279−
280− get_data_val_int : Ptr -> Int -> IO Int
281− get_data_val_int pointer col =mkForeign (FFun "sqlite3_get_val_int" [FPtr,FInt] FInt)pointer col
282−
283− get_data_val_text : Ptr -> Int -> IO String
284− get_data_val_text pointer col =mkForeign (FFun "sqlite3_get_val_text" [FPtr, FInt] FString)pointer col
285−
286−
287−
288− get_data_val_float : Ptr -> Int -> IO Float
289− get_data_val_float pointer col =mkForeign (FFun "sqlite3_get_float" [FPtr, FInt] FFloat)pointer col
290−
291− helper : Int -> IO DBVal
292− helper 1 = do i <- get_data_val_int pointer col ; return (DBInt i)
293− helper 2 = do i <- get_data_val_float pointer col ; return (DBFloat i)
294− helper 3 = do i <- get_data_val_text pointer col; return (DBText i)
295− helper _ =return (DBNull)
296−
300+ where get_data_type : Ptr ->Int -> Int -> IO Int
301+ get_data_type pointer row col =
302+ mkForeign (FFun "sqlite3_get_data_type" [FPtr, FInt, FInt] FInt) pointer row col
303+ get_data_val_int : Ptr -> Int -> IO Int
304+ get_data_val_int pointer col =
305+ mkForeign (FFun "sqlite3_get_val_int" [FPtr,FInt] FInt) pointer col
306+
307+ get_data_val_text : Ptr -> Int -> IO String
308+ get_data_val_text pointer col =
309+ mkForeign (FFun "sqlite3_get_val_text" [FPtr, FInt] FString) pointer col
310+
311+ get_data_val_float : Ptr -> Int -> IO Float
312+ get_data_val_float pointer col =
313+ mkForeign (FFun "sqlite3_get_float" [FPtr, FInt] FFloat) pointer col
314+
315+ helper : Int -> IO DBVal
316+ helper 1 = do i <- get_data_val_int pointer col ; return (DBInt i)
317+ helper 2 = do i <- get_data_val_float pointer col ; return (DBFloat i)
318+ helper 3 = do i <- get_data_val_text pointer col; return (DBText i)
319+ helper _ = return DBNull
320+
297321-----------------------------------------------------------------------------
298322-- | This function makes use of get_data to get all the result.
299323-----------------------------------------------------------------------------
300324
301−toList_v1 : DBPointer -> DB Table
302−toList_v1 db = do
303− nbR <- liftIO (num_row_v2 db)
304− nmC <- liftIO (num_col_v2 db)
305− res <- forM [0..(nbR-1)] (\ i =>
306− forM [0..(nmC-1)] (\ j =>
307− liftIO(get_data db i j)
308−
309− )
310− )
311− return res
312−
313−
325+toList_v1 : DBPointer -> DB Table
326+toList_v1 db = do nbR <- liftIO (num_row_v2 db)
327+ nmC <- liftIO (num_col_v2 db)
328+ res <- liftIO $ forM [0..(nbR-1)] $ \ i =>
329+ forM [0..(nmC-1)] $ \ j => get_data db i j
330+ return (the (List (List DBVal)) res)
331+
314332strcat : String -> String-> String
315−strcat str1 str2 = (str1 ++ str2)
333+strcat str1 str2 = str1 ++ str2
316334
317335-----------------------------------------------------------------------------
318336-- | This version of toList retunrs result from get_table
319337-- This could be removed if not needed in the future.
320338-----------------------------------------------------------------------------
321−
339+
322340--toList_v2 : String -> String -> DBPointer -> DB Table
323341--toList_v2 name stmt x = do
324342-- ptr <- (get_table x (stmt))
@@ -327,12 +345,12 @@ strcat str1 str2 = (str1 ++ str2)
327345-- res <- forM [0..(nbR-1)] (\ i =>
328346-- forM [0..(nmC-1)] (\ j =>
329347-- liftIO(get_data x name i j)
330−--
348+--
331349-- )
332350-- )
333351-- liftIO (free_table ptr)
334−-- return res
335−
352+-- return res
353+
336354
337355-----------------------------------------------------------------------------
338356-- | These routines support binding the types supported by Idris.
@@ -341,68 +359,67 @@ strcat str1 str2 = (str1 ++ str2)
341359-----------------------------------------------------------------------------
342360
343361bind_int : StmtPtr -> Int -> Int -> DB StmtPtr
344−bind_int (MkStmtPtr pointer) indexval val = do
345− x <- liftIO(mkForeign (FFun "sqlite3_bind_int_idr" [FPtr, FInt, FInt] FPtr)pointer indexval val)
346− flag <- liftIO(nullPtr x)
362+bind_int (MkStmtPtr pointer) indexval val = do
363+ x <- liftIO (mkForeign (FFun "sqlite3_bind_int_idr" [FPtr, FInt, FInt] FPtr) pointer indexval val)
364+ flag <- liftIO (nullPtr x)
347365 if flag
348− then fail "Could not bind int."
349− else return (MkStmtPtr x)
350−
351−
366+ then fail "Could not bind int."
367+ else return (MkStmtPtr x)
368+
369+
352370bind_float : StmtPtr -> Int -> Float -> DB StmtPtr
353−bind_float (MkStmtPtr pointer) indexval val = do
354− x <- liftIO(mkForeign (FFun "sqlite3_bind_float_idr" [FPtr, FInt, FFloat] FPtr)pointer indexval val)
355− flag <- liftIO(nullPtr x)
371+bind_float (MkStmtPtr pointer) indexval val = do
372+ x <- liftIO (mkForeign (FFun "sqlite3_bind_float_idr" [FPtr, FInt, FFloat] FPtr) pointer indexval val)
373+ flag <- liftIO (nullPtr x)
356374 if flag
357− then fail "Could not bind float."
358− else return (MkStmtPtr x)
375+ then fail "Could not bind float."
376+ else return (MkStmtPtr x)
359377
360378bind_text : StmtPtr -> String -> Int -> Int -> DB StmtPtr
361379bind_text (MkStmtPtr pointer) text indexval lengthval = do
362− x <- liftIO(mkForeign (FFun "sqlite3_bind_text_idr" [FPtr, FString, FInt, FInt] FPtr)pointer text indexval lengthval)
363− flag <- liftIO(nullPtr x)
380+ x <- liftIO (mkForeign (FFun "sqlite3_bind_text_idr" [FPtr, FString, FInt, FInt] FPtr)
381+ pointer text indexval lengthval)
382+ flag <- liftIO(nullPtr x)
364383 if flag
365− then fail "Could not bind text."
366− else return (MkStmtPtr x)
384+ then fail "Could not bind text."
385+ else return (MkStmtPtr x)
367386
368387bind_null : StmtPtr -> Int -> DB StmtPtr
369−bind_null (MkStmtPtr pointer) indexval = do
370− x <- liftIO(mkForeign (FFun "sqlite3_bind_null_idr" [FPtr, FInt] FPtr)pointer indexval)
371− flag <- liftIO(nullPtr x)
388+bind_null (MkStmtPtr pointer) indexval = do
389+ x <- liftIO (mkForeign (FFun "sqlite3_bind_null_idr" [FPtr, FInt] FPtr) pointer indexval)
390+ flag <- liftIO (nullPtr x)
372391 if flag
373− then fail "Could not bind null."
374− else return (MkStmtPtr x)
392+ then fail "Could not bind null."
393+ else return (MkStmtPtr x)
375394
376395-----------------------------------------------------------------------------
377396-- | String Length
378397-----------------------------------------------------------------------------
379−
398+
380399strlen : String -> DB Int
381−strlen str = liftIO(mkForeign (FFun "strLength" [FString] FInt) str)
382−
400+strlen str = liftIO (mkForeign (FFun "strLength" [FString] FInt) str)
401+
383402instance Show DBVal where
384− show (DBInt i) = "Int val: " ++ show i ++ "\n"
385− show (DBText i) = "Text val: " ++ show i ++ "\n"
386− show (DBFloat i) = "Float val: " ++ show i ++ "\n"
387− show (DBNull ) = "NULL"
403+ show (DBInt i) = "Int val: " ++ show i ++ "\n"
404+ show (DBText i) = "Text val: " ++ show i ++ "\n"
405+ show (DBFloat i) = "Float val: " ++ show i ++ "\n"
406+ show (DBNull ) = "NULL"
388407
389408-----------------------------------------------------------------------------
390409-- | Multi bind a list of values.
391410-----------------------------------------------------------------------------
392411
393412bindMulti : StmtPtr-> List (Maybe (Int, Value)) -> DB StmtPtr
394−bindMulti pointer [] = return pointer
395−bindMulti pointer (Nothing :: vs) = bindMulti pointer vs
396−bindMulti pointer ((Just (indexs, val))::vs) = case val of
397− (VInt intval) => do x <- bind_int pointer indexs intval
398− bindMulti(x) vs
399−
400− (VStr strval) => do len <- strlen strval
401− x <- bind_text pointer strval indexs len
402− bindMulti(x) vs
403−
404−
405− (VFloat floatval) => do x <- bind_float pointer indexs floatval
406−
407− bindMulti(x) vs
413+bindMulti pointer [] = return pointer
414+bindMulti pointer (Nothing :: vs) = bindMulti pointer vs
415+bindMulti pointer ((Just (indexs, (VInt i)))::vs) =
416+ do x <- bind_int pointer indexs i
417+ bindMulti x vs
418+bindMulti pointer ((Just (indexs, (VStr s)))::vs) =
419+ do len <- strlen s
420+ x <- bind_text pointer s indexs len
421+ bindMulti x vs
422+bindMulti pointer ((Just (indexs, (VFloat f)))::vs) =
423+ do x <- bind_float pointer indexs f
424+ bindMulti x vs
408425
contribs/lib/SQLite3/sqlexpr.idrdeleted−274
@@ -1,274 +0,0 @@
1−module Sqlexpr
2−import Prelude.List
3−
4−-----------------------------------------------------------------------------
5−-- |
6−-- Module : sqlexpr
7−-- Copyright : (c) The University of St Andrews, 2012
8−--
9−-- Implementations for SQLite query data type.
10−--
11−-----------------------------------------------------------------------------
12−
13−
14−-----------------------------------------------------------
15−-- | SQL data type
16−-----------------------------------------------------------
17−
18−data 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.
28−
29−data Cond = Equals Value Value
30− |MkGT Value Value
31− |MkGTE Value Value
32− |MkLT Value Value
33− |MkLTE Value Value
34− |MkNULL Value
35−
36−
37−data Clause = MkCond Cond
38− | AND Clause Clause
39− | OR Clause Clause
40− | Empty
41− | MkSQL SQL
42−
43−data condClause = SET Clause
44− |WHERE condClause Clause
45−
46−data SelVar = Cols (List String)
47− |ALL
48−
49−data ColType = CInt String -- parsed as string "int"
50− |Varchar String
51−
52−data Constr = NOTNULL
53− | UNIQUE Constr
54− | None
55− | PRIMARYKEY
56− | FOREIGNKEY
57− | CHECK
58− | DEFAULT
59−
60−
61−data SQL = SELECT SelVar SQL Clause
62− | TBL (List String)
63− | INSERT SQL (List Value)
64− | INSERTC SQL (List Value) (List Value)
65− | UPDATE SQL condClause
66− | CREATE SQL (List (Value, ColType , Constr))
67−
68−-- remember to remove these funcs later
69−-- foldr1 : (a -> a -> a) -> List a -> a
70−-- foldr1 f [x] = x
71−-- foldr1 f (x::xs) = f x (foldr1 f xs)
72−
73−
74−-- unwords' : List (List Char) -> List Char
75−-- unwords' [] = []
76−-- unwords' ws = (foldr1 addSpace ws)
77−-- where
78−-- addSpace : List Char -> List Char -> List Char
79−-- addSpace w s = w ++ (' ' :: s)
80−--
81−--
82−-- unwords : List String -> String
83−-- unwords = pack . unwords' . map unpack
84−
85−-----------------------------------------------------------
86−-- | This function replaces values with question mark
87−-- following by an index number. It then puts the value
88−-- replaced, in the list.
89−-----------------------------------------------------------
90−
91−valString : List (Maybe(Int, Value)) -> Value -> (String, List (Maybe(Int, Value)))
92−valString xs (VInt x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VInt x))])
93−valString xs (VStr x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VStr x))])
94−valString xs (VFloat x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VFloat x))])
95−valString xs (VCol n) = (n, xs)
96−
97−-----------------------------------------------------------
98−-- | This function calls valString on a list of Values
99−-- and separates the values by commas.
100−-----------------------------------------------------------
101−
102−listVal : List (Maybe(Int, Value)) -> List Value -> (String, List (Maybe(Int, Value)))
103−listVal xs [] = ("", xs)
104−listVal xs (v::vs) = let (str, newxs) = (valString xs v) in
105− let (str', newxs') = listVal newxs vs in
106− ((unwords(intersperse "," (words(str) ++ words (str')))), newxs')
107−
108−-----------------------------------------------------------
109−-- | Parses the type of column to be created.
110−-----------------------------------------------------------
111−
112−getColType : List (Maybe(Int, Value)) -> ColType -> (String, List (Maybe(Int, Value)))
113−getColType xs (CInt x) = ("int", xs)
114−getColType xs (Varchar str) = ("varchar(255)", xs)
115−
116−-----------------------------------------------------------
117−-- | CREATE Constraints
118−-----------------------------------------------------------
119−
120−getConstr : List (Maybe(Int, Value)) -> Constr -> (String, List (Maybe(Int, Value)))
121−getConstr xs (NOTNULL) = ("NOT NULL", xs)
122−getConstr xs (UNIQUE constr) = ("NOT NULL UNIQUE", xs)
123−getConstr xs (PRIMARYKEY) = ("PRIMARY KEY", xs)
124−getConstr xs (FOREIGNKEY) = ("FOREIGN KEY", xs)
125−getConstr xs (CHECK) = ("CHECK", xs)
126−getConstr xs (DEFAULT) = ("DEFAULT", xs)
127−getConstr xs (None) = ("", xs)
128−
129−putBrackets : String -> String
130−putBrackets str = "(" ++ str ++ ")"
131−
132−-----------------------------------------------------------
133−-- | Used to detect a complex type in a nested SQLite query
134−-- This function is used for bracketing the nested queries.
135−-----------------------------------------------------------
136−complexType : SQL -> Bool
137−complexType (TBL tbl) = False
138−complexType (SELECT vars sql c) = True
139−
140−-----------------------------------------------------------
141−-- | Used in CREATE
142−-----------------------------------------------------------
143−
144−listValType : List (Maybe(Int, Value)) -> List (Value, ColType , Constr) -> (String, List (Maybe(Int, Value)))
145−listValType xs [] = ("", xs)
146−listValType xs ((val, types, constr) :: vs) = let (str , newxs) = valString xs val in
147− let (str' , newxs') = getColType newxs types in
148− let (str'', newxs'') = getConstr newxs' constr in
149− let (finalstr, finalxs) = listValType newxs'' vs in
150− ((unwords(intersperse " " (words(str) ++ words(str') ++ words(str'') ++ words(finalstr)))) , finalxs)
151−
152−
153−-----------------------------------------------------------
154−-- | Evaluates a conditional WHERE clause
155−-----------------------------------------------------------
156−
157−evalCond : List (Maybe(Int, Value)) -> Cond -> (String, List (Maybe(Int, Value)))
158−evalCond xs (Equals val1 val2) = let (restring , newxs ) = valString xs val1 in
159− let (restring2, newxs') = valString newxs val2 in
160− (restring ++ " = " ++ restring2, newxs')
161−
162−evalCond xs (MkGT val1 val2) = let (restring , newxs ) = valString xs val1 in
163− let (restring2, newxs') = valString newxs val2 in
164− (restring ++ " > " ++ restring2, newxs')
165−
166−evalCond xs (MkGTE val1 val2) = let (restring , newxs ) = valString xs val1 in
167− let (restring2, newxs') = valString newxs val2 in
168− (restring ++ " >= " ++ restring2, newxs')
169−
170−evalCond xs (MkLT val1 val2) = let (restring , newxs ) = valString xs val1 in
171− let (restring2, newxs') = valString newxs val2 in
172− (restring ++ " < " ++ restring2, newxs')
173−
174−evalCond xs (MkLTE val1 val2) = let (restring , newxs ) = valString xs val1 in
175− let (restring2, newxs') = valString newxs val2 in
176− (restring ++ " =< " ++ restring2, newxs')
177−
178−evalCond xs (MkNULL val) = let (restring , newxs ) = valString xs val in
179− (restring ++ " IS NULL " , newxs)
180−
181−-----------------------------------------------------------
182−-- | Evaluates queries by calling the other functions
183−-- on each part of the query
184−-----------------------------------------------------------
185−evalSQL : List (Maybe(Int, Value)) -> SQL -> ( String, List (Maybe(Int, Value)))
186−-----------------------------------------------------------
187−-- | Evaluates clauses
188−-- Supports WHERE Clause
189−-- WHERE Clause And Another-Clause
190−-- WHERE Clause Or Another-Clause
191−-----------------------------------------------------------
192−clauseString : List (Maybe(Int, Value)) -> Clause -> (String, List (Maybe(Int, Value)))
193−
194−clauseString xs (Empty) = ("" , []) -- No condition
195−clauseString xs (MkCond cond') = let (condstr, newxs) = evalCond xs cond' in
196− (condstr , newxs)
197−
198−clauseString xs (AND c1 c2) = let (clausestr, newxs) = clauseString xs c1 in
199− let (clausestr2, newxs') = clauseString newxs c2 in
200− (clausestr ++ " AND " ++clausestr2 , newxs')
201−
202−clauseString xs (OR c1 c2) = let (clausestr, newxs) = clauseString xs c1 in
203− let (clausestr2, newxs') = clauseString newxs c2 in
204− (clausestr ++ " OR " ++clausestr2 , newxs')
205−
206−
207−-----------------------------------------------------------
208−-- | Evaluates conditional clauses.
209−-----------------------------------------------------------
210−
211−condClauseStr : List (Maybe(Int, Value)) -> condClause -> (String, List (Maybe(Int, Value)))
212−condClauseStr xs (SET setcl) = let (condstr, newxs) = clauseString xs setcl in
213− (" SET " ++ condstr, newxs)
214−
215−condClauseStr xs (WHERE setcl1 setcl2) = let (condstr, newxs) = condClauseStr xs setcl1 in
216− let (condstr', newxs') = clauseString newxs setcl2 in
217− ( condstr ++ " WHERE " ++ condstr', newxs')
218−
219−-- SELECT data from tbl1 where num > (SELECT num from tbl1 where num = 24)
220−-- evalSQL [] ((SELECT ALL)(TBL "tbl")(MkSQL ((SELECT ALL) (TBL "tbl")(MkCond (VCol "))))
221−-- NTBF
222−--clauseString xs (MkSQL sql) = (evalSQL xs sql)
223−
224−-- Separate list of tables
225−-- For complex type, return list returned by evalSQL
226−-- And add brackets
227−evalSQL xs (TBL tbl) = ((unwords (intersperse "," ( tbl))), xs)
228−evalSQL xs (SELECT vars sql' c) = let (sqlstring, newxs) = evalSQL xs sql' in
229− let (csstring, newxs') = clauseString newxs c in
230− case c of
231− Empty => case vars of
232− (ALL ) => if complexType sql' then ("SELECT " ++ "*" ++ " FROM "
233− ++ (putBrackets sqlstring) ++ csstring, newxs)
234−
235− else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring
236− ++ csstring, newxs')
237−
238− (Cols selvar) => if complexType sql' then ("SELECT " ++ (unwords selvar) ++
239− " FROM " ++ (putBrackets sqlstring) ++ csstring, newxs)
240−
241− else ("SELECT " ++ (unwords selvar )++ " FROM " ++ sqlstring
242− ++ csstring, newxs')
243−
244− _ => case vars of
245− (ALL ) => if complexType sql' then ("SELECT " ++ "*" ++ " FROM "
246− ++ " WHERE " ++ csstring , newxs)
247− else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring
248− ++ " WHERE " ++ csstring , newxs')
249−
250− (Cols selvar) => if complexType sql' then ("SELECT " ++ (unwords selvar) ++ " FROM " ++
251− (putBrackets sqlstring) ++ " WHERE "
252− ++ csstring , newxs)
253−
254− else ("SELECT " ++ (unwords selvar) ++ " FROM " ++ sqlstring
255− ++ " WHERE " ++ csstring , newxs')
256−
257−
258−evalSQL xs (INSERT sql vals) = let (tblname, newvals) = evalSQL xs sql in
259− let (str, newxs ) = listVal newvals vals in
260− ("INSERT INTO " ++ tblname ++ " VALUES (" ++ str ++ ")" , newxs)
261−
262−evalSQL xs (INSERTC sql cols vals) = let (tblname, newvals) = evalSQL xs sql in
263− let (strcol, newcol) = listVal newvals cols in
264− let (strval, newcolval) = listVal newcol vals in
265− ("INSERT INTO " ++ tblname ++ "(" ++ strcol ++ ")" ++ "VALUES (" ++ strval ++ ")", newcolval)
266−
267−
268−evalSQL xs (UPDATE sql cl) = let (tblname, newxs) = evalSQL xs sql in
269− let (csstring, newxs') = condClauseStr newxs cl in
270− ("UPDATE " ++ tblname ++ csstring, newxs')
271−
272−evalSQL xs (CREATE sql details) = let (sqlstring, newxs) = evalSQL xs sql in
273− let (csstring, newxs') = listValType newxs details in
274− ("CREATE TABLE " ++ sqlstring ++ "(" ++ csstring ++ ")", newxs')