[commit: testsuite] master: Test Trac #5045 (bde76b2)

[Simon Peyton Jones]

Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/bde76b238ca0cc3fae8d51a0afcfbb04154352de

>---------------------------------------------------------------

commit bde76b238ca0cc3fae8d51a0afcfbb04154352de
Author: simonpj <simonpj at cam-04-unx.europe.corp.microsoft.com>
Date:   Tue Apr 19 17:42:59 2011 +0100

    Test Trac #5045

>---------------------------------------------------------------

 tests/ghc-regress/ghci/scripts/T5045.hs     |   44 +++++++++++++++++++++++++++
 tests/ghc-regress/ghci/scripts/T5045.script |    2 +
 tests/ghc-regress/ghci/scripts/all.T        |    1 +
 3 files changed, 47 insertions(+), 0 deletions(-)

diff --git a/tests/ghc-regress/ghci/scripts/T5045.hs b/tests/ghc-regress/ghci/scripts/T5045.hs
new file mode 100644
index 0000000..a63bead
--- /dev/null
+++ b/tests/ghc-regress/ghci/scripts/T5045.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE Arrows, FunctionalDependencies, FlexibleContexts, 
+             MultiParamTypeClasses, RecordWildCards  #-}
+
+module T5045 where
+
+import Control.Arrow
+
+class (Control.Arrow.Arrow a') => ArrowAddReader r a a' | a -> a' where
+  elimReader :: a e b -> a' (e, r) b
+
+newtype ByteString = FakeByteString String
+
+pathInfo :: Monad m => m String
+pathInfo = undefined
+
+requestMethod :: Monad m => m String
+requestMethod = undefined
+
+getInputsFPS :: Monad m => m [(String, ByteString)]  
+getInputsFPS = undefined
+
+class HTTPRequest r s | r -> s where
+    httpGetPath :: r -> String
+    httpSetPath :: r -> String -> r
+    httpGetMethod :: r -> String
+    httpGetInputs :: r -> [(String, s)]
+
+data CGIDispatch = CGIDispatch {
+    dispatchPath :: String,
+    dispatchMethod :: String,
+    dispatchInputs :: [(String, ByteString)]  }
+
+instance HTTPRequest CGIDispatch ByteString where
+    httpGetPath = dispatchPath
+    httpSetPath r s = r { dispatchPath = s }
+    httpGetMethod = dispatchMethod
+    httpGetInputs = dispatchInputs
+
+runDispatch :: (Arrow a, ArrowAddReader CGIDispatch a a', Monad m) => a b  c -> m (a' b c)  
+runDispatch a = do
+    dispatchPath <- pathInfo
+    dispatchMethod <- requestMethod
+    dispatchInputs <- getInputsFPS
+    return $ proc b -> (| elimReader (a -< b) |) CGIDispatch { .. }  
diff --git a/tests/ghc-regress/ghci/scripts/T5045.script b/tests/ghc-regress/ghci/scripts/T5045.script
new file mode 100644
index 0000000..34e9a58
--- /dev/null
+++ b/tests/ghc-regress/ghci/scripts/T5045.script
@@ -0,0 +1,2 @@
+:l T5045.hs
+
diff --git a/tests/ghc-regress/ghci/scripts/all.T b/tests/ghc-regress/ghci/scripts/all.T
index 41ac239..e74cd90 100644
--- a/tests/ghc-regress/ghci/scripts/all.T
+++ b/tests/ghc-regress/ghci/scripts/all.T
@@ -73,3 +73,4 @@ test('T4127', normal, ghci_script, ['T4127.script'])
 test('T4127a', normal, ghci_script, ['T4127a.script'])
 test('T4316', reqlib('mtl'), ghci_script, ['T4316.script'])
 test('T4832', normal, ghci_script, ['T4832.script'])
+test('T5045', normal, ghci_script, ['T5045.script'])