diff --git a/Pipes/Text.hs b/Pipes/Text.hs --- a/Pipes/Text.hs +++ b/Pipes/Text.hs @@ -66,11 +66,9 @@ , stdin , fromHandle , readFile - , stdinLn -- * Consumers , stdout - , stdoutLn , toHandle , writeFile @@ -167,7 +165,7 @@ , module Data.Word , module Pipes.Parse , module Pipes.Group - , module Pipes.Text.Internal.Codec + , module Pipes.Text.Internal ) where import Control.Exception (throwIO, try) @@ -197,8 +195,8 @@ import qualified GHC.IO.Exception as G import Pipes import qualified Pipes.ByteString as PB -import qualified Pipes.Text.Internal.Decoding as PE -import Pipes.Text.Internal.Codec +import qualified Pipes.Text.Internal as PI +import Pipes.Text.Internal import Pipes.Core (respond, Server') import Pipes.Group (concats, intercalates, FreeT(..), FreeF(..)) import qualified Pipes.Group as PG @@ -275,28 +273,7 @@ readFile file = Safe.withFile file IO.ReadMode fromHandle {-# INLINE readFile #-} -{-| Crudely stream lines of input from stdin in the style of Pipes.Prelude. - This is for testing in ghci etc.; obviously it will be unsound if used to recieve - the contents of immense files with few newlines. ->>> let safely = runSafeT . runEffect ->>> safely $ for Text.stdinLn (lift . lift . print . T.length) -hello -5 -world -5 - --} -stdinLn :: MonadIO m => Producer' Text m () -stdinLn = go where - go = do - eof <- liftIO (IO.hIsEOF IO.stdin) - unless eof $ do - txt <- liftIO (T.hGetLine IO.stdin) - yield txt - go -{-# INLINABLE stdinLn #-} - {-| Stream text to 'stdout' Unlike 'toHandle', 'stdout' gracefully terminates on a broken output pipe. @@ -319,20 +296,6 @@ Right () -> go {-# INLINABLE stdout #-} -stdoutLn :: (MonadIO m) => Consumer' Text m () -stdoutLn = go - where - go = do - str <- await - x <- liftIO $ try (T.putStrLn str) - case x of - Left (G.IOError { G.ioe_type = G.ResourceVanished - , G.ioe_errno = Just ioe }) - | Errno ioe == ePIPE - -> return () - Left e -> liftIO (throwIO e) - Right () -> go -{-# INLINABLE stdoutLn #-} {-| Convert a text stream into a 'Handle' @@ -723,13 +686,14 @@ {-# INLINABLE isEndOfChars #-} --- | An improper lens into a stream of 'ByteString' expected to be UTF-8 encoded; the associated --- stream of Text ends by returning a stream of ByteStrings beginning at the point of failure. +{- | An improper lens into a stream of 'ByteString' expected to be UTF-8 encoded; the associated + stream of Text ends by returning a stream of ByteStrings beginning at the point of failure. + -} decodeUtf8 :: Monad m => Lens' (Producer ByteString m r) (Producer Text m (Producer ByteString m r)) decodeUtf8 k p0 = fmap (\p -> join (for p (yield . TE.encodeUtf8))) - (k (go B.empty PE.streamDecodeUtf8 p0)) where + (k (go B.empty PI.streamDecodeUtf8 p0)) where go !carry dec0 p = do x <- lift (next p) case x of Left r -> return (if B.null carry @@ -738,9 +702,9 @@ return r)) Right (chunk, p') -> case dec0 chunk of - PE.Some text carry2 dec -> do yield text + PI.Some text carry2 dec -> do yield text go carry2 dec p' - PE.Other text bs -> do yield text + PI.Other text bs -> do yield text return (do yield bs -- an invalid blob remains p') {-# INLINABLE decodeUtf8 #-} @@ -1010,7 +974,6 @@ {-# INLINABLE lines #-} - -- | Split a text stream into 'FreeT'-delimited words words :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r) @@ -1090,23 +1053,37 @@ @Pipes.Parse@ re-exports 'input', 'concat', 'FreeT' (the type) and the 'Parse' synonym. -} +{- | Use a 'Codec' as a pipes-style 'Lens' into a byte stream; the available 'Codec' s are + 'utf8', 'utf16_le', 'utf16_be', 'utf32_le', 'utf32_be' . The 'Codec' concept and the + individual 'Codec' definitions follow the enumerator and conduit libraries. + + Utf8 is handled differently in this library -- without the use of 'unsafePerformIO' &co + to catch 'Text' exceptions; but the same 'mypipe ^. codec utf8' interface can be used. + 'mypipe ^. decodeUtf8' should be the same, but has a somewhat more direct and thus perhaps + better implementation. + + -} codec :: Monad m => Codec -> Lens' (Producer ByteString m r) (Producer Text m (Producer ByteString m r)) codec (Codec _ enc dec) k p0 = fmap (\p -> join (for p (yield . fst . enc))) (k (decoder (dec B.empty) p0) ) where - decoder :: Monad m => PE.Decoding -> Producer ByteString m r -> Producer Text m (Producer ByteString m r) + decoder :: Monad m => PI.Decoding -> Producer ByteString m r -> Producer Text m (Producer ByteString m r) decoder !d p0 = case d of - PE.Other txt bad -> do yield txt + PI.Other txt bad -> do yield txt return (do yield bad p0) - PE.Some txt extra dec -> do yield txt + PI.Some txt extra dec -> do yield txt x <- lift (next p0) case x of Left r -> return (do yield extra return r) Right (chunk,p1) -> decoder (dec chunk) p1 --- decodeUtf8 k p0 = fmap (\p -> join (for p (yield . TE.encodeUtf8))) --- (k (go B.empty PE.streamDecodeUtf8 p0)) where +{- | ascii and latin encodings only represent a small fragment of 'Text'; thus we cannot + use the pipes 'Lens' style to work with them. Rather we simply define functions + each way. + 'encodeAscii' : Reduce as much of your stream of 'Text' actually is ascii to a byte stream, + returning the rest of the 'Text' at the first non-ascii 'Char' +-} encodeAscii :: Monad m => Producer Text m r -> Producer ByteString m (Producer Text m r) encodeAscii = go where go p = do echunk <- lift (next p) @@ -1121,7 +1098,9 @@ then go p' else return $ do yield unsafe p' - +{- | Reduce as much of your stream of 'Text' actually is iso8859 or latin1 to a byte stream, + returning the rest of the 'Text' upon hitting any non-latin 'Char' + -} encodeIso8859_1 :: Monad m => Producer Text m r -> Producer ByteString m (Producer Text m r) encodeIso8859_1 = go where go p = do etxt <- lift (next p) @@ -1137,6 +1116,9 @@ else return $ do yield unsafe p' +{- | Reduce a byte stream to a corresponding stream of ascii chars, returning the + unused 'ByteString' upon hitting an un-ascii byte. + -} decodeAscii :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) decodeAscii = go where go p = do echunk <- lift (next p) @@ -1152,7 +1134,9 @@ else return $ do yield unsafe p' - +{- | Reduce a byte stream to a corresponding stream of ascii chars, returning the + unused 'ByteString' upon hitting the rare un-latinizable byte. + -} decodeIso8859_1 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) decodeIso8859_1 = go where go p = do echunk <- lift (next p) @@ -1170,34 +1154,5 @@ -{- - ascii :: Codec - ascii = Codec name enc (toDecoding dec) where - name = T.pack "ASCII" - enc text = (bytes, extra) where - (safe, unsafe) = T.span (\c -> ord c <= 0x7F) text - bytes = B8.pack (T.unpack safe) - extra = if T.null unsafe - then Nothing - else Just (EncodeException ascii (T.head unsafe), unsafe) - dec bytes = (text, extra) where - (safe, unsafe) = B.span (<= 0x7F) bytes - text = T.pack (B8.unpack safe) - extra = if B.null unsafe - then Right B.empty - else Left (DecodeException ascii (B.head unsafe), unsafe) - - iso8859_1 :: Codec - iso8859_1 = Codec name enc (toDecoding dec) where - name = T.pack "ISO-8859-1" - enc text = (bytes, extra) where - (safe, unsafe) = T.span (\c -> ord c <= 0xFF) text - bytes = B8.pack (T.unpack safe) - extra = if T.null unsafe - then Nothing - else Just (EncodeException iso8859_1 (T.head unsafe), unsafe) - - dec bytes = (T.pack (B8.unpack bytes), Right B.empty) --} diff --git a/Pipes/Text/Internal.hs b/Pipes/Text/Internal.hs new file mode 100644 --- /dev/null +++ b/Pipes/Text/Internal.hs @@ -0,0 +1,15 @@ +module Pipes.Text.Internal + ( Decoding(..) + , streamDecodeUtf8 + , decodeSomeUtf8 + , Codec(..) + , TextException(..) + , utf8 + , utf16_le + , utf16_be + , utf32_le + , utf32_be + ) where + +import Pipes.Text.Internal.Decoding +import Pipes.Text.Internal.Codec diff --git a/Pipes/Text/Internal/Codec.hs b/Pipes/Text/Internal/Codec.hs --- a/Pipes/Text/Internal/Codec.hs +++ b/Pipes/Text/Internal/Codec.hs @@ -3,8 +3,12 @@ -- | -- Copyright: 2014 Michael Thompson, 2011 Michael Snoyman, 2010-2011 John Millikin -- License: MIT --- --- Parts of this code were taken from enumerator and conduits, and adapted for pipes. +-- This Parts of this code were taken from enumerator and conduits, and adapted for pipes +{- | This module follows the model of the enumerator and conduits libraries, and defines + 'Codec' s for various encodings. Note that we do not export a 'Codec' for ascii and + iso8859_1. A 'Lens' in the sense of the pipes library cannot be defined for these, so + special functions appear in @Pipes.Text@ +-} module Pipes.Text.Internal.Codec ( Decoding(..) @@ -41,12 +45,11 @@ import Pipes.Text.Internal.Decoding import Pipes -- | A specific character encoding. --- --- Since 0.3.0 + data Codec = Codec { codecName :: Text , codecEncode :: Text -> (ByteString, Maybe (TextException, Text)) - , codecDecode :: ByteString -> Decoding -- (Text, Either (TextException, ByteString) ByteString) + , codecDecode :: ByteString -> Decoding } instance Show Codec where diff --git a/Pipes/Text/Internal/Decoding.hs b/Pipes/Text/Internal/Decoding.hs --- a/Pipes/Text/Internal/Decoding.hs +++ b/Pipes/Text/Internal/Decoding.hs @@ -2,9 +2,11 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, MagicHash, UnliftedFFITypes #-} {-# LANGUAGE DeriveDataTypeable, RankNTypes #-} --- This module lifts assorted materials from Brian O'Sullivan's text package --- especially Data.Text.Encoding in order to define a pipes-appropriate --- streamDecodeUtf8 +{- | +This module lifts assorted materials from Brian O'Sullivan's text package +especially @Data.Text.Encoding@ in order to define a pipes-appropriate +'streamDecodeUtf8' +-} module Pipes.Text.Internal.Decoding ( Decoding(..) , streamDecodeUtf8 @@ -41,9 +43,9 @@ --- | A stream oriented decoding result. -data Decoding = Some Text ByteString (ByteString -> Decoding) - | Other Text ByteString +-- | A stream oriented decoding result. Distinct from the similar type in @Data.Text.Encoding@ +data Decoding = Some Text ByteString (ByteString -> Decoding) -- | Text, continuation and any undecoded fragment. + | Other Text ByteString -- | Text followed by an undecodable ByteString instance Show Decoding where showsPrec d (Some t bs _) = showParen (d > prec) $ showString "Some " . showsPrec prec' t . @@ -59,6 +61,7 @@ newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable) newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable) +-- | Resolve a 'ByteString' into 'Text' and a continuation that can handle further 'ByteStrings'. streamDecodeUtf8 :: ByteString -> Decoding streamDecodeUtf8 = decodeChunkUtf8 B.empty 0 0 where @@ -92,6 +95,7 @@ {-# INLINE decodeChunkUtf8 #-} {-# INLINE streamDecodeUtf8 #-} +-- | Resolve a ByteString into an initial segment of intelligible 'Text' and whatever is unintelligble decodeSomeUtf8 :: ByteString -> (Text, ByteString) decodeSomeUtf8 bs@(PS fp off len) = runST $ do dest <- A.new (len+1) diff --git a/pipes-text.cabal b/pipes-text.cabal --- a/pipes-text.cabal +++ b/pipes-text.cabal @@ -1,5 +1,5 @@ name: pipes-text -version: 0.0.0.0 +version: 0.0.0.1 synopsis: Text pipes. description: Many of the pipes and other operations defined here mirror those in the `pipes-bytestring` library. Folds like `length` and grouping @@ -19,23 +19,25 @@ homepage: https://github.com/michaelt/text-pipes bug-reports: https://github.com/michaelt/text-pipes/issues - license: BSD3 license-file: LICENSE author: Michael Thompson maintainer: what_is_it_to_do_anything@yahoo.com category: Text, Pipes - build-type: Simple cabal-version: >=1.10 -extra-source-files: README.md - include/*.h +extra-source-files: README.md include/*.h +source-repository head + type: git + location: https://github.com/michaelt/text-pipes + + library c-sources: cbits/cbits.c include-dirs: include - exposed-modules: Pipes.Text, Pipes.Text.Internal.Decoding, Pipes.Text.Internal.Codec - -- other-modules: + exposed-modules: Pipes.Text, Pipes.Text.Internal + other-modules: Pipes.Text.Internal.Decoding, Pipes.Text.Internal.Codec other-extensions: RankNTypes build-depends: base >= 4 && < 5 , bytestring >=0.10 && < 0.11,