1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# 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, s) b -> a' (e, (r, s)) 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 { .. }
|