@@ -8,8 +8,7 @@ import Prelude hiding (log)
88import Control.Monad (forever)
99import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)
1010import Network
11−import System.IO (stderr, Handle, IOMode(..), openFile, hFileSize, hClose)
12−import qualified System.IO.UTF8 as U
11+import System.IO
1312import System.Directory (doesFileExist, doesDirectoryExist)
1413import Control.Concurrent (forkIO)
1514import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
@@ -22,7 +21,7 @@ import Text.Hakyll.Regex
2221
2322-- | Function to log from a chan.
2423log :: Chan String -> IO ()
25−log logChan = forever (readChan logChan >>= U.hPutStrLn stderr)
24+log logChan = forever (readChan logChan >>= hPutStrLn stderr)
2625
2726-- | General server configuration.
2827data ServerConfig = ServerConfig { documentRoot :: FilePath
@@ -48,7 +47,7 @@ instance Show Request where
4847-- headers and body.
4948readRequest :: Handle -> Server Request
5049readRequest handle = do
51− requestLine <- liftIO $ U.hGetLine handle
50+ requestLine <- liftIO $ hGetLine handle
5251 let [method, uri, version] = map trim $ splitRegex " " requestLine
5352 return $ Request { requestMethod = method
5453 , requestURI = uri
@@ -110,10 +109,9 @@ createGetResponse request = do
110109 else uri
111110
112111 create200 = do
113− h <- openFile fileName ReadMode
112+ h <- openBinaryFile fileName ReadMode
114113 contentLength <- hFileSize h
115− hClose h
116− body <- readFile fileName
114+ body <- hGetContents h
117115 let headers =
118116 [ ("Content-Length", show $ contentLength)
119117 ] ++ getMIMEHeader fileName
@@ -148,7 +146,7 @@ getMIMEHeader fileName =
148146 result = lookup (takeExtension fileName) [ (".css", "text/css")
149147 , (".gif", "image/gif")
150148 , (".htm", "text/html")
151− , (".html", "text/html; charset=utf8")
149+ , (".html", "text/html")
152150 , (".jpeg", "image/jpeg")
153151 , (".jpg", "image/jpeg")
154152 , (".js", "text/javascript")
@@ -172,21 +170,21 @@ respond handle = do
172170 -- Send the response back to the handle.
173171 liftIO $ putResponse response
174172 where
175− putResponse response = do U.hPutStr handle $ intercalate " "
173+ putResponse response = do hPutStr handle $ intercalate " "
176174 [ responseVersion response
177175 , show $ responseStatusCode response
178176 , responsePhrase response
179177 ]
180− U.hPutStr handle "\r\n"
178+ hPutStr handle "\r\n"
181179 mapM_ putHeader
182180 (M.toList $ responseHeaders response)
183− U.hPutStr handle "\r\n"
184− U.hPutStr handle $ responseBody response
185− U.hPutStr handle "\r\n"
181+ hPutStr handle "\r\n"
182+ hPutStr handle $ responseBody response
183+ hPutStr handle "\r\n"
186184 hClose handle
187185
188186 putHeader (key, value) =
189− U.hPutStr handle $ key ++ ": " ++ value ++ "\r\n"
187+ hPutStr handle $ key ++ ": " ++ value ++ "\r\n"
190188
191189-- | Start a simple http server on the given 'PortNumber', serving the given
192190-- directory.