- Haskell - Haskell.org

(no subject)
by JOSEPH EDWARD 09 Jun '02

09 Jun '02

STRICTLY CONFIDENTIAL & URGENT. I am Mr, Joseph Edward a native of Cape Town in South Africa and I am an Executive Accountant with the South Africa MINISTRY OF MINERAL RESOURCES AND ENERGY First and foremost, I apologized using this medium to reach you for a transaction/business of this magnitude, but this is due to Confidentiality and prompt access reposed on this medium. I have decided to seek a confidential co-operation with you in the execution of the deal described Hereunder for the benefit of all parties and hope you will keep it as a top secret because of the nature of this transaction. Within the Department of Mining & Natural Resources where I work as an Executive Accountant and with the cooperation of four other top officials, we have in our possession as overdue payment bills totaling Twenty! - One Million, Five Hundred Thousand U. S. Dollars ($21,500,000.) which we want to transfer abroad with the assistance and cooperation of a foreign company/individual to receive the said fund on our behalf or a reliable foreign non-company account to receive such funds. More so, we are handicapped in the circumstances, as the South Africa Civil Service Code of Conduct does not allow us to operate offshore account hence your importance in the whole transaction. This amount $21.5m represents the balance of the total contract value executed on behalf of my Department by a foreign contracting firm, which we the officials over-invoiced deliberately. Though the actual contract cost have been paid to the original contractor, leaving the balance in the Tune of the said amount which we have in principles gotten approval to remit by Key tested Telegraphic Transfer (K.T.T) to any foreign bank account you will provide by fi! ling in an application through the Justice Ministry here in South Africa for the transfer of rights and privileges of the former contractor to you. I have the authority of my partners involved to propose that should you be willing to assist us in the transaction, your share of the sum will be 25% of the $21.5 million, 70% for us and 5% for taxation and miscellaneous expenses. The business itself is 100% safe, on your part provided you treat it with utmost secrecy and confidentiality. Also your area of specialization is not a hindrance to the successful execution of this transaction. I have reposed my confidence in you and hope that you will not disappoint me. Endeavor to contact me immediately my e-mail address whether or not you are interested in this deal. If you are not, it will enable me scout for another foreign partner to carry out this deal I want to assure you that my partners and myself are in a positio! n to make the payment of this claim possible provided you can give us a very strong Assurance and guarantee that our share will be secured and please remember to treat this matter as very confidential matter, because we will not comprehend with any form of exposure as we are still in active Government Service and remember once again that time is of the essence in this business.kindly furnish us with your all your contacts,telephone and fax number for more details. I wait in anticipation of your fullest co-operation. Yours faithfully, JOSEPH EDWARD

1 0

GreenCard --target=ffi
by Ferenc Wagner 08 Jun '02

08 Jun '02

