Skip to content
Browse files

Hoist out duplicated catchError definitions :-(

  • Loading branch information...
1 parent 43afcf2 commit be28fb7e65411077c58dec07d5eb8d3e1ae7f288 @bos committed Sep 8, 2012
Showing with 12 additions and 17 deletions.
  1. +12 −17 Data/Text/IO.hs
View
29 Data/Text/IO.hs
@@ -98,20 +98,22 @@ writeFile p = withFile p WriteMode . flip hPutStr
appendFile :: FilePath -> Text -> IO ()
appendFile p = withFile p AppendMode . flip hPutStr
+catchError :: String -> Handle -> Handle__ -> IOError -> IO Text
+catchError caller h Handle__{..} err
+ | isEOFError err = do
+ buf <- readIORef haCharBuffer
+ return $ if isEmptyBuffer buf
+ then T.empty
+ else T.singleton '\r'
+ | otherwise = E.throwIO (augmentIOError err caller h)
+
-- | Read a single chunk of strict text from a 'Handle'.
hGetChunk :: Handle -> IO Text
hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk
where
readSingleChunk hh@Handle__{..} = do
- let catchError e
- | isEOFError e = do
- buf <- readIORef haCharBuffer
- return $ if isEmptyBuffer buf
- then T.empty
- else T.singleton '\r'
- | otherwise = throwIO (augmentIOError e "hGetChunk" h)
buf <- readIORef haCharBuffer
- t <- readChunk hh buf `catch` catchError
+ t <- readChunk hh buf `E.catch` catchError "hGetChunk" h hh
return (hh, t)
-- | Read the remaining contents of a 'Handle' as a string. The
@@ -134,16 +136,9 @@ hGetContents h = do
wantReadableHandle "hGetContents" h readAll
where
readAll hh@Handle__{..} = do
- let catchError e
- | isEOFError e = do
- buf <- readIORef haCharBuffer
- return $ if isEmptyBuffer buf
- then T.empty
- else T.singleton '\r'
- | otherwise = E.throwIO (augmentIOError e "hGetContents" h)
- readChunks = do
+ let readChunks = do
buf <- readIORef haCharBuffer
- t <- readChunk hh buf `E.catch` catchError
+ t <- readChunk hh buf `E.catch` catchError "hGetContents" h hh
if T.null t
then return [t]
else (t:) `fmap` readChunks

0 comments on commit be28fb7

Please sign in to comment.
Something went wrong with that request. Please try again.