@@ -1,419 +0,0 @@
1−module Sqlite3
2−import public Sqlexpr
3−
4−%lib C "sqlite3"
5−-- %link C "sqlite3.o"
6−-- %include C "sqlite3.h"
7−%link C "sqlite3api.o"
8−%include C "sqlite3api.h"
9−
10−-----------------------------------------------------------------------------
11−-- |
12−-- Module : sqlite3
13−-- Copyright : (c) The University of St Andrews, 2012
14−--
15−-- Library built on top of FFI supporting basic SQLite C/C++ Interface
16−-- functions.
17−--
18−-----------------------------------------------------------------------------
19−
20−-- | The types supported by Idris returned by the database functions.
21−
22−data DBVal = DBInt Int
23− | DBText String
24− | DBFloat Float
25− | DBNull
26−
27−-- Database pointer
28−data DBPointer = MkDBPointer Ptr
29−-- Table pointer
30−data TBPointer = MkTBPointer Ptr
31−-- Statement pointer
32−data StmtPtr = MkStmtPtr Ptr
33−
34−Table : Type
35−Table = List (List DBVal)
36−
37−-- ForMap used in to_list_v1
38−forM : Applicative f => List a -> (a -> f b) -> f (List b)
39−forM xs f = (sequence (map f xs))
40−
41−-- Neater error handling done using DB
42−data DB a = MkDB (IO (Either String a))
43−
44−instance Functor DB where
45− map f (MkDB action) = MkDB (do res <- action
46− return (map f res))
47−
48−
49−instance Applicative DB where
50− pure = MkDB . return . Right
51− (MkDB f) <*> (MkDB x) = MkDB (do f' <- f
52− case f' of
53− Left err => return (Left err)
54− Right op => x >>= (return . map op))
55−
56−
57−instance Monad DB where
58− (MkDB l) >>= k = MkDB (do c <- l
59− case c of
60− Left err => return (Left err)
61− Right v => case k v of
62− MkDB k' => k')
63− --return x = MkDB (return (Right x))
64−
65−fail : String -> DB a
66−fail err = MkDB (return (Left err))
67−
68−liftIO : IO a -> DB a
69−liftIO f = MkDB (do f' <- f
70− return (Right f'))
71−
72−ioError : String -> IO a
73−ioError err = do putStrLn err
74− return (believe_me ())
75−
76−runDB : DB a -> IO a
77−runDB (MkDB f) = do f' <- f
78− case f' of
79− Right v => return v
80− Left str => ioError str
81−
82−-----------------------------------------------------------------------------
83−-- | Opens an SQLite database file as specified by the String name argument.
84−-----------------------------------------------------------------------------
85−
86−open_db : String -> DB DBPointer
87−open_db name = do x <- liftIO (foreign FFI_C "sqlite3_open_idr" (String -> IO Ptr) name)
88− return (MkDBPointer x)
89−
90−-----------------------------------------------------------------------------
91−-- | Destructor for the DBPointer.
92−-----------------------------------------------------------------------------
93−
94−close_db : DBPointer -> DB Int
95−close_db (MkDBPointer pointer) = liftIO (foreign FFI_C "sqlite3_close_idr" (Ptr -> IO Int) pointer)
96−
97−-----------------------------------------------------------------------------
98−-- | Wrapper around prepare, step and finalize.
99−-----------------------------------------------------------------------------
100−
101−exec_db : DBPointer -> String -> DB Int
102−exec_db (MkDBPointer pointer) stmt = do
103− x <- liftIO (foreign FFI_C "sqlite3_exec_idr" (Ptr -> String -> IO Int) pointer stmt)
104− if (x == 1)
105− then fail "Could not execute."
106− else return x
107−
108−-----------------------------------------------------------------------------
109−-- | Executes a prepared query. Use of this version is recommended.
110−-----------------------------------------------------------------------------
111−
112−exec_db_v2 : StmtPtr -> DB Int
113−exec_db_v2 (MkStmtPtr pointer) = do
114− x <- liftIO (foreign FFI_C "exec_db" (Ptr -> IO Int) pointer)
115− if (x == 21)
116− then fail "No data returned."
117− else return x
118−
119−-----------------------------------------------------------------------------
120−-- | Returns the error stored in the buffer by exec_db function.
121−-- This function can only be used with exec_db and get_table.
122−-- Only these functions store any occured error in the buffer array.
123−-----------------------------------------------------------------------------
124−
125−get_error : DBPointer -> IO String
126−get_error (MkDBPointer pointer) = foreign FFI_C "sqlite3_get_error" (Ptr -> IO String) pointer
127−
128−-----------------------------------------------------------------------------
129−-- | Compiles the query inot a byte-code program in order to execute it.
130−-- Returns a pointer to a Statement pointer on a successful call.
131−-- Returns a null pointer on a failure.
132−-----------------------------------------------------------------------------
133−
134−prepare_db : DBPointer -> String -> DB StmtPtr
135−prepare_db (MkDBPointer pointer) cmd = do
136− result <- liftIO (foreign FFI_C "sqlite3_prepare_idr" (Ptr -> String -> IO Ptr) pointer cmd)
137− flag <- liftIO (nullPtr result)
138− if flag
139− then fail "Error occured while preparing"
140− else return (MkStmtPtr result)
141−
142−-----------------------------------------------------------------------------
143−-- | Returns the error stored in the buffer by exec_db function.
144−-- This function can only be used with exec_db and get_table.
145−-- Only these functions store any occured error in the buffer array.
146−-----------------------------------------------------------------------------
147−
148−step_db : StmtPtr -> DB Int
149−step_db (MkStmtPtr pointer)= do
150− x <- liftIO (foreign FFI_C "sqlite3_step_idr" (Ptr -> IO Int) pointer)
151− if (x == 101)
152− then fail "SQLITE_DONE"
153− else return x
154−
155−-----------------------------------------------------------------------------
156−-- | Deletes a prepared statement. This function must be called after
157−-- prepare function.
158−-----------------------------------------------------------------------------
159−
160−finalize_db : StmtPtr -> DB Int
161−finalize_db (MkStmtPtr pointer) = do
162− x <- liftIO (foreign FFI_C "sqlite3_finalize_idr" (Ptr -> IO Int) pointer)
163− if (x /= 0)
164− then fail "Could not finalize"
165− else return x
166−
167−-----------------------------------------------------------------------------
168−-- | Resets a prepared statement pointer back to its initial state.
169−-----------------------------------------------------------------------------
170−
171−reset_db : StmtPtr -> DB Int
172−reset_db (MkStmtPtr pointer) = do
173− x <- liftIO (foreign FFI_C "sqlite3_reset_idr" (Ptr -> IO Int) pointer)
174− if (x /= 0)
175− then fail "Could not reset"
176− else return x
177−
178−-----------------------------------------------------------------------------
179−-- | These routines obtain column information.
180−-----------------------------------------------------------------------------
181−
182−column_count : DBPointer -> IO (Either String Int)
183−column_count (MkDBPointer pointer) = do
184− x <- foreign FFI_C "sqlite3_column_count_idr" (Ptr -> IO Int) pointer
185− return $ if (x == 0)
186− then Left "No Data"
187− else (Right x)
188−
189−column_name : DBPointer -> Int -> IO String
190−column_name (MkDBPointer pointer) iCol =
191− foreign FFI_C "sqlite3_column_name_idr" (Ptr -> Int -> IO String) pointer iCol
192−
193−column_decltype : DBPointer -> Int -> IO String
194−column_decltype (MkDBPointer pointer) iCol =
195− foreign FFI_C "sqlite3_column_decltype_idr" (Ptr -> Int -> IO String) pointer iCol
196−
197−column_bytes : DBPointer -> Int -> IO Int
198−column_bytes (MkDBPointer pointer) iCol =
199− foreign FFI_C "sqlite3_column_bytes_idr" (Ptr -> Int -> IO Int) pointer iCol
200−
201−column_blob : DBPointer -> Int -> IO String
202−column_blob (MkDBPointer pointer) iCol =
203− foreign FFI_C "sqlite3_column_bytes_idr" (Ptr -> Int -> IO String) pointer iCol
204−
205−column_text : DBPointer -> Int -> IO String
206−column_text (MkDBPointer pointer) iCol =
207− foreign FFI_C "sqlite3_column_text_idr" (Ptr -> Int -> IO String) pointer iCol
208−
209−column_Int : DBPointer -> Int -> IO Int
210−column_Int (MkDBPointer pointer) iCol =
211− foreign FFI_C "sqlite3_column_int_idr" (Ptr -> Int -> IO Int) pointer iCol
212−
213−-----------------------------------------------------------------------------
214−-- | These routines support some of SQLite backup functions.
215−-----------------------------------------------------------------------------
216−
217−backup_init : DBPointer -> String -> DBPointer -> String -> IO DBPointer
218−backup_init (MkDBPointer des_pointer) destName (MkDBPointer src_pointer) srcName =
219− do x <- foreign FFI_C "sqlite3_backup_init_idr" (Ptr -> String -> Ptr -> String -> IO Ptr)
220− des_pointer destName src_pointer srcName
221− return (MkDBPointer x)
222−
223−backup_step : DBPointer -> Int -> IO Int
224−backup_step (MkDBPointer pointer) nPage =
225− foreign FFI_C "sqlite3_backup_step_idr" (Ptr -> Int -> IO Int) pointer nPage
226−
227−backup_finish : DBPointer -> IO Int
228−backup_finish (MkDBPointer pointer) =
229− foreign FFI_C "sqlite3_backup_finish_idr" (Ptr -> IO Int) pointer
230−
231−backup_remaining : DBPointer -> IO Int
232−backup_remaining (MkDBPointer pointer) =
233− foreign FFI_C "sqlite3_backup_remaining_idr" (Ptr -> IO Int) pointer
234−
235−-----------------------------------------------------------------------------
236−-- | Use of this interface is not recommended.
237−-- This function returns a result table. The functions num_row and num_col
238−-- are used to obtain the number of rows and columns.
239−-- These functions can be used to print the resulting table.
240−-----------------------------------------------------------------------------
241−
242−get_table : DBPointer -> String -> DB TBPointer
243−get_table (MkDBPointer pointer) name = do
244− x <- liftIO(foreign FFI_C "sqlite3_get_table_idr" (Ptr -> String -> IO Ptr) pointer name)
245− flag <- liftIO (nullPtr x)
246− if flag
247− then do x <- liftIO(get_error_table pointer) ; fail x
248− else return (MkTBPointer x)
249− where
250− get_error_table : Ptr-> IO String
251− get_error_table pointer = do x <- foreign FFI_C "sqlite3_get_error" (Ptr -> IO String) pointer
252− return x
253−
254−free_table : TBPointer -> IO ()
255−free_table (MkTBPointer pointer) = do x <- foreign FFI_C "sqlite3_free_table_idr" (Ptr -> IO ()) pointer
256− return ()
257−
258−-----------------------------------------------------------------------------
259−-- | This version of these function obtain the row and column number
260−-- from the Table struct. These functions are only used with get_table.
261−-----------------------------------------------------------------------------
262−
263−num_row : TBPointer -> IO Int
264−num_row (MkTBPointer pointer) = do x <- foreign FFI_C "sqlite3_get_num_row" (Ptr -> IO Int) pointer
265− return x
266−
267−num_col : TBPointer -> IO Int
268−num_col (MkTBPointer pointer) = do x <- foreign FFI_C "sqlite3_get_num_col" (Ptr -> IO Int) pointer
269− return x
270−
271−-----------------------------------------------------------------------------
272−-- | This version of these function obtain the row and column number
273−-- from the Database struct.
274−-----------------------------------------------------------------------------
275−
276−num_row_v2 : DBPointer -> IO Int
277−num_row_v2 (MkDBPointer pointer) = do x <- foreign FFI_C "sqlite3_get_num_row_v2" (Ptr -> IO Int) pointer
278− return x
279−
280−num_col_v2 : DBPointer -> IO Int
281−num_col_v2 (MkDBPointer pointer) = do x <- foreign FFI_C "sqlite3_get_num_col_v2" (Ptr -> IO Int) pointer
282− return x
283−
284−-----------------------------------------------------------------------------
285−-- | This function prints the result of a query by checking the type
286−-- of each value returned, it then calls the appropriate function.
287−-- Ther result is one of the DBVal variants.
288−-----------------------------------------------------------------------------
289−
290−get_data : DBPointer -> Int -> Int -> IO DBVal
291−get_data (MkDBPointer pointer) row col = do
292− ty <- get_data_type pointer row col
293− helper ty
294− where get_data_type : Ptr ->Int -> Int -> IO Int
295− get_data_type pointer row col =
296− foreign FFI_C "sqlite3_get_data_type" (Ptr -> Int -> Int -> IO Int) pointer row col
297− get_data_val_int : Ptr -> Int -> IO Int
298− get_data_val_int pointer col =
299− foreign FFI_C "sqlite3_get_val_int" (Ptr -> Int -> IO Int) pointer col
300−
301− get_data_val_text : Ptr -> Int -> IO String
302− get_data_val_text pointer col =
303− foreign FFI_C "sqlite3_get_val_text" (Ptr -> Int -> IO String) pointer col
304−
305− get_data_val_float : Ptr -> Int -> IO Float
306− get_data_val_float pointer col =
307− foreign FFI_C "sqlite3_get_float" (Ptr -> Int -> IO Float) pointer col
308−
309− helper : Int -> IO DBVal
310− helper 1 = do i <- get_data_val_int pointer col ; return (DBInt i)
311− helper 2 = do i <- get_data_val_float pointer col ; return (DBFloat i)
312− helper 3 = do i <- get_data_val_text pointer col; return (DBText i)
313− helper _ = return DBNull
314−
315−-----------------------------------------------------------------------------
316−-- | This function makes use of get_data to get all the result.
317−-----------------------------------------------------------------------------
318−
319−toList_v1 : DBPointer -> DB Table
320−toList_v1 db = do nbR <- liftIO (num_row_v2 db)
321− nmC <- liftIO (num_col_v2 db)
322− res <- liftIO $ forM [0..(nbR-1)] $ \ i =>
323− forM [0..(nmC-1)] $ \ j => get_data db i j
324− return (the (List (List DBVal)) res)
325−
326−strcat : String -> String-> String
327−strcat str1 str2 = str1 ++ str2
328−
329−-----------------------------------------------------------------------------
330−-- | This version of toList retunrs result from get_table
331−-- This could be removed if not needed in the future.
332−-----------------------------------------------------------------------------
333−
334−--toList_v2 : String -> String -> DBPointer -> DB Table
335−--toList_v2 name stmt x = do
336−-- ptr <- (get_table x (stmt))
337−-- nbR <- liftIO (num_row ptr)
338−-- nmC <- liftIO (num_col ptr)
339−-- res <- forM [0..(nbR-1)] (\ i =>
340−-- forM [0..(nmC-1)] (\ j =>
341−-- liftIO(get_data x name i j)
342−--
343−-- )
344−-- )
345−-- liftIO (free_table ptr)
346−-- return res
347−
348−
349−-----------------------------------------------------------------------------
350−-- | These routines support binding the types supported by Idris.
351−-- These return a pointer to statement pointer since we want to allow
352−-- binding multiple values by implementing a recursive function.
353−-----------------------------------------------------------------------------
354−
355−bind_int : StmtPtr -> Int -> Int -> DB StmtPtr
356−bind_int (MkStmtPtr pointer) indexval val = do
357− x <- liftIO (foreign FFI_C "sqlite3_bind_int_idr" (Ptr -> Int -> Int -> IO Ptr) pointer indexval val)
358− flag <- liftIO (nullPtr x)
359− if flag
360− then fail "Could not bind int."
361− else return (MkStmtPtr x)
362−
363−
364−bind_float : StmtPtr -> Int -> Float -> DB StmtPtr
365−bind_float (MkStmtPtr pointer) indexval val = do
366− x <- liftIO (foreign FFI_C "sqlite3_bind_float_idr" (Ptr -> Int -> Float -> IO Ptr) pointer indexval val)
367− flag <- liftIO (nullPtr x)
368− if flag
369− then fail "Could not bind float."
370− else return (MkStmtPtr x)
371−
372−bind_text : StmtPtr -> String -> Int -> Int -> DB StmtPtr
373−bind_text (MkStmtPtr pointer) text indexval lengthval = do
374− x <- liftIO (foreign FFI_C "sqlite3_bind_text_idr" (Ptr -> String -> Int -> Int -> IO Ptr)
375− pointer text indexval lengthval)
376− flag <- liftIO(nullPtr x)
377− if flag
378− then fail "Could not bind text."
379− else return (MkStmtPtr x)
380−
381−bind_null : StmtPtr -> Int -> DB StmtPtr
382−bind_null (MkStmtPtr pointer) indexval = do
383− x <- liftIO (foreign FFI_C "sqlite3_bind_null_idr" (Ptr -> Int -> IO Ptr) pointer indexval)
384− flag <- liftIO (nullPtr x)
385− if flag
386− then fail "Could not bind null."
387− else return (MkStmtPtr x)
388−
389−-----------------------------------------------------------------------------
390−-- | String Length
391−-----------------------------------------------------------------------------
392−
393−strlen : String -> DB Int
394−strlen str = liftIO (foreign FFI_C "strLength" (String -> IO Int) str)
395−
396−instance Show DBVal where
397− show (DBInt i) = "Int val: " ++ show i ++ "\n"
398− show (DBText i) = "Text val: " ++ show i ++ "\n"
399− show (DBFloat i) = "Float val: " ++ show i ++ "\n"
400− show (DBNull ) = "NULL"
401−
402−-----------------------------------------------------------------------------
403−-- | Multi bind a list of values.
404−-----------------------------------------------------------------------------
405−
406−bindMulti : StmtPtr-> List (Maybe (Int, Value)) -> DB StmtPtr
407−bindMulti pointer [] = return pointer
408−bindMulti pointer (Nothing :: vs) = bindMulti pointer vs
409−bindMulti pointer ((Just (indexs, (VInt i)))::vs) =
410− do x <- bind_int pointer indexs i
411− bindMulti x vs
412−bindMulti pointer ((Just (indexs, (VStr s)))::vs) =
413− do len <- strlen s
414− x <- bind_text pointer s indexs len
415− bindMulti x vs
416−bindMulti pointer ((Just (indexs, (VFloat f)))::vs) =
417− do x <- bind_float pointer indexs f
418− bindMulti x vs
419−