The GreenCard manual promotes use of the FFI target (`You're encouraged to use the ffi target, since the Haskell output it generates can be used with all Haskell systems that support the common FFI (as of June 2001, all of them).'), but doesn't give any examples for using it. In the distribution there is an StdDIS.gc for Hugs and another for GHC, but what should I import with the FFI target? The C stub #includes HsFFI.h, which GHC provides, but Hugs doesn't. What should I use? If I go ahead using what I have, Hugs says that `initModule undefined' when I try to load the GC module. Any help appreciated. Feri.

2 2

(no subject)
by JOSEPH EDWARD 07 Jun '02

07 Jun '02

STRICTLY CONFIDENTIAL & URGENT. I am Mr, Joseph Edward a native of Cape Town in South Africa and I am an Executive Accountant with the South Africa MINISTRY OF MINERAL RESOURCES AND ENERGY First and foremost, I apologized using this medium to reach you for a transaction/business of this magnitude, but this is due to Confidentiality and prompt access reposed on this medium. I have decided to seek a confidential co-operation with you in the execution of the deal described Hereunder for the benefit of all parties and hope you will keep it as a top secret because of the nature of this transaction. Within the Department of Mining & Natural Resources where I work as an Executive Accountant and with the cooperation of four other top officials, we have in our possession as overdue payment bills totaling Twenty - One Million, Five Hundred Thousand U. S. Dollars ($21,500,000.) which we want to transfer abroad with the assistance and cooperation of a foreign company/individual to receive the said fund on our behalf or a reliable foreign non-company account to receive such funds. More so, we are handicapped in the circumstances, as the South Africa Civil Service Code of Conduct does not allow us to operate offshore account hence your importance in the whole transaction. This amount $21.5m represents the balance of the total contract value executed on behalf of my Department by a foreign contracting firm, which we the officials over-invoiced deliberately. Though the actual contract cost have been paid to the original contractor, leaving the balance in the Tune of the said amount which we have in principles gotten approval to remit by Key tested Telegraphic Transfer (K.T.T) to any foreign bank account you will provide by filing in an application through the Justice Ministry here in South Africa for the transfer of rights and privileges of the former contractor to you. I have the authority of my partners involved to propose that should you be willing to assist us in the transaction, your share of the sum will be 25% of the $21.5 million, 70% for us and 5% for taxation and miscellaneous expenses. The business itself is 100% safe, on your part provided you treat it with utmost secrecy and confidentiality. Also your area of specialization is not a hindrance to the successful execution of this transaction. I have reposed my confidence in you and hope that you will not disappoint me. Endeavor to contact me immediately my e-mail address whether or not you are interested in this deal. If you are not, it will enable me scout for another foreign partner to carry out this deal I want to assure you that my partners and myself are in a position to make the payment of this claim possible provided you can give us a very strong Assurance and guarantee that our share will be secured and please remember to treat this matter as very confidential matter, because we will not comprehend with any form of exposure as we are still in active Government Service and remember once again that time is of the essence in this business.please kindly provide your contacts addresses including your telephone and fax number for more details. I wait in anticipation of your fullest co-operation. Yours faithfully, JOSEPH EDWARD

1 0

Re: arrows
by Ashley Yakeley 07 Jun '02

07 Jun '02

At 2002-06-03 09:22, Wolfgang Jeltsch wrote: >I think, it would be better to > * create a class, which has only an identity and a composition > member, and call this class Arrow or Morphism; > * create a subclass of this class which introduces pure (arr); > * create a subclass of the class introducing pure in order to > introduce first. I agree. I have something similar in my experimental alternative Prelude project 'HBase', but only two classes: <http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/*checkout*/hbase/Source/Cat egory/Composition.hs?rev=HEAD&content-type=text/plain> <http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/*checkout*/hbase/Source/Cat egory/Arrow.hs?rev=HEAD&content-type=text/plain> I call them 'Compositor' and 'Arrow'. I see two issues: 1. Should I add your intermediate class? Do you have examples of something that has 'pure' but not 'first'? 2. What are the best names? I used 'Arrow' because it's for "arrows" as defined by John Hughes <http://haskell.cs.yale.edu/arrows/>. I might change 'Compositor' to 'Morphism' if it makes more sense to people. As you point out, Hughes' "arrows" are a strict subset of category theory "arrows". -- Ashley Yakeley, Seattle WA

2 1

Haskell 98 Report: May release
by Simon Peyton-Jones 07 Jun '02

07 Jun '02

Folks, I've finally managed to push out the May 2002 release of the Haskell 98 report. http://research.microsoft.com/~simonpj/h98-revised As far as I know there are no outstanding issues, so I hope that there will be blissful silence for a month and I can freeze it. I'd have done so this time if it weren't for some non-trivial changes to the specification of 'derving' for Read and Show. As ever, the bugs list makes it easy to find the changes since last time Happy reading. A big thank you to those who have spotted errors and contributed fixes. SImon

2 1

FFI and ODBC connectivity
by Krasimir Angelov 06 Jun '02

06 Jun '02

Hello all, HaskellDB is a nice, combinator library but there are two main disadvantages. * HaskellDB uses 'Trex' module which is Hugs specific. Both GHC and NHC doesn't support 'Trex'. * HaskellDB cann't execute stored SQL procedures and doesn't allow to execute plain SQL statements. I use HSQL (see mail attachment) for data access. HSQL works with ODBC but its user interface isn't ODBC specific. The module can be rewriten to use native drivers for specific databases (MySQL,PostgresSQL,Oracle,Sybase,...). If there is somebody interested in using of HSQL I will place it on CVS. Krasimir Angelov __________________________________________________ Do You Yahoo!? Yahoo! - Official partner of 2002 FIFA World Cup http://fifaworldcup.yahoo.com module HSQL ( SqlBind(..), SqlError(..), SqlType(..), Connection, Statement , catchSql -- :: IO a -> (SqlError -> IO a) -> IO a , connect -- :: String -> String -> String -> IO Connection , disconnect -- :: Connection -> IO () , execute -- :: Connection -> String -> IO Statement , closeStatement -- :: Statement -> IO () , fetch -- :: Statement -> IO Bool , inTransaction -- :: Connection -> (Connection -> IO a) -> IO a , getFieldValue -- :: SqlBind a => Statement -> String -> IO a , getFieldValueType -- :: Statement -> String -> (SqlType, Bool) , getFieldsTypes -- :: Statement -> (String, SqlType, Bool) , forEachRow -- :: (Statement -> s -> IO s) -> Statement -> s -> IO s , forEachRow' -- :: (Statement -> IO ()) -> Statement -> IO () , collectRows -- :: (Statement -> IO s) -> Statement -> IO [s] ) where import Word(Word32, Word16) import Int(Int32, Int16) import Foreign import CString import IORef import Monad(when) import Exception (throwDyn, catchDyn, Exception(..)) import Dynamic #include <HSQLStructs.h> type SQLHANDLE = Ptr () type HENV = SQLHANDLE type HDBC = SQLHANDLE type HSTMT = SQLHANDLE type HENVRef = ForeignPtr () type SQLSMALLINT = Int16 type SQLUSMALLINT = Word16 type SQLINTEGER = Int32 type SQLUINTEGER = Word32 type SQLRETURN = SQLSMALLINT type SQLLEN = SQLINTEGER type SQLULEN = SQLINTEGER foreign import stdcall "sqlext.h SQLAllocEnv" sqlAllocEnv :: Ptr HENV -> IO SQLRETURN foreign import stdcall "sqlext.h SQLFreeEnv" sqlFreeEnv :: HENV -> IO SQLRETURN foreign import stdcall "sqlext.h SQLAllocConnect" sqlAllocConnect :: HENV -> Ptr HDBC -> IO SQLRETURN foreign import stdcall "sqlext.h SQLFreeConnect" sqlFreeConnect:: HDBC -> IO SQLRETURN foreign import stdcall "sqlext.h SQLConnect" sqlConnect :: HDBC -> CString -> Int -> CString -> Int -> CString -> Int -> IO SQLRETURN foreign import stdcall "sqlext.h SQLDisconnect" sqlDisconnect :: HDBC -> IO SQLRETURN foreign import stdcall "sqlext.h SQLAllocStmt" sqlAllocStmt :: HDBC -> Ptr HSTMT -> IO SQLRETURN foreign import stdcall "sqlext.h SQLFreeStmt" sqlFreeStmt :: HSTMT -> SQLUSMALLINT -> IO SQLRETURN foreign import stdcall "sqlext.h SQLNumResultCols" sqlNumResultCols :: HSTMT -> Ptr SQLUSMALLINT -> IO SQLRETURN foreign import stdcall "sqlext.h SQLDescribeCol" sqlDescribeCol :: HSTMT -> SQLUSMALLINT -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLULEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN foreign import stdcall "sqlext.h SQLBindCol" sqlBindCol :: HSTMT -> SQLUSMALLINT -> SQLSMALLINT -> Ptr a -> SQLLEN -> Ptr SQLINTEGER -> IO SQLRETURN foreign import stdcall "sqlext.h SQLFetch" sqlFetch :: HSTMT -> IO SQLRETURN foreign import stdcall "sqlext.h SQLGetDiagRec" sqlGetDiagRec :: SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> CString -> Ptr SQLINTEGER -> CString -> SQLSMALLINT -> Ptr SQLSMALLINT -> IO SQLRETURN foreign import stdcall "sqlext.h SQLExecDirect" sqlExecDirect :: HSTMT -> CString -> Int -> IO SQLRETURN foreign import stdcall "sqlext.h SQLSetConnectOption" sqlSetConnectOption :: HDBC -> SQLUSMALLINT -> SQLULEN -> IO SQLRETURN foreign import stdcall "sqlext.h SQLTransact" sqlTransact :: HENV -> HDBC -> SQLUSMALLINT -> IO SQLRETURN data Connection = Connection { hDBC :: HDBC , environment :: HENVRef } type FieldDef = (String, SqlType, Bool, Int) data Statement = Statement { hSTMT :: HSTMT , connection :: Connection , fields :: [FieldDef] , fetchBuffer :: Ptr () } data SqlType = SqlChar Int | SqlVarChar Int | SqlLongVarChar Int | SqlDecimal Int Int | SqlNumeric Int Int | SqlSmallInt | SqlInteger | SqlReal | SqlDouble | SqlBit | SqlTinyInt | SqlBigInt | SqlBinary Int | SqlVarBinary Int | SqlLongVarBinary Int | SqlDate | SqlTime | SqlTimeStamp deriving (Eq, Show) data SqlError = SqlError { seState :: String , seNativeError :: Int , seErrorMsg :: String } | SqlNoData | SqlInvalidHandle | SqlStillExecuting | SqlNeedData deriving Show ----------------------------------------------------------------------------------------- -- routines for handling exceptions ----------------------------------------------------------------------------------------- {-# NOINLINE sqlErrorTy #-} sqlErrorTy = mkAppTy (mkTyCon "SqlError") [] instance Typeable SqlError where typeOf x = sqlErrorTy catchSql :: IO a -> (SqlError -> IO a) -> IO a catchSql = catchDyn sqlSuccess :: SQLRETURN -> Bool sqlSuccess res = (res == (#const SQL_SUCCESS)) || (res == (#const SQL_SUCCESS_WITH_INFO)) || (res == (#const SQL_NO_DATA)) handleSqlResult :: SQLSMALLINT -> SQLHANDLE -> SQLRETURN -> IO () handleSqlResult handleType handle res | sqlSuccess res = return () | res == (#const SQL_INVALID_HANDLE) = throwDyn SqlInvalidHandle | res == (#const SQL_STILL_EXECUTING) = throwDyn SqlStillExecuting | res == (#const SQL_NEED_DATA) = throwDyn SqlNeedData | res == (#const SQL_ERROR) = do pState <- mallocBytes 256 pNative <- malloc pMsg <- mallocBytes 256 pTextLen <- malloc sqlGetDiagRec handleType handle 1 pState pNative pMsg 256 pTextLen state <- peekCString pState free pState native <- peek pNative free pNative msg <- peekCString pMsg free pMsg free pTextLen throwDyn (SqlError {seState=state, seNativeError=fromIntegral native, seErrorMsg=msg}) | otherwise = error (show res) ----------------------------------------------------------------------------------------- -- keeper of HENV ----------------------------------------------------------------------------------------- {-# NOINLINE myEnvironment #-} myEnvironment :: HENVRef myEnvironment = unsafePerformIO $ do (phEnv :: Ptr HENV) <- malloc res <- sqlAllocEnv phEnv hEnv <- peek phEnv free phEnv handleSqlResult 0 nullPtr res newForeignPtr hEnv (closeEnvironment hEnv) where closeEnvironment :: HENV -> IO () closeEnvironment hEnv = sqlFreeEnv hEnv >>= handleSqlResult (#const SQL_HANDLE_ENV) hEnv ----------------------------------------------------------------------------------------- -- Connect/Disconnect ----------------------------------------------------------------------------------------- connect :: String -> String -> String -> IO Connection connect server user authentication = withForeignPtr myEnvironment $ \hEnv -> do (phDBC :: Ptr HDBC) <- malloc res <- sqlAllocConnect hEnv phDBC hDBC <- peek phDBC free phDBC handleSqlResult (#const SQL_HANDLE_ENV) hEnv res pServer <- newCString server pUser <- newCString user pAuthentication <- newCString authentication res <- sqlConnect hDBC pServer (length server) pUser (length user) pAuthentication (length authentication) free pServer free pUser free pAuthentication handleSqlResult (#const SQL_HANDLE_ENV) hEnv res return (Connection {hDBC=hDBC, environment=myEnvironment}) disconnect :: Connection -> IO () disconnect (Connection {hDBC=hDBC}) = do sqlDisconnect hDBC >>= handleSqlResult (#const SQL_HANDLE_DBC) hDBC sqlFreeConnect hDBC >>= handleSqlResult (#const SQL_HANDLE_DBC) hDBC return () ----------------------------------------------------------------------------------------- -- queries ----------------------------------------------------------------------------------------- execute :: Connection -> String -> IO Statement execute conn@(Connection {hDBC=hDBC}) query = do pFIELD <- mallocBytes (#const sizeof(FIELD)) res <- sqlAllocStmt hDBC ((#ptr FIELD, hSTMT) pFIELD) when (not (sqlSuccess res)) (free pFIELD) handleSqlResult (#const SQL_HANDLE_DBC) hDBC res hSTMT <- (#peek FIELD, hSTMT) pFIELD let handleResult res = do when (not (sqlSuccess res)) (free pFIELD) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res pQuery <- newCString query res <- sqlExecDirect hSTMT pQuery (length query) free pQuery handleResult res sqlNumResultCols hSTMT ((#ptr FIELD, fieldsCount) pFIELD) >>= handleResult count <- (#peek FIELD, fieldsCount) pFIELD (fields, offs) <- createBindState hSTMT pFIELD 0 1 count free pFIELD buffer <- mallocBytes offs let statement = Statement {hSTMT=hSTMT, connection=conn, fields=fields, fetchBuffer=buffer} catchSql (bindFields hSTMT buffer 1 fields) (errHandler statement) return statement where errHandler statement err = do closeStatement statement throwDyn err createBindState :: HSTMT -> Ptr a -> Int -> SQLUSMALLINT -> SQLUSMALLINT -> IO ([FieldDef], Int) createBindState hSTMT pFIELD offs n count | n > count = return ([], offs) | otherwise = do res <- sqlDescribeCol hSTMT n ((#ptr FIELD, fieldName) pFIELD) (#const FIELD_NAME_LENGTH) ((#ptr FIELD, NameLength) pFIELD) ((#ptr FIELD, DataType) pFIELD) ((#ptr FIELD, ColumnSize) pFIELD) ((#ptr FIELD, DecimalDigits) pFIELD) ((#ptr FIELD, Nullable) pFIELD) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res name <- peekCString ((#ptr FIELD, fieldName) pFIELD) dataType <- (#peek FIELD, DataType) pFIELD columnSize <- (#peek FIELD, ColumnSize) pFIELD decimalDigits <- (#peek FIELD, DecimalDigits) pFIELD (nullable :: SQLSMALLINT) <- (#peek FIELD, Nullable) pFIELD let (sqlType, offs') = mkSqlType dataType columnSize decimalDigits (offs+(#const sizeof(SQLINTEGER))) (fields, offs'') <- createBindState hSTMT pFIELD offs' (n+1) count return ((name,sqlType,toBool nullable,offs):fields, offs'') bindFields :: HSTMT -> Ptr () -> SQLUSMALLINT -> [FieldDef] -> IO () bindFields hSTMT fetchBuffer n [] = return () bindFields hSTMT fetchBuffer n ((name,SqlChar size, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_CHAR) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (fromIntegral (size+1) * (#const sizeof(SQLCHAR))) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlVarChar size, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_CHAR) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (fromIntegral (size+1) * (#const sizeof(SQLCHAR))) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlLongVarChar size, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_CHAR) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (fromIntegral (size+1) * (#const sizeof(SQLCHAR))) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlDecimal size prec,nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_DOUBLE) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQLDOUBLE)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlNumeric size prec,nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_DOUBLE) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQLDOUBLE)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlSmallInt, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_SHORT) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQLSMALLINT)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlInteger, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_LONG) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQLINTEGER)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlReal, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_DOUBLE) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQLDOUBLE)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlDouble, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_DOUBLE) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQLDOUBLE)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlBit, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_LONG) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQLINTEGER)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlTinyInt, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_SHORT) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQLSMALLINT)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlBigInt, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_LONG) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQLINTEGER)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlBinary size, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_CHAR) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (fromIntegral size * (#const sizeof(SQLCHAR))) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlVarBinary size, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_CHAR) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (fromIntegral size * (#const sizeof(SQLCHAR))) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlLongVarBinary size,nullable,offs):fields)= do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_CHAR) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (fromIntegral size * (#const sizeof(SQLCHAR))) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlDate, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_TYPE_DATE) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQL_DATE_STRUCT)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlTime, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_TYPE_TIME) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQL_TIME_STRUCT)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields bindFields hSTMT fetchBuffer n ((name,SqlTimeStamp, nullable,offs):fields) = do let buffer = fetchBuffer `plusPtr` offs res <- sqlBindCol hSTMT n (#const SQL_C_TYPE_TIMESTAMP) ((castPtr buffer) `plusPtr` (#const sizeof(SQLINTEGER))) (#const sizeof(SQL_TIMESTAMP_STRUCT)) (castPtr buffer) handleSqlResult (#const SQL_HANDLE_STMT) hSTMT res bindFields hSTMT fetchBuffer (n+1) fields mkSqlType :: SQLSMALLINT -> SQLULEN -> SQLSMALLINT -> Int -> (SqlType, Int) mkSqlType (#const SQL_CHAR) size _ offs = (SqlChar (fromIntegral size), offs + (#const sizeof(SQLCHAR))*(fromIntegral size+1)) mkSqlType (#const SQL_VARCHAR) size _ offs = (SqlVarChar (fromIntegral size), offs + (#const sizeof(SQLCHAR))*(fromIntegral size+1)) mkSqlType (#const SQL_LONGVARCHAR) size _ offs = (SqlLongVarChar (fromIntegral size), offs + (#const sizeof(SQLCHAR))*(fromIntegral size+1)) mkSqlType (#const SQL_DECIMAL) size prec offs = (SqlDecimal (fromIntegral size) (fromIntegral prec), offs + (#const sizeof(SQLDOUBLE))) mkSqlType (#const SQL_NUMERIC) size prec offs = (SqlNumeric (fromIntegral size) (fromIntegral prec), offs + (#const sizeof(SQLDOUBLE))) mkSqlType (#const SQL_SMALLINT) _ _ offs = (SqlSmallInt, offs + (#const sizeof(SQLSMALLINT))) mkSqlType (#const SQL_INTEGER) _ _ offs = (SqlInteger, offs + (#const sizeof(SQLINTEGER))) mkSqlType (#const SQL_REAL) _ _ offs = (SqlReal, offs + (#const sizeof(SQLDOUBLE))) mkSqlType (#const SQL_DOUBLE) _ _ offs = (SqlDouble, offs + (#const sizeof(SQLDOUBLE))) mkSqlType (#const SQL_BIT) _ _ offs = (SqlBit, offs + (#const sizeof(SQLINTEGER))) mkSqlType (#const SQL_TINYINT) _ _ offs = (SqlTinyInt, offs + (#const sizeof(SQLSMALLINT))) mkSqlType (#const SQL_BIGINT) _ _ offs = (SqlBigInt, offs + (#const sizeof(SQLINTEGER))) mkSqlType (#const SQL_BINARY) size _ offs = (SqlBinary (fromIntegral size), offs + (#const sizeof(SQLCHAR))*(fromIntegral size+1)) mkSqlType (#const SQL_VARBINARY) size _ offs = (SqlVarBinary (fromIntegral size), offs + (#const sizeof(SQLCHAR))*(fromIntegral size+1)) mkSqlType (#const SQL_LONGVARBINARY)size _ offs = (SqlLongVarBinary (fromIntegral size), offs + (#const sizeof(SQLCHAR))*(fromIntegral size+1)) mkSqlType (#const SQL_DATE) _ _ offs = (SqlDate, offs + (#const sizeof(SQL_DATE_STRUCT))) mkSqlType (#const SQL_TIME) _ _ offs = (SqlTime, offs + (#const sizeof(SQL_TIME_STRUCT))) mkSqlType (#const SQL_TIMESTAMP) _ _ offs = (SqlTimeStamp, offs + (#const sizeof(SQL_TIMESTAMP_STRUCT))) {-# NOINLINE fetch #-} fetch :: Statement -> IO Bool fetch stmt = do res <- sqlFetch (hSTMT stmt) handleSqlResult (#const SQL_HANDLE_STMT) (hSTMT stmt) res return (res /= (#const SQL_NO_DATA)) closeStatement :: Statement -> IO () closeStatement stmt = do sqlFreeStmt (hSTMT stmt) 0 >>= handleSqlResult (#const SQL_HANDLE_STMT) (hSTMT stmt) free (fetchBuffer stmt) ----------------------------------------------------------------------------------------- -- transactions ----------------------------------------------------------------------------------------- inTransaction :: Connection -> (Connection -> IO a) -> IO a inTransaction conn@(Connection {hDBC=hDBC, environment=envRef}) action = withForeignPtr envRef $ \hEnv -> do sqlSetConnectOption hDBC (#const SQL_AUTOCOMMIT) (#const SQL_AUTOCOMMIT_OFF) r <- catchSql (action conn) (\err -> do sqlTransact hEnv hDBC (#const SQL_ROLLBACK) sqlSetConnectOption hDBC (#const SQL_AUTOCOMMIT) (#const SQL_AUTOCOMMIT_ON) throwDyn err) sqlTransact hEnv hDBC (#const SQL_COMMIT) sqlSetConnectOption hDBC (#const SQL_AUTOCOMMIT) (#const SQL_AUTOCOMMIT_ON) return r ----------------------------------------------------------------------------------------- -- binding ----------------------------------------------------------------------------------------- class SqlBind a where getValue :: SqlType -> Ptr () -> IO a instance SqlBind Int where getValue SqlInteger ptr = peek (castPtr (ptr `plusPtr` (#const sizeof(SQLINTEGER)))) getValue SqlSmallInt ptr = do (n :: Int16) <- peek (castPtr (ptr `plusPtr` (#const sizeof(SQLINTEGER)))) return (fromIntegral n) instance SqlBind String where getValue (SqlChar size) ptr = do len <- peek (castPtr ptr) peekCStringLen (castPtr (ptr `plusPtr` (#const sizeof(SQLINTEGER))), len) getValue (SqlVarChar size) ptr = do len <- peek (castPtr ptr) peekCStringLen (castPtr (ptr `plusPtr` (#const sizeof(SQLINTEGER))), len) getValue (SqlLongVarChar size) ptr = do len <- peek (castPtr ptr) peekCStringLen (castPtr (ptr `plusPtr` (#const sizeof(SQLINTEGER))), len) instance SqlBind Double where getValue (SqlDecimal size prec) ptr = peek (castPtr (ptr `plusPtr` (#const sizeof(SQLINTEGER)))) getValue (SqlNumeric size prec) ptr = peek (castPtr (ptr `plusPtr` (#const sizeof(SQLINTEGER)))) getValue SqlDouble ptr = peek (castPtr (ptr `plusPtr` (#const sizeof(SQLINTEGER)))) getValue SqlReal ptr = peek (castPtr (ptr `plusPtr` (#const sizeof(SQLINTEGER)))) getFieldValue :: SqlBind a => Statement -> String -> IO a getFieldValue stmt name = getValue sqlType ((fetchBuffer stmt) `plusPtr` offs) where (_,sqlType,nullable,offs) = findField name (fields stmt) getFieldValueType :: Statement -> String -> (SqlType, Bool) getFieldValueType stmt name = (sqlType, nullable) where (_,sqlType,nullable,offs) = findField name (fields stmt) getFieldsTypes :: Statement -> [(String, SqlType, Bool)] getFieldsTypes stmt = map (\(name,sqlType,nullable,_) -> (name,sqlType,nullable)) (fields stmt) findField :: String -> [FieldDef] -> FieldDef findField name [] = error (name ++ "??") findField name (fieldDef@(name',_,_,_):fields) | name == name' = fieldDef | otherwise = findField name fields ----------------------------------------------------------------------------------------- -- helpers ----------------------------------------------------------------------------------------- forEachRow :: (Statement -> s -> IO s) -> Statement -> s -> IO s forEachRow f stmt s = do success <- fetch stmt if success then f stmt s >>= forEachRow f stmt else closeStatement stmt >> return s forEachRow' :: (Statement -> IO ()) -> Statement -> IO () forEachRow' f stmt = do success <- fetch stmt if success then f stmt >> forEachRow' f stmt else closeStatement stmt collectRows :: (Statement -> IO a) -> Statement -> IO [a] collectRows f stmt = loop where loop = do success <- fetch stmt if success then do x <- f stmt xs <- loop return (x:xs) else closeStatement stmt >> return []

1 0

FFI and ODBC connectivity
by Jamie Love 06 Jun '02

06 Jun '02

Hello all, Currently I am investigating the availability of haskell to ODBC connectivity and have been excited by the possibilities. Downloading the HaskellDB package (http://haskell.cs.yale.edu/haskellDB/) and having it run was fantastic. In the interests of continuing the work of HaskellDB, I wish to have this system work under Linux. Before attempting to extend HaskellDB to support ODBC (and work through unixODBC - http://www.unixodbc.org) I wish to ensure that my efforts are not misdirected. My questions include: Is HaskellDB dead? Is it worth extending? (I very much wish to keep the type safety HaskellDB has). Is HaskellDirect dead or superseeded by the Haskell FFI? I am having difficulty discovering which FFI technology/package is still useful, viable and alive, the same applies to ODBC connectivity packages. The second set of libraries I am interested in is HTML/CGI libraries. I have yet to investigate those available, so any direction on which library package is currently live and well would also be useful. The reason for these queries is that I wish to write pure Haskell software based heavily around both a database backend and HTML frontend. Thankyou, -- Jamie Love Phone: +64 4 9393425 "If possible, try to find a way to come downstairs that doesn't involve going bump, bump, bump, on the back of your head. - " Pooh in Winnie the Pooh

5 5

��ʦ��ǻۣ��ȡ��ҵ�ҵ��ţ�ֱ��ɹ��ʿ��Ľ��
by ��Ż�չЭ�� 06 Jun '02

06 Jun '02

1 0

�𾴵��Ͽͻ��
by syhua3000 06 Jun '02

06 Jun '02

�𾴵��Ͽͻ�� ã� ӯͨԶ��(www.9dns.net)Ϊ�˴�л��Լ��ͻ��˾��֧�ֺ��Σ��ٴ��¾ɷ��ܣ��վ�ռ��졢�� ȶ��ȫ��ͬʱ��ǻ��˲�Ʒ �۸��ܸ��ʵķ��񡣣��˾��վ��ȫ�¸İ棺www.8dns.net�� 200M HTML�ռ�+1��۸�150Ԫ/�� 100M�ռ�(֧��ASP)+100M��ҵ�ʾ�+20M ACCESS��ݿ�+1�� 288Ԫ/�� 200M�ռ�(֧��ASP)+200M��ҵ�ʾ�+30M Access��ݿ�+1�� 338Ԫ/�� ֻ��ۼ۸񡣻�ӭѡ��Ҳ��ӭ��Ϊ��ǵĴ��! ��ǻ��и��Żݼ۸�� http://www.8dns.net �� ӯͨԶ��ӿƼ��޹�˾ --------------------------------------------------------------- �е�Ⱥ��ʼ�,��ר��(http://www.21cmm.com) ��CMM��У(http://www.21cmm.com)��Ŀ��ר��

1 0

Re: ANNOUNCE: Haddock version 0.3
by Ashley Yakeley 06 Jun '02

06 Jun '02

At 2002-06-03 09:04, Simon Marlow wrote: >I'm pleased to announce version 0.3 of Haddock, a documentation >generation tool for Haskell source code. Has trouble with this: -- haddock -h -o Doc/ HaddockTest.hs module HaddockTest where { -- |comment class C a where { }; } ...gives this HaddockTest.hs:5:5: Parse error -- Ashley Yakeley, Seattle WA

1 0