special Internal module

4 files changed, 24 insertions, 156 deletions

diff --git a/LICENSE b/LICENSE
index 3b4771d..f307de2 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2013, Gabriel Gonzalez, Tobias Florek, Michael Thompson
+Copyright (c) 2013-14, Gabriel Gonzalez, Tobias Florek, Michael Thompson
 
 All rights reserved.
 
diff --git a/Pipes/Text.hs b/Pipes/Text.hs
index 0957a7d..796f672 100644
--- a/Pipes/Text.hs
+++ b/Pipes/Text.hs
@@ -167,7 +167,7 @@ module Pipes.Text  (
     , module Data.Word
     , module Pipes.Parse
     , module Pipes.Group
-    , module Pipes.Text.Internal.Codec
+    , module Pipes.Text.Internal
     ) where
 
 import Control.Exception (throwIO, try)
@@ -197,8 +197,8 @@ 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.Decoding as PE
-import Pipes.Text.Internal.Codec 
+import qualified Pipes.Text.Internal as PI
+import Pipes.Text.Internal 
 import Pipes.Core (respond, Server')
 import Pipes.Group (concats, intercalates, FreeT(..), FreeF(..))
 import qualified Pipes.Group as PG
@@ -729,7 +729,7 @@ isEndOfChars = do
 decodeUtf8 :: Monad m => Lens' (Producer ByteString m r) 
                                (Producer Text m (Producer ByteString m r))
 decodeUtf8 k p0 = fmap (\p -> join  (for p (yield . TE.encodeUtf8))) 
-                       (k (go B.empty PE.streamDecodeUtf8 p0)) where
+                       (k (go B.empty PI.streamDecodeUtf8 p0)) where
   go !carry dec0 p = do 
      x <- lift (next p) 
      case x of Left r -> return (if B.null carry 
@@ -738,9 +738,9 @@ decodeUtf8 k p0 = fmap (\p -> join  (for p (yield . TE.encodeUtf8)))
                                              return r))
                                            
                Right (chunk, p') -> case dec0 chunk of 
-                   PE.Some text carry2 dec -> do yield text
+                   PI.Some text carry2 dec -> do yield text
                                                  go carry2 dec p'
-                   PE.Other text bs -> do yield text 
+                   PI.Other text bs -> do yield text 
                                           return (do yield bs -- an invalid blob remains
                                                      p')
 {-# INLINABLE decodeUtf8 #-}
@@ -1093,19 +1093,19 @@ unwords = intercalate (yield $ T.singleton ' ')
 codec :: Monad m => Codec -> Lens' (Producer ByteString m r) (Producer Text m (Producer ByteString m r))
 codec (Codec _ enc dec) k p0 = fmap (\p -> join (for p (yield . fst . enc))) 
                                      (k (decoder (dec B.empty) p0) ) where 
-  decoder :: Monad m => PE.Decoding -> Producer ByteString m r -> Producer Text m (Producer ByteString m r)
+  decoder :: Monad m => PI.Decoding -> Producer ByteString m r -> Producer Text m (Producer ByteString m r)
   decoder !d p0 = case d of 
-      PE.Other txt bad      -> do yield txt
+      PI.Other txt bad      -> do yield txt
                                   return (do yield bad
                                              p0)
-      PE.Some txt extra dec -> do yield txt
+      PI.Some txt extra dec -> do yield txt
                                   x <- lift (next p0)
                                   case x of Left r -> return (do yield extra
                                                                  return r)
                                             Right (chunk,p1) -> decoder (dec chunk) p1
 
 -- decodeUtf8 k p0 = fmap (\p -> join  (for p (yield . TE.encodeUtf8))) 
---                        (k (go B.empty PE.streamDecodeUtf8 p0)) where
+--                        (k (go B.empty PI.streamDecodeUtf8 p0)) where
 
 encodeAscii :: Monad m => Producer Text m r -> Producer ByteString m (Producer Text m r)
 encodeAscii = go where
diff --git a/Pipes/Text/Internal.hs b/Pipes/Text/Internal.hs
index bcee278..2530b23 100644
--- a/Pipes/Text/Internal.hs
+++ b/Pipes/Text/Internal.hs
@@ -1,147 +1,15 @@
-{-# 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 
+module Pipes.Text.Internal
     ( Decoding(..)
     , streamDecodeUtf8
     , decodeSomeUtf8
+    , Codec(..)
+    , TextException(..)
+    , utf8
+    , utf16_le
+    , utf16_be
+    , utf32_le
+    , utf32_be
     ) 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.
-data Decoding = Some Text ByteString (ByteString -> Decoding)
-              | Other Text 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)
-
-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 #-}
-
-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)
\ No newline at end of file
+import Pipes.Text.Internal.Decoding
+import Pipes.Text.Internal.Codec
\ No newline at end of file
diff --git a/pipes-text.cabal b/pipes-text.cabal
index 1333f92..9af2a09 100644
--- a/pipes-text.cabal
+++ b/pipes-text.cabal
@@ -1,5 +1,5 @@
 name:                pipes-text
-version:             0.0.1.0
+version:             0.0.0.0
 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 
@@ -34,8 +34,8 @@ extra-source-files: README.md
 library
   c-sources:    cbits/cbits.c
   include-dirs: include
-  exposed-modules:     Pipes.Text, Pipes.Text.Internal.Decoding, Pipes.Text.Internal.Codec
-  -- other-modules:       
+  exposed-modules:     Pipes.Text, Pipes.Text.Internal
+  other-modules:       Pipes.Text.Internal.Decoding, Pipes.Text.Internal.Codec
   other-extensions:    RankNTypes
   build-depends:       base         >= 4       && < 5  ,
                        bytestring >=0.10       && < 0.11,