@@ -8,8 +8,7 @@ import Prelude hiding (log)
8import Control.Monad (forever)
8import Control.Monad (forever)
9import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)
9import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)
10import Network
10import Network
11−import System.IO (stderr, Handle, IOMode(..), openFile, hFileSize, hClose)
11+import System.IO
12−import qualified System.IO.UTF8 as U
13import System.Directory (doesFileExist, doesDirectoryExist)
12import System.Directory (doesFileExist, doesDirectoryExist)
14import Control.Concurrent (forkIO)
13import Control.Concurrent (forkIO)
15import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
14import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
@@ -22,7 +21,7 @@ import Text.Hakyll.Regex
23-- | Function to log from a chan.
22-- | Function to log from a chan.
24log :: Chan String -> IO ()
23log :: Chan String -> IO ()
25−log logChan = forever (readChan logChan >>= U.hPutStrLn stderr)
24+log logChan = forever (readChan logChan >>= hPutStrLn stderr)
27-- | General server configuration.
26-- | General server configuration.
28data ServerConfig = ServerConfig { documentRoot :: FilePath
27data ServerConfig = ServerConfig { documentRoot :: FilePath
@@ -48,7 +47,7 @@ instance Show Request where
48-- headers and body.
47-- headers and body.
49readRequest :: Handle -> Server Request
48readRequest :: Handle -> Server Request
50readRequest handle = do
49readRequest handle = do
51− requestLine <- liftIO $ U.hGetLine handle
50+ requestLine <- liftIO $ hGetLine handle
52 let [method, uri, version] = map trim $ splitRegex " " requestLine
51 let [method, uri, version] = map trim $ splitRegex " " requestLine
53 return $ Request { requestMethod = method
52 return $ Request { requestMethod = method
54 , requestURI = uri
53 , requestURI = uri
@@ -110,10 +109,9 @@ createGetResponse request = do
112 create200 = do
111 create200 = do
113− h <- openFile fileName ReadMode
112+ h <- openBinaryFile fileName ReadMode
114 contentLength <- hFileSize h
113 contentLength <- hFileSize h
115− hClose h
114+ body <- hGetContents h
116− body <- readFile fileName
117 let headers =
115 let headers =
118 [ ("Content-Length", show $ contentLength)
116 [ ("Content-Length", show $ contentLength)
119 ] ++ getMIMEHeader fileName
117 ] ++ getMIMEHeader fileName
@@ -148,7 +146,7 @@ getMIMEHeader fileName =
148 result = lookup (takeExtension fileName) [ (".css", "text/css")
146 result = lookup (takeExtension fileName) [ (".css", "text/css")
149 , (".gif", "image/gif")
147 , (".gif", "image/gif")
150 , (".htm", "text/html")
148 , (".htm", "text/html")
151− , (".html", "text/html; charset=utf8")
149+ , (".html", "text/html")
152 , (".jpeg", "image/jpeg")
150 , (".jpeg", "image/jpeg")
153 , (".jpg", "image/jpeg")
151 , (".jpg", "image/jpeg")
154 , (".js", "text/javascript")
152 , (".js", "text/javascript")
@@ -172,21 +170,21 @@ respond handle = do
172 -- Send the response back to the handle.
170 -- Send the response back to the handle.
173 liftIO $ putResponse response
171 liftIO $ putResponse response
175− putResponse response = do U.hPutStr handle $ intercalate " "
173+ putResponse response = do hPutStr handle $ intercalate " "
176 [ responseVersion response
174 [ responseVersion response
177 , show $ responseStatusCode response
175 , show $ responseStatusCode response
178 , responsePhrase response
176 , responsePhrase response
180− U.hPutStr handle "\r\n"
178+ hPutStr handle "\r\n"
181 mapM_ putHeader
179 mapM_ putHeader
182 (M.toList $ responseHeaders response)
180 (M.toList $ responseHeaders response)
183− U.hPutStr handle "\r\n"
181+ hPutStr handle "\r\n"
184− U.hPutStr handle $ responseBody response
182+ hPutStr handle $ responseBody response
185− U.hPutStr handle "\r\n"
183+ hPutStr handle "\r\n"
186 hClose handle
184 hClose handle
188 putHeader (key, value) =
186 putHeader (key, value) =
189− U.hPutStr handle $ key ++ ": " ++ value ++ "\r\n"
187+ hPutStr handle $ key ++ ": " ++ value ++ "\r\n"
191-- | Start a simple http server on the given 'PortNumber', serving the given
189-- | Start a simple http server on the given 'PortNumber', serving the given
192-- directory.
190-- directory.