1 {-# LANGUAGE RankNTypes, BangPatterns #-}
3 -- | This module uses the stream decoding functions from Michael Snoyman's new
4 -- <http://hackage.haskell.org/package/text-stream-decode text-stream-decode>
5 -- package to define decoding functions and lenses. The exported names
6 -- conflict with names in @Data.Text.Encoding@ but the module can otherwise be
7 -- imported unqualified.
9 module Pipes.Text.Encoding
11 -- * The Lens or Codec type
15 -- * \'Viewing\' the Text in a byte stream
23 -- * Non-lens decoding functions
31 -- * Re-encoding functions
38 -- * Functions for latin and ascii text
47 import Data.Functor.Constant (Constant(..))
48 import Data.Char (ord)
49 import Data.ByteString as B
50 import Data.ByteString (ByteString)
51 import Data.ByteString.Char8 as B8
52 import Data.Text (Text)
53 import qualified Data.Text as T
54 import qualified Data.Text.Encoding as TE
55 import Data.Text.StreamDecoding
56 import Control.Monad (join)
57 import Data.Word (Word8)
60 type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)
63 The 'Codec' type is a simple specializion of
64 the @Lens'@ type synonymn used by the standard lens libraries,
65 <http://hackage.haskell.org/package/lens lens> and
66 <http://hackage.haskell.org/package/lens-family lens-family>. That type,
68 > type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)
70 is just an alias for a Prelude type. Thus you use any particular codec with
71 the @view@ / @(^.)@ , @zoom@ and @over@ functions from either of those libraries;
72 we presuppose neither since we already have access to the types they require.
79 => Lens' (Producer ByteString m r)
80 (Producer Text m (Producer ByteString m r))
82 {- | 'decode' is just the ordinary @view@ or @(^.)@ of the lens libraries;
83 exported here under a name appropriate to the material. All of these are
86 > decode utf8 p = decodeUtf8 p = view utf8 p = p ^. utf8
90 decode :: ((b -> Constant b b) -> (a -> Constant b a)) -> a -> b
91 decode codec a = getConstant (codec Constant a)
96 Each Codec-lens looks into a byte stream that is supposed to contain text.
97 The particular \'Codec\' lenses are named in accordance with the expected
98 encoding, 'utf8', 'utf16LE' etc. To turn a Codec into an ordinary function,
99 use @view@ / @(^.)@ -- here also called 'decode':
101 > view utf8 :: Producer ByteString m r -> Producer Text m (Producer ByteString m r)
102 > decode utf8 Byte.stdin :: Producer Text IO (Producer ByteString IO r)
103 > Bytes.stdin ^. utf8 :: Producer Text IO (Producer ByteString IO r)
105 Uses of a codec with @view@ or @(^.)@ or 'decode' can always be replaced by the specialized
106 decoding functions exported here, e.g.
108 > decodeUtf8 :: Producer ByteString m r -> Producer Text m (Producer ByteString m r)
109 > decodeUtf8 Byte.stdin :: Producer Text IO (Producer ByteString IO r)
111 The stream of text that a @Codec@ \'sees\' in the stream of bytes begins at its head.
112 At any point of decoding failure, the stream of text ends and reverts to (returns)
113 the original byte stream. Thus if the first bytes are already
114 un-decodable, the whole ByteString producer will be returned, i.e.
116 > view utf8 bytestream
118 will just come to the same as
122 Where there is no decoding failure, the return value of the text stream will be
123 an empty byte stream followed by its own return value. In all cases you must
124 deal with the fact that it is a /ByteString producer/ that is returned, even if
125 it can be thrown away with @Control.Monad.void@
127 > void (Bytes.stdin ^. utf8) :: Producer Text IO ()
129 @zoom@ converts a Text parser into a ByteString parser:
131 > zoom utf8 drawChar :: Monad m => StateT (Producer ByteString m r) m (Maybe Char)
133 or, using the type synonymn from @Pipes.Parse@:
135 > zoom utf8 drawChar :: Monad m => Parser ByteString m (Maybe Char)
137 Thus we can define a ByteString parser like this:
139 > withNextByte :: Parser ByteString m (Maybe Char, Maybe Word8)))
140 > withNextByte = do char_ <- zoom utf8 Text.drawChar
141 > byte_ <- Bytes.peekByte
142 > return (char_, byte_)
144 Though @withNextByte@ is partly defined with a Text parser 'drawChar';
145 but it is a ByteString parser; it will return the first valid utf8-encoded
146 Char in a ByteString, whatever its length,
147 and the first byte of the next character, if they exist. Because
148 we \'draw\' one and \'peek\' at the other, the parser as a whole only
149 advances one Char's length along the bytestring, whatever that length may be.
150 See the slightly more complex example \'decode.hs\' in the
151 <http://www.haskellforall.com/2014/02/pipes-parse-30-lens-based-parsing.html#batteries-included haskellforall>
152 discussion of this type of byte stream parsing.
156 utf8 = mkCodec decodeUtf8 TE.encodeUtf8
159 utf8Pure = mkCodec decodeUtf8Pure TE.encodeUtf8
162 utf16LE = mkCodec decodeUtf16LE TE.encodeUtf16LE
165 utf16BE = mkCodec decodeUtf16BE TE.encodeUtf16BE
168 utf32LE = mkCodec decodeUtf32LE TE.encodeUtf32LE
171 utf32BE = mkCodec decodeUtf32BE TE.encodeUtf32BE
173 decodeStream :: Monad m
174 => (B.ByteString -> DecodeResult)
175 -> Producer ByteString m r -> Producer Text m (Producer ByteString m r)
176 decodeStream = loop where
178 do x <- lift (next p)
179 case x of Left r -> return (return r)
180 Right (chunk, p') -> case dec0 chunk of
181 DecodeResultSuccess text dec -> do yield text
183 DecodeResultFailure text bs -> do yield text
186 {-# INLINABLE decodeStream#-}
189 These are functions with the simple type:
191 > decodeUtf8 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
195 > decodeUtf8 = view utf8
196 > decodeUtf16LE = view utf16LE
198 and so forth, but these forms
199 may be more convenient (and give better type errors!) where lenses are
204 decodeUtf8 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
205 decodeUtf8 = decodeStream streamUtf8
206 {-# INLINE decodeUtf8 #-}
208 decodeUtf8Pure :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
209 decodeUtf8Pure = decodeStream streamUtf8Pure
210 {-# INLINE decodeUtf8Pure #-}
212 decodeUtf16LE :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
213 decodeUtf16LE = decodeStream streamUtf16LE
214 {-# INLINE decodeUtf16LE #-}
216 decodeUtf16BE :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
217 decodeUtf16BE = decodeStream streamUtf16BE
218 {-# INLINE decodeUtf16BE #-}
220 decodeUtf32LE :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
221 decodeUtf32LE = decodeStream streamUtf32LE
222 {-# INLINE decodeUtf32LE #-}
224 decodeUtf32BE :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
225 decodeUtf32BE = decodeStream streamUtf32BE
226 {-# INLINE decodeUtf32BE #-}
230 These are simply defined
232 > encodeUtf8 = yield . TE.encodeUtf8
234 They are intended for use with 'for'
236 > for Text.stdin encodeUtf8 :: Producer ByteString IO ()
238 which would have the effect of
240 > Text.stdin >-> Pipes.Prelude.map (TE.encodeUtf8)
242 using the encoding functions from Data.Text.Encoding
245 encodeUtf8 :: Monad m => Text -> Producer ByteString m ()
246 encodeUtf8 = yield . TE.encodeUtf8
247 encodeUtf16LE :: Monad m => Text -> Producer ByteString m ()
248 encodeUtf16LE = yield . TE.encodeUtf16LE
249 encodeUtf16BE :: Monad m => Text -> Producer ByteString m ()
250 encodeUtf16BE = yield . TE.encodeUtf16BE
251 encodeUtf32LE :: Monad m => Text -> Producer ByteString m ()
252 encodeUtf32LE = yield . TE.encodeUtf32LE
253 encodeUtf32BE :: Monad m => Text -> Producer ByteString m ()
254 encodeUtf32BE = yield . TE.encodeUtf32BE
256 mkCodec :: (forall r m . Monad m =>
257 Producer ByteString m r -> Producer Text m (Producer ByteString m r ))
258 -> (Text -> ByteString)
260 mkCodec dec enc = \k p0 -> fmap (\p -> join (for p (yield . enc))) (k (dec p0))
265 ascii and latin encodings only use a small number of the characters 'Text'
266 recognizes; thus we cannot use the pipes @Lens@ style to work with them.
267 Rather we simply define functions each way.
271 -- | 'encodeAscii' reduces as much of your stream of 'Text' actually is ascii to a byte stream,
272 -- returning the rest of the 'Text' at the first non-ascii 'Char'
274 encodeAscii :: Monad m => Producer Text m r -> Producer ByteString m (Producer Text m r)
275 encodeAscii = go where
276 go p = do e <- lift (next p)
278 Left r -> return (return r)
282 else let (safe, unsafe) = T.span (\c -> ord c <= 0x7F) chunk
283 in do yield (B8.pack (T.unpack safe))
286 else return $ do yield unsafe
289 {- | Reduce as much of your stream of 'Text' actually is iso8859 or latin1 to a byte stream,
290 returning the rest of the 'Text' upon hitting any non-latin 'Char'
292 encodeIso8859_1 :: Monad m => Producer Text m r -> Producer ByteString m (Producer Text m r)
293 encodeIso8859_1 = go where
294 go p = do e <- lift (next p)
296 Left r -> return (return r)
300 else let (safe, unsafe) = T.span (\c -> ord c <= 0xFF) txt
301 in do yield (B8.pack (T.unpack safe))
304 else return $ do yield unsafe
307 {- | Reduce a byte stream to a corresponding stream of ascii chars, returning the
308 unused 'ByteString' upon hitting an un-ascii byte.
310 decodeAscii :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
311 decodeAscii = go where
312 go p = do e <- lift (next p)
314 Left r -> return (return r)
318 else let (safe, unsafe) = B.span (<= 0x7F) chunk
319 in do yield (T.pack (B8.unpack safe))
322 else return (do yield unsafe
325 {- | Reduce a byte stream to a corresponding stream of ascii chars, returning the
326 unused 'ByteString' upon hitting the rare un-latinizable byte.
328 decodeIso8859_1 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
329 decodeIso8859_1 = go where
330 go p = do e <- lift (next p)
332 Left r -> return (return r)
336 else do let (safe, unsafe) = B.span (<= 0xFF) chunk
337 yield (T.pack (B8.unpack safe))
340 else return (do yield unsafe