@@ -1,4 +1,4 @@
1−module main
1+module sqlite3
22import sqlexpr
33
44
@@ -6,7 +6,17 @@ import sqlexpr
66%link "sqlite3api.o"
77%include "sqlite3api.h"
88
9+-----------------------------------------------------------------------------
10+-- |
11+-- Module : sqlite3
12+-- Copyright : (c) The University of St Andrews, 2012
13+--
14+-- Library built on top of FFI supporting basic SQLite C/C++ Interface
15+-- functions.
16+--
17+-----------------------------------------------------------------------------
918
19+-- | The types supported by Idris returned by the database functions.
1020
1121data DBVal = DBInt Int
1222 | DBText String
@@ -55,15 +65,24 @@ runDB (MkDB f) = do f' <- f
5565 Right v => return v
5666 Left str => ioError str
5767
68+-----------------------------------------------------------------------------
69+-- | Opens an SQLite database file as specified by the String name argument.
70+-----------------------------------------------------------------------------
5871
5972open_db : String -> DB DBPointer
6073open_db name = do x <- liftIO(mkForeign (FFun "sqlite3_open_idr" [FString] FPtr) name)
6174 return (MkDBPointer x)
6275
76+-----------------------------------------------------------------------------
77+-- | Destructor for the DBPointer.
78+-----------------------------------------------------------------------------
79+
6380close_db : DBPointer -> DB Int
6481close_db (MkDBPointer pointer) = liftIO (mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt)pointer)
6582
66−
83+-----------------------------------------------------------------------------
84+-- | Wrapper around prepare, step and finalize.
85+-----------------------------------------------------------------------------
6786
6887exec_db : DBPointer -> String -> DB Int
6988exec_db (MkDBPointer pointer) stmt = do
@@ -72,11 +91,32 @@ exec_db (MkDBPointer pointer) stmt = do
7291 then fail "Could not execute."
7392 else return x
7493
94+-----------------------------------------------------------------------------
95+-- | Executes a prepared query. Use of this version is recommended.
96+-----------------------------------------------------------------------------
7597
98+exec_db_v2 : StmtPtr -> DB Int
99+exec_db_v2 (MkStmtPtr pointer) = do
100+ x <- liftIO (mkForeign (FFun "exec_db" [FPtr] FInt) pointer)
101+ if (x == 21)
102+ then fail "No data returned."
103+ else return x
104+
105+-----------------------------------------------------------------------------
106+-- | Returns the error stored in the buffer by exec_db function.
107+-- This function can only be used with exec_db and get_table.
108+-- Only these functions store any occured error in the buffer array.
109+-----------------------------------------------------------------------------
76110
77111get_error : DBPointer -> IO String
78112get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
79113
114+
115+-----------------------------------------------------------------------------
116+-- | Compiles the query inot a byte-code program in order to execute it.
117+-- Returns a pointer to a Statement pointer on a successful call.
118+-- Returns a null pointer on a failure.
119+-----------------------------------------------------------------------------
80120
81121prepare_db : DBPointer -> String -> DB StmtPtr
82122prepare_db (MkDBPointer pointer) cmd = do
@@ -86,12 +126,11 @@ prepare_db (MkDBPointer pointer) cmd = do
86126 then fail "Error occured while preparing"
87127 else return (MkStmtPtr result)
88128
89−exec_db_v2 : StmtPtr -> DB Int
90−exec_db_v2 (MkStmtPtr pointer) = do
91− x <- liftIO (mkForeign (FFun "exec_db" [FPtr] FInt) pointer)
92− if (x == 21)
93− then fail "No data returned."
94− else return x
129+-----------------------------------------------------------------------------
130+-- | Returns the error stored in the buffer by exec_db function.
131+-- This function can only be used with exec_db and get_table.
132+-- Only these functions store any occured error in the buffer array.
133+-----------------------------------------------------------------------------
95134
96135step_db : StmtPtr -> DB Int
97136step_db (MkStmtPtr pointer)= do
@@ -100,6 +139,10 @@ step_db (MkStmtPtr pointer)= do
100139 then fail "SQLITE_DONE"
101140 else return x
102141
142+-----------------------------------------------------------------------------
143+-- | Deletes a prepared statement. This function must be called after
144+-- prepare function.
145+-----------------------------------------------------------------------------
103146
104147finalize_db : StmtPtr -> DB Int
105148finalize_db (MkStmtPtr pointer) = do
@@ -108,6 +151,10 @@ finalize_db (MkStmtPtr pointer) = do
108151 then fail "Could not finalize"
109152 else return x
110153
154+-----------------------------------------------------------------------------
155+-- | Resets a prepared statement pointer back to its initial state.
156+-----------------------------------------------------------------------------
157+
111158reset_db : StmtPtr -> DB Int
112159reset_db (MkStmtPtr pointer) = do
113160 x <- liftIO(mkForeign (FFun "sqlite3_reset_idr" [FPtr] FInt)pointer)
@@ -115,6 +162,10 @@ reset_db (MkStmtPtr pointer) = do
115162 then fail "Could not reset"
116163 else return x
117164
165+-----------------------------------------------------------------------------
166+-- | These routines obtain column information.
167+-----------------------------------------------------------------------------
168+
118169column_count : DBPointer -> IO (Either String Int)
119170column_count (MkDBPointer pointer) = do
120171 x <- mkForeign (FFun "sqlite3_column_count_idr" [FPtr] FInt)pointer
@@ -144,6 +195,9 @@ column_text (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_text_idr
144195column_Int : DBPointer -> Int -> IO Int
145196column_Int (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_int_idr" [FPtr, FInt] FInt)pointer iCol
146197
198+-----------------------------------------------------------------------------
199+-- | These routines support some of SQLite backup functions.
200+-----------------------------------------------------------------------------
147201
148202backup_init : DBPointer -> String -> DBPointer -> String -> IO DBPointer
149203backup_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
@@ -159,6 +213,12 @@ backup_remaining : DBPointer -> IO Int
159213backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt)pointer
160214
161215
216+-----------------------------------------------------------------------------
217+-- | Use of this interface is not recommended.
218+-- This function returns a result table. The functions num_row and num_col
219+-- are used to obtain the number of rows and columns.
220+-- These functions can be used to print the resulting table.
221+-----------------------------------------------------------------------------
162222
163223get_table : DBPointer -> String -> DB TBPointer
164224get_table (MkDBPointer pointer) name = do
@@ -173,6 +233,15 @@ get_table (MkDBPointer pointer) name = do
173233 return x
174234
175235
236+free_table : TBPointer -> IO ()
237+free_table (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit)pointer
238+ return ()
239+
240+-----------------------------------------------------------------------------
241+-- | This version of these function obtain the row and column number
242+-- from the Table struct. These functions are only used with get_table.
243+-----------------------------------------------------------------------------
244+
176245num_row : TBPointer -> IO Int
177246num_row (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row" [FPtr] FInt)pointer
178247 return (x)
@@ -181,30 +250,10 @@ num_col : TBPointer -> IO Int
181250num_col (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col" [FPtr] FInt)pointer
182251 return (x)
183252
184−
185−get_data : DBPointer -> String -> Int -> Int -> IO DBVal
186−get_data (MkDBPointer pointer) tbl_name row col = do
187− ty <- get_data_type pointer tbl_name row col
188− helper ty
189− where
190− get_data_type : Ptr -> String -> Int -> Int -> IO Int
191− get_data_type pointer tbl_name row col =mkForeign (FFun "sqlite3_get_data_type" [FPtr, FString, FInt, FInt] FInt)pointer tbl_name row col
192−
193− get_data_val_int : Ptr -> String -> Int -> Int -> IO Int
194− get_data_val_int pointer tbl_name row col =mkForeign (FFun "sqlite3_get_val_int" [FPtr, FString, FInt, FInt] FInt)pointer tbl_name row col
195−
196− get_data_val_text : Ptr -> String -> Int -> Int -> IO String
197− get_data_val_text pointer tbl_name row col =mkForeign (FFun "sqlite3_get_val_text" [FPtr, FString, FInt, FInt] FString)pointer tbl_name row col
198−
199− get_data_val_float : Ptr -> String -> Int -> Int -> IO Float
200− get_data_val_float pointer tbl_name row col =mkForeign (FFun "sqlite3_get_float" [FPtr, FString, FInt, FInt] FFloat)pointer tbl_name row col
201−
202−
203− helper : Int -> IO DBVal
204− helper 1 = do i <- get_data_val_int pointer tbl_name row col; return (DBInt i)
205− helper 2 = do i <- get_data_val_float pointer tbl_name row col; return (DBFloat i)
206− helper 3 = do i <- get_data_val_text pointer tbl_name row col; return (DBText i)
207− helper _ = return (DBNull)
253+-----------------------------------------------------------------------------
254+-- | This version of these function obtain the row and column number
255+-- from the Database struct.
256+-----------------------------------------------------------------------------
208257
209258num_row_v2 : DBPointer -> IO Int
210259num_row_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row_v2" [FPtr] FInt)pointer
@@ -214,14 +263,19 @@ num_col_v2 : DBPointer -> IO Int
214263num_col_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col_v2" [FPtr] FInt)pointer
215264 return (x)
216265
266+-----------------------------------------------------------------------------
267+-- | This function prints the result of a query by checking the type
268+-- of each value returned, it then calls the appropriate function.
269+-- Ther result is one of the DBVal variants.
270+-----------------------------------------------------------------------------
217271
218−get_data_v2 : DBPointer -> Int -> Int -> IO DBVal
219−get_data_v2 (MkDBPointer pointer) row col = do
220− ty <- get_data_type_v2 pointer row col
272+get_data : DBPointer -> Int -> Int -> IO DBVal
273+get_data (MkDBPointer pointer) row col = do
274+ ty <- get_data_type pointer row col
221275 helper ty
222276 where
223− get_data_type_v2 : Ptr ->Int -> Int -> IO Int
224− get_data_type_v2 pointer row col =mkForeign (FFun "sqlite3_get_data_type_v2" [FPtr, FInt, FInt] FInt)pointer row col
277+ get_data_type : Ptr ->Int -> Int -> IO Int
278+ get_data_type pointer row col =mkForeign (FFun "sqlite3_get_data_type_v2" [FPtr, FInt, FInt] FInt)pointer row col
225279
226280 get_data_val_int : Ptr -> Int -> IO Int
227281 get_data_val_int pointer col =mkForeign (FFun "sqlite3_get_val_int_v2" [FPtr,FInt] FInt)pointer col
@@ -240,43 +294,49 @@ get_data_v2 (MkDBPointer pointer) row col = do
240294 helper 3 = do i <- get_data_val_text pointer col; return (DBText i)
241295 helper _ =return (DBNull)
242296
243−
244−toList_v2 : DBPointer -> DB Table
245−toList_v2 db = do
246− nbR <- liftIO (num_row_v2 db)
247− nmC <- liftIO (num_col_v2 db)
248− res <- forM [0..(nbR-1)] (\ i =>
249− forM [0..(nmC-1)] (\ j =>
250− liftIO(get_data_v2 db i j)
297+-----------------------------------------------------------------------------
298+-- | This function makes use of get_data to get all the result.
299+-----------------------------------------------------------------------------
300+
301+toList : DBPointer -> DB Table
302+toList 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)
251308
252− )
253− )
254− return res
309+ )
310+ )
311+ return res
255312
256313
257314strcat : String -> String-> String
258315strcat str1 str2 = (str1 ++ str2)
259316
260−free_table : TBPointer -> IO ()
261−free_table (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit)pointer
262− return ()
263−
317+-----------------------------------------------------------------------------
318+-- | This version of toList retunrs result from get_table
319+-----------------------------------------------------------------------------
264320
265−toList : String -> String -> DBPointer -> DB Table
266−toList name stmt x = do
267− ptr <- (get_table x (stmt))
268− nbR <- liftIO (num_row ptr)
269− nmC <- liftIO (num_col ptr)
270− res <- forM [0..(nbR-1)] (\ i =>
271− forM [0..(nmC-1)] (\ j =>
272− liftIO(get_data x name i j)
273−
274− )
275− )
276− liftIO (free_table ptr)
277− return res
321+--toList_v2 : String -> String -> DBPointer -> DB Table
322+--toList_v2 name stmt x = do
323+-- ptr <- (get_table x (stmt))
324+-- nbR <- liftIO (num_row ptr)
325+-- nmC <- liftIO (num_col ptr)
326+-- res <- forM [0..(nbR-1)] (\ i =>
327+-- forM [0..(nmC-1)] (\ j =>
328+-- liftIO(get_data x name i j)
329+--
330+-- )
331+-- )
332+-- liftIO (free_table ptr)
333+-- return res
278334
279335
336+-----------------------------------------------------------------------------
337+-- | These routines support binding the types supported by Idris.
338+-----------------------------------------------------------------------------
339+
280340bind_int : StmtPtr -> Int -> Int -> DB StmtPtr
281341bind_int (MkStmtPtr pointer) indexval val = do
282342 x <- liftIO(mkForeign (FFun "sqlite3_bind_int_idr" [FPtr, FInt, FInt] FPtr)pointer indexval val)
@@ -302,12 +362,17 @@ bind_text (MkStmtPtr pointer) text indexval lengthval = do
302362 then fail "Could not bind text."
303363 else return (MkStmtPtr x)
304364
305−--bind_null : StmtPtr -> Int -> DB StmtPtr
306−--bind_null (MkStmtPtr pointer) indexval =do
307−-- x <- liftIO(mkForeign (FFun "sqlite3_bind_null_idr" [FPtr, FInt] FInt)pointer indexval)
308−-- if (x /= 0)
309−-- then fail "Could not bind null."
310−-- else return x
365+bind_null : StmtPtr -> Int -> DB StmtPtr
366+bind_null (MkStmtPtr pointer) indexval = do
367+ x <- liftIO(mkForeign (FFun "sqlite3_bind_null_idr" [FPtr, FInt] FPtr)pointer indexval)
368+ flag <- liftIO(nullPtr x)
369+ if flag
370+ then fail "Could not bind null."
371+ else return (MkStmtPtr x)
372+
373+-----------------------------------------------------------------------------
374+-- | String Length
375+-----------------------------------------------------------------------------
311376
312377strlen : String -> DB Int
313378strlen str = liftIO(mkForeign (FFun "strLength" [FString] FInt) str)
@@ -318,29 +383,9 @@ instance Show DBVal where
318383 show (DBFloat i) = "Float val: " ++ show i ++ "\n"
319384 show (DBNull ) = "NULL"
320385
321−print_data_v2 : DBVal -> String
322−print_data_v2 = show
323−
324−test : DB ()
325−test = do db <- open_db "somedb.db"
326− stmt <- (prepare_db db "insert into tbl1 values (?,?);")
327− bind_int stmt 1 456
328− bind_text stmt "testing" 2 4
329− step_db stmt
330− reset_db stmt
331− finalize_db stmt
332− c <- close_db db
333− return ()
334−
335−test3 : DB()
336−test3 = do db <- open_db "students.db"
337− stmt <- (prepare_db db "SELECT Student.Name FROM Student, Module, Enrollment WHERE Module.Credits = 30 AND Student.School_student = Enrollment.School_Student AND Student.School = Enrollment.School AND Enrollment.Code = Module.Code")
338− exec_db_v2 stmt
339− res <- toList_v2 db
340− liftIO(print res)
341− finalize_db stmt
342− c <- close_db db
343− return ()
386+-----------------------------------------------------------------------------
387+-- | Multi bind a list of values.
388+-----------------------------------------------------------------------------
344389
345390bindMulti : StmtPtr-> List (Maybe (Int, Value)) -> DB StmtPtr
346391bindMulti pointer [] = return pointer
@@ -356,81 +401,3 @@ bindMulti pointer ((Just (indexs, val))::vs) = case val of
356401
357402 (VFloat floatval) => do x <- bind_float pointer indexs floatval
358403 bindMulti(x) vs
359−testexpr : DB()
360−testexpr = do db <- open_db "somedb.db"
361− let sql = (evalSQL [] ((SELECT ALL)(TBL "tbl1") (OR (AND (MkCond (Equals (VCol "data")(VStr "data0"))) (MkCond (Equals (VCol "num")(VInt 1))) ) (MkCond (Equals (VCol "num")(VInt 2))))))
362− let x = (fst sql)
363− let list = (snd sql)
364− liftIO(print x)
365− stmt <- (prepare_db db x)
366− bindMulti stmt list
367− exec_db_v2 stmt
368− res <- toList_v2 db
369− liftIO(print res)
370− finalize_db stmt
371− close_db db
372− return ()
373−
374−testupdate : DB()
375−testupdate = do db <- open_db "somedb.db"
376− let sql = (evalSQL [] (UPDATE (TBL "tbl1") (WHERE (SET (MkCond (Equals(VCol "data") (VStr "data0"))) ) (MkCond (Equals (VCol "num") (VInt 2))) ) ))
377− let x = (fst sql)
378− let list = (snd sql)
379− liftIO(print x)
380− stmt <- (prepare_db db x)
381− bindMulti stmt list
382− exec_db_v2 stmt
383− finalize_db stmt
384− close_db db
385− return ()
386−
387−testInsert : DB()
388−testInsert = do db <- open_db "somedb.db"
389− let sql = (evalSQL [] (INSERT (TBL "tbl1") [(VInt 2),(VStr "histring2")]))
390− let x = (fst sql)
391− let list = (snd sql)
392− liftIO(print x)
393− stmt <- (prepare_db db x)
394− bindMulti stmt list
395− exec_db_v2 stmt
396− finalize_db stmt
397− close_db db
398− return ()
399−
400−testNull : DB()
401−testNull = do db <- open_db "somedb.db"
402− let sql = (evalSQL [] ((SELECT ALL)(TBL "tbl1") (MkCond (MkNULL (VCol "data")))))
403− let x = (fst sql)
404− let list = (snd sql)
405− liftIO(print x)
406− stmt <- (prepare_db db x)
407− bindMulti stmt list
408− exec_db_v2 stmt
409− res <- toList_v2 db
410− liftIO(print res)
411− finalize_db stmt
412− close_db db
413− return ()
414−
415−testInsertWithCond : DB()
416−testInsertWithCond = do db <- open_db "somedb.db"
417− let sql = (evalSQL [] (INSERTC (TBL "tbl1") [(VCol "data"),(VCol "num")] [(VInt 201),(VStr "newinserted")]))
418− let x = (fst sql)
419− let list = (snd sql)
420− liftIO(print x)
421− stmt <- (prepare_db db x)
422− bindMulti stmt list
423− exec_db_v2 stmt
424− finalize_db stmt
425− close_db db
426− return ()
427−
428−
429−main : IO ()
430−main = do --x <- runDB (test3)
431− y <- runDB (testInsertWithCond)
432− return ()
433−
434−
435−
436−