diff --git a/Pipes/Text.hs b/Pipes/Text.hs --- a/Pipes/Text.hs +++ b/Pipes/Text.hs @@ -10,7 +10,8 @@ example, the following program copies a document from one file to another: > import Pipes -> import qualified Data.Text.Pipes as Text +> import qualified Pipes.Text as Text +> import qualified Pipes.Text.IO as Text > import System.IO > > main = @@ -21,7 +22,8 @@ To stream from files, the following is perhaps more Prelude-like (note that it uses Pipes.Safe): > import Pipes -> import qualified Data.Text.Pipes as Text +> import qualified Pipes.Text as Text +> import qualified Pipes.Text.IO as Text > import Pipes.Safe > > main = runSafeT $ runEffect $ Text.readFile "inFile.txt" >-> Text.writeFile "outFile.txt" @@ -60,15 +62,7 @@ module Pipes.Text ( -- * Producers - fromLazy - , stdin - , fromHandle - , readFile - - -- * Consumers - , stdout - , toHandle - , writeFile + fromLazy -- * Pipes , map @@ -79,7 +73,6 @@ , dropWhile , filter , scan - , encodeUtf8 , pack , unpack , toCaseFold @@ -104,7 +97,6 @@ , count -- * Primitive Character Parsers - -- $parse , nextChar , drawChar , unDrawChar @@ -119,30 +111,13 @@ , group , word , line - - -- * Decoding Lenses - , decodeUtf8 - , codec - - -- * Codecs - , utf8 - , utf16_le - , utf16_be - , utf32_le - , utf32_be - - -- * Other Decoding/Encoding Functions - , decodeIso8859_1 - , decodeAscii - , encodeIso8859_1 - , encodeAscii -- * FreeT Splitters , chunksOf , splitsWith , splits --- , groupsBy --- , groups + , groupsBy + , groups , lines , words @@ -155,60 +130,34 @@ , unlines , unwords - -- * Re-exports - -- $reexports - , Decoding(..) - , streamDecodeUtf8 - , decodeSomeUtf8 - , Codec(..) - , TextException(..) + -- * Re-exports + , Lens' + , Iso' , module Data.ByteString , module Data.Text , module Data.Profunctor - , module Data.Word , module Pipes.Parse , module Pipes.Group ) where -import Control.Exception (throwIO, try) import Control.Applicative ((<*)) -import Control.Monad (liftM, unless, join) +import Control.Monad (liftM, join) import Control.Monad.Trans.State.Strict (StateT(..), modify) -import Data.Monoid ((<>)) import qualified Data.Text as T -import qualified Data.Text.IO as T -import qualified Data.Text.Encoding as TE -import qualified Data.Text.Encoding.Error as TE import Data.Text (Text) import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.IO as TL import Data.Text.Lazy.Internal (foldrChunks, defaultChunkSize) -import Data.ByteString.Unsafe (unsafeTake, unsafeDrop) import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import Data.Char (ord, isSpace) import Data.Functor.Constant (Constant(Constant, getConstant)) import Data.Functor.Identity (Identity) import Data.Profunctor (Profunctor) import qualified Data.Profunctor -import qualified Data.List as List -import Foreign.C.Error (Errno(Errno), ePIPE) -import qualified GHC.IO.Exception as G import Pipes -import qualified Pipes.ByteString as PB -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 import qualified Pipes.Parse as PP import Pipes.Parse (Parser) -import qualified Pipes.Safe.Prelude as Safe -import qualified Pipes.Safe as Safe -import Pipes.Safe (MonadSafe(..), Base(..)) import qualified Pipes.Prelude as P -import qualified System.IO as IO import Data.Char (isSpace) import Data.Word (Word8) @@ -246,79 +195,7 @@ fromLazy = foldrChunks (\e a -> yield e >> a) (return ()) {-# INLINE fromLazy #-} --- | Stream text from 'stdin' -stdin :: MonadIO m => Producer Text m () -stdin = fromHandle IO.stdin -{-# INLINE stdin #-} -{-| Convert a 'IO.Handle' into a text stream using a text size - determined by the good sense of the text library; note that this - is distinctly slower than @decideUtf8 (Pipes.ByteString.fromHandle h)@ - but uses the system encoding and has other `Data.Text.IO` features --} - -fromHandle :: MonadIO m => IO.Handle -> Producer Text m () -fromHandle h = go where - go = do txt <- liftIO (T.hGetChunk h) - unless (T.null txt) ( do yield txt - go ) -{-# INLINABLE fromHandle#-} - - -{-| Stream text from a file in the simple fashion of @Data.Text.IO@ - ->>> runSafeT $ runEffect $ Text.readFile "hello.hs" >-> Text.map toUpper >-> hoist lift Text.stdout -MAIN = PUTSTRLN "HELLO WORLD" --} - -readFile :: MonadSafe m => FilePath -> Producer Text m () -readFile file = Safe.withFile file IO.ReadMode fromHandle -{-# INLINE readFile #-} - - -{-| Stream text to 'stdout' - - Unlike 'toHandle', 'stdout' gracefully terminates on a broken output pipe. - - Note: For best performance, it might be best just to use @(for source (liftIO . putStr))@ - instead of @(source >-> stdout)@ . --} -stdout :: MonadIO m => Consumer' Text m () -stdout = go - where - go = do - txt <- await - x <- liftIO $ try (T.putStr txt) - 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 stdout #-} - - -{-| Convert a text stream into a 'Handle' - - Note: again, for best performance, where possible use - @(for source (liftIO . hPutStr handle))@ instead of @(source >-> toHandle handle)@. --} -toHandle :: MonadIO m => IO.Handle -> Consumer' Text m r -toHandle h = for cat (liftIO . T.hPutStr h) -{-# INLINABLE toHandle #-} - -{-# RULES "p >-> toHandle h" forall p h . - p >-> toHandle h = for p (\txt -> liftIO (T.hPutStr h txt)) - #-} - - --- | Stream text into a file. Uses @pipes-safe@. -writeFile :: (MonadSafe m) => FilePath -> Consumer' Text m () -writeFile file = Safe.withFile file IO.WriteMode toHandle -{-# INLINE writeFile #-} - - type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a) type Iso' a b = forall f p . (Functor f, Profunctor p) => p b (f b) -> p a (f a) @@ -346,17 +223,7 @@ p >-> concatMap f = for p (\txt -> yield (T.concatMap f txt)) #-} --- | Transform a Pipe of 'Text' into a Pipe of 'ByteString's using UTF-8 --- encoding; @encodeUtf8 = Pipes.Prelude.map TE.encodeUtf8@ so more complex --- encoding pipes can easily be constructed with the functions in @Data.Text.Encoding@ -encodeUtf8 :: Monad m => Pipe Text ByteString m r -encodeUtf8 = P.map TE.encodeUtf8 -{-# INLINEABLE encodeUtf8 #-} -{-# RULES "p >-> encodeUtf8" forall p . - p >-> encodeUtf8 = for p (\txt -> yield (TE.encodeUtf8 txt)) - #-} - -- | Transform a Pipe of 'String's into one of 'Text' chunks pack :: Monad m => Pipe String Text m r pack = P.map T.pack @@ -485,13 +352,15 @@ scan :: (Monad m) => (Char -> Char -> Char) -> Char -> Pipe Text Text m r -scan step begin = go begin +scan step begin = do + yield (T.singleton begin) + go begin where go c = do txt <- await let txt' = T.scanl step c txt c' = T.last txt' - yield txt' + yield (T.tail txt') go c' {-# INLINABLE scan #-} @@ -589,7 +458,6 @@ Just c -> Just (min c (T.minimum txt)) {-# INLINABLE minimum #-} - -- | Find the first element in the stream that matches the predicate find :: (Monad m) @@ -611,12 +479,12 @@ {-# INLINABLE count #-} -{-| Consume the first character from a stream of 'Text' +-- | Consume the first character from a stream of 'Text' +-- +-- 'next' either fails with a 'Left' if the 'Producer' has no more characters or +-- succeeds with a 'Right' providing the next character and the remainder of the +-- 'Producer'. - 'next' either fails with a 'Left' if the 'Producer' has no more characters or - succeeds with a 'Right' providing the next character and the remainder of the - 'Producer'. --} nextChar :: (Monad m) => Producer Text m r @@ -632,9 +500,8 @@ Just (c, txt') -> return (Right (c, yield txt' >> p')) {-# INLINABLE nextChar #-} -{-| Draw one 'Char' from a stream of 'Text', returning 'Left' if the - 'Producer' is empty --} +-- | Draw one 'Char' from a stream of 'Text', returning 'Left' if the 'Producer' is empty + drawChar :: (Monad m) => Parser Text m (Maybe Char) drawChar = do x <- PP.draw @@ -661,7 +528,9 @@ > Left _ -> return () > Right c -> unDrawChar c > return x + -} + peekChar :: (Monad m) => Parser Text m (Maybe Char) peekChar = do x <- drawChar @@ -688,30 +557,6 @@ {-# 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. - -} - -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 PI.streamDecodeUtf8 p0)) where - go !carry dec0 p = do - x <- lift (next p) - case x of Left r -> return (if B.null carry - then return r -- all bytestring input was consumed - else (do yield carry -- a potentially valid fragment remains - return r)) - - Right (chunk, p') -> case dec0 chunk of - PI.Some text carry2 dec -> do yield text - go carry2 dec p' - PI.Other text bs -> do yield text - return (do yield bs -- an invalid blob remains - p') -{-# INLINABLE decodeUtf8 #-} - - -- | Splits a 'Producer' after the given number of characters splitAt :: (Monad m, Integral n) @@ -738,9 +583,10 @@ {-# INLINABLE splitAt #-} -{-| Split a text stream in two, where the first text stream is the longest - consecutive group of text that satisfy the predicate --} +-- | Split a text stream in two, producing the longest +-- consecutive group of characters that satisfies the predicate +-- and returning the rest + span :: (Monad m) => (Char -> Bool) @@ -763,7 +609,7 @@ return (yield suffix >> p') {-# INLINABLE span #-} -{-| Split a text stream in two, where the first text stream is the longest +{-| Split a text stream in two, producing the longest consecutive group of characters that don't satisfy the predicate -} break @@ -1043,118 +889,5 @@ unwords = intercalate (yield $ T.singleton ' ') {-# INLINABLE unwords #-} -{- $parse - The following parsing utilities are single-character analogs of the ones found - @pipes-parse@. --} -{- $reexports - - @Data.Text@ re-exports the 'Text' type. - @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 => PI.Decoding -> Producer ByteString m r -> Producer Text m (Producer ByteString m r) - decoder !d p0 = case d of - PI.Other txt bad -> do yield txt - return (do yield bad - p0) - 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 - -{- | 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) - case echunk of - Left r -> return (return r) - Right (chunk, p') -> - if T.null chunk - then go p' - else let (safe, unsafe) = T.span (\c -> ord c <= 0x7F) chunk - in do yield (B8.pack (T.unpack safe)) - if T.null unsafe - 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) - case etxt of - Left r -> return (return r) - Right (txt, p') -> - if T.null txt - then go p' - else let (safe, unsafe) = T.span (\c -> ord c <= 0xFF) txt - in do yield (B8.pack (T.unpack safe)) - if T.null unsafe - then go p' - 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) - case echunk of - Left r -> return (return r) - Right (chunk, p') -> - if B.null chunk - then go p' - else let (safe, unsafe) = B.span (<= 0x7F) chunk - in do yield (T.pack (B8.unpack safe)) - if B.null unsafe - then go p' - 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) - case echunk of - Left r -> return (return r) - Right (chunk, p') -> - if B.null chunk - then go p' - else let (safe, unsafe) = B.span (<= 0xFF) chunk - in do yield (T.pack (B8.unpack safe)) - if B.null unsafe - then go p' - else return $ do yield unsafe - p' - - - - - diff --git a/Pipes/Text/Encoding.hs b/Pipes/Text/Encoding.hs new file mode 100644 --- /dev/null +++ b/Pipes/Text/Encoding.hs @@ -0,0 +1,233 @@ + +{-# LANGUAGE RankNTypes, BangPatterns #-} +-- | + +-- This module uses the stream decoding functions from the text-stream-decoding package +-- to define decoding functions and lenses. + +module Pipes.Text.Encoding + ( + -- * Lens type + -- $producers + Codec + -- * Standard lenses for viewing Text in ByteString + , utf8 + , utf8Pure + , utf16LE + , utf16BE + , utf32LE + , utf32BE + -- * Non-lens decoding functions + , decodeUtf8 + , decodeUtf8Pure + , decodeUtf16LE + , decodeUtf16BE + , decodeUtf32LE + , decodeUtf32BE + -- * Functions for latin and ascii text + -- $ascii + , encodeAscii + , decodeAscii + , encodeIso8859_1 + , decodeIso8859_1 + ) + where + +import Data.Char (ord) +import Data.ByteString as B +import Data.ByteString (ByteString) +import Data.ByteString.Char8 as B8 +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Text.StreamDecoding +import Control.Monad (join) +import Data.Word (Word8) +import Pipes + + + +{- $producers + The 'Codec' type is just an aliased standard Prelude type. It is more or + less the Lens\' type of the + standard lens libraries, @lens@ and @lens-families@ so you can use + the @view@ or @(^.)@ and @zoom@ functions from those libraries. + + Each looks into a byte stream that is expected to contain text. + The stream of text they 'see' in a bytestream ends by returning the original byte stream + beginning at the point of failure, or the empty bytestream with its return value. + They are named in accordance with the expected encoding, 'utf8', 'utf16LE' etc. + +> view utf8 :: Producer ByteString m r -> Producer Text m (Producer ByteString m r) +> Bytes.stdin ^. utf8 :: Producer Text m (Producer ByteString m r) + + @zoom@ converts a Text parser into a ByteString parser: + +> zoom utf8 drawChar :: Monad m => StateT (Producer ByteString m r) m (Maybe Char) +> +> withNextByte :: Parser ByteString m (Maybe Char, Maybe Word8))) +> withNextByte = do char_ <- zoom utf8 Text.drawChar +> byte_ <- Bytes.peekByte +> return (char_, byte_) + + @withNextByte@ will return the first valid Char in a ByteString, + and the first byte of the next character, if they exists; because + we draw one and peek at the other, we only advance one Char's length + along the bytestring. + +-} +type Codec = forall f m r . (Functor f , Monad m ) => + (Producer Text m (Producer ByteString m r) -> f (Producer Text m (Producer ByteString m r))) + -> Producer ByteString m r -> f (Producer ByteString m r ) + +decodeStream :: Monad m + => (B.ByteString -> DecodeResult) + -> Producer ByteString m r -> Producer Text m (Producer ByteString m r) +decodeStream = loop where + loop dec0 p = + do x <- lift (next p) + case x of Left r -> return (return r) + Right (chunk, p') -> case dec0 chunk of + DecodeResultSuccess text dec -> do yield text + loop dec p' + DecodeResultFailure text bs -> do yield text + return (do yield bs + p') +{-# INLINABLE decodeStream#-} + +decodeUtf8 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) +decodeUtf8 = decodeStream streamUtf8 +{-# INLINE decodeUtf8 #-} + +decodeUtf8Pure :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) +decodeUtf8Pure = decodeStream streamUtf8Pure +{-# INLINE decodeUtf8Pure #-} + +decodeUtf16LE :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) +decodeUtf16LE = decodeStream streamUtf16LE +{-# INLINE decodeUtf16LE #-} + +decodeUtf16BE :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) +decodeUtf16BE = decodeStream streamUtf16BE +{-# INLINE decodeUtf16BE #-} + +decodeUtf32LE :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) +decodeUtf32LE = decodeStream streamUtf32LE +{-# INLINE decodeUtf32LE #-} + +decodeUtf32BE :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) +decodeUtf32BE = decodeStream streamUtf32BE +{-# INLINE decodeUtf32BE #-} + +mkCodec :: (forall r m . Monad m => + Producer ByteString m r -> Producer Text m (Producer ByteString m r )) + -> (Text -> ByteString) + -> Codec +mkCodec dec enc = \k p0 -> fmap (\p -> join (for p (yield . enc))) (k (dec p0)) + + +{- | An improper lens into a byte stream expected to be UTF-8 encoded; the associated + text stream ends by returning the original bytestream beginning at the point of failure, + or the empty bytestring for a well-encoded text. + -} + +utf8 :: Codec +utf8 = mkCodec decodeUtf8 TE.encodeUtf8 + +utf8Pure :: Codec +utf8Pure = mkCodec decodeUtf8Pure TE.encodeUtf8 + +utf16LE :: Codec +utf16LE = mkCodec decodeUtf16LE TE.encodeUtf16LE + +utf16BE :: Codec +utf16BE = mkCodec decodeUtf16BE TE.encodeUtf16BE + +utf32LE :: Codec +utf32LE = mkCodec decodeUtf32LE TE.encodeUtf32LE + +utf32BE :: Codec +utf32BE = mkCodec decodeUtf32BE TE.encodeUtf32BE + + +{- $ascii + ascii and latin encodings only use a small number of the characters 'Text' + recognizes; thus we cannot use the pipes @Lens@ style to work with them. + Rather we simply define functions each way. +-} + + +-- 'encodeAscii' reduces 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 e <- lift (next p) + case e of + Left r -> return (return r) + Right (chunk, p') -> + if T.null chunk + then go p' + else let (safe, unsafe) = T.span (\c -> ord c <= 0x7F) chunk + in do yield (B8.pack (T.unpack safe)) + if T.null unsafe + 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 e <- lift (next p) + case e of + Left r -> return (return r) + Right (txt, p') -> + if T.null txt + then go p' + else let (safe, unsafe) = T.span (\c -> ord c <= 0xFF) txt + in do yield (B8.pack (T.unpack safe)) + if T.null unsafe + then go p' + 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 e <- lift (next p) + case e of + Left r -> return (return r) + Right (chunk, p') -> + if B.null chunk + then go p' + else let (safe, unsafe) = B.span (<= 0x7F) chunk + in do yield (T.pack (B8.unpack safe)) + if B.null unsafe + then go p' + 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 e <- lift (next p) + case e of + Left r -> return (return r) + Right (chunk, p') -> + if B.null chunk + then go p' + else do let (safe, unsafe) = B.span (<= 0xFF) chunk + yield (T.pack (B8.unpack safe)) + if B.null unsafe + then go p' + else return (do yield unsafe + p') + + + diff --git a/Pipes/Text/IO.hs b/Pipes/Text/IO.hs new file mode 100644 --- /dev/null +++ b/Pipes/Text/IO.hs @@ -0,0 +1,128 @@ +{-#LANGUAGE RankNTypes#-} +-- | The operations exported here are a convenience, like the similar operations in +-- @Data.Text.IO@ , or rather, @Data.Text.Lazy.IO@, since @Producer Text m r@ is +-- 'effectful text' and something like the pipes equivalent of lazy Text. +-- +-- * Like the functions in @Data.Text.IO@, they attempt to work with the system encoding. +-- +-- * Like the functions in @Data.Text.IO@, they are slower than ByteString operations. Where +-- you know what encoding you are working with, use @Pipes.ByteString@ and @Pipes.Text.Encoding@ instead, +-- e.g. @view utf8 Bytes.stdin@ instead of @Text.stdin@ +-- +-- * Like the functions in @Data.Text.IO@ , they use Text exceptions. +-- +-- Something like +-- +-- > view utf8 . Bytes.fromHandle :: Handle -> Producer Text IO (Producer ByteString m ()) +-- +-- yields a stream of Text, and follows +-- standard pipes protocols by reverting to (i.e. returning) the underlying byte stream +-- upon reaching any decoding error. (See especially the pipes-binary package.) +-- +-- By contrast, something like +-- +-- > Text.fromHandle :: Handle -> Producer Text IO () +-- +-- supplies a stream of text returning '()', which is convenient for many tasks, +-- but violates the pipes @pipes-binary@ approach to decoding errors and +-- throws an exception of the kind characteristic of the @text@ library instead. + +module Pipes.Text.IO + ( + -- * Producers + fromHandle + , stdin + , readFile + -- * Consumers + , toHandle + , stdout + , writeFile + ) where + +import qualified System.IO as IO +import Control.Exception (throwIO, try) +import Foreign.C.Error (Errno(Errno), ePIPE) +import qualified GHC.IO.Exception as G +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Pipes +import qualified Pipes.Safe.Prelude as Safe +import qualified Pipes.Safe as Safe +import Pipes.Safe (MonadSafe(..), Base(..)) +import Prelude hiding (readFile, writeFile) + + +{-| Convert a 'IO.Handle' into a text stream using a text size + determined by the good sense of the text library. Note with the remarks + at the head of this module that this + is slower than @view utf8 (Pipes.ByteString.fromHandle h)@ + but uses the system encoding and has other nice @Data.Text.IO@ features +-} + +fromHandle :: MonadIO m => IO.Handle -> Producer Text m () +fromHandle h = go where + go = do txt <- liftIO (T.hGetChunk h) + if T.null txt then return () + else do yield txt + go +{-# INLINABLE fromHandle#-} + +-- | Stream text from 'stdin' +stdin :: MonadIO m => Producer Text m () +stdin = fromHandle IO.stdin +{-# INLINE stdin #-} + + +{-| Stream text from a file in the simple fashion of @Data.Text.IO@ + +>>> runSafeT $ runEffect $ Text.readFile "hello.hs" >-> Text.map toUpper >-> hoist lift Text.stdout +MAIN = PUTSTRLN "HELLO WORLD" +-} + +readFile :: MonadSafe m => FilePath -> Producer Text m () +readFile file = Safe.withFile file IO.ReadMode fromHandle +{-# INLINE readFile #-} + + +{-| Stream text to 'stdout' + + Unlike 'toHandle', 'stdout' gracefully terminates on a broken output pipe. + + Note: For best performance, it might be best just to use @(for source (liftIO . putStr))@ + instead of @(source >-> stdout)@ . +-} +stdout :: MonadIO m => Consumer' Text m () +stdout = go + where + go = do + txt <- await + x <- liftIO $ try (T.putStr txt) + 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 stdout #-} + + +{-| Convert a text stream into a 'Handle' + + Note: again, for best performance, where possible use + @(for source (liftIO . hPutStr handle))@ instead of @(source >-> toHandle handle)@. +-} +toHandle :: MonadIO m => IO.Handle -> Consumer' Text m r +toHandle h = for cat (liftIO . T.hPutStr h) +{-# INLINABLE toHandle #-} + +{-# RULES "p >-> toHandle h" forall p h . + p >-> toHandle h = for p (\txt -> liftIO (T.hPutStr h txt)) + #-} + + +-- | Stream text into a file. Uses @pipes-safe@. +writeFile :: (MonadSafe m) => FilePath -> Consumer' Text m () +writeFile file = Safe.withFile file IO.WriteMode toHandle +{-# INLINE writeFile #-} diff --git a/Pipes/Text/Internal.hs b/Pipes/Text/Internal.hs deleted file mode 100644 --- a/Pipes/Text/Internal.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Pipes.Text.Internal - (module Pipes.Text.Internal.Codec - , module Pipes.Text.Internal.Decoding - ) where - -import Pipes.Text.Internal.Codec -import Pipes.Text.Internal.Decoding diff --git a/Pipes/Text/Internal/Codec.hs b/Pipes/Text/Internal/Codec.hs deleted file mode 100644 --- a/Pipes/Text/Internal/Codec.hs +++ /dev/null @@ -1,216 +0,0 @@ - -{-# LANGUAGE DeriveDataTypeable, RankNTypes, BangPatterns #-} --- | --- Copyright: 2014 Michael Thompson, 2011 Michael Snoyman, 2010-2011 John Millikin --- License: MIT --- 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 - ( Codec(..) - , TextException(..) - , utf8 - , utf16_le - , utf16_be - , utf32_le - , utf32_be - ) where - -import Data.Bits ((.&.)) -import Data.Char (ord) -import Data.ByteString as B -import Data.ByteString (ByteString) -import Data.ByteString.Internal as B -import Data.ByteString.Char8 as B8 -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import Data.Text.Encoding.Error () -import GHC.Word (Word8, Word32) -import qualified Data.Text.Array as A -import Data.Word (Word8, Word16) -import System.IO.Unsafe (unsafePerformIO) -import qualified Control.Exception as Exc -import Data.Bits ((.&.), (.|.), shiftL) -import Data.Typeable -import Control.Arrow (first) -import Data.Maybe (catMaybes) -import Pipes.Text.Internal.Decoding -import Pipes --- | A specific character encoding. - -data Codec = Codec - { codecName :: Text - , codecEncode :: Text -> (ByteString, Maybe (TextException, Text)) - , codecDecode :: ByteString -> Decoding - } - -instance Show Codec where - showsPrec d c = showParen (d > 10) $ - showString "Codec " . shows (codecName c) - -data TextException = DecodeException Codec Word8 - | EncodeException Codec Char - | LengthExceeded Int - | TextException Exc.SomeException - deriving (Show, Typeable) -instance Exc.Exception TextException - - -toDecoding :: (ByteString -> (Text, Either (TextException, ByteString) ByteString)) - -> (ByteString -> Decoding) -toDecoding op = loop B.empty where - loop !extra bs0 = case op (B.append extra bs0) of - (txt, Right bs) -> Some txt bs (loop bs) - (txt, Left (_,bs)) -> Other txt bs --- To do: toDecoding should be inlined in each of the 'Codec' definitions --- or else Codec changed to the conduit/enumerator definition. We have --- altered it to use 'streamDecodeUtf8' - -splitSlowly :: (ByteString -> Text) - -> ByteString - -> (Text, Either (TextException, ByteString) ByteString) -splitSlowly dec bytes = valid where - valid:_ = catMaybes $ Prelude.map decFirst $ splits (B.length bytes) - splits 0 = [(B.empty, bytes)] - splits n = B.splitAt n bytes : splits (n - 1) - decFirst (a, b) = case tryEvaluate (dec a) of - Left _ -> Nothing - Right text -> let trouble = case tryEvaluate (dec b) of - Left exc -> Left (TextException exc, b) - Right _ -> Right B.empty - in Just (text, trouble) -- this case shouldn't occur, - -- since splitSlowly is only called - -- when parsing failed somewhere - -utf8 :: Codec -utf8 = Codec name enc (toDecoding dec) where - name = T.pack "UTF-8" - enc text = (TE.encodeUtf8 text, Nothing) - dec bytes = case decodeSomeUtf8 bytes of (t,b) -> (t, Right b) - --- -- Whether the given byte is a continuation byte. --- isContinuation byte = byte .&. 0xC0 == 0x80 --- --- -- The number of continuation bytes needed by the given --- -- non-continuation byte. Returns -1 for an illegal UTF-8 --- -- non-continuation byte and the whole split quickly must fail so --- -- as the input is passed to TE.decodeUtf8, which will issue a --- -- suitable error. --- required x0 --- | x0 .&. 0x80 == 0x00 = 0 --- | x0 .&. 0xE0 == 0xC0 = 1 --- | x0 .&. 0xF0 == 0xE0 = 2 --- | x0 .&. 0xF8 == 0xF0 = 3 --- | otherwise = -1 --- --- splitQuickly bytes --- | B.null l || req == -1 = Nothing --- | req == B.length r = Just (TE.decodeUtf8 bytes, B.empty) --- | otherwise = Just (TE.decodeUtf8 l', r') --- where --- (l, r) = B.spanEnd isContinuation bytes --- req = required (B.last l) --- l' = B.init l --- r' = B.cons (B.last l) r - - -utf16_le :: Codec -utf16_le = Codec name enc (toDecoding dec) where - name = T.pack "UTF-16-LE" - enc text = (TE.encodeUtf16LE text, Nothing) - dec bytes = case splitQuickly bytes of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf16LE bytes - - splitQuickly bytes = maybeDecode (loop 0) where - maxN = B.length bytes - - loop n | n == maxN = decodeAll - | (n + 1) == maxN = decodeTo n - loop n = let - req = utf16Required - (B.index bytes n) - (B.index bytes (n + 1)) - decodeMore = loop $! n + req - in if n + req > maxN - then decodeTo n - else decodeMore - - decodeTo n = first TE.decodeUtf16LE (B.splitAt n bytes) - decodeAll = (TE.decodeUtf16LE bytes, B.empty) - -utf16_be :: Codec -utf16_be = Codec name enc (toDecoding dec) where - name = T.pack "UTF-16-BE" - enc text = (TE.encodeUtf16BE text, Nothing) - dec bytes = case splitQuickly bytes of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf16BE bytes - - splitQuickly bytes = maybeDecode (loop 0) where - maxN = B.length bytes - - loop n | n == maxN = decodeAll - | (n + 1) == maxN = decodeTo n - loop n = let - req = utf16Required - (B.index bytes (n + 1)) - (B.index bytes n) - decodeMore = loop $! n + req - in if n + req > maxN - then decodeTo n - else decodeMore - - decodeTo n = first TE.decodeUtf16BE (B.splitAt n bytes) - decodeAll = (TE.decodeUtf16BE bytes, B.empty) - -utf16Required :: Word8 -> Word8 -> Int -utf16Required x0 x1 = if x >= 0xD800 && x <= 0xDBFF then 4 else 2 where - x :: Word16 - x = (fromIntegral x1 `shiftL` 8) .|. fromIntegral x0 - - -utf32_le :: Codec -utf32_le = Codec name enc (toDecoding dec) where - name = T.pack "UTF-32-LE" - enc text = (TE.encodeUtf32LE text, Nothing) - dec bs = case utf32SplitBytes TE.decodeUtf32LE bs of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf32LE bs - - -utf32_be :: Codec -utf32_be = Codec name enc (toDecoding dec) where - name = T.pack "UTF-32-BE" - enc text = (TE.encodeUtf32BE text, Nothing) - dec bs = case utf32SplitBytes TE.decodeUtf32BE bs of - Just (text, extra) -> (text, Right extra) - Nothing -> splitSlowly TE.decodeUtf32BE bs - -utf32SplitBytes :: (ByteString -> Text) - -> ByteString - -> Maybe (Text, ByteString) -utf32SplitBytes dec bytes = split where - split = maybeDecode (dec toDecode, extra) - len = B.length bytes - lenExtra = mod len 4 - - lenToDecode = len - lenExtra - (toDecode, extra) = if lenExtra == 0 - then (bytes, B.empty) - else B.splitAt lenToDecode bytes - - -tryEvaluate :: a -> Either Exc.SomeException a -tryEvaluate = unsafePerformIO . Exc.try . Exc.evaluate - -maybeDecode :: (a, b) -> Maybe (a, b) -maybeDecode (a, b) = case tryEvaluate a of - Left _ -> Nothing - Right _ -> Just (a, b) diff --git a/Pipes/Text/Internal/Decoding.hs b/Pipes/Text/Internal/Decoding.hs deleted file mode 100644 --- a/Pipes/Text/Internal/Decoding.hs +++ /dev/null @@ -1,154 +0,0 @@ -{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface #-} -{-# 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' - -module Pipes.Text.Internal.Decoding - ( Decoding(..) - , streamDecodeUtf8 - , decodeSomeUtf8 - ) where -import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO) -import Control.Monad.ST (ST, runST) -import Data.Bits ((.&.)) -import Data.ByteString as B -import Data.ByteString (ByteString) -import Data.ByteString.Internal as B -import Data.ByteString.Char8 as B8 -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import Data.Text.Encoding.Error () -import Data.Text.Internal (Text, textP) -import Foreign.C.Types (CSize) -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Marshal.Utils (with) -import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr) -import Foreign.Storable (Storable, peek, poke) -import GHC.Base (Char(..), Int(..), MutableByteArray#, ord#, iShiftRA#) -import GHC.Word (Word8, Word32) -import qualified Data.Text.Array as A -import Data.Word (Word8, Word16) -import System.IO.Unsafe (unsafePerformIO) -import qualified Control.Exception as Exc -import Data.Bits ((.&.), (.|.), shiftL) -import Data.Typeable -import Control.Arrow (first) -import Data.Maybe (catMaybes) -#include "pipes_text_cbits.h" - - - --- 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 . - showChar ' ' . showsPrec prec' bs . - showString " _" - where prec = 10; prec' = prec + 1 - showsPrec d (Other t bs) = showParen (d > prec) $ - showString "Other " . showsPrec prec' t . - showChar ' ' . showsPrec prec' bs . - showString " _" - where prec = 10; prec' = prec + 1 - -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 - decodeChunkUtf8 :: ByteString -> CodePoint -> DecoderState -> ByteString -> Decoding - decodeChunkUtf8 old codepoint0 state0 bs@(PS fp off len) = - runST $ do marray <- A.new (len+1) - unsafeIOToST (decodeChunkToBuffer marray) - where - decodeChunkToBuffer :: A.MArray s -> IO Decoding - decodeChunkToBuffer dest = withForeignPtr fp $ \ptr -> - with (0::CSize) $ \destOffPtr -> - with codepoint0 $ \codepointPtr -> - with state0 $ \statePtr -> - with nullPtr $ \curPtrPtr -> - do let end = ptr `plusPtr` (off + len) - curPtr = ptr `plusPtr` off - poke curPtrPtr curPtr - c_decode_utf8_with_state (A.maBA dest) destOffPtr curPtrPtr end codepointPtr statePtr - state <- peek statePtr - lastPtr <- peek curPtrPtr - codepoint <- peek codepointPtr - n <- peek destOffPtr - chunkText <- mkText dest n - let left = lastPtr `minusPtr` curPtr - remaining = B.drop left bs - accum = if T.null chunkText then B.append old remaining else remaining - return $! case state of - UTF8_REJECT -> Other chunkText accum -- We encountered an encoding error - _ -> Some chunkText accum (decodeChunkUtf8 accum codepoint state) - {-# INLINE decodeChunkToBuffer #-} - {-# 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) - unsafeIOToST $ - withForeignPtr fp $ \ptr -> - with (0::CSize) $ \destOffPtr -> - with (0::CodePoint) $ \codepointPtr -> - with (0::DecoderState) $ \statePtr -> - with nullPtr $ \curPtrPtr -> - do let end = ptr `plusPtr` (off + len) - curPtr = ptr `plusPtr` off - poke curPtrPtr curPtr - c_decode_utf8_with_state (A.maBA dest) destOffPtr - curPtrPtr end codepointPtr statePtr - state <- peek statePtr - lastPtr <- peek curPtrPtr - codepoint <- peek codepointPtr - n <- peek destOffPtr - chunkText <- unsafeSTToIO $ do arr <- A.unsafeFreeze dest - return $! textP arr 0 (fromIntegral n) - let left = lastPtr `minusPtr` curPtr - remaining = B.drop left bs - return $! (chunkText, remaining) -{-# INLINE decodeSomeUtf8 #-} - -mkText :: A.MArray s -> CSize -> IO Text -mkText dest n = unsafeSTToIO $ do arr <- A.unsafeFreeze dest - return $! textP arr 0 (fromIntegral n) -{-# INLINE mkText #-} - -ord :: Char -> Int -ord (C# c#) = I# (ord# c#) -{-# INLINE ord #-} - -unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int -unsafeWrite marr i c - | n < 0x10000 = do A.unsafeWrite marr i (fromIntegral n) - return 1 - | otherwise = do A.unsafeWrite marr i lo - A.unsafeWrite marr (i+1) hi - return 2 - where n = ord c - m = n - 0x10000 - lo = fromIntegral $ (m `shiftR` 10) + 0xD800 - hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00 - shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#) - {-# INLINE shiftR #-} -{-# INLINE unsafeWrite #-} - -foreign import ccall unsafe "_hs_pipes_text_decode_utf8_state" c_decode_utf8_with_state - :: MutableByteArray# s -> Ptr CSize - -> Ptr (Ptr Word8) -> Ptr Word8 - -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,17 +1,6 @@ -text-pipes +pipes-text ========== -This repo is called `text-pipes`, but the package is named `pipes-text` as one might expect. -The two modules it contatins, `Pipes.Text` and `Pipes.Text.Parse`, use materials from [`pipes-text`](https://github.com/ibotty/pipes-text); -otherwise they follow the pattern of [`pipes-bytestring`](https://github.com/Gabriel439/Haskell-Pipes-ByteString-Library), adding a few `pipes-prelude`-like operations. -The most important function, `decodeUtf8`, written by ibotty, uses the development version of the text package; this package can however be built with the hackage `text` -though `decodeUtf8` will then not exist. +This package follows the rule `pipes-text : pipes-bytestring :: text : bytestring` It has three modules, `Pipes.Text` , `Pipes.Text.Encoding` and `Pipes.Text.IO`; the division has more or less the significance it has in the `text` library. - >>> runEffect $ stdinLn >-> P.takeWhile (/= "quit") >-> stdoutLn - hi - hi - quit - >>> runSafeT $ runEffect $ readFile "README.md" >-> toUpper >-> hoist lift stdout - TEXT-PIPES - ========== - ... +Note that the module `Pipes.Text.IO` uses version 0.11.3 or later of the `text` library. (It thus works with the version of `text` that came with the 2013 Haskell Platform. To use an older `text`, install with the flag `-fnoio` diff --git a/cbits/cbits.c b/cbits/cbits.c deleted file mode 100644 --- a/cbits/cbits.c +++ /dev/null @@ -1,168 +0,0 @@ -/* - * Copyright (c) 2011 Bryan O'Sullivan . - * - * Portions copyright (c) 2008-2010 Björn Höhrmann . - * - * See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details. - */ - -#include -#include -#include -#include "pipes_text_cbits.h" - - - -#define UTF8_ACCEPT 0 -#define UTF8_REJECT 12 - -static const uint8_t utf8d[] = { - /* - * The first part of the table maps bytes to character classes that - * to reduce the size of the transition table and create bitmasks. - */ - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, - 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, - 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, - 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8, - - /* - * The second part is a transition table that maps a combination of - * a state of the automaton and a character class to a state. - */ - 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12, - 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12, - 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12, - 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12, - 12,36,12,12,12,12,12,12,12,12,12,12, -}; - -static inline uint32_t -decode(uint32_t *state, uint32_t* codep, uint32_t byte) { - uint32_t type = utf8d[byte]; - - *codep = (*state != UTF8_ACCEPT) ? - (byte & 0x3fu) | (*codep << 6) : - (0xff >> type) & (byte); - - return *state = utf8d[256 + *state + type]; -} - -/* - * A best-effort decoder. Runs until it hits either end of input or - * the start of an invalid byte sequence. - * - * At exit, we update *destoff with the next offset to write to, *src - * with the next source location past the last one successfully - * decoded, and return the next source location to read from. - * - * Moreover, we expose the internal decoder state (state0 and - * codepoint0), allowing one to restart the decoder after it - * terminates (say, due to a partial codepoint). - * - * In particular, there are a few possible outcomes, - * - * 1) We decoded the buffer entirely: - * In this case we return srcend - * state0 == UTF8_ACCEPT - * - * 2) We met an invalid encoding - * In this case we return the address of the first invalid byte - * state0 == UTF8_REJECT - * - * 3) We reached the end of the buffer while decoding a codepoint - * In this case we return a pointer to the first byte of the partial codepoint - * state0 != UTF8_ACCEPT, UTF8_REJECT - * - */ - - #if defined(__GNUC__) || defined(__clang__) - static inline uint8_t const * - _hs_pipes_text_decode_utf8_int(uint16_t *const dest, size_t *destoff, - const uint8_t const **src, const uint8_t const *srcend, - uint32_t *codepoint0, uint32_t *state0) - __attribute((always_inline)); - #endif - -static inline uint8_t const * -_hs_pipes_text_decode_utf8_int(uint16_t *const dest, size_t *destoff, - const uint8_t const **src, const uint8_t const *srcend, - uint32_t *codepoint0, uint32_t *state0) -{ - uint16_t *d = dest + *destoff; - const uint8_t *s = *src, *last = *src; - uint32_t state = *state0; - uint32_t codepoint = *codepoint0; - - while (s < srcend) { -#if defined(__i386__) || defined(__x86_64__) - /* - * This code will only work on a little-endian system that - * supports unaligned loads. - * - * It gives a substantial speed win on data that is purely or - * partly ASCII (e.g. HTML), at only a slight cost on purely - * non-ASCII text. - */ - - if (state == UTF8_ACCEPT) { - while (s < srcend - 4) { - codepoint = *((uint32_t *) s); - if ((codepoint & 0x80808080) != 0) - break; - s += 4; - - /* - * Tried 32-bit stores here, but the extra bit-twiddling - * slowed the code down. - */ - - *d++ = (uint16_t) (codepoint & 0xff); - *d++ = (uint16_t) ((codepoint >> 8) & 0xff); - *d++ = (uint16_t) ((codepoint >> 16) & 0xff); - *d++ = (uint16_t) ((codepoint >> 24) & 0xff); - } - last = s; - } -#endif - - if (decode(&state, &codepoint, *s++) != UTF8_ACCEPT) { - if (state != UTF8_REJECT) - continue; - break; - } - - if (codepoint <= 0xffff) - *d++ = (uint16_t) codepoint; - else { - *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10)); - *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF)); - } - last = s; - } - - *destoff = d - dest; - *codepoint0 = codepoint; - *state0 = state; - *src = last; - - return s; -} - -uint8_t const * -_hs_pipes_text_decode_utf8_state(uint16_t *const dest, size_t *destoff, - const uint8_t const **src, - const uint8_t const *srcend, - uint32_t *codepoint0, uint32_t *state0) -{ - uint8_t const *ret = _hs_pipes_text_decode_utf8_int(dest, destoff, src, srcend, - codepoint0, state0); - if (*state0 == UTF8_REJECT) - ret -=1; - return ret; -} - diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,8 @@ +# Version 0.0.0.7 + + * Used the new text-stream-decoding package + * Separated IO and Encoding modules adding flag -fnoio + # Version 0.0.0.5 * Rearranged internal modules diff --git a/include/pipes_text_cbits.h b/include/pipes_text_cbits.h deleted file mode 100644 --- a/include/pipes_text_cbits.h +++ /dev/null @@ -1,11 +0,0 @@ -/* - * Copyright (c) 2013 Bryan O'Sullivan . - */ - -#ifndef _pipes_text_cbits_h -#define _pipes_text_cbits_h - -#define UTF8_ACCEPT 0 -#define UTF8_REJECT 12 - -#endif diff --git a/pipes-text.cabal b/pipes-text.cabal --- a/pipes-text.cabal +++ b/pipes-text.cabal @@ -1,25 +1,17 @@ name: pipes-text -version: 0.0.0.6 +version: 0.0.0.7 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 - operations like `lines` simply adjust for the differences between - `ByteString` and `Text` and `Word8` and `Char`. It is hoped that this - homogeneity will aid in learning the terms and programming style associated - with both of them. +description: * This package will be in a draft, or testing, phase until version 0.0.1. Please report any installation difficulties, or any wisdom about the api, on the github page! . - The most distinctive addition of the library to that core is the - apparatus for encoding and decoding `Text` and `ByteString`. + This organization of the package follows the rule . - Also defined are some simple functions akin to the `String` - operations in `Pipes.Prelude`, and others like the utilities in `Data.Text`. + * @pipes-text : pipes-bytestring :: text : bytestring@ . - All of the `IO` operations defined here - e.g `readFile`, `stdout` etc. - - are conveniences akin to those in `Data.Text.IO` which e.g. try to - find the system encoding and use the exceptions defined in the `text` - library. Proper `IO` in the sense of this library will employ - `pipes-bytestring` in conjuntion with 'pure' operations like - `decodeUtf8` and `encodeUtf8` that are defined here. + Familiarity with the other three packages should give one an idea what to expect where. The package has three modules, @Pipes.Text@ , @Pipes.Text.Encoding@ and @Pipes.Text.IO@; the division has more or less the significance it has in the @text@ library. + . + Note that the module @Pipes.Text.IO@ is present as a convenience (as is @Data.Text.IO@). Official pipes IO would use @Pipes.ByteString@ and the decoding functions present here, based on the new Michael Snoyman's new @text-stream-decoding@ package. In particular, the @Pipes.Text.IO@ functions use Text exceptions. + . + @Pipes.Text.IO@ uses version 0.11.3 or later of the @text@ library. It thus works with the version of @text@ that came with the 2013 Haskell Platform. To use an older @text@, install with the flag @-fnoio@ homepage: https://github.com/michaelt/text-pipes bug-reports: https://github.com/michaelt/text-pipes/issues @@ -31,28 +23,33 @@ build-type: Simple cabal-version: >=1.10 -extra-source-files: README.md include/*.h changelog +extra-source-files: README.md changelog source-repository head type: git location: https://github.com/michaelt/text-pipes +flag noio + default: False + Description: Use a version of text earlier than 0.11.3 library - c-sources: cbits/cbits.c - include-dirs: include - 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, - text >=0.11.3 && < 1.2, - profunctors >= 3.1.1 && < 4.1 , - pipes >=4.0 && < 4.2, - pipes-group >= 1.0.0 && < 1.1 , - pipes-parse >=2.0 && < 3.1, + exposed-modules: Pipes.Text, Pipes.Text.Encoding + build-depends: base >= 4 && < 5 , + bytestring >= 0.9 , + text >=0.11.2 && < 1.2, + text-stream-decode >= 0.1 && < 0.2, + profunctors >= 3.1.1 && < 4.1, + pipes >=4.0 && < 4.2, + pipes-group >= 1.0.0 && < 1.1, + pipes-parse >=2.0 && < 3.1, pipes-safe, - pipes-bytestring >= 1.0 && < 2.1, - transformers >= 0.2.0.0 && < 0.4 - -- hs-source-dirs: + pipes-bytestring >= 1.0 && < 2.1, + transformers >= 0.2.0.0 && < 0.4 + other-extensions: RankNTypes default-language: Haskell2010 - ghc-options: -O2 + ghc-options: -O2 + + if !flag(noio) + exposed-modules: Pipes.Text.IO + build-depends: text >=0.11.3 && < 1.2 +