554ac04 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

added update and insert

554ac04melissam14 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/._sqlite3api.c

Binary file not shown.

contribs/lib/SQLite3/sqlexpr.idr+51−22

@@ -9,6 +9,7 @@ data Value = VInt Int

9 |VStr String

10 |VFloat Float

11 |VCol String

12+ |VNULL

14data Cond = Equals Value Value

15data Cond = Equals Value Value

@@ -16,14 +17,15 @@ data Cond = Equals Value Value

16 |MkGTE Value Value

17 |MkGTE Value Value

17 |MkLT Value Value

18 |MkLT Value Value

18 |MkLTE Value Value

19 |MkLTE Value Value

19−--TODO |MkIN (List Value)

20−--TODO |MkIN SQL

23data Clause = MkCond Cond

22data Clause = MkCond Cond

24 | AND Clause Clause

23 | AND Clause Clause

25 | OR Clause Clause

24 | OR Clause Clause

26 | Empty

25 | Empty

26+

27+data condClause = SET Clause

28+ | WHERE condClause Clause

28data SelVar = Cols (List String)

30data SelVar = Cols (List String)

29 |ALL

31 |ALL

@@ -31,6 +33,7 @@ data SelVar = Cols (List String)

31data SQL = SELECT SelVar SQL Clause

33data SQL = SELECT SelVar SQL Clause

32 | TBL String

34 | TBL String

33 | INSERT SQL (List Value)

35 | INSERT SQL (List Value)

36+ | UPDATE SQL condClause

35-- remember to remove these funcs later

38-- remember to remove these funcs later

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

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

@@ -54,39 +57,55 @@ mapping : Int -> List a -> List (Int, a)

54mapping counter [] = []

57mapping counter [] = []

55mapping counter (x :: xs) = (counter, x) :: mapping (counter + 1) xs

58mapping counter (x :: xs) = (counter, x) :: mapping (counter + 1) xs

60+fromJust : Maybe Value -> Value

61+fromJust Nothing = VNULL

62+fromJust (Just x) = x

58popintoList : Maybe Value -> List (Maybe Value) -> List (Maybe Value)

64popintoList : Maybe Value -> List (Maybe Value) -> List (Maybe Value)

59popintoList (Just x) [] = [(Just x)]

65popintoList (Just x) [] = [(Just x)]

60popintoList (Just (x)) ((Just x) :: xs) = (popintoList (Just x) xs)

66popintoList (Just (x)) ((Just x) :: xs) = (popintoList (Just x) xs)

61popintoList Nothing [] = []

67popintoList Nothing [] = []

69+getlist : (String, List (Maybe(Int, Value))) -> List (Maybe(Int, Value))

70+getlist (x, (xs)) = xs

71+

72+

73+outList : List (Maybe Value) -> Maybe Value

74+outList [] = Nothing

75+outList ((Just x)::xs) = Just x

76+

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

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

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

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

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

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

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

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

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

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

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

84+listVal xs [] = ("", xs)

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

86+ let (str', newxs') = listVal newxs vs in

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

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

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

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

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

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

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

