htoolkit-cvs — HToolkit CVS commit messages

[htoolkit-cvs] HSQL/SQLite3 SQLite3.cabal,1.1,1.2

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/SQLite3
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5345/SQLite3

Modified Files:
	SQLite3.cabal 
Log Message:
Update version numbers


Index: SQLite3.cabal
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/SQLite3/SQLite3.cabal,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** SQLite3.cabal	16 Jun 2005 19:27:09 -0000	1.1
--- SQLite3.cabal	17 Jun 2005 15:44:00 -0000	1.2
***************
*** 1,4 ****
  name:		 hsql-sqlite3
! version:	 1.5
  license:	 BSD3
  author:		 Krasimir Angelov <kr....@gm...>
--- 1,4 ----
  name:		 hsql-sqlite3
! version:	 1.0
  license:	 BSD3
  author:		 Krasimir Angelov <kr....@gm...>

[htoolkit-cvs] HSQL/MySQL MySQL.cabal,1.2,1.3

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/MySQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5345/MySQL

Modified Files:
	MySQL.cabal 
Log Message:
Update version numbers


Index: MySQL.cabal
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/MySQL/MySQL.cabal,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** MySQL.cabal	17 Jun 2005 09:02:30 -0000	1.2
--- MySQL.cabal	17 Jun 2005 15:44:00 -0000	1.3
***************
*** 1,4 ****
  name:		 hsql-mysql
! version:	 1.5
  license:	 BSD3
  author:		 Krasimir Angelov <kr....@gm...>
--- 1,4 ----
  name:		 hsql-mysql
! version:	 1.6
  license:	 BSD3
  author:		 Krasimir Angelov <kr....@gm...>

[htoolkit-cvs] HSQL/PostgreSQL PostgreSQL.cabal,1.1,1.2

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/PostgreSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5345/PostgreSQL

Modified Files:
	PostgreSQL.cabal 
Log Message:
Update version numbers


Index: PostgreSQL.cabal
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/PostgreSQL/PostgreSQL.cabal,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** PostgreSQL.cabal	17 Jun 2005 06:47:07 -0000	1.1
--- PostgreSQL.cabal	17 Jun 2005 15:44:00 -0000	1.2
***************
*** 1,4 ****
  name:		 hsql-postgresql
! version:	 1.5
  license:	 BSD3
  author:		 Krasimir Angelov <kr....@gm...>
--- 1,4 ----
  name:		 hsql-postgresql
! version:	 1.6
  license:	 BSD3
  author:		 Krasimir Angelov <kr....@gm...>

[htoolkit-cvs] HSQL INSTALL,1.1,1.2

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3050/HSQL

Modified Files:
	INSTALL 
Log Message:
Wibble


Index: INSTALL
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/INSTALL,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** INSTALL	17 Jun 2005 15:35:39 -0000	1.1
--- INSTALL	17 Jun 2005 15:39:09 -0000	1.2
***************
*** 17,21 ****
  MSI (Microsoft Installer) | hsql-msi
  
! The Cabal manual have detailed instructions about package building and installation.
  The basic steps are:
  
--- 17,21 ----
  MSI (Microsoft Installer) | hsql-msi
  
! The Cabal manual has detailed instructions about package building and installation.
  The basic steps are:
  

[htoolkit-cvs] HSQL INSTALL,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1065

Added Files:
	INSTALL 
Log Message:
Add INSTALL instructions


--- NEW FILE: INSTALL ---
Building
~~~~~~~~

HSQL uses Cabal build system. There is one base package called 'hsql' and multiple
database specific packages in single bundle. The base package contains all functions 
and types which are common for all database frontends. First you have to build the base
package and after that only these frontend packages which you are interested in.
The supported databases and the corresponding packages are:

Database frontend         | Cabal package
-------------------------------------------
ODBC                      | hsql-odbc
MySQL                     | hsql-mysql
PostgreSQL                | hsql-postgresql
SQLite                    | hsql-sqlite
SQLite3 (SQLite >= 3.0)   | hsql-sqlite3
MSI (Microsoft Installer) | hsql-msi

The Cabal manual have detailed instructions about package building and installation.
The basic steps are:

$ runghc Setup.lhs configure
$ runghc Setup.lhs build
$ runghc Setup.lhs install

Note: Cabal-1.0.1 has a bug. If the <package>.cabal or <package>.buildinfo has any directories
in extra-lib-dirs then they are ignored from install command. This might be a problem for MySQL 
and PostgreSQL. The work-around is to edit manually .installed-pkg-config after install step.
You have to update the library-dirs field and to register the package again using:

$ ghc-pkg update .installed-pkg-config


Windows specific
~~~~~~~~~~~~~~~~

Under Unix/Linux the configurations options for SQLite, PostgreSQL and MySQL are retrieved
using pkg-config, pg_config and mysql_config tools. Usually these tools aren't available
under Windows. Windows users may have to setup the include and library directories manually.
You can use Setup.lhs as usual from Command Prompt or cygwin:

C:\HSQL\'frontend'> runghc Setup.lhs configure

The configure step will create 'frontend'.buildinfo file in the current directory. You have
to open this file and to fill in the right paths and library names. After that you can
build and install the package as usual.

[htoolkit-cvs] HSQL/src HSQL.hsc,1.17,NONE

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3133/src

Removed Files:
	HSQL.hsc 
Log Message:
Remove the old HSQL files


--- HSQL.hsc DELETED ---

[htoolkit-cvs] HSQL Makefile,1.17,NONE config.guess,1.1,NONE config.mk.in,1.4,NONE config.sub,1.1,NONE configure.ac,1.19,NONE hsql.pkg.in,1.4,NONE install-sh,1.1,NONE

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3133

Removed Files:
	Makefile config.guess config.mk.in config.sub configure.ac 
	hsql.pkg.in install-sh 
Log Message:
Remove the old HSQL files


--- Makefile DELETED ---

--- config.guess DELETED ---

--- config.mk.in DELETED ---

--- config.sub DELETED ---

--- configure.ac DELETED ---

--- hsql.pkg.in DELETED ---

--- install-sh DELETED ---

[htoolkit-cvs] HSQL/src/HSQL HsMySQL.h,1.1,NONE HsODBC.c,1.1,NONE HsODBC.h,1.3,NONE MySQL.hsc,1.7,NONE ODBC.hsc,1.13,NONE PostgreSQL.hsc,1.10,NONE SQLite.hsc,1.3,NONE Types.hs,1.7,NONE

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/src/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3133/src/HSQL

Removed Files:
	HsMySQL.h HsODBC.c HsODBC.h MySQL.hsc ODBC.hsc PostgreSQL.hsc 
	SQLite.hsc Types.hs 
Log Message:
Remove the old HSQL files


--- HsMySQL.h DELETED ---

--- HsODBC.c DELETED ---

--- HsODBC.h DELETED ---

--- MySQL.hsc DELETED ---

--- ODBC.hsc DELETED ---

--- PostgreSQL.hsc DELETED ---

--- SQLite.hsc DELETED ---

--- Types.hs DELETED ---

[htoolkit-cvs] HSQL/MSI/Database/HSQL MSI.hsc,1.2,1.3

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/MSI/Database/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv857/Database/HSQL

Modified Files:
	MSI.hsc 
Log Message:
Fixed error handling


Index: MSI.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/MSI/Database/HSQL/MSI.hsc,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** MSI.hsc	17 Jun 2005 14:29:24 -0000	1.2
--- MSI.hsc	17 Jun 2005 14:32:54 -0000	1.3
***************
*** 36,40 ****
    withCString dest   $ \cdest   ->
    alloca             $ \phandle -> do
!     msiOpenDatabase csource cdest phandle >>= checkResult 0
      hDatabase <- peek phandle
      refFalse <- newMVar False
--- 36,40 ----
    withCString dest   $ \cdest   ->
    alloca             $ \phandle -> do
!     msiOpenDatabase csource cdest phandle >>= checkResult
      hDatabase <- peek phandle
      refFalse <- newMVar False
***************
*** 54,59 ****
      disconnect :: MSIHANDLE -> IO ()
      disconnect hDatabase = do
!       msiDatabaseCommit hDatabase >>= checkResult hDatabase
!       msiCloseHandle hDatabase >>= checkResult hDatabase
  
      execute :: MSIHANDLE -> String -> IO ()
--- 54,59 ----
      disconnect :: MSIHANDLE -> IO ()
      disconnect hDatabase = do
!       msiDatabaseCommit hDatabase >>= checkResult
!       msiCloseHandle hDatabase >>= checkResult
  
      execute :: MSIHANDLE -> String -> IO ()
***************
*** 61,68 ****
        withCString query $ \cquery  ->
        alloca            $ \phandle -> do
!         msiDatabaseOpenView hDatabase cquery phandle >>= checkResult hDatabase
          hView <- peek phandle
!         msiViewExecute hView 0 >>= checkResult hDatabase
!         msiCloseHandle hView >>= checkResult hDatabase
  
      col_buffer_size = 1024
--- 61,68 ----
        withCString query $ \cquery  ->
        alloca            $ \phandle -> do
!         msiDatabaseOpenView hDatabase cquery phandle >>= checkResult
          hView <- peek phandle
!         msiViewExecute hView 0 >>= checkResult
!         msiCloseHandle hView >>= checkResult
  
      col_buffer_size = 1024
