aboutsummaryrefslogtreecommitdiffhomepage
path: root/Pipes
diff options
context:
space:
mode:
authormichaelt <what_is_it_to_do_anything@yahoo.com>2014-01-14 22:05:12 -0500
committermichaelt <what_is_it_to_do_anything@yahoo.com>2014-01-14 22:05:12 -0500
commit3694350ac7b9c42fd64e0092a74cf0471a080058 (patch)
tree38ddadda59a3808422fc432d37b886c456adcb1d /Pipes
parentcd4fd5dd5405ad8e324f43ee2bc81822bdece16c (diff)
downloadtext-pipes-3694350ac7b9c42fd64e0092a74cf0471a080058.tar.gz
text-pipes-3694350ac7b9c42fd64e0092a74cf0471a080058.tar.zst
text-pipes-3694350ac7b9c42fd64e0092a74cf0471a080058.zip
Use clunky Data.Text.IO when bytestring is not explicit
Diffstat (limited to 'Pipes')
-rw-r--r--Pipes/Text.hs37
-rw-r--r--Pipes/Text/Internal.hs126
2 files changed, 110 insertions, 53 deletions
diff --git a/Pipes/Text.hs b/Pipes/Text.hs
index 74d2023..cf493e9 100644
--- a/Pipes/Text.hs
+++ b/Pipes/Text.hs
@@ -1,4 +1,4 @@
1{-# LANGUAGE RankNTypes, TypeFamilies #-} 1{-# LANGUAGE RankNTypes, TypeFamilies, BangPatterns #-}
2 2
3{-| This module provides @pipes@ utilities for \"text streams\", which are 3{-| This module provides @pipes@ utilities for \"text streams\", which are
4 streams of 'Text' chunks. The individual chunks are uniformly @strict@, but 4 streams of 'Text' chunks. The individual chunks are uniformly @strict@, but
@@ -206,30 +206,36 @@ import Prelude hiding (
206-- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's 206-- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's
207fromLazy :: (Monad m) => TL.Text -> Producer' Text m () 207fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
208fromLazy = foldrChunks (\e a -> yield e >> a) (return ()) 208fromLazy = foldrChunks (\e a -> yield e >> a) (return ())
209{-# INLINABLE fromLazy #-} 209{-# INLINE fromLazy #-}
210 210
211-- | Stream text from 'stdin' 211-- | Stream text from 'stdin'
212stdin :: MonadIO m => Producer Text m (Producer ByteString m ()) 212stdin :: MonadIO m => Producer Text m ()
213stdin = fromHandle IO.stdin 213stdin = fromHandle IO.stdin
214{-# INLINABLE stdin #-} 214{-# INLINE stdin #-}
215 215
216{-| Convert a 'IO.Handle' into a text stream using a text size 216{-| Convert a 'IO.Handle' into a text stream using a text size
217 determined by the good sense of the text library. 217 determined by the good sense of the text library; note that this
218 is distinctly slower than @decideUtf8 (Pipes.ByteString.fromHandle h)@
219 but uses the system encoding and has other `Data.Text.IO` features
218-} 220-}
219 221
220fromHandle :: MonadIO m => IO.Handle -> Producer Text m (Producer ByteString m ()) 222fromHandle :: MonadIO m => IO.Handle -> Producer Text m ()
221fromHandle h = decodeUtf8 (PB.fromHandle h) 223fromHandle h = go where
222{-# INLINE fromHandle#-} 224 go = do txt <- liftIO (T.hGetChunk h)
225 unless (T.null txt) $ do yield txt
226 go
227{-# INLINABLE fromHandle#-}
223 228
224{-| Stream text from a file using Pipes.Safe 229
230{-| Stream text from a file in the simple fashion of @Data.Text.IO@
225 231
226>>> runSafeT $ runEffect $ Text.readFile "hello.hs" >-> Text.map toUpper >-> hoist lift Text.stdout 232>>> runSafeT $ runEffect $ Text.readFile "hello.hs" >-> Text.map toUpper >-> hoist lift Text.stdout
227MAIN = PUTSTRLN "HELLO WORLD" 233MAIN = PUTSTRLN "HELLO WORLD"
228-} 234-}
229 235
230readFile :: (MonadSafe m) => FilePath -> Producer Text m (Producer ByteString m ()) 236readFile :: MonadSafe m => FilePath -> Producer Text m ()
231readFile file = Safe.withFile file IO.ReadMode fromHandle 237readFile file = Safe.withFile file IO.ReadMode fromHandle
232{-# INLINABLE readFile #-} 238{-# INLINE readFile #-}
233 239
234{-| Stream lines of text from stdin (for testing in ghci etc.) 240{-| Stream lines of text from stdin (for testing in ghci etc.)
235 241
@@ -249,7 +255,7 @@ stdinLn = go where
249 txt <- liftIO (T.hGetLine IO.stdin) 255 txt <- liftIO (T.hGetLine IO.stdin)
250 yield txt 256 yield txt
251 go 257 go
252 258{-# INLINABLE stdinLn #-}
253 259
254{-| Stream text to 'stdout' 260{-| Stream text to 'stdout'
255 261
@@ -305,6 +311,7 @@ toHandle h = for cat (liftIO . T.hPutStr h)
305-- | Stream text into a file. Uses @pipes-safe@. 311-- | Stream text into a file. Uses @pipes-safe@.
306writeFile :: (MonadSafe m) => FilePath -> Consumer' Text m () 312writeFile :: (MonadSafe m) => FilePath -> Consumer' Text m ()
307writeFile file = Safe.withFile file IO.WriteMode toHandle 313writeFile file = Safe.withFile file IO.WriteMode toHandle
314{-# INLINE writeFile #-}
308 315
309-- | Apply a transformation to each 'Char' in the stream 316-- | Apply a transformation to each 'Char' in the stream
310map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r 317map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
@@ -592,10 +599,10 @@ count c p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count c))
592 599
593decodeUtf8 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r) 600decodeUtf8 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
594decodeUtf8 = go B.empty PE.streamDecodeUtf8 where 601decodeUtf8 = go B.empty PE.streamDecodeUtf8 where
595 go carry dec0 p = do 602 go !carry dec0 p = do
596 x <- lift (next p) 603 x <- lift (next p)
597 case x of Left r -> if B.null carry 604 case x of Left r -> if B.null carry
598 then return (return r) -- all input was consumed 605 then return (return r) -- all bytestrinput was consumed
599 else return (do yield carry -- a potentially valid fragment remains 606 else return (do yield carry -- a potentially valid fragment remains
600 return r) 607 return r)
601 608
@@ -605,6 +612,8 @@ decodeUtf8 = go B.empty PE.streamDecodeUtf8 where
605 PE.Other text bs -> do yield text 612 PE.Other text bs -> do yield text
606 return (do yield bs -- an invalid blob remains 613 return (do yield bs -- an invalid blob remains
607 p') 614 p')
615{-# INLINABLE decodeUtf8 #-}
616
608 617
609-- | Splits a 'Producer' after the given number of characters 618-- | Splits a 'Producer' after the given number of characters
610splitAt 619splitAt
diff --git a/Pipes/Text/Internal.hs b/Pipes/Text/Internal.hs
index 73d6fa4..7e5b044 100644
--- a/Pipes/Text/Internal.hs
+++ b/Pipes/Text/Internal.hs
@@ -6,36 +6,25 @@
6module Pipes.Text.Internal 6module Pipes.Text.Internal
7 ( Decoding(..) 7 ( Decoding(..)
8 , streamDecodeUtf8 8 , streamDecodeUtf8
9 , decodeSomeUtf8
9 ) where 10 ) where
10
11import Control.Exception (evaluate, try)
12#if __GLASGOW_HASKELL__ >= 702
13import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO) 11import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
14import Control.Monad.ST (ST, runST) 12import Control.Monad.ST (ST, runST)
15#else
16import Control.Monad.ST (unsafeIOToST, unsafeSTToIO, ST, runST)
17#endif
18import Data.Bits ((.&.)) 13import Data.Bits ((.&.))
19import Data.ByteString as B 14import Data.ByteString as B
20import Data.ByteString.Internal as B 15import Data.ByteString.Internal as B
21import Data.Text () 16import qualified Data.Text as T (null)
22import qualified Data.Text as T 17import Data.Text.Encoding.Error ()
23import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode) 18import Data.Text.Internal (Text, textP)
24import Data.Text.Internal (Text(..), safe, textP)
25import Data.Word (Word8, Word32)
26import Foreign.C.Types (CSize) 19import Foreign.C.Types (CSize)
27import Foreign.ForeignPtr (withForeignPtr) 20import Foreign.ForeignPtr (withForeignPtr)
28import Foreign.Marshal.Utils (with) 21import Foreign.Marshal.Utils (with)
29import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr) 22import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
30import Foreign.Storable (Storable, peek, poke) 23import Foreign.Storable (Storable, peek, poke)
31import GHC.Base hiding (ord) 24import GHC.Base (Char(..), Int(..), MutableByteArray#, ord#, iShiftRA#)
32import GHC.Word 25import GHC.Word (Word8, Word32)
33import qualified Data.Text.Array as A 26import qualified Data.Text.Array as A
34import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#) 27
35import GHC.Word (Word8(..), Word16(..), Word32(..))
36
37import Data.Text.Unsafe (unsafeDupablePerformIO)
38
39#include "pipes_text_cbits.h" 28#include "pipes_text_cbits.h"
40 29
41-- | A stream oriented decoding result. 30-- | A stream oriented decoding result.
@@ -52,44 +41,102 @@ instance Show Decoding where
52 showChar ' ' . showsPrec prec' bs . 41 showChar ' ' . showsPrec prec' bs .
53 showString " _" 42 showString " _"
54 where prec = 10; prec' = prec + 1 43 where prec = 10; prec' = prec + 1
55 44
56newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable) 45newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)
57newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable) 46newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
58 47
59streamDecodeUtf8 :: ByteString -> Decoding 48streamDecodeUtf8 :: ByteString -> Decoding
60streamDecodeUtf8 = decodeChunk B.empty 0 0 49streamDecodeUtf8 = decodeChunkUtf8 B.empty 0 0
50 where
51 decodeChunkUtf8 :: ByteString -> CodePoint -> DecoderState -> ByteString -> Decoding
52 decodeChunkUtf8 old codepoint0 state0 bs@(PS fp off len) =
53 runST $ do marray <- A.new (len+1)
54 unsafeIOToST (decodeChunkToBuffer marray)
55 where
56 decodeChunkToBuffer :: A.MArray s -> IO Decoding
57 decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
58 with (0::CSize) $ \destOffPtr ->
59 with codepoint0 $ \codepointPtr ->
60 with state0 $ \statePtr ->
61 with nullPtr $ \curPtrPtr ->
62 do let end = ptr `plusPtr` (off + len)
63 curPtr = ptr `plusPtr` off
64 poke curPtrPtr curPtr
65 c_decode_utf8_with_state (A.maBA dest) destOffPtr curPtrPtr end codepointPtr statePtr
66 state <- peek statePtr
67 lastPtr <- peek curPtrPtr
68 codepoint <- peek codepointPtr
69 n <- peek destOffPtr
70 chunkText <- mkText dest n
71 let left = lastPtr `minusPtr` curPtr
72 remaining = B.drop left bs
73 accum = if T.null chunkText then B.append old remaining else remaining
74 return $! case state of
75 UTF8_REJECT -> Other chunkText accum -- We encountered an encoding error
76 _ -> Some chunkText accum (decodeChunkUtf8 accum codepoint state)
77 {-# INLINE decodeChunkToBuffer #-}
78 {-# INLINE decodeChunkUtf8 #-}
79{-# INLINE streamDecodeUtf8 #-}
61 80
62decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString -> Decoding 81decodeSomeUtf8 :: ByteString -> (Text, ByteString)
63decodeChunk old codepoint0 state0 bs@(PS fp off len) = 82decodeSomeUtf8 bs@(PS fp off len) = runST $ do
64 runST $ do marray <- A.new (len+1) 83 dest <- A.new (len+1)
65 unsafeIOToST (decodeChunkToBuffer marray) 84 unsafeIOToST $
66 where 85 withForeignPtr fp $ \ptr ->
67 decodeChunkToBuffer :: A.MArray s -> IO Decoding 86 with (0::CSize) $ \destOffPtr ->
68 decodeChunkToBuffer dest = withForeignPtr fp $ \ptr -> 87 with (0::CodePoint) $ \codepointPtr ->
69 with (0::CSize) $ \destOffPtr -> 88 with (0::DecoderState) $ \statePtr ->
70 with codepoint0 $ \codepointPtr -> 89 with nullPtr $ \curPtrPtr ->
71 with state0 $ \statePtr ->
72 with nullPtr $ \curPtrPtr ->
73 do let end = ptr `plusPtr` (off + len) 90 do let end = ptr `plusPtr` (off + len)
74 curPtr = ptr `plusPtr` off 91 curPtr = ptr `plusPtr` off
75 poke curPtrPtr curPtr 92 poke curPtrPtr curPtr
76 c_decode_utf8_with_state (A.maBA dest) destOffPtr curPtrPtr end codepointPtr statePtr 93 c_decode_utf8_with_state (A.maBA dest) destOffPtr
94 curPtrPtr end codepointPtr statePtr
77 state <- peek statePtr 95 state <- peek statePtr
78 lastPtr <- peek curPtrPtr 96 lastPtr <- peek curPtrPtr
79 codepoint <- peek codepointPtr 97 codepoint <- peek codepointPtr
80 n <- peek destOffPtr 98 n <- peek destOffPtr
81 chunkText <- mkText dest n 99 chunkText <- unsafeSTToIO $ do arr <- A.unsafeFreeze dest
100 return $! textP arr 0 (fromIntegral n)
82 let left = lastPtr `minusPtr` curPtr 101 let left = lastPtr `minusPtr` curPtr
83 remaining = B.drop left bs 102 remaining = B.drop left bs
84 accum = if T.null chunkText then B.append old remaining else remaining 103 return $! (chunkText, remaining)
85 return $ case state of 104{-# INLINE decodeSomeUtf8 #-}
86 UTF8_REJECT -> Other chunkText accum -- We encountered an encoding error 105
87 _ -> Some chunkText accum (decodeChunk accum codepoint state) 106-- decodeSomeUtf8 :: ByteString -> (Text, ByteString)
107-- decodeSomeUtf8 bs@(PS fp off len) =
108-- runST $ do marray <- A.new (len+1)
109-- unsafeIOToST (decodeChunkToBuffer marray)
110--
111-- where
112-- decodeChunkToBuffer :: A.MArray s -> IO (Text, ByteString)
113-- decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->
114-- with (0::CSize) $ \destOffPtr ->
115-- with (0::CodePoint) $ \codepointPtr ->
116-- with (0::DecoderState) $ \statePtr ->
117-- with nullPtr $ \curPtrPtr ->
118-- do let end = ptr `plusPtr` (off + len)
119-- curPtr = ptr `plusPtr` off
120-- poke curPtrPtr curPtr
121-- c_decode_utf8_with_state (A.maBA dest) destOffPtr curPtrPtr end codepointPtr statePtr
122-- state <- peek statePtr
123-- lastPtr <- peek curPtrPtr
124-- codepoint <- peek codepointPtr
125-- n <- peek destOffPtr
126-- chunkText <- unsafeSTToIO $ do arr <- A.unsafeFreeze dest
127-- return $! textP arr 0 (fromIntegral n)
128-- let left = lastPtr `minusPtr` curPtr
129-- remaining = B.drop left bs
130-- return $! (chunkText, remaining)
131-- {-# INLINE decodeChunkToBuffer #-}
132-- {-# INLINE decodeSomeUtf8 #-}
133
88 134
89 135
90mkText :: A.MArray s -> CSize -> IO Text 136mkText :: A.MArray s -> CSize -> IO Text
91mkText dest n = unsafeSTToIO $ do arr <- A.unsafeFreeze dest 137mkText dest n = unsafeSTToIO $ do arr <- A.unsafeFreeze dest
92 return $! textP arr 0 (fromIntegral n) 138 return $! textP arr 0 (fromIntegral n)
139{-# INLINE mkText #-}
93 140
94ord :: Char -> Int 141ord :: Char -> Int
95ord (C# c#) = I# (ord# c#) 142ord (C# c#) = I# (ord# c#)
@@ -107,6 +154,7 @@ unsafeWrite marr i c
107 lo = fromIntegral $ (m `shiftR` 10) + 0xD800 154 lo = fromIntegral $ (m `shiftR` 10) + 0xD800
108 hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00 155 hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
109 shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#) 156 shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)
157 {-# INLINE shiftR #-}
110{-# INLINE unsafeWrite #-} 158{-# INLINE unsafeWrite #-}
111 159
112foreign import ccall unsafe "_hs_pipes_text_decode_utf8_state" c_decode_utf8_with_state 160foreign import ccall unsafe "_hs_pipes_text_decode_utf8_state" c_decode_utf8_with_state