6ce39ad · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

changed TBL String to list

6ce39admelissam14 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.idr

Binary file not shown.

contribs/lib/SQLite3/sqlexpr.idr+23−18

@@ -55,7 +55,7 @@ data Constr = NOTNULL

57data SQL = SELECT SelVar SQL Clause

58− | TBL String

58+ | TBL (List String)

59 | INSERT SQL (List Value)

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

61 | UPDATE SQL condClause

@@ -142,6 +142,7 @@ listValType xs ((val, types, constr) :: vs) = let (str , newxs) = valString xs v

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

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

144

145+

145-----------------------------------------------------------

146-----------------------------------------------------------

146-- | Evaluates a condition after WHERE clause

147-- | Evaluates a condition after WHERE clause

147-----------------------------------------------------------

148-----------------------------------------------------------

@@ -204,37 +205,41 @@ condClauseStr xs (WHERE setcl1 setcl2) = let (condstr, newxs) = condClauseStr xs

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

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

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

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

206

207

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

208+-- 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+-- evalSQL [] ((SELECT ALL) (TBL "tbl") (MkSQL ((SELECT ALL) (TBL "tbl") (MkCond (VCol ") ) ) )

210+-- NTBF

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

211--clauseString xs (MkSQL sql) = (evalSQL xs sql)

210−

211

212

213+-- Separate list of tables

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

214+evalSQL xs (TBL tbl) = ((unwords (intersperse "," ( tbl))), xs)

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

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

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

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

215 case c of

217 case c of

216 Empty => case vars of

218 Empty => case vars of

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

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

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

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

221+

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

222+ else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring

223+ ++ csstring, newxs')

220

224

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

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

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

226+ " FROM " ++ (putBrackets sqlstring) ++ csstring, newxs')

227+

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

228+ else ("SELECT " ++ (unwords selvar )++ " FROM " ++ sqlstring

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

229+ ++ csstring, newxs')

225

230

226 _ => case vars of

231 _ => case vars of

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

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

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

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

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

234+ else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring

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

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

231

236

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

237+ (Cols selvar) => if complexType sql' then ("SELECT " ++ (unwords selvar) ++ " FROM " ++

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

238+ (putBrackets sqlstring) ++ " WHERE "

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

239+ ++ csstring , newxs')

235

240

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

241+ else ("SELECT " ++ (unwords selvar) ++ " FROM " ++ sqlstring

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

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

238

243

239

244

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

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

contribs/lib/SQLite3/sqlite3.idr+44−42

@@ -29,7 +29,7 @@ data DBPointer = MkDBPointer Ptr

29data TBPointer = MkTBPointer Ptr

31data StmtPtr = MkStmtPtr Ptr

32−

32+

33Table : Set

34Table = List (List DBVal)

@@ -38,31 +38,31 @@ forM : Monad m => List a -> (a -> m b) -> m (List b)

38forM f xs = mapM xs f

41−data DB a = MkDB (IO (Either String a))

41+data DB a = MkDB (IO (Either String a))

42−

42+

43−instance Monad DB where

43+instance Monad DB where

44− (MkDB l) >>= k = MkDB (do c <- l

44+ (MkDB l) >>= k = MkDB (do c <- l

45− case c of

45+ case c of

46− Left err => return (Left err)

46+ Left err => return (Left err)

47− Right v => case k v of

47+ Right v => case k v of

48− MkDB k' => k')

48+ MkDB k' => k')

49− return x = MkDB (return (Right x))

49+ return x = MkDB (return (Right x))

50−

50+

51−fail : String -> DB a

51+fail : String -> DB a

52−fail err = MkDB (return (Left err))

52+fail err = MkDB (return (Left err))

53−

53+

54−liftIO : IO a -> DB a

54+liftIO : IO a -> DB a

55−liftIO f = MkDB (do f' <- f

55+liftIO f = MkDB (do f' <- f

56− return (Right f'))

56+ return (Right f'))

57−

57+

58−ioError : String -> IO a

58+ioError : String -> IO a

59−ioError err = do putStrLn err

59+ioError err = do putStrLn err

60− return (believe_me ())

60+ return (believe_me ())

61−

61+

62−runDB : DB a -> IO a

62+runDB : DB a -> IO a

63−runDB (MkDB f) = do f' <- f

63+runDB (MkDB f) = do f' <- f

64− case f' of

64+ case f' of

65− Right v => return v

65+ Right v => return v

66 Left str => ioError str

68-----------------------------------------------------------------------------

@@ -298,19 +298,19 @@ get_data (MkDBPointer pointer) row col = do

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

299-----------------------------------------------------------------------------

300

301−toList : DBPointer -> DB Table

301+toList_v1 : DBPointer -> DB Table

302−toList db = do

302+toList_v1 db = do

303 nbR <- liftIO (num_row_v2 db)

304 nmC <- liftIO (num_col_v2 db)

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

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

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

307− liftIO(get_data db i j)

307+ liftIO(get_data db i j)

308

309 )

310 )

311 return res

312−

312+

313−

313+

314strcat : String -> String-> String

315strcat str1 str2 = (str1 ++ str2)

316

@@ -320,17 +320,17 @@ strcat str1 str2 = (str1 ++ str2)

320

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

322--toList_v2 name stmt x = do

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

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

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

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

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

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

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

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

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

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

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

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

329--

330−-- )

330+-- )

331−-- )

331+-- )

332−-- liftIO (free_table ptr)

332+-- liftIO (free_table ptr)

333−-- return res

333+-- return res

334

335

336-----------------------------------------------------------------------------

@@ -400,4 +400,6 @@ bindMulti pointer ((Just (indexs, val))::vs) = case val of

400

401

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

403+

403 bindMulti(x) vs

404 bindMulti(x) vs

405+

contribs/lib/SQLite3/testunit.idr+27−11

@@ -4,14 +4,14 @@ import sqlite3

5testexpr : DB()

6testexpr = 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))))))

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

