c4da836 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

added tests, comments, got rid of unwanted functions

c4da836melissam14 years ago

contribs/lib/SQLite3/._sqlexpr.idr

compare with master

unifiedsplit

Binary file not shown.

contribs/lib/SQLite3/._sqlite3.idr

Binary file not shown.

contribs/lib/SQLite3/._testunit.idrnew file

Binary file not shown.

contribs/lib/SQLite3/sqlexpr.idr+124−15

@@ -1,8 +1,18 @@

1−module main

1+module sqlexpr

2import prelude.list

4+-----------------------------------------------------------------------------

5+-- |

6+-- Module : sqlexpr

7+-- Copyright : (c) The University of St Andrews, 2012

8+--

9+-- Implementations for SQLite query data type.

10+--

11+-----------------------------------------------------------------------------

12+

13+

4-----------------------------------------------------------

14-----------------------------------------------------------

5−-- * SQL data type

15+-- | SQL data type

6-----------------------------------------------------------

16-----------------------------------------------------------

8data Value = VInt Int

18data Value = VInt Int

@@ -24,6 +34,7 @@ data Clause = MkCond Cond

24 | AND Clause Clause

34 | AND Clause Clause

25 | OR Clause Clause

35 | OR Clause Clause

26 | Empty

36 | Empty

37+ | MkSQL SQL

28data condClause = SET Clause

39data condClause = SET Clause

29 |WHERE condClause Clause

40 |WHERE condClause Clause

@@ -31,12 +42,24 @@ data condClause = SET Clause

31data SelVar = Cols (List String)

42data SelVar = Cols (List String)

32 |ALL

43 |ALL

45+data ColType = CInt String -- parsed as string "int"

46+ |Varchar String

47+

48+data Constr = NOTNULL

49+ | UNIQUE Constr

50+ | None

51+ | PRIMARYKEY

52+ | FOREIGNKEY

53+ | CHECK

54+ | DEFAULT

55+

56+

34data SQL = SELECT SelVar SQL Clause

57data SQL = SELECT SelVar SQL Clause

35 | TBL String

58 | TBL String

36 | INSERT SQL (List Value)

59 | INSERT SQL (List Value)

37 | INSERTC SQL (List Value) (List Value)

60 | INSERTC SQL (List Value) (List Value)

38 | UPDATE SQL condClause

61 | UPDATE SQL condClause

39− | CREATE SQL (List Value)

62+ | CREATE SQL (List (Value, ColType , Constr))

41-- remember to remove these funcs later

64-- remember to remove these funcs later

42foldr1 : (a -> a -> a) -> List a -> a

65foldr1 : (a -> a -> a) -> List a -> a

@@ -55,18 +78,74 @@ unwords' ws = (foldr1 addSpace ws)

55unwords : List String -> String

78unwords : List String -> String

56unwords = pack . unwords' . map unpack

79unwords = pack . unwords' . map unpack

81+-----------------------------------------------------------

82+-- | This function replaces values with question mark

83+-- following by an index number.

84+-----------------------------------------------------------

85+

58valString : List (Maybe(Int, Value)) -> Value -> (String, List (Maybe(Int, Value)))

86valString : List (Maybe(Int, Value)) -> Value -> (String, List (Maybe(Int, Value)))

59valString xs (VInt x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VInt x))])

87valString xs (VInt x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VInt x))])

60valString xs (VStr x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VStr x))])

88valString xs (VStr x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VStr x))])

61valString xs (VFloat x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VFloat x))])

89valString xs (VFloat x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VFloat x))])

62valString xs (VCol n) = (n, xs)

90valString xs (VCol n) = (n, xs)

92+-----------------------------------------------------------

93+-- | This function calls valString on a list of Values.

94+-----------------------------------------------------------

95+

64listVal : List (Maybe(Int, Value)) -> List Value -> (String, List (Maybe(Int, Value)))

96listVal : List (Maybe(Int, Value)) -> List Value -> (String, List (Maybe(Int, Value)))

65listVal xs [] = ("", xs)

97listVal xs [] = ("", xs)

66listVal xs (v::vs) = let (str, newxs) = (valString xs v) in

98listVal xs (v::vs) = let (str, newxs) = (valString xs v) in

67 let (str', newxs') = listVal newxs vs in

99 let (str', newxs') = listVal newxs vs in

