From 6c2fffdc8bc84879e103e6838e4f9fc762d50a2d Mon Sep 17 00:00:00 2001 From: michaelt Date: Tue, 11 Nov 2014 22:02:24 -0500 Subject: added eoflens to discriminate whether decoding was completed --- Pipes/Text/Encoding.hs | 35 +++++++++++++++++++++++++++++++++++ Pipes/Text/Tutorial.hs | 4 ++-- 2 files changed, 37 insertions(+), 2 deletions(-) (limited to 'Pipes/Text') diff --git a/Pipes/Text/Encoding.hs b/Pipes/Text/Encoding.hs index e00cd43..f26f168 100644 --- a/Pipes/Text/Encoding.hs +++ b/Pipes/Text/Encoding.hs @@ -12,6 +12,7 @@ module Pipes.Text.Encoding -- $lenses Codec , decode + , eof -- * \'Viewing\' the Text in a byte stream -- $codecs , utf8 @@ -88,9 +89,42 @@ type Codec -} + decode :: ((b -> Constant b b) -> (a -> Constant b a)) -> a -> b decode codec a = getConstant (codec Constant a) +{- | 'eof' tells you explicitly when decoding stops due to bad bytes or instead + reaches end-of-file happily. (Without it one just makes an explicit test + for emptiness of the resulting bytestring production using 'next') + Thus + +> decode (utf8 . eof) p = view (utf8 . eof) p = p^.utf8.eof + + will be a text producer. If we hit undecodable bytes, the remaining + bytestring producer will be returned as a 'Left' value; + in the happy case, a 'Right' value is returned with the anticipated + return value for the original bytestring producer. + ) + +-} + +eof :: Monad m => Lens' (Producer Text m (Producer ByteString m r)) + (Producer Text m (Either (Producer ByteString m r) r)) +eof k p = fmap fromEither (k (toEither p)) where + + fromEither = liftM (either id return) + + toEither pp = do p <- pp + check p + + check p = do e <- lift (next p) + case e of + Left r -> return (Right r) + Right (bs,pb) -> if B.null bs + then check pb + else return (Left (do yield bs + pb)) + {- $codecs @@ -186,6 +220,7 @@ decodeStream = loop where p') {-# INLINABLE decodeStream#-} + {- $decoders These are functions with the simple type: diff --git a/Pipes/Text/Tutorial.hs b/Pipes/Text/Tutorial.hs index 07b8751..25f9e41 100644 --- a/Pipes/Text/Tutorial.hs +++ b/Pipes/Text/Tutorial.hs @@ -24,12 +24,12 @@ module Pipes.Text.Tutorial ( -- * Special types: @Producer Text m (Producer Text m r)@ and @FreeT (Producer Text m) m r@ -- $special ) where - + import Pipes import Pipes.Text import Pipes.Text.IO import Pipes.Text.Encoding - + {- $intro This package provides @pipes@ utilities for /character streams/, realized as streams of 'Text' chunks. The individual chunks are uniformly /strict/, -- cgit v1.2.3