14+ res <- toList_v1 db

15 liftIO(print res)

16 finalize_db stmt

17 close_db db

@@ -19,7 +19,7 @@ testexpr = do db <- open_db "somedb.db"

20testupdate : DB()

21testupdate = 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))) ) ))

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)

@@ -32,7 +32,7 @@ testupdate = do db <- open_db "somedb.db"

33testInsert : DB()

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

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

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)

@@ -45,14 +45,14 @@ testInsert = do db <- open_db "somedb.db"

46testNull : DB()

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

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

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

55+ res <- toList_v1 db

56 liftIO(print res)

57 finalize_db stmt

58 close_db db

@@ -61,7 +61,7 @@ testNull = do db <- open_db "somedb.db"

62testInsertWithCond : DB()

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

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

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)

@@ -75,14 +75,14 @@ testInsertWithCond = do db <- open_db "somedb.db"

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

76testNestedSel1 : DB()

77testNestedSel1 = 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 ) )

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

85+ res <- toList_v1 db

86 liftIO(print res)

87 finalize_db stmt

88 close_db db

@@ -91,7 +91,7 @@ testNestedSel1 = do db <- open_db "somedb.db"

91-- Testing Create Table

92testCreateTable : DB ()

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

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

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)

@@ -102,7 +102,23 @@ testCreateTable = do db <- open_db "somedb.db"

102 close_db db

103 return ()

104

105+testMultiTable : DB ()

106+testMultiTable = do db <- open_db "somedb.db"

107+ let sql = (evalSQL [] ((SELECT ALL )(TBL ["mytable","tbl1"]) (Empty) ) )

108+ let x = (fst sql)

109+ let list = (snd sql)

110+ liftIO(print x)

111+ stmt <- (prepare_db db x)

112+ bindMulti stmt list

113+ exec_db_v2 stmt

114+ res <- toList_v1 db

115+ liftIO(print res)

116+ finalize_db stmt

117+ close_db db

118+ return ()

119+

120+

105main : IO ()

121main : IO ()

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

122+main = do x <- runDB (testexpr)

107 y <- runDB (testNestedSel1)

123 y <- runDB (testNestedSel1)

108 return ()

124 return ()