73− (restring ++ " = " ++ restring2, (newxs ++ newxs'))

92+ (restring ++ " = " ++ restring2, (newxs'))

75evalCond xs (MkGT val1 val2) = let (restring , newxs ) = valString xs val1 in

94evalCond xs (MkGT val1 val2) = let (restring , newxs ) = valString xs val1 in

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

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

77− (restring ++ " > " ++ restring2, (newxs ++ newxs'))

96+ (restring ++ " > " ++ restring2, (newxs'))

79evalCond xs (MkGTE val1 val2) = let (restring , newxs ) = valString xs val1 in

98evalCond xs (MkGTE val1 val2) = let (restring , newxs ) = valString xs val1 in

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

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

81− (restring ++ " >= " ++ restring2, (newxs ++ newxs'))

100+ (restring ++ " >= " ++ restring2, ( newxs'))

101

83evalCond xs (MkLT val1 val2) = let (restring , newxs ) = valString xs val1 in

102evalCond xs (MkLT val1 val2) = let (restring , newxs ) = valString xs val1 in

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

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

85− (restring ++ " < " ++ restring2, (newxs ++ newxs'))

104+ (restring ++ " < " ++ restring2, (newxs'))

105

87evalCond xs (MkLTE val1 val2) = let (restring , newxs ) = valString xs val1 in

106evalCond xs (MkLTE val1 val2) = let (restring , newxs ) = valString xs val1 in

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

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

89− (restring ++ " =< " ++ restring2, (newxs ++ newxs'))

108+ (restring ++ " =< " ++ restring2, ( newxs'))

109

110

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

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

@@ -102,6 +121,14 @@ clauseString xs (OR c1 c2) = let (clausestr, newxs) = clauseString xs c1 in

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

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

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

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

104

123

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

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

126+ (" SET " ++ condstr, newxs)

127+

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

129+ let (condstr', newxs') = clauseString newxs setcl2 in

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

131+

105

132

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

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

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

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

@@ -109,26 +136,28 @@ evalSQL xs (SELECT vars sql' c) = let (sqlstring, newxs) = evalSQL xs sql' in

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

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

110 case c of

137 case c of

111 Empty => case vars of

138 Empty => case vars of

139+ (ALL ) => ("SELECT " ++ "*" ++ " FROM ("

112− (ALL ) => ("SELECT " ++ "*" ++ " FROM (" ++ sqlstring ++ ") " ++ csstring, newxs')

140+ ++ sqlstring ++ ") " ++ csstring++ ";", newxs')

113− (Cols selvar) => ("SELECT " ++ unwords ( intersperse "" ( selvar ++ (words ( " FROM (" ++ sqlstring ++ ")")))) ++ csstring, newxs')

141+ (Cols selvar) => ("SELECT " ++ unwords ( intersperse "" ( selvar ++

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

114

143

115 _ => case vars of

144 _ => case vars of

145+ (ALL ) => ("SELECT " ++ "*" ++ " FROM ("

116− (ALL ) => ("SELECT " ++ "*" ++ " FROM (" ++ sqlstring ++ ") " ++ "WHERE " ++ csstring, newxs')

146+ ++ sqlstring ++ ") " ++ "WHERE " ++ csstring++ ";", newxs')

117− (Cols selvar) => ("SELECT " ++ unwords ( intersperse "" ( selvar ++ (words ( " FROM (" ++ sqlstring ++ ")")))) ++ "WHERE" ++ csstring, newxs')

147+ (Cols selvar) => ("SELECT " ++ unwords ( intersperse "" ( selvar ++

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

149+

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

151+ let (str, newxs ) = listVal newvals vals in

152+ ("INSERT INTO " ++ tblname ++ " VALUES (" ++ str ++ ")" , newxs)

153+

154+evalSQL xs (UPDATE sql cl) = let (tblname, newxs) = evalSQL xs sql in

155+ let (csstring, newxs') = condClauseStr newxs cl in

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

118

157

158+

119

159

120display : (String, List (Maybe(Int, Value))) -> String

160display : (String, List (Maybe(Int, Value))) -> String

121display (x, (xs)) = x

161display (x, (xs)) = x

122

162

123−getlist : (String, List (Maybe(Int, Value))) -> List (Maybe(Int, Value))

124−getlist (x, (xs)) = xs

125−

126−--evalSQL2 : List (Maybe Value) -> String -> (String, List (Maybe Value))

127−--evalSQL2 [] sql = (sql, [])

128−--evalSQL2 ((Just (VInt x)) :: xs) sql = let ("string" , newxs) = evalSQL2 xs sql in

129−-- ("string" ++ sql , Just (VInt x) :: newxs)

130−

131−--main : IO ()

132−--main = (display(evalSQL [] ((SELECT ALL)(TBL "tbl") (MkCond (Equals (VCol "col")(VInt 1))))))

133−

134

163

contribs/lib/SQLite3/sqlite3.idr+31−17

@@ -62,11 +62,6 @@ open_db name = do x <- liftIO(mkForeign (FFun "sqlite3_open_idr" [FString] FPtr)

63close_db : DBPointer -> DB Int

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

65−--close_db pointer = liftIO ((runDB pointer) >>= mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt) )

66−--close_db pointer = liftIO (do

67−-- (MkDBPointer ptr) <- (runDB pointer)

68−-- i <- mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt) ptr

69−-- return i)

@@ -280,13 +275,7 @@ toList name stmt x = do

280 )

275 )

281 liftIO (free_table ptr)

276 liftIO (free_table ptr)

282 return res

277 return res

283−

278+

284−--bind_int : StmtPtr -> Int -> Int -> DB Int

285−--bind_int (MkStmtPtr pointer) indexval val = do

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

287−-- if (x /= 0 )

288−-- then fail "Could not bind int."

289−-- else return x

290

279

291bind_int : StmtPtr -> Int -> Int -> DB StmtPtr

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

292bind_int (MkStmtPtr pointer) indexval val = do

281bind_int (MkStmtPtr pointer) indexval val = do

@@ -369,8 +358,7 @@ bindMulti pointer ((Just (indexs, val))::vs) = case val of

369 bindMulti(x) vs

358 bindMulti(x) vs

370testexpr : DB()

359testexpr : DB()

371testexpr = do db <- open_db "somedb.db"

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

372− --let db = open_db "somedb.db"

373− let sql = (evalSQL [] ((SELECT ALL)(TBL "tbl1")(MkCond (Equals (VCol "data")(VStr "data1")))))

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

374 let x = (display sql)

362 let x = (display sql)

375 let list = (getlist sql)

363 let list = (getlist sql)

376 liftIO(print x)

364 liftIO(print x)

@@ -382,10 +370,36 @@ testexpr = do db <- open_db "somedb.db"

382 finalize_db stmt

370 finalize_db stmt

383 close_db db

371 close_db db

384 return ()

372 return ()

385−

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 = (display sql)

378+ let list = (getlist 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 = (display sql)

391+ let list = (getlist 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 ()

386main : IO ()

399main : IO ()

387main = do --x <- runDB (test3)

400main = do --x <- runDB (test3)

388− y <- runDB (testexpr)

401+ y <- runDB (testInsert)

389 return ()

402 return ()

390

403

391−

404+

405+

contribs/lib/SQLite3/sqlite3api.c+1−1

@@ -414,7 +414,7 @@ void* sqlite3_bind_int_idr(void* p,int index, int val){

414 DBinfo* dbi =(DBinfo*) p;

415 int rc;

416

417− printf("\nThe statement has %d wildcards\n", sqlite3_bind_parameter_count(dbi->ppStmt));

417+ //printf("\nThe statement has %d wildcards\n", sqlite3_bind_parameter_count(dbi->ppStmt));

418 rc =sqlite3_bind_int(dbi->ppStmt,index,val);

419 if(rc != SQLITE_OK){

420 printf("Error in binding\n");