diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,12 @@ +# Version 1.2.0.1 + + - `System.IO.Streams.Attoparsec.parseFromStream`: export more information + about the context of parse errors to the message returned via + `ParseException`. + + - Improved documentation about stream flushing in the docstring for + `handleToOutputStream`. + # Version 1.2.0.0 - Fixed bug #27 (https://github.com/snapframework/io-streams/issues/27): makeOutputStream now properly shuts down the stream upon receiving EOF. The diff --git a/io-streams.cabal b/io-streams.cabal --- a/io-streams.cabal +++ b/io-streams.cabal @@ -1,5 +1,5 @@ Name: io-streams -Version: 1.2.0.0 +Version: 1.2.0.1 License: BSD3 License-file: LICENSE Category: Data, Network, IO-Streams diff --git a/src/System/IO/Streams/Builder.hs b/src/System/IO/Streams/Builder.hs --- a/src/System/IO/Streams/Builder.hs +++ b/src/System/IO/Streams/Builder.hs @@ -10,7 +10,7 @@ -- -- (/N.B./: most of the @blaze-builder@ package has been moved into -- @bytestring@ in versions \>= 0.10; once two or three Haskell Platform --- editions have been released that contain @bytestring@ 0.10 or higher, the +-- editions have been released that contain @bytestring@ 0.10.2 or higher, the -- dependency on @blaze-builder@ will be dropped in favor of the native support -- for 'Builder' contained in the @bytestring@ package.) -- @@ -43,8 +43,8 @@ -- As a convention, 'builderStream' will write the empty string to the wrapped -- 'OutputStream' upon a builder buffer flush. Output streams which receive -- 'ByteString' should either ignore the empty string or interpret it as a --- signal to flush their own buffers, as the "System.IO.Streams.Zlib" functions --- do. +-- signal to flush their own buffers, as the @handleToOutputStream@ and +-- "System.IO.Streams.Zlib" functions do. -- -- /Example/ -- diff --git a/src/System/IO/Streams/Handle.hs b/src/System/IO/Streams/Handle.hs --- a/src/System/IO/Streams/Handle.hs +++ b/src/System/IO/Streams/Handle.hs @@ -56,6 +56,11 @@ -- Note that the wrapped handle is /not/ closed when it receives end-of-stream; -- you can use 'System.IO.Streams.Combinators.atEndOfOutput' to close the -- handle if you would like this behaviour. +-- +-- /Note/: to force the 'Handle' to be flushed, you can write a null string to +-- the returned 'OutputStream': +-- +-- > Streams.write (Just "") os handleToOutputStream :: Handle -> IO (OutputStream ByteString) handleToOutputStream h = makeOutputStream f where @@ -87,11 +92,12 @@ -- that the 'Handle' will be opened in non-buffering mode; if you buffer the -- 'OutputStream' using the 'Handle' buffering then @io-streams@ will copy the -- 'Handle' buffer when sending 'ByteString' values to the output, which might --- not be what you want. When the output buffer, if used, is flushed, an empty --- string is written to the output, as is conventional throughout the --- @io-streams@ library for 'ByteString' output buffers. +-- not be what you want. -- --- Note: the 'OutputStream' passed into this function is wrapped in +-- When the output buffer, if used, is flushed (using 'System.IO.hFlush'), an +-- empty string is written to the provided 'OutputStream'. +-- +-- /Note/: the 'OutputStream' passed into this function is wrapped in -- 'lockingOutputStream' to make it thread-safe. -- -- /Since: 1.0.2.0./ diff --git a/src/System/IO/Streams/Internal/Attoparsec.hs b/src/System/IO/Streams/Internal/Attoparsec.hs --- a/src/System/IO/Streams/Internal/Attoparsec.hs +++ b/src/System/IO/Streams/Internal/Attoparsec.hs @@ -1,24 +1,30 @@ -- | This module provides support for parsing values from 'InputStream's using -- @attoparsec@. +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Internal.Attoparsec ( -- * Parsing - ParseException(..) - , parseFromStream + parseFromStream , parseFromStreamInternal , parserToInputStream + + -- * Parse Exceptions + , ParseException(..) + + , eitherResult ) where ------------------------------------------------------------------------------ import Control.Exception (Exception, throwIO) import Control.Monad (when) -import Data.Attoparsec.ByteString.Char8 (Parser, Result, eitherResult, feed, parse) +import Data.Attoparsec.ByteString.Char8 (Parser, Result, feed, parse) import Data.Attoparsec.Types (IResult (..)) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S +import Data.List (intercalate) import Data.Typeable (Typeable) import Prelude hiding (read) ------------------------------------------------------------------------------ @@ -36,14 +42,16 @@ instance Exception ParseException + ------------------------------------------------------------------------------ -- | Supplies an @attoparsec@ 'Parser' with an 'InputStream', returning the --- final parsed value or a 'ParseException' if parsing fails. +-- final parsed value or throwing a 'ParseException' if parsing fails. -- -- 'parseFromStream' consumes only as much input as necessary to satisfy the --- 'Parser' and unconsumed input is pushed back onto the 'InputStream'. +-- 'Parser': any unconsumed input is pushed back onto the 'InputStream'. -- --- If the 'Parser' exhausts the 'InputStream', it receives an @EOF@. +-- If the 'Parser' exhausts the 'InputStream', the end-of-stream signal is sent +-- to attoparsec. -- -- Example: -- @@ -85,8 +93,12 @@ Partial _ -> err k' -- should be impossible Done x r -> leftover x >> return r - err r = let (Left s) = eitherResult r in throwIO $ ParseException s + err r = let (Left (!_,c,m)) = eitherResult r + in throwIO $ ParseException (ctxMsg c ++ m) + ctxMsg [] = "" + ctxMsg xs = "[parsing " ++ intercalate "/" xs ++ "] " + go r@(Fail x _ _) = leftover x >> err r go (Done x r) = leftover x >> return r go r = Streams.read is >>= @@ -128,3 +140,12 @@ -> IO (InputStream r) parserToInputStream = (Streams.makeInputStream .) . parseFromStream {-# INLINE parserToInputStream #-} + + +------------------------------------------------------------------------------ +-- A replacement for attoparsec's 'eitherResult', which discards information +-- about the context of the failed parse. +eitherResult :: Result r -> Either (ByteString, [String], String) r +eitherResult (Done _ r) = Right r +eitherResult (Fail residual ctx msg) = Left (residual, ctx, msg) +eitherResult _ = Left ("", [], "Result: incomplete input") diff --git a/test/System/IO/Streams/Tests/Attoparsec.hs b/test/System/IO/Streams/Tests/Attoparsec.hs --- a/test/System/IO/Streams/Tests/Attoparsec.hs +++ b/test/System/IO/Streams/Tests/Attoparsec.hs @@ -4,7 +4,7 @@ ------------------------------------------------------------------------------ import Control.Monad -import Data.Attoparsec.ByteString.Char8 +import Data.Attoparsec.ByteString.Char8 hiding (eitherResult) import Data.ByteString.Char8 (ByteString) import Prelude hiding (takeWhile) import System.IO.Streams @@ -78,7 +78,7 @@ expectExceptionH $ fromList ["xxxxx"] >>= p where - p = parserToInputStream testParser2 >=> toList + p = parserToInputStream ((testParser2 "foo") "bar") >=> toList ------------------------------------------------------------------------------ @@ -96,7 +96,8 @@ testTrivials :: Test testTrivials = testCase "attoparsec/trivials" $ do coverTypeableInstance (undefined :: ParseException) - + let (Right x) = eitherResult $ Done undefined (4 :: Int) + assertEqual "eitherResult" 4 x ------------------------------------------------------------------------------ testEmbeddedNull :: Test