git.iko.soy/Idris-dev
on ff0fbfa help sign in
Idris-dev/contribs/lib/SQLite3/sqlite3.idr
408 lines 18 kB history raw
1module Sqlite3
2import Sqlexpr
5%lib "sqlite3"
6%link "sqlite3api.o"
7%include "sqlite3api.h"
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-----------------------------------------------------------------------------
19-- | The types supported by Idris returned by the database functions.
21data DBVal = DBInt Int
22 | DBText String
23 | DBFloat Float
24 | DBNull
26-- Database pointer
27data DBPointer = MkDBPointer Ptr
28-- Table pointer
29data TBPointer = MkTBPointer Ptr
30-- Statement pointer
31data StmtPtr = MkStmtPtr Ptr
33Table : Set
34Table = List (List DBVal)
36-- ForMap used in to_list_v1
37forM : Monad m => List a -> (a -> m b) -> m (List b)
38forM f xs = mapM xs f
40-- Neater error handling done using DB
41data DB a = MkDB (IO (Either String a))
43instance Monad DB where
44 (MkDB l) >>= k = MkDB (do c <- l
45 case c of
46 Left err => return (Left err)
47 Right v => case k v of
48 MkDB k' => k')
49 return x = MkDB (return (Right x))
51fail : String -> DB a
52fail err = MkDB (return (Left err))
54liftIO : IO a -> DB a
55liftIO f = MkDB (do f' <- f
56 return (Right f'))
58ioError : String -> IO a
59ioError err = do putStrLn err
60 return (believe_me ())
62runDB : DB a -> IO a
63runDB (MkDB f) = do f' <- f
64 case f' of
65 Right v => return v
66 Left str => ioError str
68-----------------------------------------------------------------------------
69-- | Opens an SQLite database file as specified by the String name argument.
70-----------------------------------------------------------------------------
72open_db : String -> DB DBPointer
73open_db name = do x <- liftIO(mkForeign (FFun "sqlite3_open_idr" [FString] FPtr) name)
74 return (MkDBPointer x)
76-----------------------------------------------------------------------------
77-- | Destructor for the DBPointer.
78-----------------------------------------------------------------------------
80close_db : DBPointer -> DB Int
81close_db (MkDBPointer pointer) = liftIO (mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt)pointer)
83-----------------------------------------------------------------------------
84-- | Wrapper around prepare, step and finalize.
85-----------------------------------------------------------------------------
87exec_db : DBPointer -> String -> DB Int
88exec_db (MkDBPointer pointer) stmt = do
89 x <- liftIO(mkForeign (FFun "sqlite3_exec_idr" [FPtr, FString] FInt)pointer stmt)
90 if (x == 1)
91 then fail "Could not execute."
92 else return x
94-----------------------------------------------------------------------------
95-- | Executes a prepared query. Use of this version is recommended.
96-----------------------------------------------------------------------------
98exec_db_v2 : StmtPtr -> DB Int
99exec_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
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-----------------------------------------------------------------------------
111get_error : DBPointer -> IO String
112get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
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-----------------------------------------------------------------------------
121prepare_db : DBPointer -> String -> DB StmtPtr
122prepare_db (MkDBPointer pointer) cmd = do
123 result <- liftIO(mkForeign (FFun "sqlite3_prepare_idr" [FPtr, FString] FPtr)pointer cmd)
124 flag <- liftIO(nullPtr result)
125 if flag
126 then fail "Error occured while preparing"
127 else return (MkStmtPtr result)
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-----------------------------------------------------------------------------
135step_db : StmtPtr -> DB Int
136step_db (MkStmtPtr pointer)= do
137 x <- liftIO (mkForeign (FFun "sqlite3_step_idr" [FPtr] FInt)pointer)
138 if ( x == 101)
139 then fail "SQLITE_DONE"
140 else return x
142-----------------------------------------------------------------------------
143-- | Deletes a prepared statement. This function must be called after
144-- prepare function.
145-----------------------------------------------------------------------------
147finalize_db : StmtPtr -> DB Int
148finalize_db (MkStmtPtr pointer) = do
149 x <- liftIO (mkForeign (FFun "sqlite3_finalize_idr" [FPtr] FInt)pointer)
150 if (x /= 0)
151 then fail "Could not finalize"
152 else return x
154-----------------------------------------------------------------------------
155-- | Resets a prepared statement pointer back to its initial state.
156-----------------------------------------------------------------------------
158reset_db : StmtPtr -> DB Int
159reset_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
165-----------------------------------------------------------------------------
166-- | These routines obtain column information.
167-----------------------------------------------------------------------------
169column_count : DBPointer -> IO (Either String Int)
170column_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)
176column_name : DBPointer -> Int -> IO String
177column_name (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_name_idr" [FPtr, FInt] FString)pointer iCol
179column_decltype : DBPointer -> Int -> IO String
180column_decltype (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_decltype_idr" [FPtr, FInt] FString)pointer iCol
183column_bytes : DBPointer -> Int -> IO Int
184column_bytes (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FInt)pointer iCol
187column_blob : DBPointer -> Int -> IO String
188column_blob (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FString)pointer iCol
191column_text : DBPointer -> Int -> IO String
192column_text (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_text_idr" [FPtr, FInt] FString)pointer iCol
195column_Int : DBPointer -> Int -> IO Int
196column_Int (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_int_idr" [FPtr, FInt] FInt)pointer iCol
198-----------------------------------------------------------------------------
199-- | These routines support some of SQLite backup functions.
200-----------------------------------------------------------------------------
202backup_init : DBPointer -> String -> DBPointer -> String -> IO DBPointer
203backup_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)
206backup_step : DBPointer -> Int -> IO Int
207backup_step (MkDBPointer pointer) nPage =mkForeign (FFun "sqlite3_backup_step_idr" [FPtr, FInt] FInt)pointer nPage
209backup_finish : DBPointer -> IO Int
210backup_finish (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_finish_idr" [FPtr] FInt)pointer
212backup_remaining : DBPointer -> IO Int
213backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt)pointer
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-----------------------------------------------------------------------------
223get_table : DBPointer -> String -> DB TBPointer
224get_table (MkDBPointer pointer) name = do
225 x <- liftIO(mkForeign (FFun "sqlite3_get_table_idr" [FPtr, FString] FPtr)pointer name)
226 flag <- liftIO(nullPtr x)
227 if flag
228 then do x <- liftIO(get_error_table pointer) ; fail x
229 else return (MkTBPointer x)
230 where
231 get_error_table : Ptr-> IO String
232 get_error_table pointer = do x <- mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
233 return x
236free_table : TBPointer -> IO ()
237free_table (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit)pointer
238 return ()
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-----------------------------------------------------------------------------
245num_row : TBPointer -> IO Int
246num_row (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row" [FPtr] FInt)pointer
247 return (x)
249num_col : TBPointer -> IO Int
250num_col (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col" [FPtr] FInt)pointer
251 return (x)
253-----------------------------------------------------------------------------
254-- | This version of these function obtain the row and column number
255-- from the Database struct.
256-----------------------------------------------------------------------------
258num_row_v2 : DBPointer -> IO Int
259num_row_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row_v2" [FPtr] FInt)pointer
260 return (x)
262num_col_v2 : DBPointer -> IO Int
263num_col_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col_v2" [FPtr] FInt)pointer
264 return (x)
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-----------------------------------------------------------------------------
272get_data : DBPointer -> Int -> Int -> IO DBVal
273get_data (MkDBPointer pointer) row col = do
274 ty <- get_data_type pointer row col
275 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
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
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
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
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)
297-----------------------------------------------------------------------------
298-- | This function makes use of get_data to get all the result.
299-----------------------------------------------------------------------------
301toList_v1 : DBPointer -> DB Table
302toList_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)
309 )
310 )
311 return res
314strcat : String -> String-> String
315strcat str1 str2 = (str1 ++ str2)
317-----------------------------------------------------------------------------
318-- | This version of toList retunrs result from get_table
319-- This could be removed if not needed in the future.
320-----------------------------------------------------------------------------
322--toList_v2 : String -> String -> DBPointer -> DB Table
323--toList_v2 name stmt x = do
324-- ptr <- (get_table x (stmt))
325-- nbR <- liftIO (num_row ptr)
326-- nmC <- liftIO (num_col ptr)
327-- res <- forM [0..(nbR-1)] (\ i =>
328-- forM [0..(nmC-1)] (\ j =>
329-- liftIO(get_data x name i j)
330--
331-- )
332-- )
333-- liftIO (free_table ptr)
334-- return res
337-----------------------------------------------------------------------------
338-- | These routines support binding the types supported by Idris.
339-- These return a pointer to statement pointer since we want to allow
340-- binding multiple values by implementing a recursive function.
341-----------------------------------------------------------------------------
343bind_int : StmtPtr -> Int -> Int -> DB StmtPtr
344bind_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)
347 if flag
348 then fail "Could not bind int."
349 else return (MkStmtPtr x)
352bind_float : StmtPtr -> Int -> Float -> DB StmtPtr
353bind_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)
356 if flag
357 then fail "Could not bind float."
358 else return (MkStmtPtr x)
360bind_text : StmtPtr -> String -> Int -> Int -> DB StmtPtr
361bind_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)
364 if flag
365 then fail "Could not bind text."
366 else return (MkStmtPtr x)
368bind_null : StmtPtr -> Int -> DB StmtPtr
369bind_null (MkStmtPtr pointer) indexval = do
370 x <- liftIO(mkForeign (FFun "sqlite3_bind_null_idr" [FPtr, FInt] FPtr)pointer indexval)
371 flag <- liftIO(nullPtr x)
372 if flag
373 then fail "Could not bind null."
374 else return (MkStmtPtr x)
376-----------------------------------------------------------------------------
377-- | String Length
378-----------------------------------------------------------------------------
380strlen : String -> DB Int
381strlen str = liftIO(mkForeign (FFun "strLength" [FString] FInt) str)
383instance 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"
389-----------------------------------------------------------------------------
390-- | Multi bind a list of values.
391-----------------------------------------------------------------------------
393bindMulti : StmtPtr-> List (Maybe (Int, Value)) -> DB StmtPtr
394bindMulti pointer [] = return pointer
395bindMulti pointer (Nothing :: vs) = bindMulti pointer vs
396bindMulti pointer ((Just (indexs, val))::vs) = case val of
397 (VInt intval) => do x <- bind_int pointer indexs intval
398 bindMulti(x) vs
400 (VStr strval) => do len <- strlen strval
401 x <- bind_text pointer strval indexs len
402 bindMulti(x) vs
405 (VFloat floatval) => do x <- bind_float pointer indexs floatval
407 bindMulti(x) vs