Browse files

Fixed all hlint suggestions.

  • Loading branch information...
1 parent 904a6de commit 0173855fa03b74c3e1ed0aad83fe3f0ff5eddd1d @thoughtpolice thoughtpolice committed with Jan 20, 2009
Showing with 29 additions and 32 deletions.
  1. +1 −1 Data/Enumerator.hs
  2. +6 −9 Hyena/BufferedSocket.hs
  3. +1 −1 Hyena/Config.hs
  4. +3 −3 Hyena/Http.hs
  5. +5 −5 Hyena/Logging.hs
  6. +13 −13 Hyena/Server.hs
View
2 Data/Enumerator.hs
@@ -48,7 +48,7 @@ chunkEnum enum f initSeed = fst `liftM` enum go (initSeed, Left S.empty)
chunkLen = pHeader hdr
in case chunkLen of
Just n -> go (seed, Right n) rest
- Nothing -> error $ "malformed header" ++ (show hdr)
+ Nothing -> error $ "malformed header" ++ show hdr
Nothing -> return $ Right (seed, Left (S.append acc bs))
go (seed, Right n) bs =
let len = S.length bs
View
15 Hyena/BufferedSocket.hs
@@ -29,19 +29,17 @@ blockSize = 4 * 1024
fromSocket :: Socket -> IO BufferedSocket
fromSocket sock = do
buffRef <- newIORef S.empty
- return $ BufferedSocket
- { buffer = buffRef
- , socket = sock
- }
+ return BufferedSocket
+ { buffer = buffRef
+ , socket = sock
+ }
-- | @readBlock bsock maxBytes@ reads up to @maxBytes@ from @bsock@.
readBlock :: BufferedSocket -> Int -> IO S.ByteString
readBlock bsock n = do
buf <- readIORef $ buffer bsock
if S.null buf
- then do
- bs <- recv (socket bsock) blockSize
- split bs
+ then recv (socket bsock) blockSize >>= split
else split buf
where
split bs
@@ -54,8 +52,7 @@ readBlock bsock n = do
-- | Pushes back some data to the socket so it can later be read by
-- 'readBlock'.
putBackBlock :: BufferedSocket -> S.ByteString -> IO ()
-putBackBlock bsock bs = do
- modifyIORef (buffer bsock) (flip S.append bs)
+putBackBlock bsock = modifyIORef (buffer bsock) . flip S.append
-- | @toEnumerator bsock maxBytes@ creates an enumerator that iterates
-- over @max_bytes@ bytes from @bsock@.
View
2 Hyena/Config.hs
@@ -75,7 +75,7 @@ configFromFlags = do
progName <- getProgName
case parseArgs argv progName of
Left err -> putStr err >> exitFailure
- Right flags -> flagsToConfig $ (defaultFlags cwd) `mappend` flags
+ Right flags -> flagsToConfig $ defaultFlags cwd `mappend` flags
-- | A set of default options most users should use. Creates missing
-- directories as needed for the default log file when in 'daemonize'd
View
6 Hyena/Http.hs
@@ -37,6 +37,7 @@ import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as C (map, pack, unpack)
import Data.Char (chr, digitToInt, isAlpha, isDigit, isSpace, ord, toLower)
import Data.Either (either)
+import Control.Arrow
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Data.Word (Word8)
@@ -147,7 +148,7 @@ contentLength req
getHeader :: String -> IRequest -> Maybe S.ByteString
getHeader hdr req = lookup (C.map toLower $ C.pack hdr) headers
where
- mapFst f = map (\(k, v) -> (f k, v))
+ mapFst = map . first
headers = mapFst (C.map toLower) (iRequestHeaders req)
-- ---------------------------------------------------------------------
@@ -277,7 +278,7 @@ isValidStatusCode code = M.member code reasonPhrases
-- | Mapping from status code to reason phrases.
reasonPhrases :: M.Map Int S.ByteString
-reasonPhrases = M.fromList . map (\(k, v) -> (k, C.pack v)) $
+reasonPhrases = M.fromList . map (second C.pack) $
[(100, "Continue")
,(101, "Switching Protocols")
,(200, "OK")
@@ -337,4 +338,3 @@ parseRequest input =
, requestBody = \f z -> either id id `fmap` f z bs
}
in return $ Just (req', S.empty)
-
View
10 Hyena/Logging.hs
@@ -59,9 +59,9 @@ startLogger writer logHandle = do
chan <- newChan
finished' <- newEmptyMVar
forkIO $ logMessages chan finished'
- return $ Logger { channel = chan
- , finished = finished'
- }
+ return Logger { channel = chan
+ , finished = finished'
+ }
where
logMessages chan finished' = do
msg <- readChan chan
@@ -95,7 +95,7 @@ stopErrorLogger (ErrorLogger logger) = stopLogger logger
-- | Log an error.
logError :: ErrorLogger -> String -> IO ()
-logError (ErrorLogger logger) msg = writeChan (channel logger) $ Just msg
+logError (ErrorLogger logger) = writeChan (channel logger) . Just
-- | Write error message to the given 'Handle'.
writeError :: Handle -> String -> IO ()
@@ -104,7 +104,7 @@ writeError handle msg = hPutStr handle msg >> hFlush handle
-- | Log a client request.
logAccess :: AccessLogger -> Request -> Response -> HostAddress -> IO ()
logAccess (AccessLogger logger) req resp haddr =
- writeChan (channel logger) $ Just $
+ writeChan (channel logger) $ Just
LogRequest
{ hostAddress = haddr
, request = req
View
26 Hyena/Server.hs
@@ -128,14 +128,14 @@ serveWithConfig conf application = do
-- | Start loggers, run an action using those loggers and when
-- finished, stop the loggers.
bracketLoggers :: Handle -> (AccessLogger -> ErrorLogger -> IO ()) -> IO ()
-bracketLoggers h m =
+bracketLoggers h =
bracket (do accessLog <- startAccessLogger h
errorLog <- startErrorLogger stderr
return (accessLog, errorLog))
(\(accessLog, errorLog) -> do
stopErrorLogger errorLog
stopAccessLogger accessLog)
- (\(accessLog, errorLog) -> m accessLog errorLog)
+ . uncurry
-- | Open the server socket and start accepting connections.
serve' :: Application -> Server ()
@@ -158,11 +158,11 @@ serve' application = do
acceptConnections :: Application -> Socket -> Server ()
acceptConnections application serverSock = do
(sock, SockAddrInet _ haddr) <- io $ accept serverSock
- forkServer $ ((talk sock haddr application `finallyServer`
- (io $ sClose sock))
- `catchServer`
- (\e -> do logger <- asks errorLogger
- io $ logError logger $ show e))
+ forkServer ((talk sock haddr application `finallyServer`
+ (io $ sClose sock))
+ `catchServer`
+ (\e -> do logger <- asks errorLogger
+ io $ logError logger $ show e))
acceptConnections application serverSock
-- | Read the client input, parse the request, run the application,
@@ -190,12 +190,12 @@ run environ application = io $ do
-- TODO: Check the validity of the returned status code and headers
-- and log an error and send a 500 if either is invalid.
(status, reason, headers', output) <- application environ
- return $ Response
- { statusCode = status
- , reasonPhrase = reason
- , responseHeaders = headers'
- , responseBody = output
- }
+ return Response
+ { statusCode = status
+ , reasonPhrase = reason
+ , responseHeaders = headers'
+ , responseBody = output
+ }
-- | Check if the connection should be closed after processing this
-- request.

0 comments on commit 0173855

Please sign in to comment.