moved enumerator/conduit Codec business to its own module

4 files changed, 255 insertions, 228 deletions

diff --git a/Pipes/Text.hs b/Pipes/Text.hs
index 71b1316..9ed0d78 100644
--- a/Pipes/Text.hs
+++ b/Pipes/Text.hs
@@ -181,7 +181,7 @@ import qualified GHC.IO.Exception as G
 import Pipes
 import qualified Pipes.ByteString as PB
 import qualified Pipes.Text.Internal as PE
-import Pipes.Text.Internal (Codec(..))
+import Pipes.Text.Codec (Codec(..))
 import Pipes.Core (respond, Server')
 import Pipes.Group (concats, intercalates, FreeT(..), FreeF(..))
 import qualified Pipes.Group as PG
@@ -243,8 +243,8 @@ stdin = fromHandle IO.stdin
 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
+              unless (T.null txt) ( do yield txt
+                                       go )
 {-# INLINABLE fromHandle#-}
 
 
@@ -258,7 +258,9 @@ readFile :: MonadSafe m => FilePath -> Producer Text m ()
 readFile file = Safe.withFile file IO.ReadMode fromHandle
 {-# INLINE readFile #-}
 
-{-| Stream lines of text from stdin (for testing in ghci etc.) 
+{-| 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)
@@ -282,8 +284,8 @@ stdinLn = go where
 
     Unlike 'toHandle', 'stdout' gracefully terminates on a broken output pipe.
 
-    Note: For best performance, use @(for source (liftIO . putStr))@ instead of
-    @(source >-> stdout)@ in suitable cases.
+    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
@@ -704,11 +706,8 @@ isEndOfChars = do
 {-# INLINABLE isEndOfChars #-}
 
 
-
-
-
--- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded into a Pipe of Text
--- returning a Pipe of ByteStrings that begins 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))
@@ -716,10 +715,10 @@ decodeUtf8 k p0 = fmap (\p -> join  (for p (yield . TE.encodeUtf8)))
                        (k (go B.empty PE.streamDecodeUtf8 p0)) where
   go !carry dec0 p = do 
      x <- lift (next p) 
-     case x of Left r -> if B.null carry 
-                           then return (return r)      -- all bytestrinput was consumed
-                           else return (do yield carry -- a potentially valid fragment remains
-                                           return r)
+     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 
                    PE.Some text carry2 dec -> do yield text
diff --git a/Pipes/Text/Codec.hs b/Pipes/Text/Codec.hs
new file mode 100644
index 0000000..e4357b9
--- /dev/null
+++ b/Pipes/Text/Codec.hs
@@ -0,0 +1,240 @@
+
+{-# LANGUAGE DeriveDataTypeable, RankNTypes #-}
+-- |
+-- Copyright: 2014 Michael Thompson, 2011 Michael Snoyman, 2010-2011 John Millikin
+-- License: MIT
+--
+-- Handle streams of text.
+--
+-- Parts of this code were taken from enumerator and conduits, and adapted for pipes.
+
+module Pipes.Text.Codec
+    ( Decoding(..)
+    , streamDecodeUtf8
+    , decodeSomeUtf8
+    , Codec(..)
+    , TextException(..)
+    , utf8
+    ) 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
+
+-- | 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)
+  }
+
+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
+
+
+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
+
+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)
+
+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.hs b/Pipes/Text/Internal.hs
index 76c2f4f..bcee278 100644
--- a/Pipes/Text/Internal.hs
+++ b/Pipes/Text/Internal.hs
@@ -9,9 +9,6 @@ module Pipes.Text.Internal
     ( Decoding(..)
     , streamDecodeUtf8
     , decodeSomeUtf8
-    , Codec(..)
-    , TextException(..)
-    , utf8
     ) where
 import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
 import Control.Monad.ST (ST, runST)
@@ -43,215 +40,6 @@ import Data.Maybe (catMaybes)
 #include "pipes_text_cbits.h"
 
 
--- | 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)
-  }
-
-instance Show Codec where
-    showsPrec d c = showParen (d > 10) $ showString "Codec " . shows (codecName c)
-
--- Since 0.3.0
-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
-
-
-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
-
--- |
--- Since 0.3.0
-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)
-
--- |
--- Since 0.3.0
-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
-
--- |
--- Since 0.3.0
-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
-
--- |
--- Since 0.3.0
-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
-
--- |
--- Since 0.3.0
-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)
-
--- |
--- Since 0.3.0
-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)
-
-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)
 
 -- | A stream oriented decoding result.
 data Decoding = Some Text ByteString (ByteString -> Decoding)
diff --git a/pipes-text.cabal b/pipes-text.cabal
index 33cbab4..44bc551 100644
--- a/pipes-text.cabal
+++ b/pipes-text.cabal
@@ -14,7 +14,7 @@ cabal-version:       >=1.10
 library
   c-sources:    cbits/cbits.c
   include-dirs: include
-  exposed-modules:     Pipes.Text, Pipes.Text.Internal
+  exposed-modules:     Pipes.Text, Pipes.Text.Internal, Pipes.Text.Codec
   -- other-modules:       
   other-extensions:    RankNTypes
   build-depends:       base         >= 4       && < 5  ,