Test Trac #5045

testsuite/tests/ghc-regress/ghci/scripts/T5045.hs

+{-# 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 { .. }  

testsuite/tests/ghc-regress/ghci/scripts/T5045.script

+:l T5045.hs
+

testsuite/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'])