git.iko.soy/Idris-dev
on master help sign in
error handling
4a3ce63melissam
contribs/lib/._simpleparser.idrnew file
compare with master
unifiedsplit

Binary file not shown.

contribs/lib/SQLite3/._sqlite3.idr

Binary file not shown.

contribs/lib/SQLite3/._sqlite3api.c

Binary file not shown.

contribs/lib/SQLite3/._sqlite3api.h

Binary file not shown.

contribs/lib/SQLite3/sqlite3.idr+113−78
@@ -7,6 +7,7 @@ data DBVal = DBInt Int
7 | DBText String
7 | DBText String
8 | DBFloat Float
8 | DBFloat Float
9 | DBNull
9 | DBNull
10+
10
11
11data DBPointer = MkDBPointer Ptr
12data DBPointer = MkDBPointer Ptr
12
13
@@ -22,6 +23,35 @@ forM : Monad m => List a -> (a -> m b) -> m (List b)
22forM f xs = mapM xs f
23forM f xs = mapM xs f
23
24
24
25
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+
25open_db : String -> IO DBPointer
55open_db : String -> IO DBPointer
26open_db name = do x <- mkForeign (FFun "sqlite3_open_idr" [FString] FPtr)name
56open_db name = do x <- mkForeign (FFun "sqlite3_open_idr" [FString] FPtr)name
27 return (MkDBPointer x)
57 return (MkDBPointer x)
@@ -29,10 +59,14 @@ open_db name = do x <- mkForeign (FFun "sqlite3_open_idr" [FString] FPtr)name
29close_db : DBPointer -> IO Int
59close_db : DBPointer -> IO Int
30close_db (MkDBPointer pointer) =mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt)pointer
60close_db (MkDBPointer pointer) =mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt)pointer
31
61
32−
62+
33−exec_db : DBPointer -> String -> IO Int
63+exec_db : DBPointer -> String -> DB Int
64+exec_db (MkDBPointer pointer) stmt = do
34−exec_db (MkDBPointer pointer) stmt =mkForeign (FFun "sqlite3_exec_idr" [FPtr, FString] FInt)pointer stmt
65+ x <- liftIO(mkForeign (FFun "sqlite3_exec_idr" [FPtr, FString] FInt)pointer stmt)
35−
66+ if (x /= 0)
67+ then fail "Could not execute."
68+ else return x
69+
36get_error : DBPointer -> IO String
70get_error : DBPointer -> IO String
37get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
71get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
38
72
@@ -45,29 +79,38 @@ prepare_db (MkDBPointer pointer) cmd = do
45 then return (Left "Error occured")
79 then return (Left "Error occured")
46 else return (Right (MkStmtPtr result))
80 else return (Right (MkStmtPtr result))
47
81
48−step_db : Either String StmtPtr -> IO (Either String Int)
82+step_db : StmtPtr -> DB Int
83+step_db (MkStmtPtr pointer) = do
49−step_db (Right (MkStmtPtr pointer)) = do x <- mkForeign (FFun "sqlite3_step_idr" [FPtr] FInt)pointer
84+ x <- liftIO (mkForeign (FFun "sqlite3_step_idr" [FPtr] FInt)pointer)
50− return (Right (x))
85+ if ( x /= 0)
51−
86+ then fail "Step failed"
52−step_db (Left erro) = return (Left "Error in step")
87+ else return x
53−
88+
54−
89+
55−finalize_db : Either String StmtPtr -> IO (Either String Int)
90+finalize_db : StmtPtr -> DB Int
91+finalize_db (MkStmtPtr pointer) = do
56−finalize_db (Right (MkStmtPtr pointer)) = do x <- mkForeign (FFun "sqlite3_finalize_idr" [FPtr] FInt)pointer
92+ x <- liftIO (mkForeign (FFun "sqlite3_finalize_idr" [FPtr] FInt)pointer)
57− return (Right (x))
93+ if (x /= 0)
58−finalize_db (Left erro) = return (Left "Error while finalizing")
94+ then fail "Could not finalize"
59−
95+ else return x
96+
60−reset_db : Either String StmtPtr -> IO (Either String Int)
97+reset_db : StmtPtr -> DB Int
98+reset_db (MkStmtPtr pointer) = do
61−reset_db (Right (MkStmtPtr pointer)) = do x <- mkForeign (FFun "sqlite3_reset_idr" [FPtr] FInt)pointer
99+ x <- liftIO(mkForeign (FFun "sqlite3_reset_idr" [FPtr] FInt)pointer)
62− return (Right (x))
100+ if (x /=0)
63−reset_db (Left erro) = return (Left "Error while resetting")
101+ then fail "Could not reset"
64−
102+ else return x
103+
65−column_count : DBPointer -> IO Int
104+column_count : DBPointer -> IO (Either String Int)
105+column_count (MkDBPointer pointer) = do
66−column_count (MkDBPointer pointer) =mkForeign (FFun "sqlite3_column_count_idr" [FPtr] FInt)pointer
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)
67
110
68column_name : DBPointer -> Int -> IO String
111column_name : DBPointer -> Int -> IO String
69column_name (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_name_idr" [FPtr, FInt] FString)pointer iCol
112column_name (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_name_idr" [FPtr, FInt] FString)pointer iCol
70−
113+
71column_decltype : DBPointer -> Int -> IO String
114column_decltype : DBPointer -> Int -> IO String
72column_decltype (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_decltype_idr" [FPtr, FInt] FString)pointer iCol
115column_decltype (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_decltype_idr" [FPtr, FInt] FString)pointer iCol
73
116
@@ -101,15 +144,29 @@ backup_finish (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_finish_idr"
101backup_remaining : DBPointer -> IO Int
144backup_remaining : DBPointer -> IO Int
102backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt)pointer
145backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt)pointer
103
146
147+
148+
104−get_table : DBPointer -> String -> IO TBPointer
149+get_table : DBPointer -> String -> IO (Either String TBPointer)
150+get_table (MkDBPointer pointer) name = do
105−get_table (MkDBPointer pointer) name = do x <- mkForeign (FFun "sqlite3_get_table_idr" [FPtr, FString] FPtr)pointer name
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))
106− return (MkTBPointer 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+
107
161
108num_row : TBPointer -> IO Int
162num_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)
110
165
111num_col : TBPointer -> IO Int
166num_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+
113
170
114get_data : DBPointer -> String -> Int -> Int -> IO DBVal
171get_data : DBPointer -> String -> Int -> Int -> IO DBVal
115get_data (MkDBPointer pointer) tbl_name row col = do
172get_data (MkDBPointer pointer) tbl_name row col = do
@@ -140,19 +197,21 @@ strcat : String -> String-> String
140strcat str1 str2 = (str1 ++ str2)
197strcat str1 str2 = (str1 ++ str2)
141
198
142free_table : TBPointer -> IO ()
199free_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+
144
203
145−toList : String -> String -> DBPointer -> IO Table
204+toList : String -> String -> DBPointer -> DB Table
146toList name stmt x = do
205toList name stmt x = do
147− ptr <- get_table x (stmt)
206+ ptr <- MkDB (get_table x (stmt))
148− nbR <- num_row ptr
207+ nbR <- liftIO (num_row ptr)
149− nmC <- num_col ptr
208+ nmC <- liftIO (num_col ptr)
150 res <- forM [0..(nbR-1)] (\ i =>
209 res <- forM [0..(nbR-1)] (\ i =>
151− forM [0..(nmC-1)] (\ j =>
210+ forM [0..(nmC-1)] (\ j =>
152− get_data x name i j
211+ liftIO(get_data x name i j)
153− )
212+ )
154 )
213 )
155− free_table ptr
214+ liftIO (free_table ptr)
156 return res
215 return res
157
216
158bind_int : Either String StmtPtr -> Int -> Int -> IO (Either String Int)
217bind_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
180bind_null (Left erro) indexval = return (Left "Could not bind null.")
239bind_null (Left erro) indexval = return (Left "Could not bind null.")
181
240
182
241
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"
184
247
185−print_data : (Show DBVal) => String -> DBVal -> String -> Int -> Int -> IO String
248+print_data_v2 : DBVal -> String
186−print_data dbname val tblname dig1 dig2 = do x <- open_db dbname
249+print_data_v2 val = (show val)
187− val <- get_data x tblname 1 0
188− close_db x
189− return (show val)
190
250
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
251
219−test4 : IO ()
252+test4 : DB ()
220−test4 = do x <- open_db "somedb.db"
253+test4 = do db <- liftIO (open_db "somedb.db")
221− somedata <- get_data x "tbl1" 1 0
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")
222− mylist <- toList "tbl1" "SELECT * FROM tbl1 WHERE data='test4'" x
255+ res <- (toList "Student" "select *from Student;" db)
256+ mydata <- liftIO ( get_data db "Student" 1 1)
257+
223− close_db x
258+ c <- liftIO (close_db db)
224− return ()
259+ return ()
225
260
226main : IO ()
261main : IO ()
227−main = do x <- test4
262+main = do x <- runDB (test4)
228 return ()
263 return ()
229
264
230
265
contribs/lib/SQLite3/sqlite3api.c+2−2
@@ -58,6 +58,7 @@ int sqlite3_exec_idr(void* db, const char *sql)
58 int rc;
58 int rc;
59
59
60 rc = sqlite3_exec(dbi->db_ptr,sql,NULL, NULL, &err);
60 rc = sqlite3_exec(dbi->db_ptr,sql,NULL, NULL, &err);
61+ printf("%d\n", rc);
61 if (rc != SQLITE_OK && err != NULL) {
62 if (rc != SQLITE_OK && err != NULL) {
62 strncpy(dbi->buffer, err, sizeof(dbi->buffer));
63 strncpy(dbi->buffer, err, sizeof(dbi->buffer));
63 sqlite3_free(err);
64 sqlite3_free(err);
@@ -84,7 +85,7 @@ void* sqlite3_prepare_idr(void *db,const char *zSql){
84
85
85 if(rec != SQLITE_OK){
86 if(rec != SQLITE_OK){
86 fprintf(stderr, "SQL Prepare error.\n");
87 fprintf(stderr, "SQL Prepare error.\n");
87− return dbi
88+ return dbi;
88 }
89 }
89
90
90 return dbi;
91 return dbi;
@@ -402,7 +403,6 @@ int sqlite3_column_count_idr(void* db, const char* tbl_name){
402 fprintf(stderr, "SQL column count error\n");
403 fprintf(stderr, "SQL column count error\n");
403 return rc;
404 return rc;
404 }
405 }
405− printf("Column count successful = %d\n", rc);
406 sqlite3_finalize(stmt);
406 sqlite3_finalize(stmt);
407
407
408 // rc = actual column count
408 // rc = actual column count
contribs/lib/SQLite3/students.dbnew file

Binary file not shown.

git-credential-osxkeychainnew file

Binary file not shown.

rts/closure.onew file

Binary file not shown.

rts/libidris_rts.anew file

Binary file not shown.