68 ((unwords(intersperse "," (words(str) ++ words (str')))), newxs')

100 ((unwords(intersperse "," (words(str) ++ words (str')))), newxs')

101

102+-----------------------------------------------------------

103+-- | Parses the type of column to be created.

104+-----------------------------------------------------------

105+

106+getColType : List (Maybe(Int, Value)) -> ColType -> (String, List (Maybe(Int, Value)))

107+getColType xs (CInt x) = ("int", xs)

108+getColType xs (Varchar str) = ("varchar(255)", xs)

109+

110+-----------------------------------------------------------

111+-- | CREATE Constraints

112+-----------------------------------------------------------

113+

114+getConstr : List (Maybe(Int, Value)) -> Constr -> (String, List (Maybe(Int, Value)))

115+getConstr xs (NOTNULL) = ("NOT NULL", xs)

116+getConstr xs (UNIQUE constr) = ("NOT NULL UNIQUE", xs)

117+getConstr xs (PRIMARYKEY) = ("PRIMARY KEY", xs)

118+getConstr xs (FOREIGNKEY) = ("FOREIGN KEY", xs)

119+getConstr xs (CHECK) = ("CHECK", xs)

120+getConstr xs (DEFAULT) = ("DEFAULT", xs)

121+getConstr xs (None) = ("", xs)

122+

123+putBrackets : String -> String

124+putBrackets str = "(" ++ str ++ ")"

125+

126+-----------------------------------------------------------

127+-- | Used to detect a complex type in a nested SQLite query

128+-----------------------------------------------------------

129+complexType : SQL -> Bool

130+complexType (TBL tbl) = False

131+complexType (SELECT vars sql c) = True

132+

133+-----------------------------------------------------------

134+-- | Used in CREATE

135+-----------------------------------------------------------

136+

137+listValType : List (Maybe(Int, Value)) -> List (Value, ColType , Constr) -> (String, List (Maybe(Int, Value)))

138+listValType xs [] = ("", xs)

139+listValType xs ((val, types, constr) :: vs) = let (str , newxs) = valString xs val in

140+ let (str' , newxs') = getColType newxs types in

141+ let (str'', newxs'') = getConstr newxs' constr in

142+ let (finalstr, finalxs) = listValType newxs'' vs in

143+ ((unwords(intersperse " " (words(str) ++ words(str') ++ words(str'') ++ words(finalstr)))) , finalxs)

144+

145+-----------------------------------------------------------

146+-- | Evaluates a condition after WHERE clause

147+-----------------------------------------------------------

148+

70evalCond : List (Maybe(Int, Value)) -> Cond -> (String, List (Maybe(Int, Value)))

149evalCond : List (Maybe(Int, Value)) -> Cond -> (String, List (Maybe(Int, Value)))

71evalCond xs (Equals val1 val2) = let (restring , newxs ) = valString xs val1 in

150evalCond xs (Equals val1 val2) = let (restring , newxs ) = valString xs val1 in

72 let (restring2, newxs') = valString newxs val2 in

151 let (restring2, newxs') = valString newxs val2 in

@@ -90,8 +169,16 @@ evalCond xs (MkLTE val1 val2) = let (restring , newxs ) = valString xs val1 in

169

91evalCond xs (MkNULL val) = let (restring , newxs ) = valString xs val in

170evalCond xs (MkNULL val) = let (restring , newxs ) = valString xs val in

92 (restring ++ " IS NULL " , newxs)

171 (restring ++ " IS NULL " , newxs)

93−

172+

173+-----------------------------------------------------------

174+-- | Evaluates queries

175+-----------------------------------------------------------

176+evalSQL : List (Maybe(Int, Value)) -> SQL -> ( String, List (Maybe(Int, Value)))

177+-----------------------------------------------------------

178+-- | Evaluates clauses

179+-----------------------------------------------------------

94clauseString : List (Maybe(Int, Value)) -> Clause -> (String, List (Maybe(Int, Value)))

180clauseString : List (Maybe(Int, Value)) -> Clause -> (String, List (Maybe(Int, Value)))

181+

95clauseString xs (Empty) = ("" , []) -- No condition

182clauseString xs (Empty) = ("" , []) -- No condition

96clauseString xs (MkCond cond') = let (condstr, newxs) = evalCond xs cond' in

183clauseString xs (MkCond cond') = let (condstr, newxs) = evalCond xs cond' in

97 (condstr , newxs)

184 (condstr , newxs)

@@ -103,6 +190,11 @@ clauseString xs (AND c1 c2) = let (clausestr, newxs) = clauseString xs c1 in

103clauseString xs (OR c1 c2) = let (clausestr, newxs) = clauseString xs c1 in

190clauseString xs (OR c1 c2) = let (clausestr, newxs) = clauseString xs c1 in

104 let (clausestr2, newxs') = clauseString newxs c2 in

191 let (clausestr2, newxs') = clauseString newxs c2 in

105 (clausestr ++ " OR " ++clausestr2 , newxs')

192 (clausestr ++ " OR " ++clausestr2 , newxs')

193+

194+

195+-----------------------------------------------------------

196+-- | Evaluates conditional clauses.

197+-----------------------------------------------------------

106

198

107condClauseStr : List (Maybe(Int, Value)) -> condClause -> (String, List (Maybe(Int, Value)))

199condClauseStr : List (Maybe(Int, Value)) -> condClause -> (String, List (Maybe(Int, Value)))

108condClauseStr xs (SET setcl) = let (condstr, newxs) = clauseString xs setcl in

200condClauseStr xs (SET setcl) = let (condstr, newxs) = clauseString xs setcl in

@@ -111,24 +203,39 @@ condClauseStr xs (SET setcl) = let (condstr, newxs) = clauseString xs setcl in

111condClauseStr xs (WHERE setcl1 setcl2) = let (condstr, newxs) = condClauseStr xs setcl1 in

203condClauseStr xs (WHERE setcl1 setcl2) = let (condstr, newxs) = condClauseStr xs setcl1 in

112 let (condstr', newxs') = clauseString newxs setcl2 in

204 let (condstr', newxs') = clauseString newxs setcl2 in

113 ( condstr ++ " WHERE " ++ condstr', newxs')

205 ( condstr ++ " WHERE " ++ condstr', newxs')

206+

207+--TODO SELECT data from tbl1 where num > (SELECT num from tbl1 where num = 24)

208+-- evalSQL [] ((SELECT ALL) (TBL "tbl") (MkSQL ((SELECT ALL) (TBL "tbl") (MkCond (VCol ") ) ) )

209+--clauseString xs (MkSQL sql) = (evalSQL xs sql)

210+

114

211

115−

116−evalSQL : List (Maybe(Int, Value)) -> SQL -> ( String, List (Maybe(Int, Value)))

117evalSQL xs (TBL tbl) = (tbl, xs)

212evalSQL xs (TBL tbl) = (tbl, xs)

118evalSQL xs (SELECT vars sql' c) = let (sqlstring, newxs) = evalSQL xs sql' in

213evalSQL xs (SELECT vars sql' c) = let (sqlstring, newxs) = evalSQL xs sql' in

119 let (csstring, newxs') = clauseString newxs c in

214 let (csstring, newxs') = clauseString newxs c in

120 case c of

215 case c of

121 Empty => case vars of

216 Empty => case vars of

122− (ALL ) => ("SELECT " ++ "*" ++ " FROM ("

217+ (ALL ) => if complexType sql' then ("SELECT " ++ "*" ++ " FROM "

123− ++ sqlstring ++ ") " ++ csstring++ ";", newxs')

218+ ++ (putBrackets sqlstring) ++ csstring, newxs')

219+ else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring ++ csstring, newxs')

220+

124− (Cols selvar) => ("SELECT " ++ unwords ( intersperse "" ( selvar ++

221+ (Cols selvar) => if complexType sql' then ("SELECT " ++ unwords ( intersperse "" ( selvar ++

125− (words ( " FROM (" ++ sqlstring ++ ")")))) ++ csstring++ ";", newxs')

222+ (words ( " FROM " ++ (putBrackets sqlstring) )))) ++ csstring, newxs')

223+ else ("SELECT " ++ unwords ( intersperse "" ( selvar ++

224+ (words ( "FROM " ++ sqlstring )))) ++ csstring, newxs')

126

225

127 _ => case vars of

226 _ => case vars of

128− (ALL ) => ("SELECT " ++ "*" ++ " FROM ("

227+ (ALL ) => if complexType sql' then ("SELECT " ++ "*" ++ " FROM "

129− ++ sqlstring ++ ") " ++ "WHERE " ++ csstring++ ";", newxs')

228+ ++ (putBrackets sqlstring) ++ " WHERE " ++ csstring , newxs')

130− (Cols selvar) => ("SELECT " ++ unwords ( intersperse "" ( selvar ++

229+ else ("SELECT " ++ "*" ++ " FROM "

230+ ++ sqlstring ++ " WHERE " ++ csstring , newxs')

231+

232+ (Cols selvar) => if complexType sql' then ("SELECT " ++ unwords ( intersperse "" ( selvar ++

233+ (words ( " FROM " ++ (putBrackets sqlstring) ))))

131− (words ( " FROM (" ++ sqlstring ++ ")")))) ++ "WHERE" ++ csstring ++ ";", newxs')

234+ ++ " WHERE " ++ csstring , newxs')

235+

236+ else ("SELECT " ++ unwords ( intersperse "" ( selvar ++

237+ (words ( "FROM " ++ sqlstring )))) ++ " WHERE " ++ csstring , newxs')

238+

132

239

133evalSQL xs (INSERT sql vals) = let (tblname, newvals) = evalSQL xs sql in

240evalSQL xs (INSERT sql vals) = let (tblname, newvals) = evalSQL xs sql in

134 let (str, newxs ) = listVal newvals vals in

241 let (str, newxs ) = listVal newvals vals in

@@ -144,4 +251,6 @@ evalSQL xs (UPDATE sql cl) = let (tblname, newxs) = evalSQL xs sql in

144 let (csstring, newxs') = condClauseStr newxs cl in

251 let (csstring, newxs') = condClauseStr newxs cl in

145 ("UPDATE " ++ tblname ++ csstring, newxs')

252 ("UPDATE " ++ tblname ++ csstring, newxs')

146

253

147−

254+evalSQL xs (CREATE sql details) = let (sqlstring, newxs) = evalSQL xs sql in

255+ let (csstring, newxs') = listValType newxs details in

256+ ("CREATE TABLE " ++ sqlstring ++ "(" ++ csstring ++ ")", newxs')

contribs/lib/SQLite3/sqlite3.idr+139−172

@@ -1,4 +1,4 @@

1−module main

1+module sqlite3

2import sqlexpr

@@ -6,7 +6,17 @@ import sqlexpr

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.

11data DBVal = DBInt Int

21data DBVal = DBInt Int

12 | DBText String

22 | DBText String

@@ -55,15 +65,24 @@ runDB (MkDB f) = do f' <- f

55 Right v => return v

65 Right v => return v

56 Left str => ioError str

66 Left str => ioError str

68+-----------------------------------------------------------------------------

69+-- | Opens an SQLite database file as specified by the String name argument.

70+-----------------------------------------------------------------------------

59open_db : String -> DB DBPointer

72open_db : String -> DB DBPointer

60open_db name = do x <- liftIO(mkForeign (FFun "sqlite3_open_idr" [FString] FPtr) name)

73open_db name = do x <- liftIO(mkForeign (FFun "sqlite3_open_idr" [FString] FPtr) name)

61 return (MkDBPointer x)

74 return (MkDBPointer x)

76+-----------------------------------------------------------------------------

77+-- | Destructor for the DBPointer.

78+-----------------------------------------------------------------------------

79+

63close_db : DBPointer -> DB Int

80close_db : DBPointer -> DB Int

64close_db (MkDBPointer pointer) = liftIO (mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt)pointer)

81close_db (MkDBPointer pointer) = liftIO (mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt)pointer)

66−

83+-----------------------------------------------------------------------------

84+-- | Wrapper around prepare, step and finalize.

85+-----------------------------------------------------------------------------

68exec_db : DBPointer -> String -> DB Int

87exec_db : DBPointer -> String -> DB Int

69exec_db (MkDBPointer pointer) stmt = do

88exec_db (MkDBPointer pointer) stmt = do

@@ -72,11 +91,32 @@ exec_db (MkDBPointer pointer) stmt = do

72 then fail "Could not execute."

91 then fail "Could not execute."

73 else return x

92 else return x

94+-----------------------------------------------------------------------------

95+-- | Executes a prepared query. Use of this version is recommended.

96+-----------------------------------------------------------------------------

98+exec_db_v2 : StmtPtr -> DB Int

99+exec_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

104+

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+-----------------------------------------------------------------------------

110

77get_error : DBPointer -> IO String

111get_error : DBPointer -> IO String

78get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer

112get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer

113

114+

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+-----------------------------------------------------------------------------

120

81prepare_db : DBPointer -> String -> DB StmtPtr

121prepare_db : DBPointer -> String -> DB StmtPtr

82prepare_db (MkDBPointer pointer) cmd = do

122prepare_db (MkDBPointer pointer) cmd = do

@@ -86,12 +126,11 @@ prepare_db (MkDBPointer pointer) cmd = do

86 then fail "Error occured while preparing"

126 then fail "Error occured while preparing"

87 else return (MkStmtPtr result)

127 else return (MkStmtPtr result)

128

89−exec_db_v2 : StmtPtr -> DB Int

129+-----------------------------------------------------------------------------

90−exec_db_v2 (MkStmtPtr pointer) = do

130+-- | Returns the error stored in the buffer by exec_db function.

91− x <- liftIO (mkForeign (FFun "exec_db" [FPtr] FInt) pointer)

131+-- This function can only be used with exec_db and get_table.

92− if (x == 21)

132+-- Only these functions store any occured error in the buffer array.

93− then fail "No data returned."

133+-----------------------------------------------------------------------------

94− else return x

134

96step_db : StmtPtr -> DB Int

135step_db : StmtPtr -> DB Int

97step_db (MkStmtPtr pointer)= do

136step_db (MkStmtPtr pointer)= do

@@ -100,6 +139,10 @@ step_db (MkStmtPtr pointer)= do

100 then fail "SQLITE_DONE"

139 then fail "SQLITE_DONE"

101 else return x

140 else return x

102

141

142+-----------------------------------------------------------------------------

143+-- | Deletes a prepared statement. This function must be called after

144+-- prepare function.

145+-----------------------------------------------------------------------------

103

146

104finalize_db : StmtPtr -> DB Int

147finalize_db : StmtPtr -> DB Int

105finalize_db (MkStmtPtr pointer) = do

148finalize_db (MkStmtPtr pointer) = do

@@ -108,6 +151,10 @@ finalize_db (MkStmtPtr pointer) = do

108 then fail "Could not finalize"

151 then fail "Could not finalize"

109 else return x

152 else return x

110

153

154+-----------------------------------------------------------------------------

155+-- | Resets a prepared statement pointer back to its initial state.

156+-----------------------------------------------------------------------------

157+

111reset_db : StmtPtr -> DB Int

158reset_db : StmtPtr -> DB Int

112reset_db (MkStmtPtr pointer) = do

159reset_db (MkStmtPtr pointer) = do

113 x <- liftIO(mkForeign (FFun "sqlite3_reset_idr" [FPtr] FInt)pointer)

160 x <- liftIO(mkForeign (FFun "sqlite3_reset_idr" [FPtr] FInt)pointer)

@@ -115,6 +162,10 @@ reset_db (MkStmtPtr pointer) = do

115 then fail "Could not reset"

162 then fail "Could not reset"

116 else return x

163 else return x

117

164

165+-----------------------------------------------------------------------------

166+-- | These routines obtain column information.

167+-----------------------------------------------------------------------------

168+

118column_count : DBPointer -> IO (Either String Int)

169column_count : DBPointer -> IO (Either String Int)

119column_count (MkDBPointer pointer) = do

170column_count (MkDBPointer pointer) = do

120 x <- mkForeign (FFun "sqlite3_column_count_idr" [FPtr] FInt)pointer

171 x <- mkForeign (FFun "sqlite3_column_count_idr" [FPtr] FInt)pointer

@@ -144,6 +195,9 @@ column_text (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_text_idr

144column_Int : DBPointer -> Int -> IO Int

195column_Int : DBPointer -> Int -> IO Int

145column_Int (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_int_idr" [FPtr, FInt] FInt)pointer iCol

196column_Int (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_int_idr" [FPtr, FInt] FInt)pointer iCol

146

197

198+-----------------------------------------------------------------------------

199+-- | These routines support some of SQLite backup functions.

200+-----------------------------------------------------------------------------

147

201

148backup_init : DBPointer -> String -> DBPointer -> String -> IO DBPointer

202backup_init : DBPointer -> String -> DBPointer -> String -> IO DBPointer

149backup_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

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

@@ -159,6 +213,12 @@ backup_remaining : DBPointer -> IO Int

159backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt)pointer

213backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt)pointer

160

214

161

215

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+-----------------------------------------------------------------------------

162

222

163get_table : DBPointer -> String -> DB TBPointer

223get_table : DBPointer -> String -> DB TBPointer

164get_table (MkDBPointer pointer) name = do

224get_table (MkDBPointer pointer) name = do

@@ -173,6 +233,15 @@ get_table (MkDBPointer pointer) name = do

173 return x

233 return x

174

234

175

235

236+free_table : TBPointer -> IO ()

237+free_table (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit)pointer

238+ return ()

239+

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+-----------------------------------------------------------------------------

244+

176num_row : TBPointer -> IO Int

245num_row : TBPointer -> IO Int

177num_row (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row" [FPtr] FInt)pointer

246num_row (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row" [FPtr] FInt)pointer

178 return (x)

247 return (x)

@@ -181,30 +250,10 @@ num_col : TBPointer -> IO Int

181num_col (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col" [FPtr] FInt)pointer

250num_col (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col" [FPtr] FInt)pointer

182 return (x)

251 return (x)

183

252

184−

253+-----------------------------------------------------------------------------

185−get_data : DBPointer -> String -> Int -> Int -> IO DBVal

254+-- | This version of these function obtain the row and column number

186−get_data (MkDBPointer pointer) tbl_name row col = do

255+-- from the Database struct.

187− ty <- get_data_type pointer tbl_name row col

256+-----------------------------------------------------------------------------

188− helper ty

189− where

190− get_data_type : Ptr -> String -> Int -> Int -> IO Int

191− get_data_type pointer tbl_name row col =mkForeign (FFun "sqlite3_get_data_type" [FPtr, FString, FInt, FInt] FInt)pointer tbl_name row col

192−

193− get_data_val_int : Ptr -> String -> Int -> Int -> IO Int

194− 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

195−

196− get_data_val_text : Ptr -> String -> Int -> Int -> IO String

197− 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

198−

199− get_data_val_float : Ptr -> String -> Int -> Int -> IO Float

200− get_data_val_float pointer tbl_name row col =mkForeign (FFun "sqlite3_get_float" [FPtr, FString, FInt, FInt] FFloat)pointer tbl_name row col

201−

202−

203− helper : Int -> IO DBVal

204− helper 1 = do i <- get_data_val_int pointer tbl_name row col; return (DBInt i)

205− helper 2 = do i <- get_data_val_float pointer tbl_name row col; return (DBFloat i)

206− helper 3 = do i <- get_data_val_text pointer tbl_name row col; return (DBText i)

207− helper _ = return (DBNull)

208

257

209num_row_v2 : DBPointer -> IO Int

258num_row_v2 : DBPointer -> IO Int

210num_row_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row_v2" [FPtr] FInt)pointer

259num_row_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row_v2" [FPtr] FInt)pointer

@@ -214,14 +263,19 @@ num_col_v2 : DBPointer -> IO Int

214num_col_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col_v2" [FPtr] FInt)pointer

263num_col_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col_v2" [FPtr] FInt)pointer

215 return (x)

264 return (x)

216

265

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+-----------------------------------------------------------------------------

217

271

218−get_data_v2 : DBPointer -> Int -> Int -> IO DBVal

272+get_data : DBPointer -> Int -> Int -> IO DBVal

219−get_data_v2 (MkDBPointer pointer) row col = do

273+get_data (MkDBPointer pointer) row col = do

220− ty <- get_data_type_v2 pointer row col

274+ ty <- get_data_type pointer row col

221 helper ty

275 helper ty

222 where

276 where

223− get_data_type_v2 : Ptr ->Int -> Int -> IO Int

277+ get_data_type : Ptr ->Int -> Int -> IO Int

224− get_data_type_v2 pointer row col =mkForeign (FFun "sqlite3_get_data_type_v2" [FPtr, FInt, FInt] FInt)pointer row col

278+ get_data_type pointer row col =mkForeign (FFun "sqlite3_get_data_type_v2" [FPtr, FInt, FInt] FInt)pointer row col

225

279

226 get_data_val_int : Ptr -> Int -> IO Int

280 get_data_val_int : Ptr -> Int -> IO Int

227 get_data_val_int pointer col =mkForeign (FFun "sqlite3_get_val_int_v2" [FPtr,FInt] FInt)pointer col

281 get_data_val_int pointer col =mkForeign (FFun "sqlite3_get_val_int_v2" [FPtr,FInt] FInt)pointer col

@@ -240,43 +294,49 @@ get_data_v2 (MkDBPointer pointer) row col = do

240 helper 3 = do i <- get_data_val_text pointer col; return (DBText i)

294 helper 3 = do i <- get_data_val_text pointer col; return (DBText i)

241 helper _ =return (DBNull)

295 helper _ =return (DBNull)

242

296

243−

297+-----------------------------------------------------------------------------

298+-- | This function makes use of get_data to get all the result.

299+-----------------------------------------------------------------------------

300+

244−toList_v2 : DBPointer -> DB Table

301+toList : DBPointer -> DB Table

245−toList_v2 db = do

302+toList db = do

246− nbR <- liftIO (num_row_v2 db)

303+ nbR <- liftIO (num_row_v2 db)

247− nmC <- liftIO (num_col_v2 db)

304+ nmC <- liftIO (num_col_v2 db)

248− res <- forM [0..(nbR-1)] (\ i =>

305+ res <- forM [0..(nbR-1)] (\ i =>

249− forM [0..(nmC-1)] (\ j =>

306+ forM [0..(nmC-1)] (\ j =>

250− liftIO(get_data_v2 db i j)

307+ liftIO(get_data db i j)

251

308

252− )

309+ )

253− )

310+ )

254− return res

311+ return res

255

312

256

313

257strcat : String -> String-> String

314strcat : String -> String-> String

258strcat str1 str2 = (str1 ++ str2)

315strcat str1 str2 = (str1 ++ str2)

259

316

260−free_table : TBPointer -> IO ()

317+-----------------------------------------------------------------------------

261−free_table (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit)pointer

318+-- | This version of toList retunrs result from get_table

262− return ()

319+-----------------------------------------------------------------------------

263−

264

320

265−toList : String -> String -> DBPointer -> DB Table

321+--toList_v2 : String -> String -> DBPointer -> DB Table

266−toList name stmt x = do

322+--toList_v2 name stmt x = do

267− ptr <- (get_table x (stmt))

323+-- ptr <- (get_table x (stmt))

268− nbR <- liftIO (num_row ptr)

324+-- nbR <- liftIO (num_row ptr)

269− nmC <- liftIO (num_col ptr)

325+-- nmC <- liftIO (num_col ptr)

270− res <- forM [0..(nbR-1)] (\ i =>

326+-- res <- forM [0..(nbR-1)] (\ i =>

271− forM [0..(nmC-1)] (\ j =>

327+-- forM [0..(nmC-1)] (\ j =>

272− liftIO(get_data x name i j)

328+-- liftIO(get_data x name i j)

273−

329+--

274− )

330+-- )

275− )

331+-- )

276− liftIO (free_table ptr)

332+-- liftIO (free_table ptr)

277− return res

333+-- return res

278

334

279

335

336+-----------------------------------------------------------------------------

337+-- | These routines support binding the types supported by Idris.

338+-----------------------------------------------------------------------------

339+

280bind_int : StmtPtr -> Int -> Int -> DB StmtPtr

340bind_int : StmtPtr -> Int -> Int -> DB StmtPtr

281bind_int (MkStmtPtr pointer) indexval val = do

341bind_int (MkStmtPtr pointer) indexval val = do

282 x <- liftIO(mkForeign (FFun "sqlite3_bind_int_idr" [FPtr, FInt, FInt] FPtr)pointer indexval val)

342 x <- liftIO(mkForeign (FFun "sqlite3_bind_int_idr" [FPtr, FInt, FInt] FPtr)pointer indexval val)

@@ -302,12 +362,17 @@ bind_text (MkStmtPtr pointer) text indexval lengthval = do

302 then fail "Could not bind text."

362 then fail "Could not bind text."

303 else return (MkStmtPtr x)

363 else return (MkStmtPtr x)

304

364

305−--bind_null : StmtPtr -> Int -> DB StmtPtr

365+bind_null : StmtPtr -> Int -> DB StmtPtr

306−--bind_null (MkStmtPtr pointer) indexval =do

366+bind_null (MkStmtPtr pointer) indexval = do

307−-- x <- liftIO(mkForeign (FFun "sqlite3_bind_null_idr" [FPtr, FInt] FInt)pointer indexval)

367+ x <- liftIO(mkForeign (FFun "sqlite3_bind_null_idr" [FPtr, FInt] FPtr)pointer indexval)

368+ flag <- liftIO(nullPtr x)

308−-- if (x /= 0)

369+ if flag

309−-- then fail "Could not bind null."

370+ then fail "Could not bind null."

310−-- else return x

371+ else return (MkStmtPtr x)

372+

373+-----------------------------------------------------------------------------

374+-- | String Length

375+-----------------------------------------------------------------------------

311

376

312strlen : String -> DB Int

377strlen : String -> DB Int

313strlen str = liftIO(mkForeign (FFun "strLength" [FString] FInt) str)

378strlen str = liftIO(mkForeign (FFun "strLength" [FString] FInt) str)

@@ -318,29 +383,9 @@ instance Show DBVal where

318 show (DBFloat i) = "Float val: " ++ show i ++ "\n"

383 show (DBFloat i) = "Float val: " ++ show i ++ "\n"

319 show (DBNull ) = "NULL"

384 show (DBNull ) = "NULL"

320

385

321−print_data_v2 : DBVal -> String

386+-----------------------------------------------------------------------------

322−print_data_v2 = show

387+-- | Multi bind a list of values.

323−

388+-----------------------------------------------------------------------------

324−test : DB ()

325−test = do db <- open_db "somedb.db"

326− stmt <- (prepare_db db "insert into tbl1 values (?,?);")

327− bind_int stmt 1 456

328− bind_text stmt "testing" 2 4

329− step_db stmt

330− reset_db stmt

331− finalize_db stmt

332− c <- close_db db

333− return ()

334−

335−test3 : DB()

336−test3 = do db <- open_db "students.db"

337− stmt <- (prepare_db 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")

338− exec_db_v2 stmt

339− res <- toList_v2 db

340− liftIO(print res)

341− finalize_db stmt

342− c <- close_db db

343− return ()

344

389

345bindMulti : StmtPtr-> List (Maybe (Int, Value)) -> DB StmtPtr

390bindMulti : StmtPtr-> List (Maybe (Int, Value)) -> DB StmtPtr

346bindMulti pointer [] = return pointer

391bindMulti pointer [] = return pointer

@@ -356,81 +401,3 @@ bindMulti pointer ((Just (indexs, val))::vs) = case val of

356

401

357 (VFloat floatval) => do x <- bind_float pointer indexs floatval

402 (VFloat floatval) => do x <- bind_float pointer indexs floatval

358 bindMulti(x) vs

403 bindMulti(x) vs

359−testexpr : DB()

360−testexpr = do db <- open_db "somedb.db"

361− let sql = (evalSQL [] ((SELECT ALL)(TBL "tbl1") (OR (AND (MkCond (Equals (VCol "data")(VStr "data0"))) (MkCond (Equals (VCol "num")(VInt 1))) ) (MkCond (Equals (VCol "num")(VInt 2))))))

362− let x = (fst sql)

363− let list = (snd sql)

364− liftIO(print x)

365− stmt <- (prepare_db db x)

366− bindMulti stmt list

367− exec_db_v2 stmt

368− res <- toList_v2 db

369− liftIO(print res)

370− finalize_db stmt

371− close_db db

372− return ()

373−

374−testupdate : DB()

375−testupdate = do db <- open_db "somedb.db"

376− let sql = (evalSQL [] (UPDATE (TBL "tbl1") (WHERE (SET (MkCond (Equals(VCol "data") (VStr "data0"))) ) (MkCond (Equals (VCol "num") (VInt 2))) ) ))

377− let x = (fst sql)

378− let list = (snd sql)

379− liftIO(print x)

380− stmt <- (prepare_db db x)

381− bindMulti stmt list

382− exec_db_v2 stmt

383− finalize_db stmt

384− close_db db

385− return ()

386−

387−testInsert : DB()

388−testInsert = do db <- open_db "somedb.db"

389− let sql = (evalSQL [] (INSERT (TBL "tbl1") [(VInt 2),(VStr "histring2")]))

390− let x = (fst sql)

391− let list = (snd sql)

392− liftIO(print x)

393− stmt <- (prepare_db db x)

394− bindMulti stmt list

395− exec_db_v2 stmt

396− finalize_db stmt

397− close_db db

398− return ()

399−

400−testNull : DB()

401−testNull = do db <- open_db "somedb.db"

402− let sql = (evalSQL [] ((SELECT ALL)(TBL "tbl1") (MkCond (MkNULL (VCol "data")))))

403− let x = (fst sql)

404− let list = (snd sql)

405− liftIO(print x)

406− stmt <- (prepare_db db x)

407− bindMulti stmt list

408− exec_db_v2 stmt

409− res <- toList_v2 db

410− liftIO(print res)

411− finalize_db stmt

412− close_db db

413− return ()

414−

415−testInsertWithCond : DB()

416−testInsertWithCond = do db <- open_db "somedb.db"

417− let sql = (evalSQL [] (INSERTC (TBL "tbl1") [(VCol "data"),(VCol "num")] [(VInt 201),(VStr "newinserted")]))

418− let x = (fst sql)

419− let list = (snd sql)

420− liftIO(print x)

421− stmt <- (prepare_db db x)

422− bindMulti stmt list

423− exec_db_v2 stmt

424− finalize_db stmt

425− close_db db

426− return ()

427−

428−

429−main : IO ()

430−main = do --x <- runDB (test3)

431− y <- runDB (testInsertWithCond)

432− return ()

433−

434−

435−

436−

contribs/lib/SQLite3/testunit.idrnew file+108

@@ -0,0 +1,108 @@

1+module main

2+import sqlite3

5+testexpr : DB()

6+testexpr = do db <- open_db "somedb.db"

7+ let sql = (evalSQL [] ((SELECT ALL)(TBL "tbl1") (OR (AND (MkCond (Equals (VCol "data")(VStr "data0"))) (MkCond (Equals (VCol "num")(VInt 1))) ) (MkCond (Equals (VCol "num")(VInt 2))))))

8+ let x = (fst sql)

9+ let list = (snd sql)

10+ liftIO(print x)

11+ stmt <- (prepare_db db x)

12+ bindMulti stmt list

13+ exec_db_v2 stmt

14+ res <- toList db

15+ liftIO(print res)

16+ finalize_db stmt

17+ close_db db

18+ return ()

19+

20+testupdate : DB()

21+testupdate = do db <- open_db "somedb.db"

22+ let sql = (evalSQL [] (UPDATE (TBL "tbl1") (WHERE (SET (MkCond (Equals(VCol "data") (VStr "data0"))) ) (MkCond (Equals (VCol "num") (VInt 2))) ) ))

23+ let x = (fst sql)

24+ let list = (snd sql)

25+ liftIO(print x)

26+ stmt <- (prepare_db db x)

27+ bindMulti stmt list

28+ exec_db_v2 stmt

29+ finalize_db stmt

30+ close_db db

31+ return ()

32+

33+testInsert : DB()

34+testInsert = do db <- open_db "somedb.db"

35+ let sql = (evalSQL [] (INSERT (TBL "tbl1") [(VInt 2),(VStr "histring2")]))

36+ let x = (fst sql)

37+ let list = (snd sql)

38+ liftIO(print x)

39+ stmt <- (prepare_db db x)

40+ bindMulti stmt list

41+ exec_db_v2 stmt

42+ finalize_db stmt

43+ close_db db

44+ return ()

45+

46+testNull : DB()

47+testNull = do db <- open_db "somedb.db"

48+ let sql = (evalSQL [] ((SELECT ALL)(TBL "tbl1") (MkCond (MkNULL (VCol "data")))))

49+ let x = (fst sql)

50+ let list = (snd sql)

51+ liftIO(print x)

52+ stmt <- (prepare_db db x)

53+ bindMulti stmt list

54+ exec_db_v2 stmt

55+ res <- toList db

56+ liftIO(print res)

57+ finalize_db stmt

58+ close_db db

59+ return ()

60+

61+

62+testInsertWithCond : DB()

63+testInsertWithCond = do db <- open_db "somedb.db"

64+ let sql = (evalSQL [] (INSERTC (TBL "tbl1") [(VCol "data"),(VCol "num")] [(VInt 201),(VStr "newinserted")]))

65+ let x = (fst sql)

66+ let list = (snd sql)

67+ liftIO(print x)

68+ stmt <- (prepare_db db x)

69+ bindMulti stmt list

70+ exec_db_v2 stmt

71+ finalize_db stmt

72+ close_db db

73+ return ()

74+

75+-- Nested queries need to have the same column as the outer queries !!!

76+testNestedSel1 : DB()

77+testNestedSel1 = do db <- open_db "somedb.db"

78+ let sql = (evalSQL [] (SELECT (Cols ["data"]) (SELECT (Cols["num","data"]) (TBL "tbl1") (MkCond (Equals (VCol "num")(VInt 2))) ) Empty ) )

79+ let x = (fst sql)

80+ let list = (snd sql)

81+ liftIO(print x)

82+ stmt <- (prepare_db db x)

83+ bindMulti stmt list

84+ exec_db_v2 stmt

85+ res <- toList db

86+ liftIO(print res)

87+ finalize_db stmt

88+ close_db db

89+ return ()

90+

91+-- Testing Create Table

92+testCreateTable : DB ()

93+testCreateTable = do db <- open_db "somedb.db"

94+ let sql = (evalSQL [] (CREATE (TBL "mynewtbl") [ ((VCol "col"),(CInt "int"),(None)) ] ) )

95+ let x = (fst sql)

96+ let list = (snd sql)

97+ liftIO(print x)

98+ stmt <- (prepare_db db x)

99+ bindMulti stmt list

100+ exec_db_v2 stmt

101+ finalize_db stmt

102+ close_db db

103+ return ()

104+

105+main : IO ()

106+main = do --x <- runDB (test3)

107+ y <- runDB (testNestedSel1)

108+ return ()