[Haskell-cafe] Strictness, order of IO operations: NewCGI & HDBC
Tim Smith
trangayesi at gmail.com
Thu Aug 10 05:28:26 EDT 2006
Hello! I'm having a problem with using NewCGI & HDBC together.
NewCGI:
http://www.cs.chalmers.se/~bringert/darcs/haskell-cgi/doc/
HDBC:
http://quux.org/devel/hdbc
http://darcs.complete.org/hdbc/
I've distilled it down to a small test case:
\begin{code}
module Main
where
import Data.List (intersperse)
import qualified Database.HDBC as DB
import Database.HDBC.ODBC (connectODBC)
import Network.NewCGI
main :: IO ()
main = runCGI (handleErrors cgiMain)
cgiMain :: CGI CGIResult
cgiMain =
do
dbh <- liftIO $ connectODBC "DSN=test"
res <- liftIO (DB.getTables dbh)
-- Remove the disconnect call, and all works
liftIO (DB.disconnect dbh)
output ((concat . intersperse ", ") res)
\end{code}
2:46 ~/m/tmp/hs$ ./cgidb
Content-type: text/html; charset=ISO-8859-1
cgidb: unknown exception
If I comment out the DB.disconnect call, then it works fine.
I tried to work around it with the DeepSeq module, but couldn't find
an application of $!! or deepSeq which would make it function.
I made a similar test which uses file IO instead of HDBC, and it
behaves the way I want:
\begin{code}
module Main
where
import Network.NewCGI
import System.IO
main :: IO ()
main = runCGI (handleErrors cgiMain)
cgiMain :: CGI CGIResult
cgiMain =
do
h <- liftIO $ openFile "t.hs" ReadMode
res <- liftIO (hGetLine h)
liftIO (hClose h)
output res
\end{code}
2:55 ~/m/tmp/hs$ ./t
Content-type: text/html; charset=ISO-8859-1
module Main
My guess is that I'm doing something wrong, but I'm not sure what it
is. Or, is this a bug in HDBC, somehow?
Thanks for any ideas you might have,
Tim
--
If you're not part of the solution, you're part of the precipitate.
More information about the Haskell-Cafe
mailing list