Paste number 28273: using bracket inside CGI monad

Index of paste annotations: 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8

Paste number 28273: using bracket inside CGI monad
Pasted by: thou
When:7 years, 10 months ago
Share:Tweet this! | http://paste.lisp.org/+LTD
Channel:#haskell
Paste contents:
Raw Source | XML | Display As
{-
This program works.  It returns a nice 500 Server Error result if there are any SQL errors (e.g., an invalid DSN).

But I want proc to return a CGIResult, not a String.  So I can use output, or redirect, or whatever else from inside proc.

I tried changing proc to:
proc :: DB.Connection -> CGI.CGI CGI.CGIResult

Then I tried putting 'lift' in all sorts of places in cgiMain.  But I can't figure out how to make it work.  Any hope for me?
-}

import qualified Control.Exception as Exception (bracket)
import qualified Database.HDBC as DB
import qualified Database.HDBC.ODBC as ODBC
import qualified List
import Control.Monad.Trans (lift)
import qualified Network.NewCGI as CGI
import Text.XHtml
import qualified System
import qualified System.IO.Error as IOE

cgiMain :: CGI.CGI CGI.CGIResult
cgiMain =
	do
	res <- lift $ DB.handleSqlError $ Exception.bracket
		(ODBC.connectODBC "DSN=lbugs")
		DB.disconnect
		proc
	CGI.output res

proc :: DB.Connection -> IO String
proc dbh =
	do
	args <- System.getArgs
	return (join " " ["Hello World!", (join ", " args)])

main :: IO ()
main = CGI.runCGI (CGI.handleErrors cgiMain)

join :: [a] -> [[a]] -> [a]
join sep = concat . List.intersperse sep

Annotations for this paste:

Annotation number 1: Try without bracket
Pasted by: thou
When:7 years, 10 months ago
Share:Tweet this! | http://paste.lisp.org/+LTD/1
Paste contents:
Raw Source | Display As
{-
See bringert's suggestion (around 19:45):
http://meme.b9.com/cview.html?channel=haskell&date=061012#hour19
-}

import qualified Control.Exception as Exception (bracket)
import Control.Monad (ap)
import Control.Monad.Trans (lift)
import qualified Database.HDBC as DB
import qualified Database.HDBC.ODBC as ODBC
import qualified List
import qualified Network.NewCGI as CGI
import Text.XHtml
import qualified System
import qualified System.IO.Error as IOE

cgiMain :: CGI.CGI CGI.CGIResult
cgiMain =
	do
	dbh <- cgidb (ODBC.connectODBC "DSN=lbugs")
	cgiResult <- proc dbh
	-- Can't disconnect, or it throws an exception:
	-- http://www.haskell.org/pipermail/haskell-cafe/2006-October/018735.html
	-- cgidb (DB.disconnect dbh)
	return cgiResult

cgidb :: IO a -> CGI.CGI a
cgidb = lift . DB.handleSqlError

proc :: DB.Connection -> CGI.CGI CGI.CGIResult
proc dbh =
	do
	tables <- cgidb (DB.getTables dbh)
	CGI.output (join " " ["Tables:", (join ", " tables)])

main :: IO ()
main = CGI.runCGI (CGI.handleErrors cgiMain)

join :: [a] -> [[a]] -> [a]
join sep = concat . List.intersperse sep

Annotation number 2: Exception.evaluate: still not enough
Pasted by: thou
When:7 years, 10 months ago
Share:Tweet this! | http://paste.lisp.org/+LTD/2
Paste contents:
Raw Source | Display As
{-
I modified the cgidb function from annotation #1 as follows, but it still doesn't work with DB.disconnect
-}

cgidb :: IO a -> CGI.CGI a
cgidb action = lift $ DB.handleSqlError action >>= Exception.evaluate

Annotation number 3: Using deepSeq? no dice.
Pasted by: thou
When:7 years, 10 months ago
Share:Tweet this! | http://paste.lisp.org/+LTD/3
Paste contents:
Raw Source | Display As
import qualified Control.Exception as Exception (bracket, evaluate)
import Control.Monad (ap)
import Control.Monad.Trans (lift)
import qualified Database.HDBC as DB
import qualified Database.HDBC.ODBC as ODBC
import DeepSeq (DeepSeq, deepSeq)
import qualified List
import qualified Network.NewCGI as CGI
import Text.XHtml
import qualified System
import qualified System.IO.Error as IOE

instance  DeepSeq DB.Connection  where  deepSeq = seq

cgiMain :: CGI.CGI CGI.CGIResult
cgiMain =
	do
	dbh <- cgidb (ODBC.connectODBC "DSN=lbugs")
	cgiResult <- proc dbh
	cgidb (DB.disconnect dbh)
	return cgiResult

cgidb :: DeepSeq a => IO a -> CGI.CGI a
cgidb action =
	lift $
		do
		dbResult <- DB.handleSqlError action
		return (deepSeq dbResult dbResult)

