@@ -0,0 +1,230 @@
1+module main
2+%lib "sqlite3"
3+%link "sqlite3api.o"
4+%include "sqlite3api.h"
5+
6+data DBVal = DBInt Int
7+ | DBText String
8+ | DBFloat Float
9+ | DBNull
10+
11+data DBPointer = MkDBPointer Ptr
12+
13+data TBPointer = MkTBPointer Ptr
14+
15+data StmtPtr = MkStmtPtr Ptr
16+
17+Table : Set
18+Table = List (List DBVal)
19+
20+
21+forM : Monad m => List a -> (a -> m b) -> m (List b)
22+forM f xs = mapM xs f
23+
24+
25+open_db : String -> IO DBPointer
26+open_db name = do x <- mkForeign (FFun "sqlite3_open_idr" [FString] FPtr)name
27+ return (MkDBPointer x)
28+
29+close_db : DBPointer -> IO Int
30+close_db (MkDBPointer pointer) =mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt)pointer
31+
32+
33+exec_db : DBPointer -> String -> IO Int
34+exec_db (MkDBPointer pointer) stmt =mkForeign (FFun "sqlite3_exec_idr" [FPtr, FString] FInt)pointer stmt
35+
36+get_error : DBPointer -> IO String
37+get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
38+
39+prepare_db : DBPointer -> String -> IO (Either String StmtPtr)
40+prepare_db (MkDBPointer pointer) cmd = do
41+
42+ result <- mkForeign (FFun "sqlite3_prepare_idr" [FPtr, FString] FPtr)pointer cmd
43+ flag <- nullPtr result
44+ if flag
45+ then return (Left "Error occured")
46+ else return (Right (MkStmtPtr result))
47+
48+step_db : Either String StmtPtr -> IO (Either String Int)
49+step_db (Right (MkStmtPtr pointer)) = do x <- mkForeign (FFun "sqlite3_step_idr" [FPtr] FInt)pointer
50+ return (Right (x))
51+
52+step_db (Left erro) = return (Left "Error in step")
53+
54+
55+finalize_db : Either String StmtPtr -> IO (Either String Int)
56+finalize_db (Right (MkStmtPtr pointer)) = do x <- mkForeign (FFun "sqlite3_finalize_idr" [FPtr] FInt)pointer
57+ return (Right (x))
58+finalize_db (Left erro) = return (Left "Error while finalizing")
59+
60+reset_db : Either String StmtPtr -> IO (Either String Int)
61+reset_db (Right (MkStmtPtr pointer)) = do x <- mkForeign (FFun "sqlite3_reset_idr" [FPtr] FInt)pointer
62+ return (Right (x))
63+reset_db (Left erro) = return (Left "Error while resetting")
64+
65+column_count : DBPointer -> IO Int
66+column_count (MkDBPointer pointer) =mkForeign (FFun "sqlite3_column_count_idr" [FPtr] FInt)pointer
67+
68+column_name : DBPointer -> Int -> IO String
69+column_name (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_name_idr" [FPtr, FInt] FString)pointer iCol
70+
71+column_decltype : DBPointer -> Int -> IO String
72+column_decltype (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_decltype_idr" [FPtr, FInt] FString)pointer iCol
73+
74+
75+column_bytes : DBPointer -> Int -> IO Int
76+column_bytes (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FInt)pointer iCol
77+
78+
79+column_blob : DBPointer -> Int -> IO String
80+column_blob (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FString)pointer iCol
81+
82+
83+column_text : DBPointer -> Int -> IO String
84+column_text (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_text_idr" [FPtr, FInt] FString)pointer iCol
85+
86+
87+column_Int : DBPointer -> Int -> IO Int
88+column_Int (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_int_idr" [FPtr, FInt] FInt)pointer iCol
89+
90+
91+backup_init : DBPointer -> String -> DBPointer -> String -> IO DBPointer
92+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
93+ return (MkDBPointer x)
94+
95+backup_step : DBPointer -> Int -> IO Int
96+backup_step (MkDBPointer pointer) nPage =mkForeign (FFun "sqlite3_backup_step_idr" [FPtr, FInt] FInt)pointer nPage
97+
98+backup_finish : DBPointer -> IO Int
99+backup_finish (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_finish_idr" [FPtr] FInt)pointer
100+
101+backup_remaining : DBPointer -> IO Int
102+backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt)pointer
103+
104+get_table : DBPointer -> String -> IO TBPointer
105+get_table (MkDBPointer pointer) name = do x <- mkForeign (FFun "sqlite3_get_table_idr" [FPtr, FString] FPtr)pointer name
106+ return (MkTBPointer x)
107+
108+num_row : TBPointer -> IO Int
109+num_row (MkTBPointer pointer) = mkForeign (FFun "sqlite3_get_num_row" [FPtr] FInt)pointer
110+
111+num_col : TBPointer -> IO Int
112+num_col (MkTBPointer pointer) = mkForeign (FFun "sqlite3_get_num_col" [FPtr] FInt)pointer
113+
114+get_data : DBPointer -> String -> Int -> Int -> IO DBVal
115+get_data (MkDBPointer pointer) tbl_name row col = do
116+ ty <- get_data_type pointer tbl_name row col
117+ helper ty
118+ where
119+ get_data_type : Ptr -> String -> Int -> Int -> IO Int
120+ get_data_type pointer tbl_name row col =mkForeign (FFun "sqlite3_get_data_type" [FPtr, FString, FInt, FInt] FInt)pointer tbl_name row col
121+
122+ get_data_val_int : Ptr -> String -> Int -> Int -> IO Int
123+ 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
124+
125+ get_data_val_text : Ptr -> String -> Int -> Int -> IO String
126+ 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
127+
128+ get_data_val_float : Ptr -> String -> Int -> Int -> IO Float
129+ get_data_val_float pointer tbl_name row col =mkForeign (FFun "sqlite3_get_float" [FPtr, FString, FInt, FInt] FFloat)pointer tbl_name row col
130+
131+
132+ helper : Int -> IO DBVal
133+ helper 1 = do i <- get_data_val_int pointer tbl_name row col; return (DBInt i)
134+ helper 2 = do i <- get_data_val_float pointer tbl_name row col; return (DBFloat i)
135+ helper 3 = do i <- get_data_val_text pointer tbl_name row col; return (DBText i)
136+ helper _ = return (DBNull)
137+
138+
139+strcat : String -> String-> String
140+strcat str1 str2 = (str1 ++ str2)
141+
142+free_table : TBPointer -> IO ()
143+free_table (MkTBPointer pointer) =mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit)pointer
144+
145+toList : String -> String -> DBPointer -> IO Table
146+toList name stmt x = do
147+ ptr <- get_table x (stmt)
148+ nbR <- num_row ptr
149+ nmC <- num_col ptr
150+ res <- forM [0..(nbR-1)] (\ i =>
151+ forM [0..(nmC-1)] (\ j =>
152+ get_data x name i j
153+ )
154+ )
155+ free_table ptr
156+ return res
157+
158+bind_int : Either String StmtPtr -> Int -> Int -> IO (Either String Int)
159+bind_int (Right (MkStmtPtr pointer)) indexval val = do x <- mkForeign (FFun "sqlite3_bind_int_idr" [FPtr, FInt, FInt] FInt)pointer indexval val
160+ return (Right x)
161+
162+bind_int (Left erro) indexval val = return (Left "Could not bind int.")
163+
164+bind_float : Either String StmtPtr -> Int -> Int -> IO (Either String Int)
165+bind_float (Right (MkStmtPtr pointer)) indexval val = do x <- mkForeign (FFun "sqlite3_bind_float_idr" [FPtr, FInt, FInt] FInt)pointer indexval val
166+ return (Right x)
167+
168+bind_float (Left erro) indexval val = return (Left "Could not bind float.")
169+
170+bind_text : Either String StmtPtr -> String -> Int -> Int -> IO (Either String Int)
171+bind_text (Right (MkStmtPtr pointer)) text indexval lengthval = do x <- mkForeign (FFun "sqlite3_bind_text_idr" [FPtr, FString, FInt, FInt] FInt)pointer text indexval lengthval
172+ return (Right x)
173+
174+bind_text (Left erro) text indexval lengthval = return (Left "Could not bind text.")
175+
176+bind_null : Either String StmtPtr -> Int -> IO (Either String Int)
177+bind_null (Right (MkStmtPtr pointer)) indexval =do x <- mkForeign (FFun "sqlite3_bind_null_idr" [FPtr, FInt] FInt)pointer indexval
178+ return (Right x)
179+
180+bind_null (Left erro) indexval = return (Left "Could not bind null.")
181+
182+
183+-- May need some alterations
184+
185+print_data : (Show DBVal) => String -> DBVal -> String -> Int -> Int -> IO String
186+print_data dbname val tblname dig1 dig2 = do x <- open_db dbname
187+ val <- get_data x tblname 1 0
188+ close_db x
189+ return (show val)
190+
191+-- Some simple test cases
192+
193+test : IO ()
194+test = do x <- open_db "somedb.db"
195+ stmt <- prepare_db x "SELECT * FROM tbl1 WHERE data='test2'"
196+ f <- step_db stmt
197+ finalize_db stmt
198+ close_db x
199+ return ()
200+
201+test2 : IO ()
202+test2 = do x <- open_db "somedb.db"
203+ tbl <- get_table x "SELECT * FROM tbl1 WHERE num =44'"
204+ free_table tbl
205+ close_db x
206+ return ()
207+
208+test3 : IO ()
209+test3 = do x <- open_db "somedb.db"
210+ e <- open_db "./newdb.db"
211+ tbl <- get_table x "SELECT * FROM tbl1;"
212+ tbl2 <- get_table x "SELECT * FROM mytable ;"
213+ free_table tbl
214+ free_table tbl2
215+ close_db x
216+ close_db e
217+ return ()
218+
219+test4 : IO ()
220+test4 = do x <- open_db "somedb.db"
221+ somedata <- get_data x "tbl1" 1 0
222+ mylist <- toList "tbl1" "SELECT * FROM tbl1 WHERE data='test4'" x
223+ close_db x
224+ return ()
225+
226+main : IO ()
227+main = do x <- test4
228+ return ()
229+
230+