Commits

Luke Plant committed 50c5ddd

Changed order of arguments of buildResponse

Comments (0)

Files changed (5)

src/Blog/Views.hs

 import Blog.Templates
 
 mainIndex :: Request -> IO (Maybe Response)
-mainIndex req = return $ Just $ buildResponse utf8HtmlResponse [
+mainIndex req = return $ Just $ buildResponse [
                  addHtml mainIndexPage
-                ]
+                ] utf8HtmlResponse
 
-debug path req = return $ Just $ buildResponse utf8TextResponse [
+debug path req = return $ Just $ buildResponse [
                   addContent "Path:\n"
                  , addContent $ utf8 path
                  , addContent "\n\nRequest:\n"
                  , addContent $ utf8 $ show req
-                 ]
+                 ] utf8TextResponse 

src/Web/Framework.hs

 
 type View = Request -> IO (Maybe Response)
 
-default404 = buildResponse utf8HtmlResponse [
+default404 = buildResponse [
               setStatus 404,
               addContent "<h1>404 Not Found</h1>\n<p>Sorry, the page you requested could not be found.</p>"
-             ]
+             ] utf8HtmlResponse
 
 defaultDispatchOptions = DispatchOptions {
                            notFoundHandler = const $ return $ default404

src/Web/Response.hs

 -- | Create an empty response for sending HTML, UTF-8 encoding
 utf8HtmlResponse = htmlResponse "UTF-8"
 
--- | Build a Response from an initial Response and a list of
--- Response transformation functions
-buildResponse :: Response -> [Response -> Response] -> Response
-buildResponse rinit fs = foldl (flip ($)) rinit fs
-
+-- | Build a Response from a list of Response transformation functions
+-- and an initial Response
+buildResponse :: [Response -> Response] -> Response -> Response
+buildResponse fs rinit = foldl (flip ($)) rinit fs
 
 allHeaders resp =
     let statusHeader = (HeaderName "Status", show $ status resp)

testsuite/tests/Tests/Web/Framework.hs

 import Web.Utils
 
 req1 = mkGetReq "/posts/"
-resp1 = buildResponse utf8HtmlResponse [ addContent "resp1" ]
-resp2 = buildResponse utf8HtmlResponse [ addContent "resp2" ]
+resp1 = buildResponse [ addContent "resp1" ] utf8HtmlResponse
+resp2 = buildResponse [ addContent "resp2" ] utf8HtmlResponse
 
 mkGetReq path = mkRequest [("REQUEST_METHOD","GET"),
                            ("PATH_INFO", path)] ""
 
 viewWithStringParam1 :: String -> Request -> IO (Maybe Response)
 viewWithStringParam1 p req = return $ Just $ viewWithStringParam1' p
-viewWithStringParam1' p = buildResponse utf8HtmlResponse [
+viewWithStringParam1' p = buildResponse [
                            addContent $ utf8 ("Got: " ++ p)
-                          ]
+                          ] utf8HtmlResponse
 
 viewWithIntParam1 :: Int -> Request -> IO (Maybe Response)
 viewWithIntParam1 p req = return $ Just $ viewWithIntParam1' p
-viewWithIntParam1' p = buildResponse utf8HtmlResponse [
+viewWithIntParam1' p = buildResponse [
                         addContent $ utf8 ("Got integer: " ++ show p)
-                       ]
+                       ] utf8HtmlResponse
 
 viewWithIntParam2 :: Int -> Request -> IO (Maybe Response)
 viewWithIntParam2 p req = return $ Just $ viewWithIntParam2' p
-viewWithIntParam2' p = buildResponse utf8HtmlResponse [
+viewWithIntParam2' p = buildResponse [
                         addContent $ utf8 ("2: Got integer: " ++ show p)
-                       ]
+                       ] utf8HtmlResponse
 
 viewWithIntAndStringParam1 :: Int -> String -> Request -> IO (Maybe Response)
 viewWithIntAndStringParam1 i s req = return $ Just $ viewWithIntAndStringParam1' i s
-viewWithIntAndStringParam1' i s = buildResponse utf8HtmlResponse [
+viewWithIntAndStringParam1' i s = buildResponse [
                                    addContent $ utf8 ("Got integer: " ++ show i ++
                                                       " and string: " ++ s)
-                                  ]
+                                  ] utf8HtmlResponse
 
 viewWithIntStringInt1 :: Int -> String -> Int -> Request -> IO (Maybe Response)
 viewWithIntStringInt1 i s i2 req = return $ Just $ viewWithIntStringInt1' i s i2
-viewWithIntStringInt1' i s i2 = buildResponse utf8HtmlResponse [
-                                   addContent $ utf8 ("Got integer 1: " ++ show i ++
-                                                      " and string: " ++ s ++
-                                                      " and integer 2: "++ show i2)
-                                ]
+viewWithIntStringInt1' i s i2 = buildResponse [
+                                 addContent $ utf8 ("Got integer 1: " ++ show i ++
+                                                    " and string: " ++ s ++
+                                                    " and integer 2: "++ show i2)
+                                ] utf8HtmlResponse
 
 -- Some of the syntax below is complicated by the fact that the
 -- functions being tested all use the IO monad in their type

testsuite/tests/Tests/Web/Response.hs

 testAddContent2 = "Hello world" ~=? (content $ addContent " world" $ addContent "Hello" $ emptyResponse)
 
 testBuildResponse = "hello world" ~=? (content $
-                                       buildResponse utf8HtmlResponse [
-                                                          addContent "hello",
-                                                          addContent " world"
-                                                         ])
+                                       buildResponse [ addContent "hello"
+                                                     , addContent " world"
+                                                     ] utf8HtmlResponse)
 
 testFormatResponse = "Content-type: text/html; charset=UTF-8\r\n\
                      \Status: 200\r\n\
                      \\r\n\
-                     \<h1>Test</h1>" ~=? 
-                     (formatResponse $ buildResponse utf8HtmlResponse [
+                     \<h1>Test</h1>" ~=?
+                     (formatResponse $ buildResponse [
                                           addContent "<h1>Test</h1>"
-                                         ])
+                                         ] utf8HtmlResponse)
 
 testFormatResponse2 = "Content-type: text/html; charset=UTF-8\r\n\
                       \Status: 404\r\n\
                       \\r\n\
                       \<h1>404 Not Found</h1>" ~=?
-                      (formatResponse $ buildResponse utf8HtmlResponse [
+                      (formatResponse $ buildResponse [
                                            addContent "<h1>404 Not Found</h1>"
                                           , setStatus 404
-                                          ])
+                                          ] utf8HtmlResponse)
 
 tests = test [
           testAddContent1