proc :: DB.Connection -> CGI.CGI CGI.CGIResult
proc dbh =
	do
	tables <- cgidb (DB.getTables dbh)
	CGI.output (join " " ["Tables:", (join ", " tables)])

main :: IO ()
main = CGI.runCGI (CGI.handleErrors cgiMain)

join :: [a] -> [[a]] -> [a]
join sep = concat . List.intersperse sep

Annotation number 4: This one works (deepSeq, no bracket)
Pasted by: thou
When:7 years, 10 months ago
Share:Tweet this! | http://paste.lisp.org/+LTD/4
Paste contents:
Raw Source | Display As
main :: IO ()
main = CGI.runCGI (CGI.handleErrors cgiMain)

cgiMain :: CGI.CGI CGI.CGIResult
cgiMain =
	do
	dbh <- liftDB (ODBC.connectODBC "DSN=lbugs")
	cgiResult <- proc dbh
	liftDB (DB.disconnect dbh)
	return cgiResult

liftDB :: DeepSeq a => IO a -> CGI.CGI a
liftDB action =
	lift $
		do
		dbResult <- DB.handleSqlError action
		dbResult `deepSeq` return dbResult

proc :: DB.Connection -> CGI.CGI CGI.CGIResult
proc dbh =
	do
	tables <- liftDB (DB.getTables dbh)
	CGI.output (join " " ["Tables:", (join ", " tables)])

Annotation number 5: attempt at myBracket :: IO a -> (a -> IO b) -> (a -> CGI c) -> CGI c
Pasted by: thou
When:7 years, 10 months ago
Share:Tweet this! | http://paste.lisp.org/+LTD/5
Paste contents:
Raw Source | Display As
cgiMain :: CGI.CGI CGI.CGIResult
cgiMain =
	myBracket
		(ODBC.connectODBC "DSN=lbugs")
		DB.disconnect
		proc

myBracket :: IO a -> (a -> IO b) -> (a -> CGI.CGI c) -> CGI.CGI c
myBracket acquire destroy use =
	-- lift Exception.block $
		do
		resource <- lift acquire
		result <- Monad.liftM2 Exception.catch
			(lift (Exception.unblock (use resource)))
			(\e -> do { lift (destroy resource); Exception.throw e })
		lift (destroy resource)
		return result

Annotation number 6: myBracket (without block/unblock); with errors
Pasted by: thou
When:7 years, 10 months ago
Share:Tweet this! | http://paste.lisp.org/+LTD/6
Paste contents:
Raw Source | Display As
{-

ghc -o t --make -O -fallow-overlapping-instances t.hs -package HDBC -package HDBC-odbc -package xhtml -package cgi-compat
Chasing modules from: t.hs
Skipping  DeepSeq          ( ./DeepSeq.lhs, ./DeepSeq.o )
Compiling Main             ( t.hs, t.o )

t.hs:28:25:
    Couldn't match the rigid variable `c' against `IO a'
      `c' is bound by the type signature for `myBracket'
      Expected type: Network.CGI.Monad.CGIT IO (IO a)
      Inferred type: Network.CGI.Monad.CGI c
    In the application `use resource'
    In the second argument of `Control.Monad.liftM2', namely `(use resource)'
*** Error code 1

Stop in /usr/home/tim/m/tmp/hs.

-}

cgiMain :: CGI.CGI CGI.CGIResult
cgiMain =
	myBracket
		(ODBC.connectODBC "DSN=lbugs")
		DB.disconnect
		proc

myBracket :: IO a -> (a -> IO b) -> (a -> CGI.CGI c) -> CGI.CGI c
myBracket acquire destroy use =
	-- lift Exception.block $
		do
		resource <- lift acquire
		result <- Monad.liftM2 Exception.catch
			(use resource)
			(\e -> do { lift (destroy resource); Exception.throw e })
		lift (destroy resource)
		return result

Annotation number 7: error without type signature for myBracket ("Couldn't match kind...")
Pasted by: thou
When:7 years, 10 months ago
Share:Tweet this! | http://paste.lisp.org/+LTD/7
Paste contents:
Raw Source | Display As
t.hs:29:36:
    Couldn't match kind `?? -> ? -> *' against `(* -> *) -> * -> *'
    When matching the kinds of `(->) :: ?? -> ? -> *' and `t :: (* -> *) -> * -> *'
      Expected type: (->) GHC.IOBase.Exception
      Inferred type: t m
    In a 'do' expression: lift (destroy resource)
*** Error code 1

Annotation number 8: Simpler program (using StateT and basic IO) demonstrating same problem
Pasted by: thou
When:7 years, 10 months ago
Share:Tweet this! | http://paste.lisp.org/+LTD/8
Paste contents:
Raw Source | Display As
I made a simpler test program which shows the same structure, but uses only standard modules.  I hope it will make it easier for someone to understand the problem, play with solutions, etc.

http://www.magnesium.net/~thim/tmp/transbracket.hs

Thanks again for all your help so far.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.