@@ -7,6 +7,7 @@ data DBVal = DBInt Int
77 | DBText String
88 | DBFloat Float
99 | DBNull
10+
1011
1112data DBPointer = MkDBPointer Ptr
1213
@@ -22,6 +23,35 @@ forM : Monad m => List a -> (a -> m b) -> m (List b)
2223forM f xs = mapM xs f
2324
2425
26+data DB a = MkDB (IO (Either String a))
27+
28+instance Monad DB where
29+ (MkDB l) >>= k = MkDB (do c <- l
30+ case c of
31+ Left err => return (Left err)
32+ Right v => case k v of
33+ MkDB k' => k')
34+ return x = MkDB (return (Right x))
35+
36+fail : String -> DB a
37+fail err = MkDB (return (Left err))
38+
39+liftIO : IO a -> DB a
40+liftIO f = MkDB (do f' <- f
41+ return (Right f'))
42+
43+ioError : String -> IO a
44+ioError err = do putStrLn err
45+ return (believe_me ())
46+
47+runDB : DB a -> IO a
48+runDB (MkDB f) = do f' <- f
49+ case f' of
50+ Right v => return v
51+ Left str => ioError str
52+
53+
54+
2555open_db : String -> IO DBPointer
2656open_db name = do x <- mkForeign (FFun "sqlite3_open_idr" [FString] FPtr)name
2757 return (MkDBPointer x)
@@ -29,10 +59,14 @@ open_db name = do x <- mkForeign (FFun "sqlite3_open_idr" [FString] FPtr)name
2959close_db : DBPointer -> IO Int
3060close_db (MkDBPointer pointer) =mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt)pointer
3161
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−
62+
63+exec_db : DBPointer -> String -> DB Int
64+exec_db (MkDBPointer pointer) stmt = do
65+ x <- liftIO(mkForeign (FFun "sqlite3_exec_idr" [FPtr, FString] FInt)pointer stmt)
66+ if (x /= 0)
67+ then fail "Could not execute."
68+ else return x
69+
3670get_error : DBPointer -> IO String
3771get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
3872
@@ -45,29 +79,38 @@ prepare_db (MkDBPointer pointer) cmd = do
4579 then return (Left "Error occured")
4680 else return (Right (MkStmtPtr result))
4781
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
82+step_db : StmtPtr -> DB Int
83+step_db (MkStmtPtr pointer) = do
84+ x <- liftIO (mkForeign (FFun "sqlite3_step_idr" [FPtr] FInt)pointer)
85+ if ( x /= 0)
86+ then fail "Step failed"
87+ else return x
88+
89+
90+finalize_db : StmtPtr -> DB Int
91+finalize_db (MkStmtPtr pointer) = do
92+ x <- liftIO (mkForeign (FFun "sqlite3_finalize_idr" [FPtr] FInt)pointer)
93+ if (x /= 0)
94+ then fail "Could not finalize"
95+ else return x
96+
97+reset_db : StmtPtr -> DB Int
98+reset_db (MkStmtPtr pointer) = do
99+ x <- liftIO(mkForeign (FFun "sqlite3_reset_idr" [FPtr] FInt)pointer)
100+ if (x /=0)
101+ then fail "Could not reset"
102+ else return x
103+
104+column_count : DBPointer -> IO (Either String Int)
105+column_count (MkDBPointer pointer) = do
106+ x <- mkForeign (FFun "sqlite3_column_count_idr" [FPtr] FInt)pointer
107+ if (x == 0 )
108+ then return (Left "No Data")
109+ else return (Right x)
67110
68111column_name : DBPointer -> Int -> IO String
69112column_name (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_name_idr" [FPtr, FInt] FString)pointer iCol
70−
113+
71114column_decltype : DBPointer -> Int -> IO String
72115column_decltype (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_decltype_idr" [FPtr, FInt] FString)pointer iCol
73116
@@ -101,15 +144,29 @@ backup_finish (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_finish_idr"
101144backup_remaining : DBPointer -> IO Int
102145backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt)pointer
103146
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)
147+
148+
149+get_table : DBPointer -> String -> IO (Either String TBPointer)
150+get_table (MkDBPointer pointer) name = do
151+ x <- mkForeign (FFun "sqlite3_get_table_idr" [FPtr, FString] FPtr)pointer name
152+ flag <- nullPtr x
153+ if flag
154+ then do x <- get_error_table pointer ; return (Left (x))
155+ else return (Right (MkTBPointer x))
156+ where
157+ get_error_table : Ptr-> IO String
158+ get_error_table pointer = do x <- mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
159+ return x
160+
107161
108162num_row : TBPointer -> IO Int
109−num_row (MkTBPointer pointer) = mkForeign (FFun "sqlite3_get_num_row" [FPtr] FInt)pointer
163+num_row (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row" [FPtr] FInt)pointer
164+ return (x)
110165
111166num_col : TBPointer -> IO Int
112−num_col (MkTBPointer pointer) = mkForeign (FFun "sqlite3_get_num_col" [FPtr] FInt)pointer
167+num_col (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col" [FPtr] FInt)pointer
168+ return (x)
169+
113170
114171get_data : DBPointer -> String -> Int -> Int -> IO DBVal
115172get_data (MkDBPointer pointer) tbl_name row col = do
@@ -140,19 +197,21 @@ strcat : String -> String-> String
140197strcat str1 str2 = (str1 ++ str2)
141198
142199free_table : TBPointer -> IO ()
143−free_table (MkTBPointer pointer) =mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit)pointer
200+free_table (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit)pointer
201+ return ()
202+
144203
145−toList : String -> String -> DBPointer -> IO Table
204+toList : String -> String -> DBPointer -> DB Table
146205toList name stmt x = do
147− ptr <- get_table x (stmt)
148− nbR <- num_row ptr
149− nmC <- num_col ptr
206+ ptr <- MkDB (get_table x (stmt))
207+ nbR <- liftIO (num_row ptr)
208+ nmC <- liftIO (num_col ptr)
150209 res <- forM [0..(nbR-1)] (\ i =>
151− forM [0..(nmC-1)] (\ j =>
152− get_data x name i j
153− )
210+ forM [0..(nmC-1)] (\ j =>
211+ liftIO(get_data x name i j)
212+ )
154213 )
155− free_table ptr
214+ liftIO (free_table ptr)
156215 return res
157216
158217bind_int : Either String StmtPtr -> Int -> Int -> IO (Either String Int)
@@ -180,51 +239,27 @@ bind_null (Right (MkStmtPtr pointer)) indexval =do x <- mkForeign (FFun "sqlite3
180239bind_null (Left erro) indexval = return (Left "Could not bind null.")
181240
182241
183−-- May need some alterations
242+instance Show DBVal where
243+ show (DBInt i) = "Int val: " ++ show i
244+ show (DBText i) = "Text val: " ++ i
245+ show (DBFloat i) = "Float val: " ++ show i
246+ show (DBNull ) = "NULL"
184247
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)
248+print_data_v2 : DBVal -> String
249+print_data_v2 val = (show val)
190250
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 ()
218251
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 ()
252+test4 : DB ()
253+test4 = do db <- liftIO (open_db "somedb.db")
254+ tbl <- liftIO (get_table 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")
255+ res <- (toList "Student" "select *from Student;" db)
256+ mydata <- liftIO ( get_data db "Student" 1 1)
257+
258+ c <- liftIO (close_db db)
259+ return ()
225260
226261main : IO ()
227−main = do x <- test4
262+main = do x <- runDB (test4)
228263 return ()
229264
230265