Added feature of forming reponse into text

3 files changed, 80 insertions, 2 deletions

diff --git a/Main.hs b/Main.hs
index aefc95c..3ebb7d1 100644
--- a/Main.hs
+++ b/Main.hs
@@ -14,4 +14,4 @@ table = [ Route indexGet (T.pack "/") GET
 
 main = do
   response <- resolve table (Request [] (T.pack "/hello") GET)
-  print $ response
\ No newline at end of file
+  print $ formResponse response
\ No newline at end of file
diff --git a/Web/Response.hs b/Web/Response.hs
index 39f6887..9bc2179 100644
--- a/Web/Response.hs
+++ b/Web/Response.hs
@@ -3,6 +3,8 @@ module Web.Response where
 import qualified Data.Text as T
 import Data.Text (Text)
 
+import Web.Utils
+
 data Response
   = HtmlResponse Int Text -- Код возврата, содержимое HTML
   | TextResponse Int Text Text -- Код возврата, Content-Type, содержимое HTML
@@ -18,3 +20,11 @@ getContentType (TextResponse _ contentType _) = contentType
 
 getContent (HtmlResponse _ content) = content
 getContent (TextResponse _ _ content) = content
+
+formResponse :: Response -> Text
+formResponse (HtmlResponse code html) = 
+  T.unlines
+  $ map T.pack [ "HTTP/1.1 " ++ getStatus code
+               , "Content-Type: text/html; charset=utf-8"
+               , "Connection: keep-alive"
+               , "" ] ++ [html]
diff --git a/Web/Utils.hs b/Web/Utils.hs
index 3449f21..4e9082b 100644
--- a/Web/Utils.hs
+++ b/Web/Utils.hs
@@ -1,4 +1,4 @@
-module Web.Utils (parseQs, parseHttp) where
+module Web.Utils (parseQs, parseHttp, getStatus) where
 
 import Network.HTTP.Types.URI as URI
 import qualified Data.ByteString as S
@@ -81,3 +81,71 @@ parseHttp text =
     (path, query) = parseQs url
   in 
     ((method, path, query), parseHeaders headers, rest2)
+
+-- HTTP Status Codes
+statusCodes = 
+  [ (100, "Continue"),
+    (101, "Switching Protocols"),
+    (102, "Processing"),
+    (200, "OK"),
+    (201, "Created"),
+    (202, "Accepted"),
+    (203, "Non Authoritative Information"),
+    (204, "No Content"),
+    (205, "Reset Content"),
+    (206, "Partial Content"),
+    (207, "Multi Status"),
+    (226, "IM Used"),
+    (300, "Multiple Choices"),
+    (301, "Moved Permanently"),
+    (302, "Found"),
+    (303, "See Other"),
+    (304, "Not Modified"),
+    (305, "Use Proxy"),
+    (307, "Temporary Redirect"),
+    (308, "Permanent Redirect"),
+    (400, "Bad Request"),
+    (401, "Unauthorized"),
+    (402, "Payment Required"),
+    (403, "Forbidden"),
+    (404, "Not Found"),
+    (405, "Method Not Allowed"),
+    (406, "Not Acceptable"),
+    (407, "Proxy Authentication Required"),
+    (408, "Request Timeout"),
+    (409, "Conflict"),
+    (410, "Gone"),
+    (411, "Length Required"),
+    (412, "Precondition Failed"),
+    (413, "Request Entity Too Large"),
+    (414, "Request URI Too Long"),
+    (415, "Unsupported Media Type"),
+    (416, "Requested Range Not Satisfiable"),
+    (417, "Expectation Failed"),
+    (418, "I'm a teapot"),
+    (421, "Misdirected Request"),
+    (422, "Unprocessable Entity"),
+    (423, "Locked"),
+    (424, "Failed Dependency"),
+    (426, "Upgrade Required"),
+    (428, "Precondition Required"),
+    (429, "Too Many Requests"),
+    (431, "Request Header Fields Too Large"),
+    (449, "Retry With"),
+    (451, "Unavailable For Legal Reasons"),
+    (500, "Internal Server Error"),
+    (501, "Not Implemented"),
+    (502, "Bad Gateway"),
+    (503, "Service Unavailable"),
+    (504, "Gateway Timeout"),
+    (505, "HTTP Version Not Supported"),
+    (507, "Insufficient Storage"),
+    (510, "Not Extended") ]
+
+getStatus :: Int -> String
+getStatus code = findStatus statusCodes
+  where
+    findStatus ((codeCheck, stat) : rest)
+      | codeCheck == code = show code ++ " " ++ stat
+      | otherwise         = findStatus rest
+    findStatus [] = "500 Internal Server Error"