d733172 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

added another case of insert and is Null

d733172melissam14 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/sqlexpr.idr+12−1

@@ -17,6 +17,7 @@ data Cond = Equals Value Value

17 |MkGTE Value Value

18 |MkLT Value Value

19 |MkLTE Value Value

20+ |MkNULL Value

22data Clause = MkCond Cond

23data Clause = MkCond Cond

@@ -25,7 +26,7 @@ data Clause = MkCond Cond

25 | Empty

26 | Empty

27data condClause = SET Clause

28data condClause = SET Clause

28− | WHERE condClause Clause

29+ |WHERE condClause Clause

30data SelVar = Cols (List String)

31data SelVar = Cols (List String)

31 |ALL

32 |ALL

@@ -33,7 +34,9 @@ data SelVar = Cols (List String)

33data SQL = SELECT SelVar SQL Clause

34data SQL = SELECT SelVar SQL Clause

34 | TBL String

35 | TBL String

35 | INSERT SQL (List Value)

36 | INSERT SQL (List Value)

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

36 | UPDATE SQL condClause

38 | UPDATE SQL condClause

39+ | CREATE SQL (List Value)

38-- remember to remove these funcs later

41-- remember to remove these funcs later

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

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

@@ -85,6 +88,8 @@ evalCond xs (MkLTE val1 val2) = let (restring , newxs ) = valString xs val1 in

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

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

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

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

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

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

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

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

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

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

@@ -129,6 +134,12 @@ evalSQL xs (INSERT sql vals) = let (tblname, newvals) = evalSQL xs sql in

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

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

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

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

131

136

137+evalSQL xs (INSERTC sql cols vals) = let (tblname, newvals) = evalSQL xs sql in

138+ let (strcol, newcol) = listVal newvals cols in

139+ let (strval, newcolval) = listVal newcol vals in

140+ ("INSERT INTO " ++ tblname ++ "(" ++ strcol ++ ")" ++ "VALUES (" ++ strval ++ ")", newcolval)

141+

142+

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

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

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

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

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

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

contribs/lib/SQLite3/sqlite3.idr+33−2

@@ -395,11 +395,42 @@ testInsert = do db <- open_db "somedb.db"

395 exec_db_v2 stmt

396 finalize_db stmt

397 close_db db

398− return ()

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+

399main : IO ()

429main : IO ()

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

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

401− y <- runDB (testexpr)

431+ y <- runDB (testInsertWithCond)

402 return ()

432 return ()

403

433

434+

404

435

405

436