git.iko.soy/Idris-dev
on master help sign in
Merge pull request #296 from david-christiansen/sqlite
c8ba164Edwin Brady
contribs/lib/SQLite3/Makefile+1−1
compare with master
unifiedsplit
@@ -3,7 +3,7 @@
3
3
4.PHONY: all
4.PHONY: all
5
5
6−sqltest : testunit.idr sqlite3.idr sqlite3api.o
6+sqltest : testunit.idr Sqlite3.idr sqlite3api.o
7 idris testunit.idr -o sqltest
7 idris testunit.idr -o sqltest
8
8
9sqlite3api.o : sqlite3api.c
9sqlite3api.o : sqlite3api.c
contribs/lib/SQLite3/Sqlexpr.idrnew file+278
@@ -0,0 +1,278 @@
1+module Sqlexpr
2+import Prelude.List
3+
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+
14+-----------------------------------------------------------
15+-- | SQL data type
16+-----------------------------------------------------------
17+
18+data Value = VInt Int
19+ | VStr String
20+ | VFloat Float
21+ | VCol String
22+ | VNULL
23+
24+--Perhaps could extend this by adding
25+-- a dot operator to allow mapping
26+-- between table and column and
27+-- comparing different table columns.
28+
29+data Cond = Equals Value Value
30+ | MkGT Value Value
31+ | MkGTE Value Value
32+ | MkLT Value Value
33+ | MkLTE Value Value
34+ | MkNULL Value
35+
36+data SelVar = Cols (List String)
37+ | ALL
38+
39+data ColType = CInt String -- parsed as string "int"
40+ | Varchar String
41+
42+
43+
44+mutual
45+ data Clause = MkCond Cond
46+ | AND Clause Clause
47+ | OR Clause Clause
48+ | Empty
49+ | MkSQL SQL
50+
51+ data condClause = SET Clause
52+ | WHERE condClause Clause
53+
54+ data Constr = NOTNULL
55+ | UNIQUE Constr
56+ | None
57+ | PRIMARYKEY
58+ | FOREIGNKEY
59+ | CHECK
60+ | DEFAULT
61+
62+
63+ data SQL = SELECT SelVar SQL Clause
64+ | TBL (List String)
65+ | INSERT SQL (List Value)
66+ | INSERTC SQL (List Value) (List Value)
67+ | UPDATE SQL condClause
68+ | CREATE SQL (List (Value, ColType , Constr))
69+
70+-- remember to remove these funcs later
71+-- foldr1 : (a -> a -> a) -> List a -> a
72+-- foldr1 f [x] = x
73+-- foldr1 f (x::xs) = f x (foldr1 f xs)
74+
75+
76+-- unwords' : List (List Char) -> List Char
77+-- unwords' [] = []
78+-- unwords' ws = (foldr1 addSpace ws)
79+-- where
80+-- addSpace : List Char -> List Char -> List Char
81+-- addSpace w s = w ++ (' ' :: s)
82+--
83+--
84+-- unwords : List String -> String
85+-- unwords = pack . unwords' . map unpack
86+
87+-----------------------------------------------------------
88+-- | This function replaces values with question mark
89+-- following by an index number. It then puts the value
90+-- replaced, in the list.
91+-----------------------------------------------------------
92+
93+valString : List (Maybe (Int, Value)) -> Value -> (String, List (Maybe (Int, Value)))
94+valString xs (VInt x) = ("?" ++ show (cast (length xs) + 1), xs ++ [Just (cast ((length xs) + 1), (VInt x))])
95+valString xs (VStr x) = ("?" ++ show (cast (length xs) + 1), xs ++ [Just (cast ((length xs) + 1), (VStr x))])
96+valString xs (VFloat x) = ("?" ++ show (cast (length xs) + 1), xs ++ [Just (cast ((length xs) + 1), (VFloat x))])
97+valString xs (VCol n) = (n, xs)
98+
99+-----------------------------------------------------------
100+-- | This function calls valString on a list of Values
101+-- and separates the values by commas.
102+-----------------------------------------------------------
103+
104+listVal : List (Maybe (Int, Value)) -> List Value -> (String, List (Maybe (Int, Value)))
105+listVal xs [] = ("", xs)
106+listVal xs (v::vs) = let (str, newxs) = (valString xs v) in
107+ let (str', newxs') = listVal newxs vs in
108+ (unwords (intersperse "," (words (str) ++ words (str'))), newxs')
109+
110+-----------------------------------------------------------
111+-- | Parses the type of column to be created.
112+-----------------------------------------------------------
113+
114+getColType : List (Maybe (Int, Value)) -> ColType -> (String, List (Maybe (Int, Value)))
115+getColType xs (CInt x) = ("int", xs)
116+getColType xs (Varchar str) = ("varchar(255)", xs)
117+
118+-----------------------------------------------------------
119+-- | CREATE Constraints
120+-----------------------------------------------------------
121+
122+getConstr : List (Maybe (Int, Value)) -> Constr -> (String, List (Maybe (Int, Value)))
123+getConstr xs (NOTNULL) = ("NOT NULL", xs)
124+getConstr xs (UNIQUE constr) = ("NOT NULL UNIQUE", xs)
125+getConstr xs (PRIMARYKEY) = ("PRIMARY KEY", xs)
126+getConstr xs (FOREIGNKEY) = ("FOREIGN KEY", xs)
127+getConstr xs (CHECK) = ("CHECK", xs)
128+getConstr xs (DEFAULT) = ("DEFAULT", xs)
129+getConstr xs (None) = ("", xs)
130+
131+putBrackets : String -> String
132+putBrackets str = "(" ++ str ++ ")"
133+
134+-----------------------------------------------------------
135+-- | Used to detect a complex type in a nested SQLite query
136+-- This function is used for bracketing the nested queries.
137+-----------------------------------------------------------
138+complexType : SQL -> Bool
139+complexType (TBL tbl) = False
140+complexType (SELECT vars sql c) = True
141+
142+-----------------------------------------------------------
143+-- | Used in CREATE
144+-----------------------------------------------------------
145+
146+listValType : List (Maybe (Int, Value)) -> List (Value, ColType , Constr) -> (String, List (Maybe (Int, Value)))
147+listValType xs [] = ("", xs)
148+listValType xs ((val, types, constr) :: vs) =
149+ let (str , newxs) = valString xs val in
150+ let (str' , newxs') = getColType newxs types in
151+ let (str'', newxs'') = getConstr newxs' constr in
152+ let (finalstr, finalxs) = listValType newxs'' vs in
153+ (unwords (intersperse " " (words str ++ words str' ++ words str'' ++ words finalstr)) , finalxs)
154+
155+
156+-----------------------------------------------------------
157+-- | Evaluates a conditional WHERE clause
158+-----------------------------------------------------------
159+
160+evalCond : List (Maybe (Int, Value)) -> Cond -> (String, List (Maybe (Int, Value)))
161+evalCond xs (Equals val1 val2) = let (restring , newxs ) = valString xs val1 in
162+ let (restring2, newxs') = valString newxs val2 in
163+ (restring ++ " = " ++ restring2, newxs')
164+
165+evalCond xs (MkGT val1 val2) = let (restring , newxs ) = valString xs val1 in
166+ let (restring2, newxs') = valString newxs val2 in
167+ (restring ++ " > " ++ restring2, newxs')
168+
169+evalCond xs (MkGTE val1 val2) = let (restring , newxs ) = valString xs val1 in
170+ let (restring2, newxs') = valString newxs val2 in
171+ (restring ++ " >= " ++ restring2, newxs')
172+
173+evalCond xs (MkLT val1 val2) = let (restring , newxs ) = valString xs val1 in
174+ let (restring2, newxs') = valString newxs val2 in
175+ (restring ++ " < " ++ restring2, newxs')
176+
177+evalCond xs (MkLTE val1 val2) = let (restring , newxs ) = valString xs val1 in
178+ let (restring2, newxs') = valString newxs val2 in
179+ (restring ++ " =< " ++ restring2, newxs')
180+
181+evalCond xs (MkNULL val) = let (restring , newxs ) = valString xs val in
182+ (restring ++ " IS NULL " , newxs)
183+
184+
185+-----------------------------------------------------------
186+-- | Evaluates clauses
187+-- Supports WHERE Clause
188+-- WHERE Clause And Another-Clause
189+-- WHERE Clause Or Another-Clause
190+-----------------------------------------------------------
191+clauseString : List (Maybe (Int, Value)) -> Clause -> (String, List (Maybe (Int, Value)))
192+
193+clauseString xs (Empty) = ("" , []) -- No condition
194+clauseString xs (MkCond cond') = let (condstr, newxs) = evalCond xs cond' in
195+ (condstr , newxs)
196+
197+clauseString xs (AND c1 c2) = let (clausestr, newxs) = clauseString xs c1 in
198+ let (clausestr2, newxs') = clauseString newxs c2 in
199+ (clausestr ++ " AND " ++ clausestr2 , newxs')
200+
201+clauseString xs (OR c1 c2) = let (clausestr, newxs) = clauseString xs c1 in
202+ let (clausestr2, newxs') = clauseString newxs c2 in
203+ (clausestr ++ " OR " ++ clausestr2 , newxs')
204+
205+
206+-----------------------------------------------------------
207+-- | Evaluates conditional clauses.
208+-----------------------------------------------------------
209+
210+condClauseStr : List (Maybe (Int, Value)) -> condClause -> (String, List (Maybe (Int, Value)))
211+condClauseStr xs (SET setcl) = let (condstr, newxs) = clauseString xs setcl in
212+ (" SET " ++ condstr, newxs)
213+
214+condClauseStr xs (WHERE setcl1 setcl2) = let (condstr, newxs) = condClauseStr xs setcl1 in
215+ let (condstr', newxs') = clauseString newxs setcl2 in
216+ ( condstr ++ " WHERE " ++ condstr', newxs')
217+
218+
219+-----------------------------------------------------------
220+-- | Evaluates queries by calling the other functions
221+-- on each part of the query
222+-----------------------------------------------------------
223+evalSQL : List (Maybe (Int, Value)) -> SQL -> (String, List (Maybe (Int, Value)))
224+-- SELECT data from tbl1 where num > (SELECT num from tbl1 where num = 24)
225+-- evalSQL [] ((SELECT ALL)(TBL "tbl")(MkSQL ((SELECT ALL) (TBL "tbl")(MkCond (VCol "))))
226+-- NTBF
227+--clauseString xs (MkSQL sql) = (evalSQL xs sql)
228+
229+-- Separate list of tables
230+-- For complex type, return list returned by evalSQL
231+-- And add brackets
232+evalSQL xs (TBL tbl) = (unwords (intersperse "," ( tbl)), xs)
233+evalSQL xs (SELECT vars sql' c) =
234+ let (sqlstring, newxs) = evalSQL xs sql' in
235+ let (csstring, newxs') = clauseString newxs c in
236+ case c of
237+ Empty => case vars of
238+ ALL => if complexType sql'
239+ then ("SELECT " ++ "*" ++ " FROM " ++
240+ putBrackets sqlstring ++ csstring, newxs)
241+ else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring ++
242+ csstring, newxs')
243+ Cols selvar => if complexType sql'
244+ then ("SELECT " ++ unwords selvar ++
245+ " FROM " ++ putBrackets sqlstring ++ csstring, newxs)
246+ else ("SELECT " ++ unwords selvar ++ " FROM " ++ sqlstring ++
247+ csstring, newxs')
248+ _ => case vars of
249+ ALL => if complexType sql'
250+ then ("SELECT " ++ "*" ++ " FROM " ++
251+ " WHERE " ++ csstring, newxs)
252+ else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring
253+ ++ " WHERE " ++ csstring, newxs')
254+ Cols selvar => if complexType sql'
255+ then ("SELECT " ++ (unwords selvar) ++ " FROM " ++
256+ putBrackets sqlstring ++ " WHERE " ++
257+ csstring , newxs)
258+ else ("SELECT " ++ (unwords selvar) ++ " FROM " ++ sqlstring ++
259+ " WHERE " ++ csstring, newxs')
260+
261+
262+evalSQL xs (INSERT sql vals) = let (tblname, newvals) = evalSQL xs sql in
263+ let (str, newxs ) = listVal newvals vals in
264+ ("INSERT INTO " ++ tblname ++ " VALUES (" ++ str ++ ")", newxs)
265+
266+evalSQL xs (INSERTC sql cols vals) = let (tblname, newvals) = evalSQL xs sql in
267+ let (strcol, newcol) = listVal newvals cols in
268+ let (strval, newcolval) = listVal newcol vals in
269+ ("INSERT INTO " ++ tblname ++ "(" ++ strcol ++ ")" ++ "VALUES (" ++ strval ++ ")", newcolval)
270+
271+
272+evalSQL xs (UPDATE sql cl) = let (tblname, newxs) = evalSQL xs sql in
273+ let (csstring, newxs') = condClauseStr newxs cl in
274+ ("UPDATE " ++ tblname ++ csstring, newxs')
275+
276+evalSQL xs (CREATE sql details) = let (sqlstring, newxs) = evalSQL xs sql in
277+ let (csstring, newxs') = listValType newxs details in
278+ ("CREATE TABLE " ++ sqlstring ++ "(" ++ csstring ++ ")", newxs')
contribs/lib/SQLite3/sqlite3.idr → contribs/lib/SQLite3/Sqlite3.idrrenamed+172−155
@@ -22,7 +22,7 @@ data DBVal = DBInt Int
22 | DBText String
22 | DBText String
23 | DBFloat Float
23 | DBFloat Float
24 | DBNull
24 | DBNull
25−
25+
26-- Database pointer
26-- Database pointer
27data DBPointer = MkDBPointer Ptr
27data DBPointer = MkDBPointer Ptr
28-- Table pointer
28-- Table pointer
@@ -30,16 +30,29 @@ data TBPointer = MkTBPointer Ptr
30-- Statement pointer
30-- Statement pointer
31data StmtPtr = MkStmtPtr Ptr
31data StmtPtr = MkStmtPtr Ptr
32
32
33−Table : Set
33+Table : Type
34Table = List (List DBVal)
34Table = List (List DBVal)
35
35
36-- ForMap used in to_list_v1
36-- ForMap used in to_list_v1
37−forM : Monad m => List a -> (a -> m b) -> m (List b)
37+forM : Applicative f => List a -> (a -> f b) -> f (List b)
38−forM f xs = mapM xs f
38+forM xs f = (sequence (map f xs))
39
39
40-- Neater error handling done using DB
40-- Neater error handling done using DB
41data DB a = MkDB (IO (Either String a))
41data DB a = MkDB (IO (Either String a))
42
42
43+instance Functor DB where
44+ fmap f (MkDB action) = MkDB (do res <- action
45+ return (fmap f res))
46+
47+
48+instance Applicative DB where
49+ pure = MkDB . return . Right
50+ (MkDB f) <$> (MkDB x) = MkDB (do f' <- f
51+ case f' of
52+ Left err => return (Left err)
53+ Right op => x >>= (return . fmap op))
54+
55+
43instance Monad DB where
56instance Monad DB where
44 (MkDB l) >>= k = MkDB (do c <- l
57 (MkDB l) >>= k = MkDB (do c <- l
45 case c of
58 case c of
@@ -63,14 +76,14 @@ runDB : DB a -> IO a
63runDB (MkDB f) = do f' <- f
76runDB (MkDB f) = do f' <- f
64 case f' of
77 case f' of
65 Right v => return v
78 Right v => return v
66− Left str => ioError str
79+ Left str => ioError str
67−
80+
68-----------------------------------------------------------------------------
81-----------------------------------------------------------------------------
69-- | Opens an SQLite database file as specified by the String name argument.
82-- | Opens an SQLite database file as specified by the String name argument.
70-----------------------------------------------------------------------------
83-----------------------------------------------------------------------------
71−
84+
72open_db : String -> DB DBPointer
85open_db : String -> DB DBPointer
73−open_db name = do x <- liftIO(mkForeign (FFun "sqlite3_open_idr" [FString] FPtr) name)
86+open_db name = do x <- liftIO (mkForeign (FFun "sqlite3_open_idr" [FString] FPtr) name)
74 return (MkDBPointer x)
87 return (MkDBPointer x)
75
88
76-----------------------------------------------------------------------------
89-----------------------------------------------------------------------------
@@ -78,38 +91,38 @@ open_db name = do x <- liftIO(mkForeign (FFun "sqlite3_open_idr" [FString] FPtr)
78-----------------------------------------------------------------------------
91-----------------------------------------------------------------------------
79
92
80close_db : DBPointer -> DB Int
93close_db : DBPointer -> DB Int
81−close_db (MkDBPointer pointer) = liftIO (mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt)pointer)
94+close_db (MkDBPointer pointer) = liftIO (mkForeign (FFun "sqlite3_close_idr" [FPtr] FInt) pointer)
82
95
83-----------------------------------------------------------------------------
96-----------------------------------------------------------------------------
84-- | Wrapper around prepare, step and finalize.
97-- | Wrapper around prepare, step and finalize.
85-----------------------------------------------------------------------------
98-----------------------------------------------------------------------------
86−
99+
87exec_db : DBPointer -> String -> DB Int
100exec_db : DBPointer -> String -> DB Int
88−exec_db (MkDBPointer pointer) stmt = do
101+exec_db (MkDBPointer pointer) stmt = do
89− x <- liftIO(mkForeign (FFun "sqlite3_exec_idr" [FPtr, FString] FInt)pointer stmt)
102+ x <- liftIO (mkForeign (FFun "sqlite3_exec_idr" [FPtr, FString] FInt) pointer stmt)
90 if (x == 1)
103 if (x == 1)
91− then fail "Could not execute."
104+ then fail "Could not execute."
92− else return x
105+ else return x
93
106
94-----------------------------------------------------------------------------
107-----------------------------------------------------------------------------
95-- | Executes a prepared query. Use of this version is recommended.
108-- | Executes a prepared query. Use of this version is recommended.
96-----------------------------------------------------------------------------
109-----------------------------------------------------------------------------
97
110
98exec_db_v2 : StmtPtr -> DB Int
111exec_db_v2 : StmtPtr -> DB Int
99−exec_db_v2 (MkStmtPtr pointer) = do
112+exec_db_v2 (MkStmtPtr pointer) = do
100 x <- liftIO (mkForeign (FFun "exec_db" [FPtr] FInt) pointer)
113 x <- liftIO (mkForeign (FFun "exec_db" [FPtr] FInt) pointer)
101 if (x == 21)
114 if (x == 21)
102− then fail "No data returned."
115+ then fail "No data returned."
103− else return x
116+ else return x
104−
117+
105-----------------------------------------------------------------------------
118-----------------------------------------------------------------------------
106-- | Returns the error stored in the buffer by exec_db function.
119-- | Returns the error stored in the buffer by exec_db function.
107-- This function can only be used with exec_db and get_table.
120-- This function can only be used with exec_db and get_table.
108-- Only these functions store any occured error in the buffer array.
121-- Only these functions store any occured error in the buffer array.
109-----------------------------------------------------------------------------
122-----------------------------------------------------------------------------
110−
123+
111get_error : DBPointer -> IO String
124get_error : DBPointer -> IO String
112−get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
125+get_error (MkDBPointer pointer) = mkForeign (FFun "sqlite3_get_error" [FPtr] FString) pointer
113
126
114
127
115-----------------------------------------------------------------------------
128-----------------------------------------------------------------------------
@@ -117,14 +130,14 @@ get_error (MkDBPointer pointer) =mkForeign (FFun "sqlite3_get_error" [FPtr] FStr
117-- Returns a pointer to a Statement pointer on a successful call.
130-- Returns a pointer to a Statement pointer on a successful call.
118-- Returns a null pointer on a failure.
131-- Returns a null pointer on a failure.
119-----------------------------------------------------------------------------
132-----------------------------------------------------------------------------
120−
133+
121prepare_db : DBPointer -> String -> DB StmtPtr
134prepare_db : DBPointer -> String -> DB StmtPtr
122prepare_db (MkDBPointer pointer) cmd = do
135prepare_db (MkDBPointer pointer) cmd = do
123− result <- liftIO(mkForeign (FFun "sqlite3_prepare_idr" [FPtr, FString] FPtr)pointer cmd)
136+ result <- liftIO (mkForeign (FFun "sqlite3_prepare_idr" [FPtr, FString] FPtr) pointer cmd)
124− flag <- liftIO(nullPtr result)
137+ flag <- liftIO (nullPtr result)
125 if flag
138 if flag
126− then fail "Error occured while preparing"
139+ then fail "Error occured while preparing"
127− else return (MkStmtPtr result)
140+ else return (MkStmtPtr result)
128
141
129-----------------------------------------------------------------------------
142-----------------------------------------------------------------------------
130-- | Returns the error stored in the buffer by exec_db function.
143-- | Returns the error stored in the buffer by exec_db function.
@@ -136,81 +149,92 @@ step_db : StmtPtr -> DB Int
136step_db (MkStmtPtr pointer)= do
149step_db (MkStmtPtr pointer)= do
137 x <- liftIO (mkForeign (FFun "sqlite3_step_idr" [FPtr] FInt)pointer)
150 x <- liftIO (mkForeign (FFun "sqlite3_step_idr" [FPtr] FInt)pointer)
138 if ( x == 101)
151 if ( x == 101)
139− then fail "SQLITE_DONE"
152+ then fail "SQLITE_DONE"
140− else return x
153+ else return x
141
154
142-----------------------------------------------------------------------------
155-----------------------------------------------------------------------------
143−-- | Deletes a prepared statement. This function must be called after
156+-- | Deletes a prepared statement. This function must be called after
144-- prepare function.
157-- prepare function.
145-----------------------------------------------------------------------------
158-----------------------------------------------------------------------------
146
159
147finalize_db : StmtPtr -> DB Int
160finalize_db : StmtPtr -> DB Int
148−finalize_db (MkStmtPtr pointer) = do
161+finalize_db (MkStmtPtr pointer) = do
149− x <- liftIO (mkForeign (FFun "sqlite3_finalize_idr" [FPtr] FInt)pointer)
162+ x <- liftIO (mkForeign (FFun "sqlite3_finalize_idr" [FPtr] FInt) pointer)
150 if (x /= 0)
163 if (x /= 0)
151− then fail "Could not finalize"
164+ then fail "Could not finalize"
152− else return x
165+ else return x
153
166
154-----------------------------------------------------------------------------
167-----------------------------------------------------------------------------
155-- | Resets a prepared statement pointer back to its initial state.
168-- | Resets a prepared statement pointer back to its initial state.
156-----------------------------------------------------------------------------
169-----------------------------------------------------------------------------
157
170
158reset_db : StmtPtr -> DB Int
171reset_db : StmtPtr -> DB Int
159−reset_db (MkStmtPtr pointer) = do
172+reset_db (MkStmtPtr pointer) = do
160− x <- liftIO(mkForeign (FFun "sqlite3_reset_idr" [FPtr] FInt)pointer)
173+ x <- liftIO (mkForeign (FFun "sqlite3_reset_idr" [FPtr] FInt) pointer)
161− if (x /=0)
174+ if (x /= 0)
162− then fail "Could not reset"
175+ then fail "Could not reset"
163− else return x
176+ else return x
164
177
165-----------------------------------------------------------------------------
178-----------------------------------------------------------------------------
166-- | These routines obtain column information.
179-- | These routines obtain column information.
167-----------------------------------------------------------------------------
180-----------------------------------------------------------------------------
168
181
169column_count : DBPointer -> IO (Either String Int)
182column_count : DBPointer -> IO (Either String Int)
170−column_count (MkDBPointer pointer) = do
183+column_count (MkDBPointer pointer) = do
171− x <- mkForeign (FFun "sqlite3_column_count_idr" [FPtr] FInt)pointer
184+ x <- mkForeign (FFun "sqlite3_column_count_idr" [FPtr] FInt) pointer
172− if (x == 0 )
185+ return $ if (x == 0 )
173− then return (Left "No Data")
186+ then Left "No Data"
174− else return (Right x)
187+ else (Right x)
175
188
176column_name : DBPointer -> Int -> IO String
189column_name : DBPointer -> Int -> IO String
190+column_name (MkDBPointer pointer) iCol =
177−column_name (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_name_idr" [FPtr, FInt] FString)pointer iCol
191+ mkForeign (FFun "sqlite3_column_name_idr" [FPtr, FInt] FString) pointer iCol
178−
192+
179column_decltype : DBPointer -> Int -> IO String
193column_decltype : DBPointer -> Int -> IO String
194+column_decltype (MkDBPointer pointer) iCol =
180−column_decltype (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_decltype_idr" [FPtr, FInt] FString)pointer iCol
195+ mkForeign (FFun "sqlite3_column_decltype_idr" [FPtr, FInt] FString) pointer iCol
181
196
182
197
183column_bytes : DBPointer -> Int -> IO Int
198column_bytes : DBPointer -> Int -> IO Int
199+column_bytes (MkDBPointer pointer) iCol =
184−column_bytes (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FInt)pointer iCol
200+ mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FInt) pointer iCol
185
201
186
202
187column_blob : DBPointer -> Int -> IO String
203column_blob : DBPointer -> Int -> IO String
204+column_blob (MkDBPointer pointer) iCol =
188−column_blob (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FString)pointer iCol
205+ mkForeign (FFun "sqlite3_column_bytes_idr" [FPtr, FInt] FString) pointer iCol
189
206
190
207
191column_text : DBPointer -> Int -> IO String
208column_text : DBPointer -> Int -> IO String
209+column_text (MkDBPointer pointer) iCol =
192−column_text (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_text_idr" [FPtr, FInt] FString)pointer iCol
210+ mkForeign (FFun "sqlite3_column_text_idr" [FPtr, FInt] FString) pointer iCol
193
211
194
212
195column_Int : DBPointer -> Int -> IO Int
213column_Int : DBPointer -> Int -> IO Int
214+column_Int (MkDBPointer pointer) iCol =
196−column_Int (MkDBPointer pointer) iCol =mkForeign (FFun "sqlite3_column_int_idr" [FPtr, FInt] FInt)pointer iCol
215+ mkForeign (FFun "sqlite3_column_int_idr" [FPtr, FInt] FInt) pointer iCol
197
216
198-----------------------------------------------------------------------------
217-----------------------------------------------------------------------------
199-- | These routines support some of SQLite backup functions.
218-- | These routines support some of SQLite backup functions.
200-----------------------------------------------------------------------------
219-----------------------------------------------------------------------------
201
220
202−backup_init : DBPointer -> String -> DBPointer -> String -> IO DBPointer
221+backup_init : DBPointer -> String -> DBPointer -> String -> IO DBPointer
203−backup_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
222+backup_init (MkDBPointer des_pointer) destName (MkDBPointer src_pointer) srcName =
223+ do x <- mkForeign (FFun "sqlite3_backup_init_idr" [FPtr,FString, FPtr, FString] FPtr)
224+ des_pointer destName src_pointer srcName
204− return (MkDBPointer x)
225+ return (MkDBPointer x)
205
226
206backup_step : DBPointer -> Int -> IO Int
227backup_step : DBPointer -> Int -> IO Int
228+backup_step (MkDBPointer pointer) nPage =
207−backup_step (MkDBPointer pointer) nPage =mkForeign (FFun "sqlite3_backup_step_idr" [FPtr, FInt] FInt)pointer nPage
229+ mkForeign (FFun "sqlite3_backup_step_idr" [FPtr, FInt] FInt) pointer nPage
208
230
209backup_finish : DBPointer -> IO Int
231backup_finish : DBPointer -> IO Int
232+backup_finish (MkDBPointer pointer) =
210−backup_finish (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_finish_idr" [FPtr] FInt)pointer
233+ mkForeign (FFun "sqlite3_backup_finish_idr" [FPtr] FInt) pointer
211
234
212backup_remaining : DBPointer -> IO Int
235backup_remaining : DBPointer -> IO Int
236+backup_remaining (MkDBPointer pointer) =
213−backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt)pointer
237+ mkForeign (FFun "sqlite3_backup_remaining_idr" [FPtr] FInt) pointer
214
238
215
239
216-----------------------------------------------------------------------------
240-----------------------------------------------------------------------------
@@ -221,104 +245,98 @@ backup_remaining (MkDBPointer pointer) =mkForeign (FFun "sqlite3_backup_remainin
221-----------------------------------------------------------------------------
245-----------------------------------------------------------------------------
222
246
223get_table : DBPointer -> String -> DB TBPointer
247get_table : DBPointer -> String -> DB TBPointer
224−get_table (MkDBPointer pointer) name = do
248+get_table (MkDBPointer pointer) name = do
225− x <- liftIO(mkForeign (FFun "sqlite3_get_table_idr" [FPtr, FString] FPtr)pointer name)
249+ x <- liftIO(mkForeign (FFun "sqlite3_get_table_idr" [FPtr, FString] FPtr) pointer name)
226− flag <- liftIO(nullPtr x)
250+ flag <- liftIO (nullPtr x)
227 if flag
251 if flag
228− then do x <- liftIO(get_error_table pointer) ; fail x
252+ then do x <- liftIO(get_error_table pointer) ; fail x
229− else return (MkTBPointer x)
253+ else return (MkTBPointer x)
230 where
254 where
231 get_error_table : Ptr-> IO String
255 get_error_table : Ptr-> IO String
232− get_error_table pointer = do x <- mkForeign (FFun "sqlite3_get_error" [FPtr] FString)pointer
256+ get_error_table pointer = do x <- mkForeign (FFun "sqlite3_get_error" [FPtr] FString) pointer
233 return x
257 return x
234
258
235
259
236free_table : TBPointer -> IO ()
260free_table : TBPointer -> IO ()
237−free_table (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit)pointer
261+free_table (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_free_table_idr" [FPtr] FUnit) pointer
238 return ()
262 return ()
239−
263+
240-----------------------------------------------------------------------------
264-----------------------------------------------------------------------------
241-- | This version of these function obtain the row and column number
265-- | This version of these function obtain the row and column number
242-- from the Table struct. These functions are only used with get_table.
266-- from the Table struct. These functions are only used with get_table.
243-----------------------------------------------------------------------------
267-----------------------------------------------------------------------------
244
268
245num_row : TBPointer -> IO Int
269num_row : TBPointer -> IO Int
246−num_row (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row" [FPtr] FInt)pointer
270+num_row (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row" [FPtr] FInt) pointer
247− return (x)
271+ return x
248
272
249num_col : TBPointer -> IO Int
273num_col : TBPointer -> IO Int
250−num_col (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col" [FPtr] FInt)pointer
274+num_col (MkTBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col" [FPtr] FInt) pointer
251− return (x)
275+ return x
252−
276+
253-----------------------------------------------------------------------------
277-----------------------------------------------------------------------------
254-- | This version of these function obtain the row and column number
278-- | This version of these function obtain the row and column number
255-- from the Database struct.
279-- from the Database struct.
256-----------------------------------------------------------------------------
280-----------------------------------------------------------------------------
257
281
258num_row_v2 : DBPointer -> IO Int
282num_row_v2 : DBPointer -> IO Int
259−num_row_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row_v2" [FPtr] FInt)pointer
283+num_row_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_row_v2" [FPtr] FInt) pointer
260− return (x)
284+ return x
261
285
262num_col_v2 : DBPointer -> IO Int
286num_col_v2 : DBPointer -> IO Int
263−num_col_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col_v2" [FPtr] FInt)pointer
287+num_col_v2 (MkDBPointer pointer) = do x <- mkForeign (FFun "sqlite3_get_num_col_v2" [FPtr] FInt) pointer
264− return (x)
288+ return x
265−
289+
266-----------------------------------------------------------------------------
290-----------------------------------------------------------------------------
267-- | This function prints the result of a query by checking the type
291-- | This function prints the result of a query by checking the type
268-- of each value returned, it then calls the appropriate function.
292-- of each value returned, it then calls the appropriate function.
269-- Ther result is one of the DBVal variants.
293-- Ther result is one of the DBVal variants.
270-----------------------------------------------------------------------------
294-----------------------------------------------------------------------------
271−
295+
272get_data : DBPointer -> Int -> Int -> IO DBVal
296get_data : DBPointer -> Int -> Int -> IO DBVal
273get_data (MkDBPointer pointer) row col = do
297get_data (MkDBPointer pointer) row col = do
274 ty <- get_data_type pointer row col
298 ty <- get_data_type pointer row col
275 helper ty
299 helper ty
276− where
277− get_data_type : Ptr ->Int -> Int -> IO Int
300+ where get_data_type : Ptr ->Int -> Int -> IO Int
301+ get_data_type pointer row col =
278− get_data_type pointer row col =mkForeign (FFun "sqlite3_get_data_type" [FPtr, FInt, FInt] FInt)pointer row col
302+ mkForeign (FFun "sqlite3_get_data_type" [FPtr, FInt, FInt] FInt) pointer row col
279−
280− get_data_val_int : Ptr -> Int -> IO Int
303+ get_data_val_int : Ptr -> Int -> IO Int
304+ get_data_val_int pointer col =
281− get_data_val_int pointer col =mkForeign (FFun "sqlite3_get_val_int" [FPtr,FInt] FInt)pointer col
305+ mkForeign (FFun "sqlite3_get_val_int" [FPtr,FInt] FInt) pointer col
282−
306+
283− get_data_val_text : Ptr -> Int -> IO String
307+ get_data_val_text : Ptr -> Int -> IO String
308+ get_data_val_text pointer col =
284− get_data_val_text pointer col =mkForeign (FFun "sqlite3_get_val_text" [FPtr, FInt] FString)pointer col
309+ mkForeign (FFun "sqlite3_get_val_text" [FPtr, FInt] FString) pointer col
285−
310+
286−
287−
288− get_data_val_float : Ptr -> Int -> IO Float
311+ get_data_val_float : Ptr -> Int -> IO Float
312+ get_data_val_float pointer col =
289− get_data_val_float pointer col =mkForeign (FFun "sqlite3_get_float" [FPtr, FInt] FFloat)pointer col
313+ mkForeign (FFun "sqlite3_get_float" [FPtr, FInt] FFloat) pointer col
290−
314+
291− helper : Int -> IO DBVal
315+ helper : Int -> IO DBVal
292− helper 1 = do i <- get_data_val_int pointer col ; return (DBInt i)
316+ helper 1 = do i <- get_data_val_int pointer col ; return (DBInt i)
293− helper 2 = do i <- get_data_val_float pointer col ; return (DBFloat i)
317+ helper 2 = do i <- get_data_val_float pointer col ; return (DBFloat i)
294− helper 3 = do i <- get_data_val_text pointer col; return (DBText i)
318+ helper 3 = do i <- get_data_val_text pointer col; return (DBText i)
295− helper _ =return (DBNull)
319+ helper _ = return DBNull
296−
320+
297-----------------------------------------------------------------------------
321-----------------------------------------------------------------------------
298-- | This function makes use of get_data to get all the result.
322-- | This function makes use of get_data to get all the result.
299-----------------------------------------------------------------------------
323-----------------------------------------------------------------------------
300
324
301−toList_v1 : DBPointer -> DB Table
325+toList_v1 : DBPointer -> DB Table
302−toList_v1 db = do
303− nbR <- liftIO (num_row_v2 db)
326+toList_v1 db = do nbR <- liftIO (num_row_v2 db)
304− nmC <- liftIO (num_col_v2 db)
327+ nmC <- liftIO (num_col_v2 db)
305− res <- forM [0..(nbR-1)] (\ i =>
328+ res <- liftIO $ forM [0..(nbR-1)] $ \ i =>
306− forM [0..(nmC-1)] (\ j =>
329+ forM [0..(nmC-1)] $ \ j => get_data db i j
307− liftIO(get_data db i j)
308−
309− )
310− )
311− return res
330+ return (the (List (List DBVal)) res)
312−
331+
313−
314strcat : String -> String-> String
332strcat : String -> String-> String
315−strcat str1 str2 = (str1 ++ str2)
333+strcat str1 str2 = str1 ++ str2
316
334
317-----------------------------------------------------------------------------
335-----------------------------------------------------------------------------
318-- | This version of toList retunrs result from get_table
336-- | This version of toList retunrs result from get_table
319-- This could be removed if not needed in the future.
337-- This could be removed if not needed in the future.
320-----------------------------------------------------------------------------
338-----------------------------------------------------------------------------
321−
339+
322--toList_v2 : String -> String -> DBPointer -> DB Table
340--toList_v2 : String -> String -> DBPointer -> DB Table
323--toList_v2 name stmt x = do
341--toList_v2 name stmt x = do
324-- ptr <- (get_table x (stmt))
342-- ptr <- (get_table x (stmt))
@@ -327,12 +345,12 @@ strcat str1 str2 = (str1 ++ str2)
327-- res <- forM [0..(nbR-1)] (\ i =>
345-- res <- forM [0..(nbR-1)] (\ i =>
328-- forM [0..(nmC-1)] (\ j =>
346-- forM [0..(nmC-1)] (\ j =>
329-- liftIO(get_data x name i j)
347-- liftIO(get_data x name i j)
330−--
348+--
331-- )
349-- )
332-- )
350-- )
333-- liftIO (free_table ptr)
351-- liftIO (free_table ptr)
334−-- return res
352+-- return res
335−
353+
336
354
337-----------------------------------------------------------------------------
355-----------------------------------------------------------------------------
338-- | These routines support binding the types supported by Idris.
356-- | These routines support binding the types supported by Idris.
@@ -341,68 +359,67 @@ strcat str1 str2 = (str1 ++ str2)
341-----------------------------------------------------------------------------
359-----------------------------------------------------------------------------
342
360
343bind_int : StmtPtr -> Int -> Int -> DB StmtPtr
361bind_int : StmtPtr -> Int -> Int -> DB StmtPtr
344−bind_int (MkStmtPtr pointer) indexval val = do
362+bind_int (MkStmtPtr pointer) indexval val = do
345− x <- liftIO(mkForeign (FFun "sqlite3_bind_int_idr" [FPtr, FInt, FInt] FPtr)pointer indexval val)
363+ x <- liftIO (mkForeign (FFun "sqlite3_bind_int_idr" [FPtr, FInt, FInt] FPtr) pointer indexval val)
346− flag <- liftIO(nullPtr x)
364+ flag <- liftIO (nullPtr x)
347 if flag
365 if flag
348− then fail "Could not bind int."
366+ then fail "Could not bind int."
349− else return (MkStmtPtr x)
367+ else return (MkStmtPtr x)
350−
368+
351−
369+
352bind_float : StmtPtr -> Int -> Float -> DB StmtPtr
370bind_float : StmtPtr -> Int -> Float -> DB StmtPtr
353−bind_float (MkStmtPtr pointer) indexval val = do
371+bind_float (MkStmtPtr pointer) indexval val = do
354− x <- liftIO(mkForeign (FFun "sqlite3_bind_float_idr" [FPtr, FInt, FFloat] FPtr)pointer indexval val)
372+ x <- liftIO (mkForeign (FFun "sqlite3_bind_float_idr" [FPtr, FInt, FFloat] FPtr) pointer indexval val)
355− flag <- liftIO(nullPtr x)
373+ flag <- liftIO (nullPtr x)
356 if flag
374 if flag
357− then fail "Could not bind float."
375+ then fail "Could not bind float."
358− else return (MkStmtPtr x)
376+ else return (MkStmtPtr x)
359
377
360bind_text : StmtPtr -> String -> Int -> Int -> DB StmtPtr
378bind_text : StmtPtr -> String -> Int -> Int -> DB StmtPtr
361bind_text (MkStmtPtr pointer) text indexval lengthval = do
379bind_text (MkStmtPtr pointer) text indexval lengthval = do
362− x <- liftIO(mkForeign (FFun "sqlite3_bind_text_idr" [FPtr, FString, FInt, FInt] FPtr)pointer text indexval lengthval)
380+ x <- liftIO (mkForeign (FFun "sqlite3_bind_text_idr" [FPtr, FString, FInt, FInt] FPtr)
381+ pointer text indexval lengthval)
363− flag <- liftIO(nullPtr x)
382+ flag <- liftIO(nullPtr x)
364 if flag
383 if flag
365− then fail "Could not bind text."
384+ then fail "Could not bind text."
366− else return (MkStmtPtr x)
385+ else return (MkStmtPtr x)
367
386
368bind_null : StmtPtr -> Int -> DB StmtPtr
387bind_null : StmtPtr -> Int -> DB StmtPtr
369−bind_null (MkStmtPtr pointer) indexval = do
388+bind_null (MkStmtPtr pointer) indexval = do
370− x <- liftIO(mkForeign (FFun "sqlite3_bind_null_idr" [FPtr, FInt] FPtr)pointer indexval)
389+ x <- liftIO (mkForeign (FFun "sqlite3_bind_null_idr" [FPtr, FInt] FPtr) pointer indexval)
371− flag <- liftIO(nullPtr x)
390+ flag <- liftIO (nullPtr x)
372 if flag
391 if flag
373− then fail "Could not bind null."
392+ then fail "Could not bind null."
374− else return (MkStmtPtr x)
393+ else return (MkStmtPtr x)
375
394
376-----------------------------------------------------------------------------
395-----------------------------------------------------------------------------
377-- | String Length
396-- | String Length
378-----------------------------------------------------------------------------
397-----------------------------------------------------------------------------
379−
398+
380strlen : String -> DB Int
399strlen : String -> DB Int
381−strlen str = liftIO(mkForeign (FFun "strLength" [FString] FInt) str)
400+strlen str = liftIO (mkForeign (FFun "strLength" [FString] FInt) str)
382−
401+
383instance Show DBVal where
402instance Show DBVal where
384− show (DBInt i) = "Int val: " ++ show i ++ "\n"
403+ show (DBInt i) = "Int val: " ++ show i ++ "\n"
385− show (DBText i) = "Text val: " ++ show i ++ "\n"
404+ show (DBText i) = "Text val: " ++ show i ++ "\n"
386− show (DBFloat i) = "Float val: " ++ show i ++ "\n"
405+ show (DBFloat i) = "Float val: " ++ show i ++ "\n"
387− show (DBNull ) = "NULL"
406+ show (DBNull ) = "NULL"
388
407
389-----------------------------------------------------------------------------
408-----------------------------------------------------------------------------
390-- | Multi bind a list of values.
409-- | Multi bind a list of values.
391-----------------------------------------------------------------------------
410-----------------------------------------------------------------------------
392
411
393bindMulti : StmtPtr-> List (Maybe (Int, Value)) -> DB StmtPtr
412bindMulti : StmtPtr-> List (Maybe (Int, Value)) -> DB StmtPtr
394−bindMulti pointer [] = return pointer
413+bindMulti pointer [] = return pointer
395−bindMulti pointer (Nothing :: vs) = bindMulti pointer vs
414+bindMulti pointer (Nothing :: vs) = bindMulti pointer vs
396−bindMulti pointer ((Just (indexs, val))::vs) = case val of
415+bindMulti pointer ((Just (indexs, (VInt i)))::vs) =
397− (VInt intval) => do x <- bind_int pointer indexs intval
416+ do x <- bind_int pointer indexs i
398− bindMulti(x) vs
417+ bindMulti x vs
399−
418+bindMulti pointer ((Just (indexs, (VStr s)))::vs) =
400− (VStr strval) => do len <- strlen strval
419+ do len <- strlen s
401− x <- bind_text pointer strval indexs len
420+ x <- bind_text pointer s indexs len
402− bindMulti(x) vs
421+ bindMulti x vs
403−
422+bindMulti pointer ((Just (indexs, (VFloat f)))::vs) =
404−
405− (VFloat floatval) => do x <- bind_float pointer indexs floatval
423+ do x <- bind_float pointer indexs f
406−
407− bindMulti(x) vs
424+ bindMulti x vs
408
425
contribs/lib/SQLite3/sqlexpr.idrdeleted−274
@@ -1,274 +0,0 @@
1−module Sqlexpr
2−import Prelude.List
3−
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−
14−-----------------------------------------------------------
15−-- | SQL data type
16−-----------------------------------------------------------
17−
18−data Value = VInt Int
19− |VStr String
20− |VFloat Float
21− |VCol String
22− |VNULL
23−
24−--Perhaps could extend this by adding
25−-- a dot operator to allow mapping
26−-- between table and column and
27−-- comparing different table columns.
28−
29−data Cond = Equals Value Value
30− |MkGT Value Value
31− |MkGTE Value Value
32− |MkLT Value Value
33− |MkLTE Value Value
34− |MkNULL Value
35−
36−
37−data Clause = MkCond Cond
38− | AND Clause Clause
39− | OR Clause Clause
40− | Empty
41− | MkSQL SQL
42−
43−data condClause = SET Clause
44− |WHERE condClause Clause
45−
46−data SelVar = Cols (List String)
47− |ALL
48−
49−data ColType = CInt String -- parsed as string "int"
50− |Varchar String
51−
52−data Constr = NOTNULL
53− | UNIQUE Constr
54− | None
55− | PRIMARYKEY
56− | FOREIGNKEY
57− | CHECK
58− | DEFAULT
59−
60−
61−data SQL = SELECT SelVar SQL Clause
62− | TBL (List String)
63− | INSERT SQL (List Value)
64− | INSERTC SQL (List Value) (List Value)
65− | UPDATE SQL condClause
66− | CREATE SQL (List (Value, ColType , Constr))
67−
68−-- remember to remove these funcs later
69−-- foldr1 : (a -> a -> a) -> List a -> a
70−-- foldr1 f [x] = x
71−-- foldr1 f (x::xs) = f x (foldr1 f xs)
72−
73−
74−-- unwords' : List (List Char) -> List Char
75−-- unwords' [] = []
76−-- unwords' ws = (foldr1 addSpace ws)
77−-- where
78−-- addSpace : List Char -> List Char -> List Char
79−-- addSpace w s = w ++ (' ' :: s)
80−--
81−--
82−-- unwords : List String -> String
83−-- unwords = pack . unwords' . map unpack
84−
85−-----------------------------------------------------------
86−-- | This function replaces values with question mark
87−-- following by an index number. It then puts the value
88−-- replaced, in the list.
89−-----------------------------------------------------------
90−
91−valString : List (Maybe(Int, Value)) -> Value -> (String, List (Maybe(Int, Value)))
92−valString xs (VInt x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VInt x))])
93−valString xs (VStr x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VStr x))])
94−valString xs (VFloat x) = ("?" ++ show (cast(length xs)+1), xs ++ [Just (cast((length xs)+1),(VFloat x))])
95−valString xs (VCol n) = (n, xs)
96−
97−-----------------------------------------------------------
98−-- | This function calls valString on a list of Values
99−-- and separates the values by commas.
100−-----------------------------------------------------------
101−
102−listVal : List (Maybe(Int, Value)) -> List Value -> (String, List (Maybe(Int, Value)))
103−listVal xs [] = ("", xs)
104−listVal xs (v::vs) = let (str, newxs) = (valString xs v) in
105− let (str', newxs') = listVal newxs vs in
106− ((unwords(intersperse "," (words(str) ++ words (str')))), newxs')
107−
108−-----------------------------------------------------------
109−-- | Parses the type of column to be created.
110−-----------------------------------------------------------
111−
112−getColType : List (Maybe(Int, Value)) -> ColType -> (String, List (Maybe(Int, Value)))
113−getColType xs (CInt x) = ("int", xs)
114−getColType xs (Varchar str) = ("varchar(255)", xs)
115−
116−-----------------------------------------------------------
117−-- | CREATE Constraints
118−-----------------------------------------------------------
119−
120−getConstr : List (Maybe(Int, Value)) -> Constr -> (String, List (Maybe(Int, Value)))
121−getConstr xs (NOTNULL) = ("NOT NULL", xs)
122−getConstr xs (UNIQUE constr) = ("NOT NULL UNIQUE", xs)
123−getConstr xs (PRIMARYKEY) = ("PRIMARY KEY", xs)
124−getConstr xs (FOREIGNKEY) = ("FOREIGN KEY", xs)
125−getConstr xs (CHECK) = ("CHECK", xs)
126−getConstr xs (DEFAULT) = ("DEFAULT", xs)
127−getConstr xs (None) = ("", xs)
128−
129−putBrackets : String -> String
130−putBrackets str = "(" ++ str ++ ")"
131−
132−-----------------------------------------------------------
133−-- | Used to detect a complex type in a nested SQLite query
134−-- This function is used for bracketing the nested queries.
135−-----------------------------------------------------------
136−complexType : SQL -> Bool
137−complexType (TBL tbl) = False
138−complexType (SELECT vars sql c) = True
139−
140−-----------------------------------------------------------
141−-- | Used in CREATE
142−-----------------------------------------------------------
143−
144−listValType : List (Maybe(Int, Value)) -> List (Value, ColType , Constr) -> (String, List (Maybe(Int, Value)))
145−listValType xs [] = ("", xs)
146−listValType xs ((val, types, constr) :: vs) = let (str , newxs) = valString xs val in
147− let (str' , newxs') = getColType newxs types in
148− let (str'', newxs'') = getConstr newxs' constr in
149− let (finalstr, finalxs) = listValType newxs'' vs in
150− ((unwords(intersperse " " (words(str) ++ words(str') ++ words(str'') ++ words(finalstr)))) , finalxs)
151−
152−
153−-----------------------------------------------------------
154−-- | Evaluates a conditional WHERE clause
155−-----------------------------------------------------------
156−
157−evalCond : List (Maybe(Int, Value)) -> Cond -> (String, List (Maybe(Int, Value)))
158−evalCond xs (Equals val1 val2) = let (restring , newxs ) = valString xs val1 in
159− let (restring2, newxs') = valString newxs val2 in
160− (restring ++ " = " ++ restring2, newxs')
161−
162−evalCond xs (MkGT val1 val2) = let (restring , newxs ) = valString xs val1 in
163− let (restring2, newxs') = valString newxs val2 in
164− (restring ++ " > " ++ restring2, newxs')
165−
166−evalCond xs (MkGTE val1 val2) = let (restring , newxs ) = valString xs val1 in
167− let (restring2, newxs') = valString newxs val2 in
168− (restring ++ " >= " ++ restring2, newxs')
169−
170−evalCond xs (MkLT val1 val2) = let (restring , newxs ) = valString xs val1 in
171− let (restring2, newxs') = valString newxs val2 in
172− (restring ++ " < " ++ restring2, newxs')
173−
174−evalCond xs (MkLTE val1 val2) = let (restring , newxs ) = valString xs val1 in
175− let (restring2, newxs') = valString newxs val2 in
176− (restring ++ " =< " ++ restring2, newxs')
177−
178−evalCond xs (MkNULL val) = let (restring , newxs ) = valString xs val in
179− (restring ++ " IS NULL " , newxs)
180−
181−-----------------------------------------------------------
182−-- | Evaluates queries by calling the other functions
183−-- on each part of the query
184−-----------------------------------------------------------
185−evalSQL : List (Maybe(Int, Value)) -> SQL -> ( String, List (Maybe(Int, Value)))
186−-----------------------------------------------------------
187−-- | Evaluates clauses
188−-- Supports WHERE Clause
189−-- WHERE Clause And Another-Clause
190−-- WHERE Clause Or Another-Clause
191−-----------------------------------------------------------
192−clauseString : List (Maybe(Int, Value)) -> Clause -> (String, List (Maybe(Int, Value)))
193−
194−clauseString xs (Empty) = ("" , []) -- No condition
195−clauseString xs (MkCond cond') = let (condstr, newxs) = evalCond xs cond' in
196− (condstr , newxs)
197−
198−clauseString xs (AND c1 c2) = let (clausestr, newxs) = clauseString xs c1 in
199− let (clausestr2, newxs') = clauseString newxs c2 in
200− (clausestr ++ " AND " ++clausestr2 , newxs')
201−
202−clauseString xs (OR c1 c2) = let (clausestr, newxs) = clauseString xs c1 in
203− let (clausestr2, newxs') = clauseString newxs c2 in
204− (clausestr ++ " OR " ++clausestr2 , newxs')
205−
206−
207−-----------------------------------------------------------
208−-- | Evaluates conditional clauses.
209−-----------------------------------------------------------
210−
211−condClauseStr : List (Maybe(Int, Value)) -> condClause -> (String, List (Maybe(Int, Value)))
212−condClauseStr xs (SET setcl) = let (condstr, newxs) = clauseString xs setcl in
213− (" SET " ++ condstr, newxs)
214−
215−condClauseStr xs (WHERE setcl1 setcl2) = let (condstr, newxs) = condClauseStr xs setcl1 in
216− let (condstr', newxs') = clauseString newxs setcl2 in
217− ( condstr ++ " WHERE " ++ condstr', newxs')
218−
219−-- SELECT data from tbl1 where num > (SELECT num from tbl1 where num = 24)
220−-- evalSQL [] ((SELECT ALL)(TBL "tbl")(MkSQL ((SELECT ALL) (TBL "tbl")(MkCond (VCol "))))
221−-- NTBF
222−--clauseString xs (MkSQL sql) = (evalSQL xs sql)
223−
224−-- Separate list of tables
225−-- For complex type, return list returned by evalSQL
226−-- And add brackets
227−evalSQL xs (TBL tbl) = ((unwords (intersperse "," ( tbl))), xs)
228−evalSQL xs (SELECT vars sql' c) = let (sqlstring, newxs) = evalSQL xs sql' in
229− let (csstring, newxs') = clauseString newxs c in
230− case c of
231− Empty => case vars of
232− (ALL ) => if complexType sql' then ("SELECT " ++ "*" ++ " FROM "
233− ++ (putBrackets sqlstring) ++ csstring, newxs)
234−
235− else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring
236− ++ csstring, newxs')
237−
238− (Cols selvar) => if complexType sql' then ("SELECT " ++ (unwords selvar) ++
239− " FROM " ++ (putBrackets sqlstring) ++ csstring, newxs)
240−
241− else ("SELECT " ++ (unwords selvar )++ " FROM " ++ sqlstring
242− ++ csstring, newxs')
243−
244− _ => case vars of
245− (ALL ) => if complexType sql' then ("SELECT " ++ "*" ++ " FROM "
246− ++ " WHERE " ++ csstring , newxs)
247− else ("SELECT " ++ "*" ++ " FROM " ++ sqlstring
248− ++ " WHERE " ++ csstring , newxs')
249−
250− (Cols selvar) => if complexType sql' then ("SELECT " ++ (unwords selvar) ++ " FROM " ++
251− (putBrackets sqlstring) ++ " WHERE "
252− ++ csstring , newxs)
253−
254− else ("SELECT " ++ (unwords selvar) ++ " FROM " ++ sqlstring
255− ++ " WHERE " ++ csstring , newxs')
256−
257−
258−evalSQL xs (INSERT sql vals) = let (tblname, newvals) = evalSQL xs sql in
259− let (str, newxs ) = listVal newvals vals in
260− ("INSERT INTO " ++ tblname ++ " VALUES (" ++ str ++ ")" , newxs)
261−
262−evalSQL xs (INSERTC sql cols vals) = let (tblname, newvals) = evalSQL xs sql in
263− let (strcol, newcol) = listVal newvals cols in
264− let (strval, newcolval) = listVal newcol vals in
265− ("INSERT INTO " ++ tblname ++ "(" ++ strcol ++ ")" ++ "VALUES (" ++ strval ++ ")", newcolval)
266−
267−
268−evalSQL xs (UPDATE sql cl) = let (tblname, newxs) = evalSQL xs sql in
269− let (csstring, newxs') = condClauseStr newxs cl in
270− ("UPDATE " ++ tblname ++ csstring, newxs')
271−
272−evalSQL xs (CREATE sql details) = let (sqlstring, newxs) = evalSQL xs sql in
273− let (csstring, newxs') = listValType newxs details in
274− ("CREATE TABLE " ++ sqlstring ++ "(" ++ csstring ++ ")", newxs')