***************
*** 72,78 ****
        withCString query $ \cquery  ->
        alloca            $ \phandle -> do
!         msiDatabaseOpenView hDatabase cquery phandle >>= checkResult hDatabase
          hView <- peek phandle
!         msiViewExecute hView 0 >>= checkResult hDatabase
          fields <- getFields hView
          refFalse <- newMVar False
--- 72,78 ----
        withCString query $ \cquery  ->
        alloca            $ \phandle -> do
!         msiDatabaseOpenView hDatabase cquery phandle >>= checkResult
          hView <- peek phandle
!         msiViewExecute hView 0 >>= checkResult
          fields <- getFields hView
          refFalse <- newMVar False
***************
*** 91,96 ****
            alloca $ \phNamesRecord ->
            alloca $ \phTypesRecord -> do
!             msiViewGetColumnInfo hView 0 phNamesRecord >>= checkResult hView
!             msiViewGetColumnInfo hView 1 phTypesRecord >>= checkResult hView
              hNamesRecord <- peek phNamesRecord
              hTypesRecord <- peek phTypesRecord
--- 91,96 ----
            alloca $ \phNamesRecord ->
            alloca $ \phTypesRecord -> do
!             msiViewGetColumnInfo hView 0 phNamesRecord >>= checkResult
!             msiViewGetColumnInfo hView 1 phTypesRecord >>= checkResult
              hNamesRecord <- peek phNamesRecord
              hTypesRecord <- peek phTypesRecord
***************
*** 104,111 ****
                alloca                      $ \plen -> do
                  poke plen (fromIntegral col_buffer_size)
!                 msiRecordGetString hNamesRecord n buffer plen >>= checkResult hNamesRecord
                  name <- peekCString buffer
                  poke plen (fromIntegral col_buffer_size)
!                 msiRecordGetString hTypesRecord n buffer plen >>= checkResult hTypesRecord
                  typ <- peekCString buffer
                  fieldDefs <- loop (n+1) count hNamesRecord hTypesRecord
--- 104,111 ----
                alloca                      $ \plen -> do
                  poke plen (fromIntegral col_buffer_size)
!                 msiRecordGetString hNamesRecord n buffer plen >>= checkResult
                  name <- peekCString buffer
                  poke plen (fromIntegral col_buffer_size)
!                 msiRecordGetString hTypesRecord n buffer plen >>= checkResult
                  typ <- peekCString buffer
                  fieldDefs <- loop (n+1) count hNamesRecord hTypesRecord
***************
*** 132,138 ****
        withCString query $ \cquery  ->
        alloca            $ \phandle -> do
!         msiDatabaseOpenView hDatabase cquery phandle >>= checkResult hDatabase
          hView <- peek phandle
!         msiViewExecute hView 0 >>= checkResult hDatabase
          loop hView
        where
--- 132,138 ----
        withCString query $ \cquery  ->
        alloca            $ \phandle -> do
!         msiDatabaseOpenView hDatabase cquery phandle >>= checkResult
          hView <- peek phandle
!         msiViewExecute hView 0 >>= checkResult
          loop hView
        where
***************
*** 146,158 ****
  	      then do msiCloseHandle hView
  	              return []
! 	      else do checkResult hView res
  	              hRecord <- peek phRecord
  	              name <- allocaBytes col_buffer_size $ \buffer ->
  		              alloca                      $ \plen -> do
  		                poke plen (fromIntegral col_buffer_size)
! 		                msiRecordGetString hRecord 1 buffer plen >>= checkResult hRecord
  		                len <- peek plen
  		                peekCStringLen (buffer,fromIntegral len)
! 	              msiCloseHandle hRecord >>= checkResult hRecord
  	              names <- loop hView
                        return (name:names)
--- 146,158 ----
  	      then do msiCloseHandle hView
  	              return []
! 	      else do checkResult res
  	              hRecord <- peek phRecord
  	              name <- allocaBytes col_buffer_size $ \buffer ->
  		              alloca                      $ \plen -> do
  		                poke plen (fromIntegral col_buffer_size)
! 		                msiRecordGetString hRecord 1 buffer plen >>= checkResult
  		                len <- peek plen
  		                peekCStringLen (buffer,fromIntegral len)
! 	              msiCloseHandle hRecord >>= checkResult
  	              names <- loop hView
                        return (name:names)
***************
*** 162,168 ****
        withCString query $ \cquery  ->
        alloca            $ \phandle -> do
!         msiDatabaseOpenView hDatabase cquery phandle >>= checkResult hDatabase
          hView <- peek phandle
!         msiViewExecute hView 0 >>= checkResult hDatabase
          loop hView
        where
--- 162,168 ----
        withCString query $ \cquery  ->
        alloca            $ \phandle -> do
!         msiDatabaseOpenView hDatabase cquery phandle >>= checkResult
          hView <- peek phandle
!         msiViewExecute hView 0 >>= checkResult
          loop hView
        where
***************
*** 176,188 ****
  	      then do msiCloseHandle hView
  	              return []
! 	      else do checkResult hView res
  	              hRecord <- peek phRecord
  	              name <- allocaBytes col_buffer_size $ \buffer ->
  		              alloca                      $ \plen -> do
  		                poke plen (fromIntegral col_buffer_size)
! 		                msiRecordGetString hRecord 1 buffer plen >>= checkResult hRecord
  		                len <- peek plen
  		                peekCStringLen (buffer,fromIntegral len)
! 	              msiCloseHandle hRecord >>= checkResult hRecord
  	              columns <- loop hView
                        return ((name, SqlText, False):columns)
--- 176,188 ----
  	      then do msiCloseHandle hView
  	              return []
! 	      else do checkResult res
  	              hRecord <- peek phRecord
  	              name <- allocaBytes col_buffer_size $ \buffer ->
  		              alloca                      $ \plen -> do
  		                poke plen (fromIntegral col_buffer_size)
! 		                msiRecordGetString hRecord 1 buffer plen >>= checkResult
  		                len <- peek plen
  		                peekCStringLen (buffer,fromIntegral len)
! 	              msiCloseHandle hRecord >>= checkResult
  	              columns <- loop hView
                        return ((name, SqlText, False):columns)
***************
*** 196,200 ****
        hRecord <- readIORef refRecord
        unless (hRecord == 0) $
!         (msiCloseHandle hRecord >>= checkResult hRecord)
        alloca $ \phRecord -> do
          res <- msiViewFetch hView phRecord
--- 196,200 ----
        hRecord <- readIORef refRecord
        unless (hRecord == 0) $
!         (msiCloseHandle hRecord >>= checkResult)
        alloca $ \phRecord -> do
          res <- msiViewFetch hView phRecord
***************
*** 202,206 ****
            then do writeIORef refRecord 0
                    return False
!           else do checkResult hView res
                    hRecord <- peek phRecord
                    writeIORef refRecord hRecord
--- 202,206 ----
            then do writeIORef refRecord 0
                    return False
!           else do checkResult res
                    hRecord <- peek phRecord
                    writeIORef refRecord hRecord
***************
*** 213,217 ****
          poke plen (fromIntegral col_buffer_size)
          hRecord <- readIORef refRecord
!         msiRecordGetString hRecord (fromIntegral colNumber+1) buffer plen >>= checkResult hRecord
          len <- peek plen
          f sqlType buffer (fromIntegral len)
--- 213,217 ----
          poke plen (fromIntegral col_buffer_size)
          hRecord <- readIORef refRecord
!         msiRecordGetString hRecord (fromIntegral colNumber+1) buffer plen >>= checkResult
          len <- peek plen
          f sqlType buffer (fromIntegral len)
***************
*** 219,226 ****
      closeStatement :: MSIHANDLE -> IORef MSIHANDLE -> IO ()
      closeStatement hView refRecord = do
!       msiCloseHandle hView >>= checkResult 0
        hRecord <- readIORef refRecord
        unless (hRecord == 0) $
!         (msiCloseHandle hRecord >>= checkResult 0)
  
  foreign import stdcall "MsiOpenDatabaseA" msiOpenDatabase :: CString -> CString -> Ptr MSIHANDLE -> IO Word32
--- 219,226 ----
      closeStatement :: MSIHANDLE -> IORef MSIHANDLE -> IO ()
      closeStatement hView refRecord = do
!       msiCloseHandle hView >>= checkResult
        hRecord <- readIORef refRecord
        unless (hRecord == 0) $
!         (msiCloseHandle hRecord >>= checkResult)
  
  foreign import stdcall "MsiOpenDatabaseA" msiOpenDatabase :: CString -> CString -> Ptr MSIHANDLE -> IO Word32
***************
*** 237,248 ****
  foreign import stdcall "FormatMessageA" formatMessage :: Word32 -> Ptr () -> Word32 -> Word32 -> CString -> Word32 -> Ptr () -> IO Word32
  
! checkResult :: MSIHANDLE -> Word32 -> IO ()
! checkResult hDatabase err
    | err == 0  = return ()
    | otherwise = do
