Commit b534b270 authored by simonpj's avatar simonpj
Browse files

Test Trac #5045

parent 7a6a7a3b
{-# 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 { .. }
......@@ -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'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment