sqlite (empty) → 0.4.1
raw patch · 22 files changed
+2189/−0 lines, 22 filesdep +basedep +bytestringdep +directorysetup-changedbinary-added
Dependencies added: base, bytestring, directory, pretty, time, utf8-string
Files
- Database/SQL.hs +8/−0
- Database/SQL/Types.hs +436/−0
- Database/SQLite.hs +371/−0
- Database/SQLite/Base.hs +708/−0
- Database/SQLite/Types.hs +422/−0
- LICENSE +27/−0
- README +6/−0
- Setup.hs +7/−0
- cbits/sqlite3-local.c +27/−0
- configure +18/−0
- include/sqlite3-local.h +11/−0
- sqlite.buildinfo.unix +3/−0
- sqlite.buildinfo.win32 +3/−0
- sqlite.cabal +56/−0
- sqlite3.5/sqlite3.c too large to diff
- tests/Main.hs +42/−0
- tests/Setup.hs +7/−0
- tests/configure +15/−0
- tests/sqlite-tests.buildinfo.unix +1/−0
- tests/sqlite-tests.buildinfo.win32 +1/−0
- tests/sqlite-tests.cabal +20/−0
- tests/test.db binary
+ Database/SQL.hs view
@@ -0,0 +1,8 @@+module Database.SQL (module Database.SQL, module Database.SQL.Types) where++import Database.SQL.Types++sqlInsert :: TableName -> [(ColumnName,SQLExpr)] -> SQLInsert+sqlInsert t xs = let (as,bs) = unzip xs+ in SQLInsert t as bs+
+ Database/SQL/Types.hs view
@@ -0,0 +1,436 @@+--------------------------------------------------------------------+-- |+-- Module : Database.SQL.Types+-- Copyright : (c) Galois, Inc. 2007+-- License : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability:+--+-- Basic embedding of SQL types in Haskell.+--+-- Note: the quary part of this modules was imported (with modifications)+-- from the lowest layer of abstraction of HaskellDB.+module Database.SQL.Types+ ( TableName+ , ColumnName+ , DatabaseName+ , OpName++ , SQLOrder(..)+ , SQLSelect(..)+ , select_all+ , SelectSource(..)+ , Join(..)+ , TableSource(..)+ , SQLExpr(..)+ , SQLUpdate(..)+ , SQLDelete(..)+ , SQLInsert(..)+ , SQLCreate(..)+ , SQLDrop(..)++ , Clause(..)+ , Constraint(..)+ , Table(..)+ , Column(..)+ , SQLTable++ , SQLType(..)+ , IntType(..)+ , DateTimeType(..)+ , BlobType(..)++ , showType+ , showClause+ , toSQLString+ , export_sql+ , PrettySQL(..)+ ) where++import Data.List ( intersperse )+import Text.PrettyPrint.HughesPJ++type DatabaseName = String+type TableName = String+type ColumnName = String+type OpName = String++data Clause+ = IsNullable Bool+ | DefaultValue String+ | PrimaryKey Bool -- ^ Auto-increment?+ | ForeignKey TableName [ColumnName]+ | Clustered Bool+ | Unique++data Constraint+ = TablePrimaryKey [ColumnName]+ | TableUnique [ColumnName]+ | TableCheck SQLExpr++data Table a+ = Table { tabName :: String+ , tabColumns :: [Column a]+ , tabConstraints :: [Constraint]+ }++type SQLTable = Table SQLType++-- | We parameterize over column type, since SQL engines+-- do tend to provide their own set of supported datatypes+-- (which may or may not map onto SQL99's set of types.)+data Column a+ = Column { colName :: ColumnName+ , colType :: a+ , colClauses :: [Clause]+ }++-- | MySQL slanted, but also SQLite friendly if you don't get+-- too fancy..+data SQLType+ = SQLBoolean+ | SQLChar (Maybe Int)+ | SQLVarChar Int+ | SQLBlob BlobType+ | SQLDateTime DateTimeType+ | SQLInt IntType Bool{-unsigned?-} Bool{-zero fill-}+ | SQLDecimal (Maybe Int){-total number of digits-}+ (Maybe Int){-digits after dec. point (the scale)-}+ | SQLFloat (Maybe Int){-total number of digits-}+ (Maybe Int){-digits following dec. point-}+ | SQLEnum [String]+ | SQLSet [String]++data IntType+ = TINY | SMALL | MEDIUM | NORMAL | BIG++data DateTimeType+ = DATE | DATETIME | TIMESTAMP | TIME | YEAR (Maybe Int)++data BlobType+ = TinyBlob+ | NormalBlob (Maybe Int)+ | MediumBlob+ | LongBlob++showType :: SQLType -> String+showType t =+ case t of+ SQLBoolean -> "BOOLEAN"+ SQLChar Nothing -> "CHAR"+ SQLChar (Just x) -> "CHAR("++shows x ")"+ SQLVarChar x -> "VARCHAR("++shows x ")"+ SQLBlob bt ->+ case bt of+ TinyBlob -> "TINYBLOB"+ NormalBlob Nothing -> "BLOB"+ NormalBlob (Just x) -> "BLOB("++shows x ")"+ MediumBlob -> "MEDIUMBLOB"+ LongBlob -> "LONGBLOB"++ SQLDateTime dt ->+ case dt of+ DATE -> "DATE"+ DATETIME -> "DATETIME"+ TIMESTAMP -> "TIMESTAMP"+ TIME -> "TIME"+ YEAR Nothing -> "YEAR"+ YEAR (Just x) -> "YEAR(" ++ shows x ")"+ SQLInt it unsigned zeroFill ->+ (if unsigned then (++" UNSIGNED") else id) $+ (if zeroFill then (++" ZEROFILL") else id) $+ (case it of+ TINY -> "TINYINT"+ SMALL -> "SMALLINT"+ MEDIUM -> "MEDIUMINT"+ NORMAL -> "INTEGER"+ BIG -> "BIGINT")+ SQLDecimal mbDig mbScale -> + "DECIMAL" ++ + case sequence [mbDig,mbScale] of + Nothing -> ""+ Just xs -> '(':concat (intersperse "," (map show xs)) ++ ")"+ SQLFloat mbDig mbScale -> + "FLOAT" ++ + case sequence [mbDig,mbScale] of + Nothing -> ""+ Just xs -> '(':concat (intersperse "," (map show xs)) ++ ")"+ SQLEnum tgs -> + "ENUM(" ++ toTags tgs ++ ")"+ SQLSet tgs -> + "SET(" ++ toTags tgs ++ ")"+ where+ toTags xs = concat $ intersperse "," (map quote xs)++ quote nm = '\'':nm ++ "'"++showClause :: Clause -> String+showClause c = + case c of + IsNullable flg + | flg -> "NULL"+ | otherwise -> "NOT NULL"+ DefaultValue x -> "DEFAULT " ++ toSQLString x+ PrimaryKey auto -> "PRIMARY KEY" ++ if auto then " AUTOINCREMENT" else ""+ ForeignKey tb cs -> "FOREIGN KEY " ++ tb ++ '(':concat (intersperse ", " cs) ++ ")"+ Clustered flg+ | flg -> "CLUSTERED"+ | otherwise -> "NONCLUSTERED"+ Unique -> "UNIQUE"++toSQLString :: String -> String+toSQLString "" = ""+toSQLString ('\'':xs) = '\'':'\'':toSQLString xs+toSQLString (x:xs) = x : toSQLString xs++--------------------------------------------------------------------------------+++++data SQLOrder = SQLAsc | SQLDesc++-- | Data type for SQL SELECT statements.+data SQLSelect = SQLSelect+ { options :: [String] -- ^ DISTINCT, ALL etc.+ -- | result, alias. Empty list means "select all".+ , attrs :: [(SQLExpr,String)]+ , tables :: SelectSource -- ^ FROM+ , criteria :: [SQLExpr] -- ^ WHERE+ , groupby :: [SQLExpr] -- ^ GROUP BY+ , orderby :: [(SQLExpr,SQLOrder)] -- ^ ORDER BY+ , extra :: [String] -- ^ TOP n, etc.+ }+ | SQLBin OpName SQLSelect SQLSelect -- ^ UNION, etc++select_all :: SelectSource -> SQLSelect+select_all src = SQLSelect { options = ["DISTINCT"]+ , attrs = []+ , tables = src+ , criteria = []+ , groupby = []+ , orderby = []+ , extra = []+ }++data SelectSource = From TableSource [Join]++-- | Join with another table.+data Join = Join OpName TableSource (Maybe (OpName ,SQLExpr))++-- | Use empty string for no alias.+data TableSource = SrcTable TableName String+ | SrcSelect SQLSelect String++-- | Expressions in SQL statements.+data SQLExpr = ColumnSQLExpr ColumnName+ | BinSQLExpr OpName SQLExpr SQLExpr+ | PrefixSQLExpr OpName SQLExpr+ | PostfixSQLExpr OpName SQLExpr+ | FunSQLExpr OpName [SQLExpr]+ | ConstSQLExpr String+ | CaseSQLExpr [(SQLExpr,SQLExpr)] SQLExpr+ | ListSQLExpr [SQLExpr]++-- | Data type for SQL UPDATE statements.+data SQLUpdate = SQLUpdate TableName [(ColumnName,SQLExpr)] [SQLExpr]++-- | Data type for SQL DELETE statements.+data SQLDelete = SQLDelete TableName [SQLExpr]++-- | Data type for SQL INSERT statements.+data SQLInsert = SQLInsert TableName [ColumnName] [SQLExpr]+ | SQLInsertQuery TableName [ColumnName] SQLSelect++-- | Data type for SQL CREATE statements.+data SQLCreate a = SQLCreateDB DatabaseName -- ^ Create a database+ | SQLCreateTable (Table a) -- ^ Create a table++-- | Data type representing the SQL DROP statement.+data SQLDrop = SQLDropDB DatabaseName -- ^ Delete a database+ | SQLDropTable TableName -- ^ Delete a table named SQLTable++++--------------------------------------------------------------------------------+++++class PrettySQL t where+ pp_sql :: t -> Doc++export_sql :: (PrettySQL t) => t -> String+export_sql x = render (pp_sql x)++instance PrettySQL SQLSelect where pp_sql = ppSelect+instance PrettySQL SQLUpdate where pp_sql = ppUpdate+instance PrettySQL SQLDelete where pp_sql = ppDelete+instance PrettySQL SQLInsert where pp_sql = ppInsert+instance PrettySQL a => PrettySQL (SQLCreate a) where pp_sql = ppCreate pp_sql+instance PrettySQL SQLDrop where pp_sql = ppDrop++instance PrettySQL SQLType where pp_sql = text . showType+++-- * SELECT++-- | Pretty prints a 'SQLSelect'+ppSelect :: SQLSelect -> Doc+ppSelect (SQLSelect opts as src crit group order other)+ = text "SELECT"+ <+> hsep (map text opts)+ <+> ppAttrs as+ $$ ppSelectSource src+ $$ ppWhere crit+ $$ ppGroupBy group+ $$ ppOrderBy order+ $$ hsep (map text other)+ppSelect (SQLBin op q1 q2) = parens (ppSelect q1) $$ text op $$ parens (ppSelect q2)++ppAttrs :: [(SQLExpr,ColumnName)] -> Doc+ppAttrs [] = text "*"+ppAttrs xs = commaV nameAs xs+ where+ -- | Print a name-value binding, or just the name if+ -- name and value are the same.+ nameAs :: (SQLExpr,ColumnName) -> Doc+ nameAs (ColumnSQLExpr c, name) | name == c = text name+ nameAs (expr, name) = ppSQLExpr expr <+> ppAlias name+++ppSelectSource :: SelectSource -> Doc+ppSelectSource (From t js) = text "FROM" <+> ppTableSource t+ <+> vcat (map ppJoin js)++ppJoin :: Join -> Doc+ppJoin (Join op s a) = text op <+> ppTableSource s <+> ppJoinArg a++ppJoinArg :: Maybe (String,SQLExpr) -> Doc+ppJoinArg Nothing = empty+ppJoinArg (Just (op,e)) = text op <+> ppSQLExpr e++ppTableSource :: TableSource -> Doc+ppTableSource (SrcTable x a) = text x <+> ppAlias a+ppTableSource (SrcSelect s a) = parens (ppSelect s) <+> ppAlias a++ppAlias :: String -> Doc+ppAlias "" = empty+ppAlias as = text "AS" <+> text as++ppWhere :: [SQLExpr] -> Doc+ppWhere [] = empty+ppWhere es = text "WHERE"+ <+> hsep (intersperse (text "AND") (map ppSQLExpr es))++ppGroupBy :: [SQLExpr] -> Doc+ppGroupBy [] = empty+ppGroupBy es = text "GROUP BY" <+> commaV ppSQLExpr es++ppOrderBy :: [(SQLExpr,SQLOrder)] -> Doc+ppOrderBy [] = empty+ppOrderBy ord = text "ORDER BY" <+> commaV ppOrd ord+ where+ ppOrd (e,o) = ppSQLExpr e <+> ppSQLOrder o+ ppSQLOrder :: SQLOrder -> Doc+ ppSQLOrder SQLAsc = text "ASC"+ ppSQLOrder SQLDesc = text "DESC"+++-- * UPDATE++-- | Pretty prints a 'SQLUpdate'+ppUpdate :: SQLUpdate -> Doc+ppUpdate (SQLUpdate name assigns crit)+ = text "UPDATE" <+> text name+ $$ text "SET" <+> commaV ppAssign assigns+ $$ ppWhere crit+ where+ ppAssign (c,e) = text c <+> equals <+> ppSQLExpr e+++-- * DELETE++-- | Pretty prints a 'SQLDelete'+ppDelete :: SQLDelete -> Doc+ppDelete (SQLDelete name crit) =+ text "DELETE FROM" <+> text name $$ ppWhere crit+++-- * INSERT++ppInsert :: SQLInsert -> Doc++ppInsert (SQLInsert table names values)+ = text "INSERT INTO" <+> text table+ <+> parens (commaV text names)+ $$ text "VALUES" <+> parens (commaV ppSQLExpr values)++ppInsert (SQLInsertQuery table names select)+ = text "INSERT INTO" <+> text table+ <+> parens (commaV text names)+ $$ ppSelect select+++-- * CREATE++-- | Pretty prints a 'SQLCreate'.+ppCreate :: (a -> Doc) -> SQLCreate a -> Doc+ppCreate _ (SQLCreateDB name) = text "CREATE DATABASE" <+> text name+ppCreate ppType (SQLCreateTable t)+ = text "CREATE TABLE" <+> text (tabName t)+ <+> parens (vcat $ punctuate comma+ $ map (ppColumn ppType) (tabColumns t) +++ map ppConstraint (tabConstraints t)+ )++ppColumn :: (a -> Doc) -> Column a -> Doc+ppColumn ppType c = text (colName c)+ <+> ppType (colType c)+ <+> hsep (map ppClause (colClauses c))++ppClause :: Clause -> Doc+ppClause c = text (showClause c)++ppConstraint :: Constraint -> Doc+ppConstraint c = case c of+ TablePrimaryKey cs -> text "PRIMARY KEY" <+> parens (commaH text cs)+ TableUnique cs -> text "UNIQUE" <+> parens (commaH text cs)+ TableCheck e -> text "CHECK" <+> (ppSQLExpr e)+++++-- * DROP++-- | Pretty prints a 'SQLDrop'.+ppDrop :: SQLDrop -> Doc+ppDrop (SQLDropDB name) = text "DROP DATABASE" <+> text name+ppDrop (SQLDropTable name) = text "DROP TABLE" <+> text name+++-- * Expressions++-- | Pretty prints a 'SQLExpr'+ppSQLExpr :: SQLExpr -> Doc+ppSQLExpr e =+ case e of+ ColumnSQLExpr c -> text c+ BinSQLExpr op e1 e2 -> ppSQLExpr e1 <+> text op <+> ppSQLExpr e2+ PrefixSQLExpr op e1 -> text op <+> ppSQLExpr e1+ PostfixSQLExpr op e1-> ppSQLExpr e1 <+> text op+ FunSQLExpr f es -> text f <> parens (commaH ppSQLExpr es)+ ConstSQLExpr c -> text c+ CaseSQLExpr cs el -> text "CASE" <+> vcat (map ppWhen cs)+ <+> text "ELSE" <+> ppSQLExpr el <+> text "END"+ where ppWhen (w,t) = text "WHEN" <+> ppSQLExpr w+ <+> text "THEN" <+> ppSQLExpr t+ ListSQLExpr es -> parens (commaH ppSQLExpr es)++commaH :: (a -> Doc) -> [a] -> Doc+commaH f = hcat . punctuate comma . map f++commaV :: (a -> Doc) -> [a] -> Doc+commaV f = vcat . punctuate comma . map f
+ Database/SQLite.hs view
@@ -0,0 +1,371 @@+--------------------------------------------------------------------+-- |+-- Module : Database.SQLite+-- Copyright : (c) Galois, Inc. 2007+-- License : BSD3+--+-- Maintainer: docserver-dev-team@galois.com+-- Stability : provisional+-- Portability: portable+--+-- A Haskell binding to the sqlite3 database.+-- See:+--+-- * <http://www.sqlite.org/>+--+-- for more information.+--+-- The api is documented at:+--+-- * <http://www.sqlite.org/c3ref/funclist.html>+--++module Database.SQLite+ ( module Database.SQLite.Base+ , module Database.SQLite.Types+ , module Database.SQL.Types++ -- * Opening and closing a database+ , openConnection+ , closeConnection++ -- * Executing SQL queries on the database+ , execStatement+ , execStatement_+ , execParamStatement+ , execParamStatement_++ -- * Basic insertion operations+ , insertRow+ , defineTable+ , defineTableOpt+ , getLastRowID+ , Row+ , Value(..)++ , addRegexpSupport+ , RegexpHandler+ , withPrim+ , SQLiteHandle()+ , newSQLiteHandle+ ) where++import Database.SQLite.Types+import Database.SQLite.Base+import Database.SQL.Types++import Foreign.Marshal+import Foreign.C+import Foreign.C.String (newCStringLen, peekCString)+import Foreign.Storable+import qualified Foreign.Concurrent as Conc+import Foreign.Ptr+import Foreign.ForeignPtr+import Data.List+import Data.Int+import Data.Char ( isDigit )+import Data.ByteString (ByteString, packCStringLen, useAsCStringLen)+import Data.ByteString.Unsafe (unsafePackCStringLen)+import Control.Monad ((<=<),when)+import qualified Codec.Binary.UTF8.String as UTF8++------------------------------------------------------------------------++newtype SQLiteHandle = SQLiteHandle (ForeignPtr ())++addSQLiteHandleFinalizer :: SQLiteHandle -> IO () -> IO ()+addSQLiteHandleFinalizer (SQLiteHandle h) = Conc.addForeignPtrFinalizer h++newSQLiteHandle :: SQLite -> IO SQLiteHandle+newSQLiteHandle h@(SQLite p) = SQLiteHandle `fmap` Conc.newForeignPtr p close+ where close = sqlite3_close h >> return ()++-- | Open a new database connection, whose name is given+-- by the 'dbName' argument. A sqlite3 handle is returned.+--+-- An exception is thrown if the database could not be opened.+--+openConnection :: String -> IO SQLiteHandle+openConnection dbName =+ alloca $ \ptr -> do+ st <- withCString dbName $ \ c_dbName ->+ sqlite3_open c_dbName ptr+ case st of+ 0 -> do db <- peek ptr+ newSQLiteHandle db+ _ -> fail ("openDatabase: failed to open " ++ show st)+++-- | Close a database connection.+-- Destroys the SQLite value associated with a database, closes+-- all open files relating to the database, and releases all resources.+--+closeConnection :: SQLiteHandle -> IO ()+closeConnection (SQLiteHandle h) = finalizeForeignPtr h++withPrim :: SQLiteHandle -> (SQLite -> IO a) -> IO a+withPrim (SQLiteHandle h) f = withForeignPtr h (f . SQLite)++------------------------------------------------------------------------+-- Adding data++type Row a = [(ColumnName,a)]++defineTableOpt :: SQLiteHandle -> Bool -> SQLTable -> IO (Maybe String)+defineTableOpt h check tab = execStatement_ h (createTable tab)+ where+ opt = if check then " IF NOT EXISTS " else ""+ createTable t =+ "CREATE TABLE " ++ opt ++ toSQLString (tabName t) +++ tupled (map toCols (tabColumns t)) ++ ";"++ toCols col =+ toSQLString (colName col) ++ " " ++ showType (colType col) +++ ' ':unwords (map showClause (colClauses col))+++-- | Define a new table, populated from 'tab' in the database.+--+defineTable :: SQLiteHandle -> SQLTable -> IO (Maybe String)+defineTable h tab = defineTableOpt h False tab++-- | Insert a row into the table 'tab'.+insertRow :: SQLiteHandle -> TableName -> Row String -> IO (Maybe String)+insertRow h tab cs = do+ let stmt = ("INSERT INTO " ++ tab +++ tupled (toVals fst) ++ " VALUES " +++ tupled (toVals (quote.snd)) ++ ";")+ execStatement_ h stmt+ where+ toVals f = map (toVal f) cs+ toVal f p = f p -- ($ f)++ quote "" = "''"+ quote nm@(x:_)+ | isDigit x = nm+ | otherwise = '\'':toSQLString nm ++ "'"+++-- | Return the rowid (as an Integer) of the most recent+-- successful INSERT into the database.+--+getLastRowID :: SQLiteHandle -> IO Integer+getLastRowID h = withPrim h $ \ p -> do+ v <- sqlite3_last_insert_rowid p+ return (fromIntegral v)++------------------------------------------------------------------------+-- Executing queries++data Value+ = Double Double+ | Int Int64+ | Text String+ | Blob ByteString+ | Null+ deriving Show++foreign import ccall "stdlib.h &free"+ p_free :: FunPtr (Ptr a -> IO ())+++-- | Sets the value of a parameter in a statement.+-- Perofrms UTF8 encoding.+bindValue :: SQLiteStmt -> String -> Value -> IO Status+bindValue stmt key value =+ withCString (UTF8.encodeString key) $ \ckey ->+ ensure (sqlite3_bind_parameter_index stmt ckey)+ (> 0) (return sQLITE_OK) $ \ix ->+ case value of+ Text txt ->+ do (cptr,len) <- newCStringLen (UTF8.encodeString txt)+ res <- sqlite3_bind_text stmt ix cptr (fromIntegral len) p_free+ when (res /= sQLITE_OK) (free cptr)+ return res+ Null -> sqlite3_bind_null stmt ix+ Int x -> sqlite3_bind_int64 stmt ix x+ Double x -> sqlite3_bind_double stmt ix x+ Blob x -> useAsCStringLen x $ \ (ptr,bytes) ->+ sqlite3_bind_blob stmt ix (castPtr ptr)+ (fromIntegral bytes) nullFunPtr+++-- | Called when we know that an error has occured.+to_error :: SQLite -> IO (Either String a)+to_error db = Left `fmap` (peekCString =<< sqlite3_errmsg db)++++-- | Prepare and execute a parameterized statment, ignoring the result.+-- See also 'execParamStatement'.+execParamStatement_ :: SQLiteHandle -> String -> [(String,Value)]+ -> IO (Maybe String)+execParamStatement_ db q ps =+ either Just (const Nothing) `fmap`+ (execParamStatement db q ps :: IO (Either String [[Row ()]]))++-- | Prepare and execute a parameterized statment.+-- Statement parameter names start with a colon (for example, @:col_id@).+-- Note that for the moment, column names should not contain \0+-- characters because that part of the column name will be ignored.+execParamStatement :: SQLiteResult a => SQLiteHandle -> String+ -> [(String,Value)] -> IO (Either String [[Row a]])+execParamStatement h query params = withPrim h $ \ db ->+ alloca $ \stmt_ptr ->+ alloca $ \pzTail ->+ let encoded = UTF8.encodeString query in+ withCString encoded $ \zSql -> do+ poke pzTail zSql+ prepare_loop db stmt_ptr pzTail++ where+ prepare_loop db stmt_ptr sqltxt_ptr = loop [] where+ loop xs =+ peek sqltxt_ptr >>= \ sqltxt ->+ ensure_ (peek sqltxt) (/= 0) (eReturn (reverse xs)) $++ ensure_ (sqlite3_prepare db sqltxt (-1) stmt_ptr sqltxt_ptr)+ (== sQLITE_OK) (to_error db) $++ ensure (peek stmt_ptr)+ (not . isNullStmt) (loop xs) $ \ stmt ->++ then_finalize db (recv_rows db stmt) stmt `ebind` \ x ->+ loop (x:xs)++ recv_rows db stmt =+ do mapM_ (uncurry $ bindValue stmt) params+ col_num <- sqlite3_column_count stmt+ let cols = [0..col_num-1]+ -- Note: column names should not contain \0 characters+ names <- mapM (peekCString <=< sqlite3_column_name stmt) cols+ let decoded_names = map UTF8.decodeString names+ get_rows db stmt cols decoded_names []++ get_rows db stmt cols col_names rows = do+ res <- sqlite3_step stmt+ if res == sQLITE_ROW+ then do+ txts <- mapM (get_sqlite_val stmt) cols+ let row = zip col_names txts+ get_rows db stmt cols col_names (row:rows)+ else if res == sQLITE_DONE+ then eReturn (reverse rows)+ else to_error db++ then_finalize db m stmt = do+ e <- m+ sqlite3_finalize stmt+ case e of+ Left _ -> to_error db+ Right r -> return (Right r)++-- | Evaluate the SQL statement specified by 'sqlStmt'+execStatement :: SQLiteResult a+ => SQLiteHandle -> String -> IO (Either String [[Row a]])+execStatement db s = execParamStatement db s []++-- | Returns an error, or 'Nothing' if everything was OK.+execStatement_ :: SQLiteHandle -> String -> IO (Maybe String)+execStatement_ h sqlStmt = withPrim h $ \ db ->+ withCString (UTF8.encodeString sqlStmt) $ \ c_sqlStmt ->+ sqlite3_exec db c_sqlStmt noCallback nullPtr nullPtr >>= \ st ->+ if st == sQLITE_OK+ then return Nothing+ else fmap Just . peekCString =<< sqlite3_errmsg db++tupled :: [String] -> String+tupled xs = "(" ++ concat (intersperse ", " xs) ++ ")"++infixl 1 `ebind`+ebind :: Monad m => m (Either e a) -> (a -> m (Either e b)) -> m (Either e b)+m `ebind` f = do x <- m+ case x of Left e -> return $ Left e+ Right r -> f r++eReturn :: Monad m => a -> m (Either e a)+eReturn x = return $ Right x++ensure :: Monad m => m a -> (a -> Bool) -> m b -> (a -> m b) -> m b+ensure m p t f = m >>= \ x -> if p x then f x else t++ensure_ :: Monad m => m a -> (a -> Bool) -> m b -> m b -> m b+ensure_ m p t f = ensure m p t (const f)++class SQLiteResult a where+ get_sqlite_val :: SQLiteStmt -> CInt -> IO a++instance SQLiteResult String where+ get_sqlite_val = get_text_val++instance SQLiteResult () where+ get_sqlite_val _ _ = return ()++instance SQLiteResult Value where+ get_sqlite_val = get_val++get_text_val :: SQLiteStmt -> CInt -> IO String+get_text_val stmt n =+ do ptr <- sqlite3_column_text stmt n+ bytes <- sqlite3_column_bytes stmt n+ str <- peekCStringLen (ptr,fromIntegral bytes)+ return (UTF8.decodeString str)++get_val :: SQLiteStmt -> CInt -> IO Value+get_val stmt n =+ do val <- sqlite3_column_value stmt n+ typ <- sqlite3_value_type val+ case () of+ _ | typ == sQLITE_NULL -> return Null+ | typ == sQLITE_INTEGER -> Int `fmap` sqlite3_value_int64 val+ | typ == sQLITE_FLOAT -> Double `fmap` sqlite3_value_double val+ | typ == sQLITE_TEXT ->+ fmap Text . peekCStringLen =<< sqlite3_value_cstringlen val+ | typ == sQLITE_BLOB ->+ do SQLiteBLOB ptr <- sqlite3_value_blob val+ bytes <- sqlite3_value_bytes val+ str <- packCStringLen (castPtr ptr, fromIntegral bytes)+ return $ Blob str+ | otherwise -> error "get_val: unknown type"++-- | This is the type of the function supported by the 'add_regexp_support'+-- function. The first argument is the regular expression to match with+-- and the second argument is the string to match. The result shall be+-- 'True' for successful match and 'False' otherwise.+type RegexpHandler = ByteString -> ByteString -> IO Bool++-- | This function registers a 'RegexpHandler' to be called when+-- REGEXP(regexp,str) is used in an SQL query.+addRegexpSupport :: SQLiteHandle -> RegexpHandler -> IO ()+addRegexpSupport h f =+ withCString "REGEXP" $ \ zFunctionName ->+ do xFunc <- mkStepHandler $ regexp_callback f+ withPrim h $ \ db ->+ sqlite3_create_function db zFunctionName 2 sQLITE_UTF8 nullPtr+ xFunc noCallback noCallback+ addSQLiteHandleFinalizer h (freeCallback xFunc)++-- | Internal function to marshall the C types into Haskell types to+-- make a RegexpHandler compatible with the Sqlite3 API.+regexp_callback :: RegexpHandler -> StepHandler+regexp_callback f ctx argc argv =+ if argc /= 2 then return_fail else+ do arg0 <- sqlite3_value_cstringlen =<< peek argv+ arg1 <- sqlite3_value_cstringlen =<< peekElemOff argv 1+ if isNullCStringLen arg0 || isNullCStringLen arg1 then return_fail else+ do regexp_str <- unsafePackCStringLen arg0+ str <- unsafePackCStringLen arg1+ res <- f regexp_str str+ if res then return_success else return_fail+ where+ return_fail = sqlite3_result_int ctx 0+ return_success = sqlite3_result_int ctx 1++isNullCStringLen :: CStringLen -> Bool+isNullCStringLen (p,_) = p == nullPtr++sqlite3_value_cstringlen :: SQLiteValue -> IO CStringLen+sqlite3_value_cstringlen v =+ do str <- sqlite3_value_text v+ len <- sqlite3_value_bytes v+ return (str, fromIntegral len)
+ Database/SQLite/Base.hs view
@@ -0,0 +1,708 @@+{-# LANGUAGE ForeignFunctionInterface #-}+--------------------------------------------------------------------+-- |+-- Module : Database.SQLite.Base+-- Copyright : (c) Galois, Inc. 2007+-- License : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability:+--+-- Bindings to the SQLite C interface.+--+-- The documentation for these functions is at:+--+-- * <http://www.sqlite.org/c3ref/funclist.html>+--+module Database.SQLite.Base+ ( sqlite3_libversion+ , sqlite3_libversion_number+ , sqlite3_close+ , sqlite3_exec+ , sqlite3_extended_result_codes+ , sqlite3_last_insert_rowid+ , sqlite3_changes+ , sqlite3_total_changes+ , sqlite3_interrupt+ , sqlite3_complete+ , sqlite3_complete16+ , sqlite3_busy_handler+ , sqlite3_busy_timeout+ , sqlite3_get_table+ , sqlite3_free_table+ , sqlite3_malloc+ , sqlite3_realloc+ , sqlite3_free+{-+ , sqlite3_memory_used+ , sqlite3_memory_highwater+-}+ , sqlite3_set_authorizer+ , sqlite3_trace+ , sqlite3_profile+ , sqlite3_progress_handler+ , sqlite3_open+ , sqlite3_open16+-- , sqlite3_open_v2+ , sqlite3_errcode+ , sqlite3_errmsg++ , sqlite3_prepare++ , sqlite3_bind_blob+ , sqlite3_bind_double+ , sqlite3_bind_int+ , sqlite3_bind_int64+ , sqlite3_bind_null+ , sqlite3_bind_text+ , sqlite3_bind_value+ , sqlite3_bind_zeroblob+ , sqlite3_bind_parameter_count+ , sqlite3_bind_parameter_name+ , sqlite3_bind_parameter_index++ , sqlite3_clear_bindings+ , sqlite3_column_count+ , sqlite3_column_name+ , sqlite3_column_decltype+ , sqlite3_step+ , sqlite3_data_count++ , sqlite3_column_blob+ , sqlite3_column_bytes+ , sqlite3_column_bytes16+ , sqlite3_column_double+ , sqlite3_column_int+ , sqlite3_column_int64+ , sqlite3_column_text+ , sqlite3_column_text16+ , sqlite3_column_type+ , sqlite3_column_value++ , sqlite3_finalize+ , sqlite3_create_function++ , sqlite3_value_blob+ , sqlite3_value_bytes+ , sqlite3_value_bytes16+ , sqlite3_value_double+ , sqlite3_value_int+ , sqlite3_value_int64+ , sqlite3_value_text+ , sqlite3_value_text16+ , sqlite3_value_text16le+ , sqlite3_value_text16be+ , sqlite3_value_numeric_type+ , sqlite3_value_type+ , sqlite3_aggregate_context+ , sqlite3_user_data++ , sqlite3_get_auxdata+ , sqlite3_set_auxdata++ , sqlite3_static_destructor+ , sqlite3_transient_destructor++ , sqlite3_result_blob+ , sqlite3_result_double+ , sqlite3_result_error+ , sqlite3_result_error16+ , sqlite3_result_error_toobig+{-+ , sqlite3_result_error_nomem+-}+ , sqlite3_result_int+ , sqlite3_result_int64+ , sqlite3_result_null+ , sqlite3_result_text+ , sqlite3_result_text16+ , sqlite3_result_text16le+ , sqlite3_result_text16be+ , sqlite3_result_value+ , sqlite3_result_zeroblob++ , sqlite3_create_collation+ , sqlite3_create_collation16+ , sqlite3_create_collation_v2+ , sqlite3_collation_needed+ , sqlite3_collation_needed16++ , sqlite3_sleep+ , sqlite3_set_temp_directory+ , sqlite3_get_temp_directory+ , sqlite3_get_autocommit+ , sqlite3_db_handle+ , sqlite3_commit_hook+ , sqlite3_rollback_hook+ , sqlite3_update_hook+ , sqlite3_enable_shared_cache+{-+ , sqlite3_release_memory+ , sqlite3_soft_heap_limit+-}++ , sqlite3_blob_open+ , sqlite3_blob_close+ , sqlite3_blob_bytes+ , sqlite3_blob_read+ , sqlite3_blob_write++ -- helpful callback constructors:+ , ExecHandler+ , FreeHandler+ , UpdateHook+ , FilterHandler+ , StepHandler+ , FinalizeContextHandler+ , CompareHandler+ , CollationHandler+ , CollationHandler16+ , mkExecHandler+ , mkFreeHandler+ , mkUpdateHook+ , mkFilterHandler+ , mkStepHandler+ , mkFinalizeContextHandler+ , mkCompareHandler+ , mkCollationHandler+ , mkCollationHandler16+ ) where++import Database.SQLite.Types++import Foreign.C+import Foreign.Ptr++-- the various callback function types and constructors for their+-- Haskell wrappers:++type ExecHandler+ = SQLiteCallbackUserData+ -> CInt+ -> Ptr CString+ -> Ptr CString+ -> IO Status++foreign import ccall "wrapper"+ mkExecHandler :: ExecHandler -> IO (SQLiteCallback ExecHandler)++type FreeHandler = SQLiteCallbackUserData -> IO ()++foreign import ccall "wrapper"+ mkFreeHandler :: FreeHandler -> IO (SQLiteCallback FreeHandler)++type UpdateHook+ = SQLiteCallbackUserData+ -> CInt+ -> CString+ -> CString+ -> SQLiteInt64 -> IO ()++foreign import ccall "wrapper"+ mkUpdateHook :: UpdateHook -> IO (SQLiteCallback UpdateHook)++type FilterHandler+ = SQLiteCallbackUserData+ -> IO Status++foreign import ccall "wrapper"+ mkFilterHandler :: FilterHandler -> IO (SQLiteCallback FilterHandler)++type FinalizeContextHandler = SQLiteContext -> IO ()++foreign import ccall "wrapper"+ mkFinalizeContextHandler+ :: FinalizeContextHandler+ -> IO (SQLiteCallback FinalizeContextHandler)++type StepHandler+ = SQLiteContext+ -> CInt+ -> Ptr SQLiteValue+ -> IO ()++foreign import ccall "wrapper"+ mkStepHandler :: StepHandler -> IO (SQLiteCallback StepHandler)++type CompareHandler+ = SQLiteCallbackUserData+ -> CInt+ -> Ptr ()+ -> CInt+ -> Ptr ()+ -> IO CInt++foreign import ccall "wrapper"+ mkCompareHandler :: CompareHandler -> IO (SQLiteCallback CompareHandler)++type CollationHandler+ = SQLiteCallbackUserData+ -> SQLite+ -> TextEncodeFlag+ -> CString+ -> IO ()++foreign import ccall "wrapper"+ mkCollationHandler :: CollationHandler -> IO (SQLiteCallback CollationHandler)++type CollationHandler16+ = SQLiteCallbackUserData+ -> SQLite+ -> TextEncodeFlag+ -> SQLiteUTF16+ -> IO ()++foreign import ccall "wrapper"+ mkCollationHandler16 :: CollationHandler16 -> IO (SQLiteCallback CollationHandler16)++-- Binding the main API:++foreign import ccall "sqlite3.h sqlite3_libversion" + sqlite3_libversion :: IO CString++foreign import ccall "sqlite3.h sqlite3_libversion_number" + sqlite3_libversion_number :: IO CString++foreign import ccall "sqlite3.h sqlite3_close"+ sqlite3_close :: SQLite -> IO Status++foreign import ccall "sqlite3.h sqlite3_exec"+ sqlite3_exec :: SQLite+ -> CString+ -> SQLiteCallback ExecHandler+ -> SQLiteCallbackUserData+ -> Ptr CString+ -> IO Status++foreign import ccall "sqlite3.h sqlite3_extended_result_codes"+ sqlite3_extended_result_codes :: SQLite -> Bool -> IO Status++foreign import ccall "sqlite3.h sqlite3_last_insert_rowid"+ sqlite3_last_insert_rowid :: SQLite -> IO SQLiteInt64++foreign import ccall "sqlite3.h sqlite3_changes"+ sqlite3_changes :: SQLite -> IO CInt++foreign import ccall "sqlite3.h sqlite3_total_changes"+ sqlite3_total_changes :: SQLite -> IO CInt++foreign import ccall "sqlite3.h sqlite3_interrupt"+ sqlite3_interrupt :: SQLite -> IO ()++foreign import ccall "sqlite3.h sqlite3_complete"+ sqlite3_complete :: CString -> IO Bool++foreign import ccall "sqlite3.h sqlite3_complete16"+ sqlite3_complete16 :: SQLiteUTF16 -> IO Bool++foreign import ccall "sqlite3.h sqlite3_busy_handler"+ sqlite3_busy_handler :: SQLite -> FunPtr (Ptr () -> CInt -> IO CInt) -> Ptr () -> IO Status++foreign import ccall "sqlite3.h sqlite3_busy_timeout"+ sqlite3_busy_timeout :: SQLite -> CInt -> IO Status++foreign import ccall "sqlite3.h sqlite3_get_table"+ sqlite3_get_table :: SQLite+ -> CString+ -> Ptr (Ptr CString)+ -> Ptr CInt+ -> Ptr CInt+ -> Ptr (Ptr CString)+ -> IO Status++foreign import ccall "sqlite3.h sqlite3_free_table"+ sqlite3_free_table :: Ptr (Ptr CString) -> IO ()++foreign import ccall "sqlite3.h sqlite3_malloc"+ sqlite3_malloc :: CInt -> IO (Ptr ())++foreign import ccall "sqlite3.h sqlite3_realloc"+ sqlite3_realloc :: Ptr () -> CInt -> IO (Ptr ())++foreign import ccall "sqlite3.h sqlite3_free"+ sqlite3_free :: Ptr () -> IO ()++{-+foreign import ccall "sqlite3.h sqlite3_memory_used"+ sqlite3_memory_used :: IO SQLiteInt64++foreign import ccall "sqlite3.h sqlite3_memory_highwater"+ sqlite3_memory_highwater :: CInt -> IO SQLiteInt64+-}++foreign import ccall "sqlite3.h sqlite3_set_authorizer"+ sqlite3_set_authorizer :: SQLite -> FunPtr (Ptr () -> CInt -> CString -> CString -> CString -> CString -> IO Status) -> Ptr () -> IO Status++foreign import ccall "sqlite3.h sqlite3_trace"+ sqlite3_trace :: SQLite -> FunPtr (Ptr () -> CString -> IO ()) -> Ptr () -> IO (Ptr ())++foreign import ccall "sqlite3.h sqlite3_profile"+ sqlite3_profile :: SQLite -> FunPtr (Ptr () -> CString -> SQLiteInt64 -> IO ()) -> Ptr () -> IO (Ptr ())++foreign import ccall "sqlite3.h sqlite3_progress_handler"+ sqlite3_progress_handler :: SQLite -> CInt -> FunPtr (Ptr () -> IO CInt) -> Ptr () -> IO ()++foreign import ccall "sqlite3.h sqlite3_open"+ sqlite3_open :: CString -> Ptr SQLite -> IO Status++foreign import ccall "sqlite3.h sqlite3_open16"+ sqlite3_open16 :: SQLiteUTF16 -> Ptr SQLite -> IO Status++{-+foreign import ccall "sqlite3.h sqlite3_open_v2"+ sqlite3_open_v2 :: CString -> Ptr SQLite -> OpenFlags -> CString -> IO Status+-}++foreign import ccall "sqlite3.h sqlite3_errcode"+ sqlite3_errcode :: SQLite -> IO Status++foreign import ccall "sqlite3.h sqlite3_errmsg"+ sqlite3_errmsg :: SQLite -> IO CString++foreign import ccall "sqlite3.h sqlite3_prepare_v2"+ sqlite3_prepare :: SQLite -> CString -> CInt -> Ptr SQLiteStmt -> Ptr CString -> IO Status++foreign import ccall "sqlite3.h sqlite3_bind_blob"+ sqlite3_bind_blob :: SQLiteStmt -> CInt -> Ptr () -> CInt -> FunPtr (Ptr () -> IO ()) -> IO Status++foreign import ccall "sqlite3.h sqlite3_bind_double"+ sqlite3_bind_double :: SQLiteStmt -> CInt -> Double -> IO Status++foreign import ccall "sqlite3.h sqlite3_bind_int"+ sqlite3_bind_int :: SQLiteStmt -> CInt -> CInt -> IO Status++foreign import ccall "sqlite3.h sqlite3_bind_int64"+ sqlite3_bind_int64 :: SQLiteStmt -> CInt -> SQLiteInt64 -> IO Status++foreign import ccall "sqlite3.h sqlite3_bind_null"+ sqlite3_bind_null :: SQLiteStmt -> CInt -> IO Status++foreign import ccall "sqlite3.h sqlite3_bind_text"+ sqlite3_bind_text :: SQLiteStmt -> CInt -> CString -> CInt -> FunPtr (Ptr () -> IO ()) -> IO Status++foreign import ccall "sqlite3.h sqlite3_bind_value"+ sqlite3_bind_value :: SQLiteStmt -> CInt -> SQLiteValue -> IO Status++foreign import ccall "sqlite3.h sqlite3_bind_zeroblob"+ sqlite3_bind_zeroblob :: SQLiteStmt -> CInt -> CInt -> IO Status++foreign import ccall "sqlite3.h sqlite3_bind_parameter_count"+ sqlite3_bind_parameter_count :: SQLiteStmt -> IO CInt++foreign import ccall "sqlite3.h sqlite3_bind_parameter_name"+ sqlite3_bind_parameter_name :: SQLiteStmt -> CInt -> IO CString++foreign import ccall "sqlite3.h sqlite3_bind_parameter_index"+ sqlite3_bind_parameter_index :: SQLiteStmt -> CString -> IO CInt++foreign import ccall "sqlite3.h sqlite3_clear_bindings"+ sqlite3_clear_bindings :: SQLiteStmt -> IO Status++foreign import ccall "sqlite3.h sqlite3_column_count"+ sqlite3_column_count :: SQLiteStmt -> IO CInt++foreign import ccall "sqlite3.h sqlite3_column_name"+ sqlite3_column_name :: SQLiteStmt -> CInt -> IO CString++{- Not compiled into the Windows version of the lib by default, hence leave out+ for now:+foreign import ccall "sqlite3.h sqlite3_column_database_name"+ sqlite3_column_database_name :: SQLiteStmt -> CInt -> IO CString++foreign import ccall "sqlite3.h sqlite3_column_table_name"+ sqlite3_column_table_name :: SQLiteStmt -> CInt -> IO CString++foreign import ccall "sqlite3.h sqlite3_column_origin_name"+ sqlite3_column_origin_name :: SQLiteStmt -> CInt -> IO CString+-}+foreign import ccall "sqlite3.h sqlite3_column_decltype"+ sqlite3_column_decltype :: SQLiteStmt -> CInt -> IO CString++foreign import ccall "sqlite3.h sqlite3_step"+ sqlite3_step :: SQLiteStmt -> IO Status++foreign import ccall "sqlite3.h sqlite3_data_count"+ sqlite3_data_count :: SQLiteStmt -> IO Status++foreign import ccall "sqlite3.h sqlite3_column_blob"+ sqlite3_column_blob :: SQLiteStmt -> CInt -> IO (Ptr ())++foreign import ccall "sqlite3.h sqlite3_column_bytes"+ sqlite3_column_bytes :: SQLiteStmt -> CInt -> IO CInt++foreign import ccall "sqlite3.h sqlite3_column_bytes16"+ sqlite3_column_bytes16 :: SQLiteStmt -> CInt -> IO CInt++foreign import ccall "sqlite3.h sqlite3_column_double"+ sqlite3_column_double :: SQLiteStmt -> CInt -> IO Double++foreign import ccall "sqlite3.h sqlite3_column_int"+ sqlite3_column_int :: SQLiteStmt -> CInt -> IO CInt++foreign import ccall "sqlite3.h sqlite3_column_int64"+ sqlite3_column_int64 :: SQLiteStmt -> CInt -> IO SQLiteInt64++foreign import ccall "sqlite3.h sqlite3_column_text"+ sqlite3_column_text :: SQLiteStmt -> CInt -> IO CString++foreign import ccall "sqlite3.h sqlite3_column_text16"+ sqlite3_column_text16 :: SQLiteStmt -> CInt -> IO SQLiteUTF16++foreign import ccall "sqlite3.h sqlite3_column_type"+ sqlite3_column_type :: SQLiteStmt -> CInt -> IO CInt++foreign import ccall "sqlite3.h sqlite3_column_value"+ sqlite3_column_value :: SQLiteStmt -> CInt -> IO SQLiteValue++foreign import ccall "sqlite3.h sqlite3_finalize"+ sqlite3_finalize :: SQLiteStmt -> IO Status++foreign import ccall "sqlite3.h sqlite3_create_function"+ sqlite3_create_function :: SQLite+ -> CString+ -> CInt+ -> TextEncodeFlag+ -> SQLiteCallbackUserData+ -> SQLiteCallback StepHandler+ -> SQLiteCallback StepHandler+ -> SQLiteCallback FinalizeContextHandler+ -> IO CInt++foreign import ccall "sqlite3.h sqlite3_value_blob"+ sqlite3_value_blob :: SQLiteValue -> IO SQLiteBLOB++foreign import ccall "sqlite3.h sqlite3_value_bytes"+ sqlite3_value_bytes :: SQLiteValue -> IO CInt++foreign import ccall "sqlite3.h sqlite3_value_bytes16"+ sqlite3_value_bytes16 :: SQLiteValue -> IO CInt++foreign import ccall "sqlite3.h sqlite3_value_double"+ sqlite3_value_double :: SQLiteValue -> IO Double++foreign import ccall "sqlite3.h sqlite3_value_int"+ sqlite3_value_int :: SQLiteValue -> IO CInt++foreign import ccall "sqlite3.h sqlite3_value_int64"+ sqlite3_value_int64 :: SQLiteValue -> IO SQLiteInt64++foreign import ccall "sqlite3.h sqlite3_value_text"+ sqlite3_value_text :: SQLiteValue -> IO CString++foreign import ccall "sqlite3.h sqlite3_value_text16"+ sqlite3_value_text16 :: SQLiteValue -> IO SQLiteUTF16++foreign import ccall "sqlite3.h sqlite3_value_text16le"+ sqlite3_value_text16le :: SQLiteValue -> IO SQLiteUTF16++foreign import ccall "sqlite3.h sqlite3_value_text16be"+ sqlite3_value_text16be :: SQLiteValue -> IO SQLiteUTF16++foreign import ccall "sqlite3.h sqlite3_value_numeric_type"+ sqlite3_value_numeric_type :: SQLiteValue -> IO CInt++foreign import ccall "sqlite3.h sqlite3_value_type"+ sqlite3_value_type :: SQLiteValue -> IO FundamentalDatatype++foreign import ccall "sqlite3.h sqlite3_aggregate_context"+ sqlite3_aggregate_context :: SQLiteContext -> CInt -> IO SQLiteContextBuffer++foreign import ccall "sqlite3.h sqlite3_user_data"+ sqlite3_user_data :: SQLiteContext -> IO (Ptr ())++foreign import ccall "sqlite3.h sqlite3_get_auxdata"+ sqlite3_get_auxdata :: SQLiteContext -> CInt -> IO (Ptr ())++foreign import ccall "sqlite3.h sqlite3_set_auxdata"+ sqlite3_set_auxdata :: SQLiteContext -> CInt -> Ptr () -> SQLiteCallback FreeHandler -> IO ()++foreign import ccall "sqlite3.h get_SQLITE_STATIC"+ sqlite3_static_destructor :: SQLiteCallback FreeHandler++foreign import ccall "sqlite3.h get_SQLITE_TRANSIENT"+ sqlite3_transient_destructor :: SQLiteCallback FreeHandler++foreign import ccall "sqlite3.h sqlite3_result_blob"+ sqlite3_result_blob :: SQLiteContext -> Ptr () -> CInt -> SQLiteCallback FreeHandler -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_double"+ sqlite3_result_double :: SQLiteContext -> Double -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_error"+ sqlite3_result_error :: SQLiteContext -> CString -> CInt -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_error16"+ sqlite3_result_error16 :: SQLiteContext -> SQLiteUTF16 -> CInt -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_error_toobig"+ sqlite3_result_error_toobig :: SQLiteContext -> IO ()++{-+foreign import ccall "sqlite3.h sqlite3_result_error_nomem"+ sqlite3_result_error_nomem :: SQLiteContext -> IO ()+-}++foreign import ccall "sqlite3.h sqlite3_result_int"+ sqlite3_result_int :: SQLiteContext -> CInt -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_int64"+ sqlite3_result_int64 :: SQLiteContext -> SQLiteInt64 -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_null"+ sqlite3_result_null :: SQLiteContext -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_text"+ sqlite3_result_text :: SQLiteContext+ -> CString+ -> CInt+ -> SQLiteCallback FreeHandler+ -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_text16"+ sqlite3_result_text16 :: SQLiteContext -> SQLiteUTF16 -> CInt+ -> SQLiteCallback FreeHandler+ -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_text16le"+ sqlite3_result_text16le :: SQLiteContext -> SQLiteUTF16 -> CInt+ -> SQLiteCallback FreeHandler -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_text16be"+ sqlite3_result_text16be :: SQLiteContext -> SQLiteUTF16 -> CInt+ -> SQLiteCallback FreeHandler -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_value"+ sqlite3_result_value :: SQLiteContext -> SQLiteValue -> IO ()++foreign import ccall "sqlite3.h sqlite3_result_zeroblob"+ sqlite3_result_zeroblob :: SQLiteContext -> CInt -> IO ()++foreign import ccall "sqlite3.h sqlite3_create_collation"+ sqlite3_create_collation + :: SQLite -> CString -> TextEncodeFlag+ -> SQLiteCallbackUserData+ -> SQLiteCallback CompareHandler+ -> IO Status++foreign import ccall "sqlite3.h sqlite3_create_collation16"+ sqlite3_create_collation16+ :: SQLite -> SQLiteUTF16 -> TextEncodeFlag+ -> SQLiteCallbackUserData+ -> SQLiteCallback CompareHandler+ -> IO Status++foreign import ccall "sqlite3.h sqlite3_create_collation_v2"+ sqlite3_create_collation_v2 :: SQLite -> CString -> TextEncodeFlag+ -> SQLiteCallbackUserData+ -> SQLiteCallback CompareHandler+ -> SQLiteCallback FreeHandler+ -> IO Status++foreign import ccall "sqlite3.h sqlite3_collation_needed"+ sqlite3_collation_needed :: SQLite -> SQLiteCallbackUserData+ -> SQLiteCallback CollationHandler+ -> IO Status++foreign import ccall "sqlite3.h sqlite3_collation_needed16"+ sqlite3_collation_needed16 :: SQLite -> SQLiteCallbackUserData+ -> SQLiteCallback CollationHandler16+ -> IO Status++{-+foreign import ccall "sqlite3.h sqlite3_key"+ sqlite3_key :: SQLite -> Ptr () -> CInt -> IO Status++foreign import ccall "sqlite3.h sqlite3_rekey"+ sqlite3_rekey :: SQLite -> Ptr () -> CInt -> IO Status+-}+foreign import ccall "sqlite3.h sqlite3_sleep"+ sqlite3_sleep :: CInt -> IO Status++foreign import ccall "sqlite3-local.h sqlite3_set_temp_directory"+ sqlite3_set_temp_directory :: CString -> IO ()++foreign import ccall "sqlite3-local.h sqlite3_get_temp_directory"+ sqlite3_get_temp_directory :: IO CString++foreign import ccall "sqlite3.h sqlite3_get_autocommit"+ sqlite3_get_autocommit :: SQLite -> IO Bool++foreign import ccall "sqlite3.h sqlite3_db_handle"+ sqlite3_db_handle :: SQLiteStmt -> IO SQLite++foreign import ccall "sqlite3.h sqlite3_commit_hook"+ sqlite3_commit_hook :: SQLite+ -> SQLiteCallback FilterHandler+ -> SQLiteCallbackUserData+ -> IO (SQLiteCallback FilterHandler)++foreign import ccall "sqlite3.h sqlite3_rollback_hook"+ sqlite3_rollback_hook :: SQLite+ -> SQLiteCallback FreeHandler+ -> SQLiteCallbackUserData+ -> IO (SQLiteCallback FreeHandler)++foreign import ccall "sqlite3.h sqlite3_update_hook"+ sqlite3_update_hook :: SQLite+ -> SQLiteCallback UpdateHook+ -> SQLiteCallbackUserData+ -> IO (SQLiteCallback FreeHandler)++foreign import ccall "sqlite3.h sqlite3_enable_shared_cache"+ sqlite3_enable_shared_cache :: CInt -> IO CInt++{-+foreign import ccall "sqlite3.h sqlite3_release_memory"+ sqlite3_release_memory :: CInt -> IO Status++foreign import ccall "sqlite3.h sqlite3_soft_heap_limit"+ sqlite3_soft_heap_limit :: CInt -> IO ()++foreign import ccall "sqlite3.h sqlite3_table_column_metadata"+ sqlite3_table_column_metadata + :: SQLite+ -> CString+ -> CString+ -> CString+ -> Ptr CString+ -> Ptr CString+ -> Ptr Bool+ -> Ptr Bool+ -> Ptr Bool+ -> IO Status++foreign import ccall "sqlite3.h sqlite3_load_extension"+ sqlite3_load_extension :: SQLite -> CString -> CString -> Ptr CString -> IO Status++foreign import ccall "sqlite3.h sqlite3_enable_load_extension"+ sqlite3_enable_load_extension :: SQLite -> CInt -> IO CInt++foreign import ccall "sqlite3.h sqlite3_auto_extension"+ sqlite3_auto_extension :: Ptr () -> IO Status++foreign import ccall "sqlite3.h sqlite3_reset_auto_extension"+ sqlite3_reset_auto_extension :: IO ()+-}+foreign import ccall "sqlite3.h sqlite3_blob_open"+ sqlite3_blob_open+ :: SQLite+ -> CString+ -> CString+ -> CString+ -> SQLiteInt64+ -> Bool+ -> Ptr SQLiteBLOB+ -> IO Status++foreign import ccall "sqlite3.h sqlite3_blob_close"+ sqlite3_blob_close :: SQLiteBLOB -> IO Status++foreign import ccall "sqlite3.h sqlite3_blob_bytes"+ sqlite3_blob_bytes :: SQLiteBLOB -> IO CInt++foreign import ccall "sqlite3.h sqlite3_blob_read"+ sqlite3_blob_read :: SQLiteBLOB -> Ptr () -> CInt -> CInt -> IO Status++foreign import ccall "sqlite3.h sqlite3_blob_write"+ sqlite3_blob_write :: SQLiteBLOB -> Ptr () -> CInt -> CInt -> IO Status
+ Database/SQLite/Types.hs view
@@ -0,0 +1,422 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+--------------------------------------------------------------------+-- |+-- Module : Database.SQLite.Types+-- Copyright : (c) Galois, Inc. 2007+-- License : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability: portable+--+-- Objects, types and constants used in the sqlite3 binding.+--+--------------------------------------------------------------------++module Database.SQLite.Types where++import Foreign.C+import Foreign.Ptr+import Foreign.Storable+import Data.Int+import Data.Word+import Data.Bits++type SQLiteInt64 = Int64+type SQLiteWord64 = Word64++------------------------------------------------------------------------+-- 'typed' pointers to various SQLite handles\/values.++-- | An open SQLite database object.+--+newtype SQLite = SQLite (Ptr ()) deriving Storable++-- | An instance of this object represent single SQL statements. This+-- object is variously known as a "prepared statement" or a "compiled+-- SQL statement" or simply as a "statement".+--+newtype SQLiteStmt = SQLiteStmt (Ptr ()) deriving Storable++-- | SQLite uses the sqlite3_value object to represent all values that+-- are or can be stored in a database table. SQLite uses dynamic typing+-- for the values it stores. Values stored in sqlite3_value objects can+-- be be integers, floating point values, strings, BLOBs, or NULL.+--+newtype SQLiteValue = SQLiteValue (Ptr ()) deriving Storable++-- | The context in which an SQL function executes is stored in an+-- sqlite3_context object. A pointer to an sqlite3_context object is+-- always first parameter to application-defined SQL functions.+--+newtype SQLiteContext = SQLiteContext (Ptr ()) deriving Storable++-- | A BLOB handle+newtype SQLiteBLOB = SQLiteBLOB (Ptr ()) deriving Storable++newtype SQLiteUTF16 = SQLiteUTF16 (Ptr ()) deriving Storable+newtype SQLiteContextBuffer = SQLiteContextBuffer (Ptr ()) deriving Storable+newtype SQLiteCallback a = SQLiteCallback (FunPtr a) deriving Storable++-- don't use it much, so leave it as a bare pointer.+type SQLiteCallbackUserData = Ptr ()++------------------------------------------------------------------------++-- | SQLite types+data SQLiteType+ = SQLiteInt+ | SQLiteFloat+ | SQLiteText+ | SQLiteBlob+ | SQLiteNull+ deriving ( Eq )++instance Enum SQLiteType where+ fromEnum e =+ case e of+ SQLiteInt -> 1+ SQLiteFloat -> 2+ SQLiteText -> 3+ SQLiteBlob -> 4+ SQLiteNull -> 5+ toEnum x =+ case x of+ 1 -> SQLiteInt+ 2 -> SQLiteFloat+ 3 -> SQLiteText+ 4 -> SQLiteBlob+ 5 -> SQLiteNull+ _ -> error ("toEnum{SQLiteType}: unknown type tag " ++ show x)++------------------------------------------------------------------------++type Status = Word32++-- | SQLite C status codes.+-- +-- * <http://www.sqlite.org/c3ref/c_abort.html>+-- +sQLITE_OK :: Status+sQLITE_OK = 0++-- error codes:+sQLITE_ERROR :: Status+sQLITE_ERROR = 1+sQLITE_INTERNAL :: Status+sQLITE_INTERNAL = 2+sQLITE_PERM :: Status+sQLITE_PERM = 3+sQLITE_ABORT :: Status+sQLITE_ABORT = 4+sQLITE_BUSY :: Status+sQLITE_BUSY = 5+sQLITE_LOCKED :: Status+sQLITE_LOCKED = 6+sQLITE_NOMEM :: Status+sQLITE_NOMEM = 7+sQLITE_READONLY :: Status+sQLITE_READONLY = 8+sQLITE_INTERRUPT :: Status+sQLITE_INTERRUPT = 9+sQLITE_IOERR :: Status+sQLITE_IOERR = 10+sQLITE_CORRUPT :: Status+sQLITE_CORRUPT = 11+sQLITE_NOTFOUND :: Status+sQLITE_NOTFOUND = 12+sQLITE_FULL :: Status+sQLITE_FULL = 13+sQLITE_CANTOPEN :: Status+sQLITE_CANTOPEN = 14+sQLITE_PROTOCOL :: Status+sQLITE_PROTOCOL = 15+sQLITE_EMPTY :: Status+sQLITE_EMPTY = 16+sQLITE_SCHEMA :: Status+sQLITE_SCHEMA = 17+sQLITE_TOOBIG :: Status+sQLITE_TOOBIG = 18+sQLITE_CONSTRAINT :: Status+sQLITE_CONSTRAINT = 19+sQLITE_MISMATCH :: Status+sQLITE_MISMATCH = 20+sQLITE_MISUSE :: Status+sQLITE_MISUSE = 21+sQLITE_NOLFS :: Status+sQLITE_NOLFS = 22+sQLITE_AUTH :: Status+sQLITE_AUTH = 23+sQLITE_FORMAT :: Status+sQLITE_FORMAT = 24+sQLITE_RANGE :: Status+sQLITE_RANGE = 25+sQLITE_NOTADB :: Status+sQLITE_NOTADB = 26+sQLITE_ROW :: Status+sQLITE_ROW = 100+sQLITE_DONE :: Status+sQLITE_DONE = 101++------------------------------------------------------------------------+-- | SQLite extended result codes:+--+-- * <http://www.sqlite.org/c3ref/c_ioerr_blocked.html>+--+sQLITE_IOERR_READ :: Status+sQLITE_IOERR_READ = sQLITE_IOERR + (1 `shiftL` 8)+sQLITE_IOERR_SHORT_READ :: Status+sQLITE_IOERR_SHORT_READ = sQLITE_IOERR + (2 `shiftL` 8)+sQLITE_IOERR_WRITE :: Status+sQLITE_IOERR_WRITE = sQLITE_IOERR + (3 `shiftL` 8)+sQLITE_IOERR_FSYNC :: Status+sQLITE_IOERR_FSYNC = sQLITE_IOERR + (4 `shiftL` 8)+sQLITE_IOERR_DIR_FSYNC :: Status+sQLITE_IOERR_DIR_FSYNC = sQLITE_IOERR + (5 `shiftL` 8)+sQLITE_IOERR_TRUNCATE :: Status+sQLITE_IOERR_TRUNCATE = sQLITE_IOERR + (6 `shiftL` 8)+sQLITE_IOERR_FSTAT :: Status+sQLITE_IOERR_FSTAT = sQLITE_IOERR + (7 `shiftL` 8)+sQLITE_IOERR_UNLOCK :: Status+sQLITE_IOERR_UNLOCK = sQLITE_IOERR + (8 `shiftL` 8)+sQLITE_IOERR_RDLOCK :: Status+sQLITE_IOERR_RDLOCK = sQLITE_IOERR + (9 `shiftL` 8)+sQLITE_IOERR_DELETE :: Status+sQLITE_IOERR_DELETE = sQLITE_IOERR + (10 `shiftL` 8)+sQLITE_IOERR_BLOCKED :: Status+sQLITE_IOERR_BLOCKED = sQLITE_IOERR + (11 `shiftL` 8)+sQLITE_IOERR_NOMEM :: Status+sQLITE_IOERR_NOMEM = sQLITE_IOERR + (12 `shiftL` 8)++------------------------------------------------------------------------++type OpenFlags = Word32++-- | SQLite flags for open operations.+--+-- * <http://www.sqlite.org/c3ref/c_open_create.html>+--+sQLITE_OPEN_READONLY :: OpenFlags+sQLITE_OPEN_READONLY = 0x00000001+sQLITE_OPEN_READWRITE :: OpenFlags+sQLITE_OPEN_READWRITE = 0x00000002+sQLITE_OPEN_CREATE :: OpenFlags+sQLITE_OPEN_CREATE = 0x00000004+sQLITE_OPEN_DELETEONCLOSE :: OpenFlags+sQLITE_OPEN_DELETEONCLOSE = 0x00000008+sQLITE_OPEN_EXCLUSIVE :: OpenFlags+sQLITE_OPEN_EXCLUSIVE = 0x00000010+sQLITE_OPEN_MAIN_DB :: OpenFlags+sQLITE_OPEN_MAIN_DB = 0x00000100+sQLITE_OPEN_TEMP_DB :: OpenFlags+sQLITE_OPEN_TEMP_DB = 0x00000200+sQLITE_OPEN_TRANSIENT_DB :: OpenFlags+sQLITE_OPEN_TRANSIENT_DB = 0x00000400+sQLITE_OPEN_MAIN_JOURNAL :: OpenFlags+sQLITE_OPEN_MAIN_JOURNAL = 0x00000800+sQLITE_OPEN_TEMP_JOURNAL :: OpenFlags+sQLITE_OPEN_TEMP_JOURNAL = 0x00001000+sQLITE_OPEN_SUBJOURNAL :: OpenFlags+sQLITE_OPEN_SUBJOURNAL = 0x00002000+sQLITE_OPEN_MASTER_JOURNAL :: OpenFlags+sQLITE_OPEN_MASTER_JOURNAL = 0x00004000++------------------------------------------------------------------------++type IOCap = Word32++-- | Device characteristics+--+-- * <http://www.sqlite.org/c3ref/c_iocap_atomic.html>+--+sQLITE_IOCAP_ATOMIC :: IOCap+sQLITE_IOCAP_ATOMIC = 0x00000001+sQLITE_IOCAP_ATOMIC512 :: IOCap+sQLITE_IOCAP_ATOMIC512 = 0x00000002+sQLITE_IOCAP_ATOMIC1K :: IOCap+sQLITE_IOCAP_ATOMIC1K = 0x00000004+sQLITE_IOCAP_ATOMIC2K :: IOCap+sQLITE_IOCAP_ATOMIC2K = 0x00000008+sQLITE_IOCAP_ATOMIC4K :: IOCap+sQLITE_IOCAP_ATOMIC4K = 0x00000010+sQLITE_IOCAP_ATOMIC8K :: IOCap+sQLITE_IOCAP_ATOMIC8K = 0x00000020+sQLITE_IOCAP_ATOMIC16K :: IOCap+sQLITE_IOCAP_ATOMIC16K = 0x00000040+sQLITE_IOCAP_ATOMIC32K :: IOCap+sQLITE_IOCAP_ATOMIC32K = 0x00000080+sQLITE_IOCAP_ATOMIC64K :: IOCap+sQLITE_IOCAP_ATOMIC64K = 0x00000100+sQLITE_IOCAP_SAFE_APPEND :: IOCap+sQLITE_IOCAP_SAFE_APPEND = 0x00000200+sQLITE_IOCAP_SEQUENTIAL :: IOCap+sQLITE_IOCAP_SEQUENTIAL = 0x00000400++------------------------------------------------------------------------++type LockFlag = Word32++-- | File locking levels+--+-- * <http://www.sqlite.org/c3ref/c_lock_exclusive.html>+--+sQLITE_LOCK_NONE :: LockFlag+sQLITE_LOCK_NONE = 0+sQLITE_LOCK_SHARED :: LockFlag+sQLITE_LOCK_SHARED = 1+sQLITE_LOCK_RESERVED :: LockFlag+sQLITE_LOCK_RESERVED = 2+sQLITE_LOCK_PENDING :: LockFlag+sQLITE_LOCK_PENDING = 3+sQLITE_LOCK_EXCLUSIVE :: LockFlag+sQLITE_LOCK_EXCLUSIVE = 4++------------------------------------------------------------------------++type SyncFlag = Word32++-- | Synchronization flags+--+-- * <http://www.sqlite.org/c3ref/c_sync_dataonly.html>+--+sQLITE_SYNC_NORMAL :: SyncFlag+sQLITE_SYNC_NORMAL = 0x00002+sQLITE_SYNC_FULL :: SyncFlag+sQLITE_SYNC_FULL = 0x00003+sQLITE_SYNC_DATAONLY:: SyncFlag+sQLITE_SYNC_DATAONLY = 0x00010++------------------------------------------------------------------------++type AccessFlag = Word32++-- | xAccess methods+--+-- * <http://www.sqlite.org/c3ref/c_access_exists.html>+--+sQLITE_ACCESS_EXISTS :: AccessFlag+sQLITE_ACCESS_EXISTS = 0+sQLITE_ACCESS_READWRITE :: AccessFlag+sQLITE_ACCESS_READWRITE = 1+sQLITE_ACCESS_READ :: AccessFlag+sQLITE_ACCESS_READ = 2++------------------------------------------------------------------------++type AuthCode = Word32++-- | Authorizer Action Codes+--+-- * <http://www.sqlite.org/c3ref/c_alter_table.html>+--+sQLITE_COPY :: AuthCode+sQLITE_COPY = 0 -- No longer used+sQLITE_CREATE_INDEX :: AuthCode+sQLITE_CREATE_INDEX = 1 -- Index Name Table Name+sQLITE_CREATE_TABLE :: AuthCode+sQLITE_CREATE_TABLE = 2 -- Table Name NULL+sQLITE_CREATE_TEMP_INDEX :: AuthCode+sQLITE_CREATE_TEMP_INDEX = 3 -- Index Name Table Name+sQLITE_CREATE_TEMP_TABLE :: AuthCode+sQLITE_CREATE_TEMP_TABLE = 4 -- Table Name NULL+sQLITE_CREATE_TEMP_TRIGGER :: AuthCode+sQLITE_CREATE_TEMP_TRIGGER = 5 -- Trigger Name Table Name+sQLITE_CREATE_TEMP_VIEW :: AuthCode+sQLITE_CREATE_TEMP_VIEW = 6 -- View Name NULL+sQLITE_CREATE_TRIGGER :: AuthCode+sQLITE_CREATE_TRIGGER = 7 -- Trigger Name Table Name+sQLITE_CREATE_VIEW :: AuthCode+sQLITE_CREATE_VIEW = 8 -- View Name NULL+sQLITE_DELETE :: AuthCode+sQLITE_DELETE = 9 -- Table Name NULL+sQLITE_DROP_INDEX :: AuthCode+sQLITE_DROP_INDEX = 10 -- Index Name Table Name+sQLITE_DROP_TABLE :: AuthCode+sQLITE_DROP_TABLE = 11 -- Table Name NULL+sQLITE_DROP_TEMP_INDEX :: AuthCode+sQLITE_DROP_TEMP_INDEX = 12 -- Index Name Table Name+sQLITE_DROP_TEMP_TABLE :: AuthCode+sQLITE_DROP_TEMP_TABLE = 13 -- Table Name NULL+sQLITE_DROP_TEMP_TRIGGER :: AuthCode+sQLITE_DROP_TEMP_TRIGGER = 14 -- Trigger Name Table Name+sQLITE_DROP_TEMP_VIEW :: AuthCode+sQLITE_DROP_TEMP_VIEW = 15 -- View Name NULL+sQLITE_DROP_TRIGGER :: AuthCode+sQLITE_DROP_TRIGGER = 16 -- Trigger Name Table Name+sQLITE_DROP_VIEW :: AuthCode+sQLITE_DROP_VIEW = 17 -- View Name NULL+sQLITE_INSERT :: AuthCode+sQLITE_INSERT = 18 -- Table Name NULL+sQLITE_PRAGMA :: AuthCode+sQLITE_PRAGMA = 19 -- Pragma Name 1st arg or NULL+sQLITE_READ :: AuthCode+sQLITE_READ = 20 -- Table Name Column Name+sQLITE_SELECT :: AuthCode+sQLITE_SELECT = 21 -- NULL NULL+sQLITE_TRANSACTION :: AuthCode+sQLITE_TRANSACTION = 22 -- NULL NULL+sQLITE_UPDATE :: AuthCode+sQLITE_UPDATE = 23 -- Table Name Column Name+sQLITE_ATTACH :: AuthCode+sQLITE_ATTACH = 24 -- Filename NULL+sQLITE_DETACH :: AuthCode+sQLITE_DETACH = 25 -- Database Name NULL+sQLITE_ALTER_TABLE :: AuthCode+sQLITE_ALTER_TABLE = 26 -- Database Name Table Name+sQLITE_REINDEX :: AuthCode+sQLITE_REINDEX = 27 -- Index Name NULL+sQLITE_ANALYZE :: AuthCode+sQLITE_ANALYZE = 28 -- Table Name NULL+sQLITE_CREATE_VTABLE :: AuthCode+sQLITE_CREATE_VTABLE = 29 -- Table Name Module Name+sQLITE_DROP_VTABLE :: AuthCode+sQLITE_DROP_VTABLE = 30 -- Table Name Module Name+sQLITE_FUNCTION :: AuthCode+sQLITE_FUNCTION = 31 -- Function Name NULL++------------------------------------------------------------------------++type TextEncodeFlag = CInt++-- | Text encodings+--+-- * <http://www.sqlite.org/c3ref/c_any.html>+--+sQLITE_UTF8 :: TextEncodeFlag+sQLITE_UTF8 = 1+sQLITE_UTF16LE :: TextEncodeFlag+sQLITE_UTF16LE = 2+sQLITE_UTF16BE :: TextEncodeFlag+sQLITE_UTF16BE = 3+sQLITE_UTF16 :: TextEncodeFlag+sQLITE_UTF16 = 4+sQLITE_ANY :: TextEncodeFlag+sQLITE_ANY = 5+sQLITE_UTF16_ALIGNED :: TextEncodeFlag+sQLITE_UTF16_ALIGNED = 8++type FundamentalDatatype = CInt++-- | Fundamental datatypes+--+-- * <http://www.sqlite.org/c3ref/c_blob.html>+--+sQLITE_INTEGER :: FundamentalDatatype+sQLITE_INTEGER = 1+sQLITE_FLOAT :: FundamentalDatatype+sQLITE_FLOAT = 2+sQLITE_BLOB :: FundamentalDatatype+sQLITE_BLOB = 4+sQLITE_NULL :: FundamentalDatatype+sQLITE_NULL = 5+sQLITE_TEXT :: FundamentalDatatype+sQLITE_TEXT = 3++isNullStmt :: SQLiteStmt -> Bool+isNullStmt (SQLiteStmt p) = p == nullPtr++noCallback :: SQLiteCallback a+noCallback = SQLiteCallback nullFunPtr++freeCallback :: SQLiteCallback a -> IO ()+freeCallback (SQLiteCallback c) = freeHaskellFunPtr c
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Galois Inc, 2007++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ README view
@@ -0,0 +1,6 @@+sqlite3 bindings for Haskell.++The configuration of this package isn't automatic on Windows+platforms, you'll have to manually move sqlite.buildinfo away before+renaming sqlite.buildinfo.win32 as sqlite.buildinfo, followed by+tweaking the paths in there to fit your local environment.
+ Setup.hs view
@@ -0,0 +1,7 @@+module Main where + +import Distribution.Simple + + +main :: IO () +main = defaultMainWithHooks defaultUserHooks
+ cbits/sqlite3-local.c view
@@ -0,0 +1,27 @@+#include "sqlite3.h" +#include "sqlite3-local.h" +#include <stdlib.h> +#include <string.h> + +void +sqlite3_set_temp_directory(char* x) +{ + sqlite3_temp_directory = (char*)sqlite3_malloc(strlen(x)+1); + if (sqlite3_temp_directory) { + strcpy(sqlite3_temp_directory,x); + } +} + +char * +sqlite3_get_temp_directory(void) +{ + return sqlite3_temp_directory; +} + +sqlite3_destructor_type +get_SQLITE_STATIC() +{ return SQLITE_STATIC; } + +sqlite3_destructor_type +get_SQLITE_TRANSIENT() +{ return SQLITE_TRANSIENT; }
+ configure view
@@ -0,0 +1,18 @@+#!/bin/sh+#+#+UNAME=uname+case `${UNAME} -a` in+ *MINGW* | *CYGWIN* )+ echo "Windows platform... using .buildinfo.win32"+ cp sqlite.buildinfo.win32 sqlite.buildinfo+ ;;+ *)+ # subst standard header path variables+ if test -n "$CPPFLAGS" ; then+ echo "Found CPPFLAGS in environment: '$CPPFLAGS'"+ sed 's,@CPPFLAGS@,'"$CPPFLAGS"',g' < sqlite.buildinfo.unix > sqlite.buildinfo+ fi+ ;;+esac+
+ include/sqlite3-local.h view
@@ -0,0 +1,11 @@+#ifndef __SQLITE3_LOCAL_H+#define __SQLITE3_LOCAL_H+#include "sqlite3.h"++extern void sqlite3_set_temp_directory(char* x);+extern char *sqlite3_get_temp_directory();++extern sqlite3_destructor_type get_SQLITE_STATIC();+extern sqlite3_destructor_type get_SQLITE_TRANSIENT();++#endif
+ sqlite.buildinfo.unix view
@@ -0,0 +1,3 @@+-- Should you have a custom include path for sqlite, edit the next two lines:+Ghc-options: -optc@CPPFLAGS@+Cc-options: @CPPFLAGS@
+ sqlite.buildinfo.win32 view
@@ -0,0 +1,3 @@+-- Should you have a custom include path for sqlite, edit the next two lines:+Ghc-options: -optc-Ic:/src/sqlite-3.5.1 +Cc-options: -Ic:/src/sqlite-3.5.1
+ sqlite.cabal view
@@ -0,0 +1,56 @@+Name: sqlite+Version: 0.4.1+Synopsis: Haskell binding to sqlite3+Description:+ Haskell binding to sqlite3 <http://sqlite.org/>.+ .+License: BSD3+License-file: LICENSE+Author: Galois Inc+Maintainer: Don Stewart+Copyright:+ Copyright (c) 2007-8, Galois Inc+Category: Database+cabal-version: >= 1.2+build-type: Configure++-- Cheating here, including the tests/ .cabal ++-- files in the parent (so as to dist them as one.)+extra-source-files:+ README configure+ include/sqlite3-local.h+ sqlite.buildinfo.unix sqlite.buildinfo.win32+ tests/configure tests/Main.hs tests/Setup.hs+ tests/sqlite-tests.cabal+ tests/test.db tests/sqlite-tests.buildinfo.unix+ tests/sqlite-tests.buildinfo.win32+extra-tmp-files:+ sqlite.buildinfo++flag builtin-sqlite3+ default: False+ description: Compile sqlite3 as a part of the library.++library+ Build-depends: base, pretty, utf8-string, bytestring, time, directory+ Extensions: ForeignFunctionInterface, GeneralizedNewtypeDeriving,+ TypeSynonymInstances+ Ghc-options: -Wall+ Cc-options: -Wall+ Include-dirs: include+ Includes: sqlite3-local.h+ C-Sources: cbits/sqlite3-local.c++ if flag(builtin-sqlite3)+ Include-dirs: sqlite3.5+ Includes: sqlite3.5+ C-Sources: sqlite3.5/sqlite3.c+ else+ Extra-Libraries: sqlite3++ Exposed-modules:+ Database.SQLite,+ Database.SQLite.Base,+ Database.SQLite.Types,+ Database.SQL+ Database.SQL.Types
+ sqlite3.5/sqlite3.c view
file too large to diff
+ tests/Main.hs view
@@ -0,0 +1,42 @@+module Main where++import Database.SQLite++newTable :: TableName -> Table SQLType+newTable tName = + Table { tabName = tName+ , tabColumns = + [ Column { colName = "id"+ , colType = SQLInt NORMAL False False+ , colClauses = [PrimaryKey True]+ }+ , Column { colName = "name"+ , colType = SQLVarChar 200+ , colClauses = [IsNullable False]+ }+ , Column { colName = "age"+ , colType = SQLVarChar 200+ , colClauses = [IsNullable True]+ }+ ]+ , tabConstraints = []+ }++main :: IO ()+main = do+ let dbFile = "test.db"+ let ign act = + catch (act >> return ()) + (\ err -> putStrLn ("Error (but ignoring) -- " ++ show err) >> return ())+ h <- openConnection dbFile+ ign $ defineTable h (newTable "names")+ ign $ insertRow h "Poststed" [("Postnr", "4278"),("Poststed", "Veakrossen")]+ ls <- execStatement h "SELECT * FROM Poststed WHERE PostNr=4276;"+ print ls+ ign $ insertRow h "names" [("id", "1"),("name", "foo"), ("age", "30")]+ ls <- execStatement h "SELECT * FROM names;"+ print ls+ ls <- execStatement h "SELECT * FROM names where id=1;"+ print ls+ closeConnection h+
+ tests/Setup.hs view
@@ -0,0 +1,7 @@+module Main where + +import Distribution.Simple + + +main :: IO () +main = defaultMainWithHooks defaultUserHooks
+ tests/configure view
@@ -0,0 +1,15 @@+#!/bin/sh+#+#+UNAME=uname+case `${UNAME} -a` in+ *MINGW* | *CYGWIN* )+ echo "Windows platform... using .buildinfo.win32"+ cp sqlite-tests.buildinfo.win32 sqlite-tests.buildinfo+ ;;+ *)+ echo "UNIXy platform... using .buildinfo.unix"+ cp sqlite-tests.buildinfo.unix sqlite-tests.buildinfo+ ;;+esac+
+ tests/sqlite-tests.buildinfo.unix view
@@ -0,0 +1,1 @@+ghc-options: -L/usr/lib
+ tests/sqlite-tests.buildinfo.win32 view
@@ -0,0 +1,1 @@+ghc-options: -Lc:/src/sqlite-3.5.1/
+ tests/sqlite-tests.cabal view
@@ -0,0 +1,20 @@+name: sqlite-tests +cabal-version: >= 1.2.0 +version: 0.1 + +flag new-base { + description: Build with new smaller base library + default: False +} + +executable sqlite-test { + build-depends: base, sqlite + if flag(new-base) { + build-depends: base >= 2.1 + } else { + build-depends: base == 2.0 || == 2.1.1 + } + + main-is: Main.hs + ghc-options: -Wall -fglasgow-exts -lsqlite3 +}
+ tests/test.db view
binary file changed (absent → 5120 bytes)