-       hRecord <- msiGetLastErrorRecord
        msg <- allocaBytes 1024 $ \cmsg -> do
                  formatMessage (#const FORMAT_MESSAGE_FROM_SYSTEM) nullPtr err 0 cmsg 1024 nullPtr
                  peekCString cmsg
-       msiCloseHandle hRecord
        throwDyn (SqlError "" (fromIntegral err) msg)
--- 237,246 ----
  foreign import stdcall "FormatMessageA" formatMessage :: Word32 -> Ptr () -> Word32 -> Word32 -> CString -> Word32 -> Ptr () -> IO Word32
  
! checkResult :: Word32 -> IO ()
! checkResult err
    | err == 0  = return ()
    | otherwise = do
        msg <- allocaBytes 1024 $ \cmsg -> do
                  formatMessage (#const FORMAT_MESSAGE_FROM_SYSTEM) nullPtr err 0 cmsg 1024 nullPtr
                  peekCString cmsg
        throwDyn (SqlError "" (fromIntegral err) msg)

[htoolkit-cvs] HSQL/MSI/Database/HSQL MSI.hsc,1.1,1.2

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/MSI/Database/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31030/Database/HSQL

Modified Files:
	MSI.hsc 
Log Message:
Implementation for tables and describe functions


Index: MSI.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/MSI/Database/HSQL/MSI.hsc,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** MSI.hsc	14 Jun 2005 14:16:31 -0000	1.1
--- MSI.hsc	17 Jun 2005 14:29:24 -0000	1.2
***************
*** 43,48 ****
      			, connExecute    = execute hDatabase
      			, connQuery      = query connection hDatabase
!     			, connTables     = tables connection hDatabase
!     			, connDescribe   = describe connection hDatabase
      			, connBeginTransaction = beginTransaction hDatabase
      			, connCommitTransaction = commitTransaction hDatabase
--- 43,48 ----
      			, connExecute    = execute hDatabase
      			, connQuery      = query connection hDatabase
!     			, connTables     = tables hDatabase
!     			, connDescribe   = describe hDatabase
      			, connBeginTransaction = beginTransaction hDatabase
      			, connCommitTransaction = commitTransaction hDatabase
***************
*** 66,69 ****
--- 66,71 ----
          msiCloseHandle hView >>= checkResult hDatabase
  
+     col_buffer_size = 1024
+ 
      query :: Connection -> MSIHANDLE -> String -> IO Statement
      query connection hDatabase query =
***************
*** 99,108 ****
            | n > count = return []
            | otherwise = 
!               allocaBytes 1024 $ \buffer ->
!               alloca           $ \plen -> do
!                 poke plen 1024
                  msiRecordGetString hNamesRecord n buffer plen >>= checkResult hNamesRecord
                  name <- peekCString buffer
!                 poke plen 1024
                  msiRecordGetString hTypesRecord n buffer plen >>= checkResult hTypesRecord
                  typ <- peekCString buffer
--- 101,110 ----
            | n > count = return []
            | otherwise = 
!               allocaBytes col_buffer_size $ \buffer ->
!               alloca                      $ \plen -> do
!                 poke plen (fromIntegral col_buffer_size)
                  msiRecordGetString hNamesRecord n buffer plen >>= checkResult hNamesRecord
                  name <- peekCString buffer
!                 poke plen (fromIntegral col_buffer_size)
                  msiRecordGetString hTypesRecord n buffer plen >>= checkResult hTypesRecord
                  typ <- peekCString buffer
***************
*** 126,135 ****
  			         0 -> SqlBLOB
  
!     tables :: Connection -> MSIHANDLE -> IO [String]
!     tables connection hDatabase = undefined
  
-     describe :: Connection -> MSIHANDLE -> String -> IO [FieldDef]
-     describe connection hDatabase tableName = undefined
-     
      beginTransaction hDatabase = throwDyn SqlUnsupportedOperation
      commitTransaction hDatabase = throwDyn SqlUnsupportedOperation
--- 128,191 ----
  			         0 -> SqlBLOB
  
!     tables :: MSIHANDLE -> IO [String]
!     tables hDatabase =
!       withCString query $ \cquery  ->
!       alloca            $ \phandle -> do
!         msiDatabaseOpenView hDatabase cquery phandle >>= checkResult hDatabase
!         hView <- peek phandle
!         msiViewExecute hView 0 >>= checkResult hDatabase
!         loop hView
!       where
!         query = "select Name from _Tables"
!         
!         loop :: MSIHANDLE -> IO [String]
! 	loop hView = do
! 	  alloca $ \phRecord -> do
! 	    res <- msiViewFetch hView phRecord
! 	    if res == 259
! 	      then do msiCloseHandle hView
! 	              return []
! 	      else do checkResult hView res
! 	              hRecord <- peek phRecord
! 	              name <- allocaBytes col_buffer_size $ \buffer ->
! 		              alloca                      $ \plen -> do
! 		                poke plen (fromIntegral col_buffer_size)
! 		                msiRecordGetString hRecord 1 buffer plen >>= checkResult hRecord
! 		                len <- peek plen
! 		                peekCStringLen (buffer,fromIntegral len)
! 	              msiCloseHandle hRecord >>= checkResult hRecord
! 	              names <- loop hView
!                       return (name:names)
! 
!     describe :: MSIHANDLE -> String -> IO [FieldDef]
!     describe hDatabase tableName =
!       withCString query $ \cquery  ->
!       alloca            $ \phandle -> do
!         msiDatabaseOpenView hDatabase cquery phandle >>= checkResult hDatabase
!         hView <- peek phandle
!         msiViewExecute hView 0 >>= checkResult hDatabase
!         loop hView
!       where
!         query = "select Name from _Columns where `Table`="++toSqlValue tableName
!         
!         loop :: MSIHANDLE -> IO [FieldDef]
! 	loop hView = do
! 	  alloca $ \phRecord -> do
! 	    res <- msiViewFetch hView phRecord
! 	    if res == 259
! 	      then do msiCloseHandle hView
! 	              return []
! 	      else do checkResult hView res
! 	              hRecord <- peek phRecord
! 	              name <- allocaBytes col_buffer_size $ \buffer ->
! 		              alloca                      $ \plen -> do
! 		                poke plen (fromIntegral col_buffer_size)
! 		                msiRecordGetString hRecord 1 buffer plen >>= checkResult hRecord
! 		                len <- peek plen
! 		                peekCStringLen (buffer,fromIntegral len)
! 	              msiCloseHandle hRecord >>= checkResult hRecord
! 	              columns <- loop hView
!                       return ((name, SqlText, False):columns)
  
      beginTransaction hDatabase = throwDyn SqlUnsupportedOperation
      commitTransaction hDatabase = throwDyn SqlUnsupportedOperation
***************
*** 153,159 ****
      getColValue :: IORef MSIHANDLE -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
      getColValue refRecord colNumber (name,sqlType,nullable) f =
!       allocaBytes 1024 $ \buffer ->
!       alloca           $ \plen -> do
!         poke plen 1024
          hRecord <- readIORef refRecord
          msiRecordGetString hRecord (fromIntegral colNumber+1) buffer plen >>= checkResult hRecord
--- 209,215 ----
      getColValue :: IORef MSIHANDLE -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
      getColValue refRecord colNumber (name,sqlType,nullable) f =
!       allocaBytes col_buffer_size $ \buffer ->
!       alloca                      $ \plen -> do
!         poke plen (fromIntegral col_buffer_size)
          hRecord <- readIORef refRecord
          msiRecordGetString hRecord (fromIntegral colNumber+1) buffer plen >>= checkResult hRecord

[htoolkit-cvs] HSQL/mingw32lib msi.def,1.1,1.2

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/mingw32lib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24187/mingw32lib

Modified Files:
	msi.def 
Log Message:
Update


Index: msi.def
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/mingw32lib/msi.def,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** msi.def	10 Jun 2005 08:26:24 -0000	1.1
--- msi.def	17 Jun 2005 13:17:58 -0000	1.2
***************
*** 178,184 ****
     MsiRecordClearData
     MsiRecordDataSize
!    MsiRecordGetFieldCount
     MsiRecordGetInteger
!    MsiRecordGetStringA
     MsiRecordGetStringW
     MsiRecordIsNull
--- 178,184 ----
     MsiRecordClearData
     MsiRecordDataSize
!    MsiRecordGetFieldCount@4
     MsiRecordGetInteger
!    MsiRecordGetStringA@16
     MsiRecordGetStringW
     MsiRecordIsNull
***************
*** 233,238 ****
     MsiViewClose
     MsiViewExecute@8
!    MsiViewFetch
!    MsiViewGetColumnInfo
     MsiViewGetErrorA
     MsiViewGetErrorW
--- 233,238 ----
     MsiViewClose
     MsiViewExecute@8
!    MsiViewFetch@8
!    MsiViewGetColumnInfo@12
     MsiViewGetErrorA
     MsiViewGetErrorW

[htoolkit-cvs] HSQL/MySQL MySQL.cabal,1.1,1.2

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/MySQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26477/MySQL

Modified Files:
	MySQL.cabal 
Log Message:
FIX


Index: MySQL.cabal
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/MySQL/MySQL.cabal,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** MySQL.cabal	17 Jun 2005 08:43:51 -0000	1.1
--- MySQL.cabal	17 Jun 2005 09:02:30 -0000	1.2
***************
*** 8,10 ****
  build-depends: 	 base, hsql
  extensions:      ForeignFunctionInterface, CPP
! include-dirs: Database/HSQL
\ No newline at end of file
--- 8,10 ----
  build-depends: 	 base, hsql
  extensions:      ForeignFunctionInterface, CPP
! cc-options: -IDatabase/HSQL
\ No newline at end of file

[htoolkit-cvs] HSQL/MySQL/Database/HSQL HsMySQL.h,NONE,1.1 MySQL.hsc,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/MySQL/Database/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16963/MySQL/Database/HSQL

Added Files:
	HsMySQL.h MySQL.hsc 
Log Message:
MySQL driver


--- NEW FILE: HsMySQL.h ---
#ifndef HsMySQL
#define HsMySQL

#if defined(_WIN32_)
#include <windows.h>
#endif

#include <mysql.h>

#endif

--- NEW FILE: MySQL.hsc ---
-----------------------------------------------------------------------------------------
{-| Module      :  Database.HSQL.MySQL
    Copyright   :  (c) Krasimir Angelov 2003
    License     :  BSD-style

    Maintainer  :  ka2...@ya...
    Stability   :  provisional
    Portability :  portable

    The module provides interface to MySQL database
-}
-----------------------------------------------------------------------------------------

#include <config.h>

module Database.HSQL.MySQL(connect, module Database.HSQL) where

import Database.HSQL
import Database.HSQL.Types
import Data.Dynamic
import Data.Bits
import Data.Char
import Foreign
import Foreign.C
import Control.Monad(when,unless)
import Control.Exception (throwDyn, finally)
import Control.Concurrent.MVar
import System.Time
import System.IO.Unsafe
import Text.ParserCombinators.ReadP
import Text.Read

#include <HsMySQL.h>

type MYSQL = Ptr ()
type MYSQL_RES = Ptr ()
type MYSQL_FIELD = Ptr ()
type MYSQL_ROW = Ptr CString
type MYSQL_LENGTHS = Ptr CULong

#if defined(_WIN32_)
#let CALLCONV = "stdcall"
#else
#let CALLCONV = "ccall"
#endif

foreign import #{CALLCONV} "HsMySQL.h mysql_init" mysql_init :: MYSQL -> IO MYSQL
foreign import #{CALLCONV} "HsMySQL.h mysql_real_connect" mysql_real_connect :: MYSQL -> CString -> CString -> CString -> CString -> CInt -> CString -> CInt -> IO MYSQL
foreign import #{CALLCONV} "HsMySQL.h mysql_close" mysql_close :: MYSQL -> IO ()
foreign import #{CALLCONV} "HsMySQL.h mysql_errno" mysql_errno :: MYSQL -> IO CInt
foreign import #{CALLCONV} "HsMySQL.h mysql_error" mysql_error :: MYSQL -> IO CString
foreign import #{CALLCONV} "HsMySQL.h mysql_query" mysql_query :: MYSQL -> CString -> IO CInt
foreign import #{CALLCONV} "HsMySQL.h mysql_use_result" mysql_use_result :: MYSQL -> IO MYSQL_RES
foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_field" mysql_fetch_field :: MYSQL_RES -> IO MYSQL_FIELD
foreign import #{CALLCONV} "HsMySQL.h mysql_free_result" mysql_free_result :: MYSQL_RES -> IO ()
foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_row" mysql_fetch_row :: MYSQL_RES -> IO MYSQL_ROW
foreign import #{CALLCONV} "HsMySQL.h mysql_fetch_lengths" mysql_fetch_lengths :: MYSQL_RES -> IO MYSQL_LENGTHS
foreign import #{CALLCONV} "HsMySQL.h mysql_list_tables" mysql_list_tables :: MYSQL -> CString -> IO MYSQL_RES
foreign import #{CALLCONV} "HsMySQL.h mysql_list_fields" mysql_list_fields :: MYSQL -> CString -> CString -> IO MYSQL_RES
foreign import #{CALLCONV} "HsMySQL.h mysql_next_result" mysql_next_result :: MYSQL -> IO CInt



-----------------------------------------------------------------------------------------
-- routines for handling exceptions
-----------------------------------------------------------------------------------------

handleSqlError :: MYSQL -> IO a
handleSqlError pMYSQL = do
	errno <- mysql_errno pMYSQL
	errMsg <- mysql_error pMYSQL >>= peekCString
	throwDyn (SqlError "" (fromIntegral errno) errMsg)

-----------------------------------------------------------------------------------------
-- Connect/Disconnect
-----------------------------------------------------------------------------------------

-- | Makes a new connection to the database server.
connect :: String   -- ^ Server name
        -> String   -- ^ Database name
        -> String   -- ^ User identifier
        -> String   -- ^ Authentication string (password)
        -> IO Connection
connect server database user authentication = do
	pMYSQL <- mysql_init nullPtr
	pServer <- newCString server
	pDatabase <- newCString database
	pUser <- newCString user
	pAuthentication <- newCString authentication
	res <- mysql_real_connect pMYSQL pServer pUser pAuthentication pDatabase 0 nullPtr (#const CLIENT_MULTI_STATEMENTS)
	free pServer
	free pDatabase
	free pUser
	free pAuthentication
	when (res == nullPtr) (handleSqlError pMYSQL)
	refFalse <- newMVar False
	let connection = Connection
		{ connDisconnect = mysql_close pMYSQL
		, connExecute = execute pMYSQL
		, connQuery = query connection pMYSQL
		, connTables = tables connection pMYSQL
		, connDescribe = describe connection pMYSQL
		, connBeginTransaction = execute pMYSQL "begin"
		, connCommitTransaction = execute pMYSQL "commit"
		, connRollbackTransaction = execute pMYSQL "rollback"
		, connClosed = refFalse
		}
	return connection
	where
		execute :: MYSQL -> String -> IO ()
		execute pMYSQL query = do
			res <- withCString query (mysql_query pMYSQL)
			when (res /= 0) (handleSqlError pMYSQL)

		withStatement :: Connection -> MYSQL -> MYSQL_RES -> IO Statement
		withStatement conn pMYSQL pRes = do
			currRow  <- newMVar (nullPtr, nullPtr)
			refFalse <- newMVar False
			if (pRes == nullPtr)
			  then do
				errno <- mysql_errno pMYSQL
				when (errno /= 0) (handleSqlError pMYSQL)
				return (Statement
			              { stmtConn   = conn
			              , stmtClose  = return ()
			              , stmtFetch  = fetch pRes currRow
			              , stmtGetCol = getColValue currRow
			              , stmtFields = []
			              , stmtClosed = refFalse
			              })
			  else do
				fieldDefs <- getFieldDefs pRes
				return (Statement
			              { stmtConn   = conn
			              , stmtClose  = mysql_free_result pRes
			              , stmtFetch  = fetch pRes currRow
			              , stmtGetCol = getColValue currRow
			              , stmtFields = fieldDefs
			              , stmtClosed = refFalse
			              })
			where
				getFieldDefs pRes = do
					pField <- mysql_fetch_field pRes
					if pField == nullPtr
					  then return []
					  else do
						name <- (#peek MYSQL_FIELD, name) pField >>= peekCString
						dataType <-  (#peek MYSQL_FIELD, type) pField
						columnSize <-  (#peek MYSQL_FIELD, length) pField
						flags <-  (#peek MYSQL_FIELD, flags) pField
						decimalDigits <-  (#peek MYSQL_FIELD, decimals) pField
						let sqlType = mkSqlType dataType columnSize decimalDigits
						defs <- getFieldDefs pRes
						return ((name,sqlType,((flags :: Int) .&. (#const NOT_NULL_FLAG)) == 0):defs)

				mkSqlType :: Int -> Int -> Int -> SqlType
				mkSqlType (#const FIELD_TYPE_STRING)     size _	   = SqlChar size
				mkSqlType (#const FIELD_TYPE_VAR_STRING) size _    = SqlVarChar size
				mkSqlType (#const FIELD_TYPE_DECIMAL)    size prec = SqlNumeric size prec
				mkSqlType (#const FIELD_TYPE_SHORT)      _    _    = SqlSmallInt
				mkSqlType (#const FIELD_TYPE_INT24)      _    _    = SqlMedInt
				mkSqlType (#const FIELD_TYPE_LONG)       _    _    = SqlInteger
				mkSqlType (#const FIELD_TYPE_FLOAT)      _    _	   = SqlReal
				mkSqlType (#const FIELD_TYPE_DOUBLE)     _    _    = SqlDouble
				mkSqlType (#const FIELD_TYPE_TINY)       _    _    = SqlTinyInt
				mkSqlType (#const FIELD_TYPE_LONGLONG)   _    _    = SqlBigInt
				mkSqlType (#const FIELD_TYPE_DATE)       _    _    = SqlDate
				mkSqlType (#const FIELD_TYPE_TIME)       _    _    = SqlTime
				mkSqlType (#const FIELD_TYPE_TIMESTAMP)  _    _    = SqlTimeStamp
				mkSqlType (#const FIELD_TYPE_DATETIME)   _    _    = SqlDateTime
				mkSqlType (#const FIELD_TYPE_YEAR)       _    _    = SqlYear
				mkSqlType (#const FIELD_TYPE_BLOB)       _    _    = SqlBLOB
				mkSqlType (#const FIELD_TYPE_SET)        _    _    = SqlSET
				mkSqlType (#const FIELD_TYPE_ENUM)       _    _    = SqlENUM
				mkSqlType tp                             _    _    = SqlUnknown tp

		query :: Connection -> MYSQL -> String -> IO Statement
		query conn pMYSQL query = do
			res <- withCString query (mysql_query pMYSQL)
			when (res /= 0) (handleSqlError pMYSQL)
			pRes <- getFirstResult pMYSQL
			withStatement conn pMYSQL pRes
			where
			  getFirstResult :: MYSQL -> IO MYSQL_RES
			  getFirstResult pMYSQL = do
			    pRes <- mysql_use_result pMYSQL
			    if pRes == nullPtr
			      then do
			        res <- mysql_next_result pMYSQL
			        if res == 0
			          then getFirstResult pMYSQL
			          else return nullPtr
			      else return pRes

		fetch :: MYSQL_RES -> MVar (MYSQL_ROW, MYSQL_LENGTHS) -> IO Bool
		fetch pRes currRow
			| pRes == nullPtr = return False
			| otherwise = modifyMVar currRow $ \(pRow, pLengths) -> do
				pRow <- mysql_fetch_row pRes
				pLengths <- mysql_fetch_lengths pRes
				return ((pRow, pLengths), pRow /= nullPtr)

		getColValue :: MVar (MYSQL_ROW, MYSQL_LENGTHS) -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
		getColValue currRow colNumber (name,sqlType,nullable) f = do
			(row, lengths) <- readMVar currRow
			pValue <- peekElemOff row colNumber
			len <- fmap fromIntegral (peekElemOff lengths colNumber)
			if pValue == nullPtr
			  then return Nothing
			  else do
				mv <- f sqlType pValue len
				case mv of
					Just v  -> return (Just v)
					Nothing -> throwDyn (SqlBadTypeCast name sqlType)

		tables :: Connection -> MYSQL -> IO [String]
		tables conn pMYSQL = do
			pRes <- mysql_list_tables pMYSQL nullPtr
			stmt <- withStatement conn pMYSQL pRes
			-- SQLTables returns:
			-- Column name     #   Type
			-- Tables_in_xx      0   VARCHAR
			collectRows (\stmt -> do
				mb_v <- stmtGetCol stmt 0 ("Tables", SqlVarChar 0, False) fromNonNullSqlCStringLen
				return (case mb_v of { Nothing -> ""; Just a -> a })) stmt

		describe :: Connection -> MYSQL -> String -> IO [FieldDef]
		describe conn pMYSQL table = do
			pRes <- withCString table (\table -> mysql_list_fields pMYSQL table nullPtr)
			stmt <- withStatement conn pMYSQL pRes
			return (getFieldsTypes stmt)

[htoolkit-cvs] HSQL/MySQL MySQL.cabal,NONE,1.1 Setup.lhs,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/MySQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16963/MySQL

Added Files:
	MySQL.cabal Setup.lhs 
Log Message:
MySQL driver


--- NEW FILE: MySQL.cabal ---
name:		 hsql-mysql
version:	 1.5
license:	 BSD3
author:		 Krasimir Angelov <kr....@gm...>
category:	 Database
description: 	 MySQL driver for HSQL.
exposed-modules: Database.HSQL.MySQL
build-depends: 	 base, hsql
extensions:      ForeignFunctionInterface, CPP
include-dirs: Database/HSQL
--- NEW FILE: Setup.lhs ---
#!/usr/bin/runghc

\begin{code}
import Data.Maybe(fromMaybe)
import Distribution.PackageDescription
import Distribution.Setup
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils(rawSystemVerbose)
import System.Info
import System.Exit
import System.Directory
import System.Process(runInteractiveProcess, waitForProcess)
import System.IO(hClose, hGetContents, hPutStr, stderr)
import Control.Monad(when)
import Control.Exception(try)

main = defaultMainWithHooks defaultUserHooks{preConf=preConf, postConf=postConf}
  where
    preConf ::  [String] -> ConfigFlags -> IO HookedBuildInfo
    preConf args flags = do
      try (removeFile "MySQL.buildinfo")
      return emptyHookedBuildInfo
    postConf :: [String] -> ConfigFlags -> LocalBuildInfo -> IO ExitCode
    postConf args flags localbuildinfo = do
      mb_bi <- mysqlConfigBuildInfo (configVerbose flags)
      writeHookedBuildInfo "MySQL.buildinfo" (Just (fromMaybe emptyBuildInfo{extraLibs=["mysqlclient"]} mb_bi),[])
      return ExitSuccess
\end{code}

The following code is derived from Distribution.Simple.Configure
\begin{code}
findProgram
    :: String              -- ^ program name
    -> Maybe FilePath      -- ^ optional explicit path
    -> IO (Maybe FilePath)
findProgram name Nothing = do
  mb_path <- findExecutable name
  case mb_path of
    Nothing   -> message ("No " ++ name ++ " found")
    Just path -> message ("Using " ++ name ++ ": " ++ path)
  return mb_path
findProgram name (Just path) = do
  message ("Using " ++ name ++ ": " ++ path)
  return (Just path)

rawSystemGrabOutput :: Int -> FilePath -> [String] -> IO String
rawSystemGrabOutput verbose path args = do
  when (verbose > 0) $
        putStrLn (path ++ concatMap (' ':) args)
  (inp,out,err,pid) <- runInteractiveProcess path args Nothing Nothing
  exitCode <- waitForProcess pid
  if exitCode /= ExitSuccess
    then do errMsg <- hGetContents err
            hPutStr stderr errMsg
            exitWith exitCode
    else return ()
  hClose inp
  hClose err
  hGetContents out

message :: String -> IO ()
message s = putStrLn $ "configure: " ++ s
\end{code}

Populate BuildInfo using pkg-config tool.
\begin{code}
mysqlConfigBuildInfo :: Int -> IO (Maybe BuildInfo)
mysqlConfigBuildInfo verbose = do
  mb_mysql_config_path <- findProgram "mysql_config" Nothing
  case mb_mysql_config_path of
    Just mysql_config_path -> do
       message ("configuring mysqlclient library") 
       res <- rawSystemGrabOutput verbose mysql_config_path ["--libs"]
       let (lib_dirs,libs,ld_opts) = splitLibsFlags (words res)
       res <- rawSystemGrabOutput verbose mysql_config_path ["--cflags"]
       let (inc_dirs,cc_opts) = splitCFlags (words res)
       let bi = emptyBuildInfo{extraLibDirs=lib_dirs, extraLibs=libs, ldOptions=ld_opts, includeDirs=inc_dirs, ccOptions=cc_opts}
       return (Just bi)
    Nothing -> do
       message ("The package will be built using default settings for mysqlclient library")
       return Nothing
  where
    splitLibsFlags []         = ([],[],[])
    splitLibsFlags (arg:args) =
      case arg of
        ('-':'L':lib_dir) -> let (lib_dirs,libs,ld_opts) = splitLibsFlags args
                             in (lib_dir:lib_dirs,libs,ld_opts)
        ('-':'l':lib) ->     let (lib_dirs,libs,ld_opts) = splitLibsFlags args
                             in (lib_dirs,lib:libs,ld_opts)
        ld_opt ->            let (lib_dirs,libs,ld_opts) = splitLibsFlags args
                             in (lib_dirs,libs,ld_opt:ld_opts)

    splitCFlags []         = ([],[])
    splitCFlags (arg:args) =
      case arg of
        ('-':'I':inc_dir) -> let (inc_dirs,c_opts) = splitCFlags args
                             in (inc_dir:inc_dirs,c_opts)
        c_opt ->             let (inc_dirs,c_opts) = splitCFlags args
                             in (inc_dirs,c_opt:c_opts)

\end{code}

[htoolkit-cvs] HSQL/MySQL/Database/HSQL - New directory

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/MySQL/Database/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15631/HSQL

Log Message:
Directory /cvsroot/htoolkit/HSQL/MySQL/Database/HSQL added to the repository

[htoolkit-cvs] HSQL/MySQL/Database - New directory

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/MySQL/Database
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15264/Database

Log Message:
Directory /cvsroot/htoolkit/HSQL/MySQL/Database added to the repository

[htoolkit-cvs] HSQL/SQLite SQLite.cabal,1.3,1.4

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/SQLite
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24864/SQLite

Modified Files:
	SQLite.cabal 
Log Message:
Remove extra-libraries field.


Index: SQLite.cabal
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/SQLite/SQLite.cabal,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** SQLite.cabal	9 Jun 2005 12:16:34 -0000	1.3
--- SQLite.cabal	17 Jun 2005 06:48:10 -0000	1.4
***************
*** 8,10 ****
  build-depends: 	 base, hsql
  extensions:      ForeignFunctionInterface, CPP
- extra-libraries: sqlite
\ No newline at end of file
--- 8,9 ----

[htoolkit-cvs] HSQL/PostgreSQL PostgreSQL.cabal,NONE,1.1 Setup.lhs,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/PostgreSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23927/PostgreSQL

Added Files:
	PostgreSQL.cabal Setup.lhs 
Log Message:
Add PostgreSQL driver


--- NEW FILE: PostgreSQL.cabal ---
name:		 hsql-postgresql
version:	 1.5
license:	 BSD3
author:		 Krasimir Angelov <kr....@gm...>
category:	 Database
description: 	 PostgreSQL driver for HSQL.
exposed-modules: Database.HSQL.PostgreSQL
build-depends: 	 base, hsql
extensions:      ForeignFunctionInterface, CPP
extra-libraries: pq
--- NEW FILE: Setup.lhs ---
#!/usr/bin/runghc

\begin{code}
import Data.Maybe(fromMaybe)
import Distribution.PackageDescription
import Distribution.Setup
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils(rawSystemVerbose)
import System.Info
import System.Exit
import System.Directory
import System.Process(runInteractiveProcess, waitForProcess)
import System.IO(hClose, hGetContents, hPutStr, stderr)
import Control.Monad(when)
import Control.Exception(try)

main = defaultMainWithHooks defaultUserHooks{preConf=preConf, postConf=postConf}
  where
    preConf ::  [String] -> ConfigFlags -> IO HookedBuildInfo
    preConf args flags = do
      try (removeFile "PostgreSQL.buildinfo")
      return emptyHookedBuildInfo
    postConf :: [String] -> ConfigFlags -> LocalBuildInfo -> IO ExitCode
    postConf args flags localbuildinfo = do
      mb_bi <- pqConfigBuildInfo (configVerbose flags)
      writeHookedBuildInfo "PostgreSQL.buildinfo" (Just (fromMaybe emptyBuildInfo mb_bi),[])
      return ExitSuccess
\end{code}

The following code is derived from Distribution.Simple.Configure
\begin{code}
findProgram
    :: String              -- ^ program name
    -> Maybe FilePath      -- ^ optional explicit path
    -> IO (Maybe FilePath)
findProgram name Nothing = do
  mb_path <- findExecutable name
  case mb_path of
    Nothing   -> message ("No " ++ name ++ " found")
    Just path -> message ("Using " ++ name ++ ": " ++ path)
  return mb_path
findProgram name (Just path) = do
  message ("Using " ++ name ++ ": " ++ path)
  return (Just path)

rawSystemGrabOutput :: Int -> FilePath -> [String] -> IO String
rawSystemGrabOutput verbose path args = do
  when (verbose > 0) $
        putStrLn (path ++ concatMap (' ':) args)
  (inp,out,err,pid) <- runInteractiveProcess path args Nothing Nothing
  exitCode <- waitForProcess pid
  if exitCode /= ExitSuccess
    then do errMsg <- hGetContents err
            hPutStr stderr errMsg
            exitWith exitCode
    else return ()
  hClose inp
  hClose err
  hGetContents out

message :: String -> IO ()
message s = putStrLn $ "configure: " ++ s
\end{code}

Populate BuildInfo using pkg-config tool.
\begin{code}
pqConfigBuildInfo :: Int -> IO (Maybe BuildInfo)
pqConfigBuildInfo verbose = do
  mb_pq_config_path <- findProgram "pg_config" Nothing
  case mb_pq_config_path of
    Just pq_config_path -> do
       message ("configuring pq library") 
       res <- rawSystemGrabOutput verbose pq_config_path ["--libdir"]
       let lib_dirs = words res
       res <- rawSystemGrabOutput verbose pq_config_path ["--includedir"]
       let inc_dirs = words res
       res <- rawSystemGrabOutput verbose pq_config_path ["--includedir-server"]
       let inc_dirs_server = words res
       let bi = emptyBuildInfo{extraLibDirs=lib_dirs, includeDirs=inc_dirs++inc_dirs_server}
       return (Just bi)
    Nothing -> do
       message ("The package will be built using default settings for pq library")
       return Nothing
\end{code}

[htoolkit-cvs] HSQL/PostgreSQL/Database/HSQL PostgreSQL.hsc,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/PostgreSQL/Database/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23927/PostgreSQL/Database/HSQL

Added Files:
	PostgreSQL.hsc 
Log Message:
Add PostgreSQL driver


--- NEW FILE: PostgreSQL.hsc ---
-----------------------------------------------------------------------------------------
{-| Module      :  Database.HSQL.PostgreSQL
    Copyright   :  (c) Krasimir Angelov 2003
    License     :  BSD-style

    Maintainer  :  ka2...@ya...
    Stability   :  provisional
    Portability :  portable

    The module provides interface to PostgreSQL database
-}
-----------------------------------------------------------------------------------------

module Database.HSQL.PostgreSQL(connect, module Database.HSQL) where

import Database.HSQL
import Database.HSQL.Types
import Data.Dynamic
import Data.Char
import Foreign
import Foreign.C
import Control.Exception (throwDyn, catchDyn, dynExceptions, Exception(..))
import Control.Monad(when,unless,mplus)
import Control.Concurrent.MVar
import System.Time
import System.IO.Unsafe
import Text.ParserCombinators.ReadP
import Text.Read
import Numeric

# include <time.h>
#include <libpq-fe.h>
#include <postgres.h>
#include <catalog/pg_type.h>

type PGconn = Ptr ()
type PGresult = Ptr ()
type ConnStatusType = #type ConnStatusType
type ExecStatusType = #type ExecStatusType
type Oid = #type Oid

foreign import ccall "libpq-fe.h PQsetdbLogin" pqSetdbLogin :: CString -> CString -> CString -> CString -> CString -> CString -> CString -> IO PGconn
foreign import ccall "libpq-fe.h PQstatus" pqStatus :: PGconn -> IO ConnStatusType
foreign import ccall "libpq-fe.h PQerrorMessage"  pqErrorMessage :: PGconn -> IO CString
foreign import ccall "libpq-fe.h PQfinish" pqFinish :: PGconn -> IO ()
foreign import ccall "libpq-fe.h PQexec" pqExec :: PGconn -> CString -> IO PGresult
foreign import ccall "libpq-fe.h PQresultStatus" pqResultStatus :: PGresult -> IO ExecStatusType
foreign import ccall "libpq-fe.h PQresStatus" pqResStatus :: ExecStatusType -> IO CString
foreign import ccall "libpq-fe.h PQresultErrorMessage" pqResultErrorMessage :: PGresult -> IO CString
foreign import ccall "libpq-fe.h PQnfields" pgNFields :: PGresult -> IO Int
foreign import ccall "libpq-fe.h PQntuples" pqNTuples :: PGresult -> IO Int
foreign import ccall "libpq-fe.h PQfname" pgFName :: PGresult -> Int -> IO CString
foreign import ccall "libpq-fe.h PQftype" pqFType :: PGresult -> Int -> IO Oid
foreign import ccall "libpq-fe.h PQfmod" pqFMod :: PGresult -> Int -> IO Int
foreign import ccall "libpq-fe.h PQfnumber" pqFNumber :: PGresult -> CString -> IO Int
foreign import ccall "libpq-fe.h PQgetvalue" pqGetvalue :: PGresult -> Int -> Int -> IO CString
foreign import ccall "libpq-fe.h PQgetisnull" pqGetisnull :: PGresult -> Int -> Int -> IO Int

foreign import ccall "strlen" strlen :: CString -> IO Int

-----------------------------------------------------------------------------------------
-- Connect/Disconnect
-----------------------------------------------------------------------------------------

-- | Makes a new connection to the database server.
connect :: String   -- ^ Server name
        -> String   -- ^ Database name
        -> String   -- ^ User identifier
        -> String   -- ^ Authentication string (password)
        -> IO Connection
connect server database user authentication = do
	pServer <- newCString server
	pDatabase <- newCString database
	pUser <- newCString user
	pAuthentication <- newCString authentication
	pConn <- pqSetdbLogin pServer nullPtr nullPtr nullPtr pDatabase pUser pAuthentication
	free pServer
	free pUser
	free pAuthentication
	status <- pqStatus pConn
	unless (status == (#const CONNECTION_OK))  (do
		errMsg <- pqErrorMessage pConn >>= peekCString
		pqFinish pConn
		throwDyn (SqlError {seState="C", seNativeError=fromIntegral status, seErrorMsg=errMsg}))
	refFalse <- newMVar False
	let connection = Connection
		{ connDisconnect = pqFinish pConn
		, connExecute = execute pConn
		, connQuery = query connection pConn
		, connTables = tables connection pConn
		, connDescribe = describe connection pConn
		, connBeginTransaction = execute pConn "begin"
		, connCommitTransaction = execute pConn "commit"
		, connRollbackTransaction = execute pConn "rollback"
		, connClosed = refFalse
		}
	return connection
	where
		execute :: PGconn -> String -> IO ()
		execute pConn sqlExpr = do
			pRes <- withCString sqlExpr (pqExec pConn)
			when (pRes==nullPtr) (do
				errMsg <- pqErrorMessage pConn >>= peekCString
				throwDyn (SqlError {seState="E", seNativeError=(#const PGRES_FATAL_ERROR), seErrorMsg=errMsg}))
			status <- pqResultStatus pRes
			unless (status == (#const PGRES_COMMAND_OK) || status == (#const PGRES_TUPLES_OK)) (do
				errMsg <- pqResultErrorMessage pRes >>= peekCString
				throwDyn (SqlError {seState="E", seNativeError=fromIntegral status, seErrorMsg=errMsg}))
			return ()

		query :: Connection -> PGconn -> String -> IO Statement
		query conn pConn query = do
			pRes <- withCString query (pqExec pConn)
			when (pRes==nullPtr) (do
				errMsg <- pqErrorMessage pConn >>= peekCString
				throwDyn (SqlError {seState="E", seNativeError=(#const PGRES_FATAL_ERROR), seErrorMsg=errMsg}))
			status <- pqResultStatus pRes
			unless (status == (#const PGRES_COMMAND_OK) || status == (#const PGRES_TUPLES_OK)) (do
				errMsg <- pqResultErrorMessage pRes >>= peekCString
				throwDyn (SqlError {seState="E", seNativeError=fromIntegral status, seErrorMsg=errMsg}))
			defs <- if status ==  (#const PGRES_TUPLES_OK) then pgNFields pRes >>= getFieldDefs pRes 0 else return []
			countTuples <- pqNTuples pRes;
			tupleIndex <- newMVar (-1)
			refFalse <- newMVar False
			return (Statement
			              { stmtConn   = conn
			              , stmtClose  = return ()
			              , stmtFetch  = fetch tupleIndex countTuples
			              , stmtGetCol = getColValue pRes tupleIndex countTuples
			              , stmtFields = defs
			              , stmtClosed = refFalse
			              })
			where
				getFieldDefs pRes i n
					| i >= n = return []
					| otherwise = do
						name <- pgFName pRes i	>>= peekCString
						dataType <- pqFType pRes i
						modifier <- pqFMod pRes i
						defs <- getFieldDefs pRes (i+1) n
						return ((name,mkSqlType dataType modifier,True):defs)

		mkSqlType :: Oid -> Int -> SqlType
		mkSqlType (#const BPCHAROID)    size = SqlChar (size-4)
		mkSqlType (#const VARCHAROID)   size = SqlVarChar (size-4)
		mkSqlType (#const NAMEOID)      size = SqlVarChar 31
		mkSqlType (#const TEXTOID)      size = SqlText
		mkSqlType (#const NUMERICOID)   size = SqlNumeric ((size-4) `div` 0x10000) ((size-4) `mod` 0x10000)
		mkSqlType (#const INT2OID)      size = SqlSmallInt
		mkSqlType (#const INT4OID)      size = SqlInteger
		mkSqlType (#const FLOAT4OID)    size = SqlReal
		mkSqlType (#const FLOAT8OID)    size = SqlDouble
		mkSqlType (#const BOOLOID)      size = SqlBit
		mkSqlType (#const BITOID)       size = SqlBinary size
		mkSqlType (#const VARBITOID)    size = SqlVarBinary size
		mkSqlType (#const BYTEAOID)     size = SqlTinyInt
		mkSqlType (#const INT8OID)      size = SqlBigInt
		mkSqlType (#const DATEOID)      size = SqlDate
		mkSqlType (#const TIMEOID)      size = SqlTime
		mkSqlType (#const TIMETZOID)    size = SqlTimeTZ
		mkSqlType (#const ABSTIMEOID)   size = SqlAbsTime
		mkSqlType (#const RELTIMEOID)   size = SqlRelTime
		mkSqlType (#const INTERVALOID)  size = SqlTimeInterval
		mkSqlType (#const TINTERVALOID) size = SqlAbsTimeInterval
		mkSqlType (#const TIMESTAMPOID)	size = SqlDateTime
		mkSqlType (#const TIMESTAMPTZOID)	size = SqlDateTimeTZ
		mkSqlType (#const CASHOID)      size = SqlMoney
		mkSqlType (#const INETOID)      size = SqlINetAddr
		mkSqlType (#const 829)          size = SqlMacAddr		-- hack
		mkSqlType (#const CIDROID)      size = SqlCIDRAddr
		mkSqlType (#const POINTOID)     size = SqlPoint
		mkSqlType (#const LSEGOID)      size = SqlLSeg
		mkSqlType (#const PATHOID)      size = SqlPath
		mkSqlType (#const BOXOID)       size = SqlBox
		mkSqlType (#const POLYGONOID)   size = SqlPolygon
		mkSqlType (#const LINEOID)      size = SqlLine
		mkSqlType (#const CIRCLEOID)    size = SqlCircle
		mkSqlType tp   size = SqlUnknown (fromIntegral tp)

		getFieldValue stmt colNumber fieldDef v = do
			mb_v <- stmtGetCol stmt colNumber fieldDef fromNonNullSqlCStringLen
			return (case mb_v of { Nothing -> v; Just a -> a })

		tables :: Connection -> PGconn -> IO [String]
		tables connection pConn = do
			stmt <- query connection pConn "select relname from pg_class where relkind='r' and relname !~ '^pg_'"
			collectRows (\s -> getFieldValue  s 0 ("relname", SqlVarChar 0, False) "") stmt

		describe :: Connection -> PGconn -> String -> IO [FieldDef]
		describe connection pConn table = do
			stmt <- query connection pConn
					("select attname, atttypid, atttypmod, attnotnull " ++
					 "from pg_attribute as cols join pg_class as ts on cols.attrelid=ts.oid " ++
					 "where cols.attnum > 0 and ts.relname="++toSqlValue table++
					 " and cols.attisdropped = False ")

			collectRows getColumnInfo stmt
			where
				getColumnInfo stmt = do
					column_name <- getFieldValue stmt 0 ("attname", SqlVarChar 0, False) ""
					data_type <- getFieldValue stmt 1 ("atttypid", SqlInteger, False) 0
					type_mod <- getFieldValue stmt 2 ("atttypmod", SqlInteger, False) 0
					notnull <- getFieldValue stmt 3 ("attnotnull", SqlBit, False) False
					let sqlType = mkSqlType (fromIntegral (data_type :: Int)) (fromIntegral (type_mod :: Int))
					return (column_name, sqlType, not notnull)

		fetch :: MVar Int -> Int -> IO Bool
		fetch tupleIndex countTuples =
			modifyMVar tupleIndex (\index -> return (index+1,index < countTuples-1))

		getColValue :: PGresult -> MVar Int -> Int -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
		getColValue pRes tupleIndex countTuples colNumber  (name,sqlType,nullable) f = do
			index <- readMVar tupleIndex
			when (index >= countTuples) (throwDyn SqlNoData)
			isnull <- pqGetisnull pRes index colNumber
			if isnull == 1
				then return Nothing
				else do
					pStr <- pqGetvalue pRes index colNumber
					strLen <- strlen pStr
					mb_value <- f sqlType pStr strLen
					case mb_value of
						Just v   -> return (Just v)
						Nothing -> throwDyn (SqlBadTypeCast name sqlType)

[htoolkit-cvs] HSQL/PostgreSQL/Database/HSQL - New directory

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/PostgreSQL/Database/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23295/HSQL

Log Message:
Directory /cvsroot/htoolkit/HSQL/PostgreSQL/Database/HSQL added to the repository

[htoolkit-cvs] HSQL/PostgreSQL/Database - New directory

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/PostgreSQL/Database
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23024/Database

Log Message:
Directory /cvsroot/htoolkit/HSQL/PostgreSQL/Database added to the repository

[htoolkit-cvs] HSQL/SQLite3/Database/HSQL SQLite3.hsc,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/SQLite3/Database/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22294/Database/HSQL

Added Files:
	SQLite3.hsc 
Log Message:
Added sqlite3 driver.


--- NEW FILE: SQLite3.hsc ---
-----------------------------------------------------------------------------------------
{-| Module      :  Database.HSQL.SQLite3
    Copyright   :  (c) Krasimir Angelov 2005
    License     :  BSD-style

    Maintainer  :  kr....@gm...
    Stability   :  provisional
    Portability :  portable

    The module provides interface to SQLite3
-}
-----------------------------------------------------------------------------------------

module Database.HSQL.SQLite3(connect, module Database.HSQL) where

import Database.HSQL
import Database.HSQL.Types
import Foreign
import Foreign.C
import System.IO
import Control.Monad(when)
import Control.Exception(throwDyn)
import Control.Concurrent.MVar

#include <fcntl.h>
#include <sqlite3.h>

type SQLite3 = Ptr ()

foreign import ccall sqlite3_open :: CString -> (Ptr SQLite3) -> IO Int
foreign import ccall sqlite3_errmsg :: SQLite3 -> IO CString
foreign import ccall sqlite3_close :: SQLite3 -> IO ()
foreign import ccall sqlite3_exec :: SQLite3 -> CString -> FunPtr () -> Ptr () -> Ptr CString -> IO CInt
foreign import ccall sqlite3_get_table ::   SQLite3 -> CString -> Ptr (Ptr CString) -> Ptr CInt -> Ptr CInt -> Ptr CString -> IO CInt
foreign import ccall sqlite3_free_table :: Ptr CString -> IO ()
foreign import ccall sqlite3_free :: CString -> IO ()

foreign import ccall "strlen" strlen :: CString -> IO CInt

-----------------------------------------------------------------------------------------
-- routines for handling exceptions
-----------------------------------------------------------------------------------------

handleSqlResult :: CInt -> Ptr CString -> IO ()
handleSqlResult res ppMsg
	| res == (#const SQLITE_OK) = return ()
	| otherwise = do
		pMsg <- peek ppMsg
		msg <- peekCString pMsg
		sqlite3_free pMsg
		throwDyn (SqlError "E" (fromIntegral res) msg)

-----------------------------------------------------------------------------------------
-- Connect
-----------------------------------------------------------------------------------------

connect :: FilePath -> IOMode -> IO Connection
connect fpath mode =
	alloca $ \psqlite ->
	  withCString fpath $ \pFPath -> do
		res <- sqlite3_open pFPath psqlite
		sqlite <- peek psqlite
		when (res /= (#const SQLITE_OK)) $ do
			pMsg <- sqlite3_errmsg sqlite
			msg <- peekCString pMsg
			throwDyn (SqlError
			            { seState = "C"
			            , seNativeError = 0
			            , seErrorMsg = msg
			            })
		refFalse <- newMVar False
		let connection = Connection
			{ connDisconnect = sqlite3_close sqlite
			, connClosed     = refFalse
			, connExecute    = execute sqlite
			, connQuery      = query connection sqlite
			, connTables     = tables connection sqlite
			, connDescribe   = describe connection sqlite
			, connBeginTransaction = execute sqlite "BEGIN TRANSACTION"
			, connCommitTransaction = execute sqlite "COMMIT TRANSACTION"
			, connRollbackTransaction = execute sqlite "ROLLBACK TRANSACTION"
			}
		return connection
	where
		oflags1 = case mode of
	    	  ReadMode      -> (#const O_RDONLY)
	    	  WriteMode     -> (#const O_WRONLY)
	    	  ReadWriteMode -> (#const O_RDWR)
	    	  AppendMode    -> (#const O_APPEND)

		execute :: SQLite3 -> String -> IO ()
		execute sqlite query =
			withCString query $ \pQuery -> do
			alloca $ \ppMsg -> do
				res <- sqlite3_exec sqlite pQuery nullFunPtr nullPtr ppMsg
				handleSqlResult res ppMsg

		query :: Connection -> SQLite3 -> String -> IO Statement
		query connection sqlite query = do
			withCString query $ \pQuery -> do
			alloca $ \ppResult -> do
			alloca $ \pnRow -> do
			alloca $ \pnColumn -> do
			alloca $ \ppMsg -> do
				res <- sqlite3_get_table sqlite pQuery ppResult pnRow pnColumn ppMsg
				handleSqlResult res ppMsg
				pResult <- peek ppResult
				rows    <- fmap fromIntegral (peek pnRow)
				columns <- fmap fromIntegral (peek pnColumn)
				defs <- getFieldDefs pResult 0 columns
				refFalse <- newMVar False
				refIndex <- newMVar 0
				return (Statement
				              { stmtConn   = connection
				              , stmtClose  = sqlite3_free_table pResult
				              , stmtFetch  = fetch refIndex rows
				              , stmtGetCol = getColValue pResult refIndex columns rows
				              , stmtFields = defs
				              , stmtClosed = refFalse
				              })
			where
				getFieldDefs :: Ptr CString -> Int -> Int -> IO [FieldDef]
				getFieldDefs pResult index count
					| index >= count = return []
					| otherwise         = do
						name <- peekElemOff pResult index >>= peekCString
						defs <- getFieldDefs pResult (index+1) count
						return ((name,SqlText,True):defs)

		tables :: Connection -> SQLite3 -> IO [String]
		tables connection sqlite = do
			stmt <- query connection sqlite "select tbl_name from sqlite_master"
			collectRows (\stmt -> getFieldValue stmt "tbl_name") stmt

		describe :: Connection -> SQLite3 -> String -> IO [FieldDef]
		describe connection sqlite table = do
			stmt <- query connection sqlite ("pragma table_info("++table++")")
			collectRows getRow stmt
			where
				getRow stmt = do
					name <- getFieldValue stmt "name"
					notnull <- getFieldValue stmt "notnull"
					return (name, SqlText, notnull=="0")

		fetch tupleIndex countTuples =
			modifyMVar tupleIndex (\index -> return (index+1,index < countTuples))

		getColValue pResult refIndex columns rows colNumber  (name,sqlType,nullable) f = do
			index <- readMVar refIndex
			when (index > rows) (throwDyn SqlNoData)
			pStr <- peekElemOff pResult (columns*index+colNumber)
			if pStr == nullPtr
			  then return Nothing
			  else do
				strLen <- strlen pStr
				mb_value <- f sqlType pStr (fromIntegral strLen)
				case mb_value of
					Just v   -> return (Just v)
					Nothing -> throwDyn (SqlBadTypeCast name sqlType)

[htoolkit-cvs] HSQL/SQLite3 SQLite3.cabal,NONE,1.1 Setup.lhs,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/SQLite3
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22294

Added Files:
	SQLite3.cabal Setup.lhs 
Log Message:
Added sqlite3 driver.


--- NEW FILE: SQLite3.cabal ---
name:		 hsql-sqlite3
version:	 1.5
license:	 BSD3
author:		 Krasimir Angelov <kr....@gm...>
category:	 Database
description: 	 SQLite3 driver for HSQL.
exposed-modules: Database.HSQL.SQLite3
build-depends: 	 base, hsql
extensions:      ForeignFunctionInterface, CPP

--- NEW FILE: Setup.lhs ---
#!/usr/bin/runghc

\begin{code}
import Distribution.PackageDescription
import Distribution.Setup
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils(rawSystemVerbose)
import System.Info
import System.Exit
import System.Directory
import System.Process(runInteractiveProcess, waitForProcess)
import System.IO(hClose, hGetContents, hPutStr, stderr)
import Control.Monad(when)
import Control.Exception(try)

main = defaultMainWithHooks defaultUserHooks{preConf=preConf, postConf=postConf}
  where
    preConf ::  [String] -> ConfigFlags -> IO HookedBuildInfo
    preConf args flags = do
      try (removeFile "SQLite3.buildinfo")
      return emptyHookedBuildInfo
    postConf :: [String] -> ConfigFlags -> LocalBuildInfo -> IO ExitCode
    postConf args flags localbuildinfo = do
      mb_bi <- pkgConfigBuildInfo (configVerbose flags) "sqlite3"
      let bi = case mb_bi of
                 Just bi -> bi
                 Nothing -> emptyBuildInfo{extraLibs=["sqlite"]}
      writeHookedBuildInfo "SQLite3.buildinfo" (Just bi,[])
      return ExitSuccess
\end{code}

The following code is derived from Distribution.Simple.Configure
\begin{code}
findProgram
    :: String              -- ^ program name
    -> Maybe FilePath      -- ^ optional explicit path
    -> IO (Maybe FilePath)
findProgram name Nothing = do
  mb_path <- findExecutable name
  case mb_path of
    Nothing   -> message ("No " ++ name ++ " found")
    Just path -> message ("Using " ++ name ++ ": " ++ path)
  return mb_path
findProgram name (Just path) = do
  message ("Using " ++ name ++ ": " ++ path)
  return (Just path)

rawSystemGrabOutput :: Int -> FilePath -> [String] -> IO String
rawSystemGrabOutput verbose path args = do
  when (verbose > 0) $
        putStrLn (path ++ concatMap (' ':) args)
  (inp,out,err,pid) <- runInteractiveProcess path args Nothing Nothing
  exitCode <- waitForProcess pid
  if exitCode /= ExitSuccess
    then do errMsg <- hGetContents err
            hPutStr stderr errMsg
            exitWith exitCode
    else return ()
  hClose inp
  hClose err
  hGetContents out

message :: String -> IO ()
message s = putStrLn $ "configure: " ++ s
\end{code}

Populate BuildInfo using pkg-config tool.
\begin{code}
pkgConfigBuildInfo :: Int -> String -> IO (Maybe BuildInfo)
pkgConfigBuildInfo verbose pkgName = do
  mb_pkg_config_path <- findProgram "pkg-config" Nothing
  case mb_pkg_config_path of
    Just pkg_config_path -> do
       message ("configuring "++pkgName++" package using pkg-config") 
       res <- rawSystemGrabOutput verbose pkg_config_path [pkgName, "--libs-only-l"]
       let libs = map (tail.tail) (words res)
       res <- rawSystemGrabOutput verbose pkg_config_path [pkgName, "--libs-only-L"]
       let lib_dirs = map (tail.tail) (words res)
       res <- rawSystemGrabOutput verbose pkg_config_path [pkgName, "--libs-only-other"]
       let ld_opts = words res
       res <- rawSystemGrabOutput verbose pkg_config_path [pkgName, "--cflags-only-I"]
       let inc_dirs = map (tail.tail) (words res)
       res <- rawSystemGrabOutput verbose pkg_config_path [pkgName, "--cflags-only-other"]
       let cc_opts = words res
       let bi = emptyBuildInfo{extraLibs=libs, extraLibDirs=lib_dirs, ldOptions=ld_opts, includeDirs=inc_dirs, ccOptions=cc_opts}
       return (Just bi)
    Nothing -> do
       message ("The package will be built using default settings for "++pkgName)
       return Nothing
\end{code}

[htoolkit-cvs] HSQL/SQLite3/Database/HSQL - New directory

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/SQLite3/Database/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13288/HSQL

Log Message:
Directory /cvsroot/htoolkit/HSQL/SQLite3/Database/HSQL added to the repository

[htoolkit-cvs] HSQL/SQLite3/Database - New directory

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/SQLite3/Database
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12826/Database

Log Message:
Directory /cvsroot/htoolkit/HSQL/SQLite3/Database added to the repository