{-# LANGUAGE BangPatterns #-} -- | -- Module : Data.Text.Internal.Encoding.Fusion.Common -- Copyright : (c) Tom Harper 2008-2009, -- (c) Bryan O'Sullivan 2009, -- (c) Duncan Coutts 2009, -- (c) Jasper Van der Jeugt 2011 -- -- License : BSD-style -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- /Warning/: this is an internal module, and does not have a stable -- API or name. Use at your own risk! -- -- Fusible 'Stream'-oriented functions for converting between 'Text' -- and several common encodings. module Data.Text.Internal.Encoding.Fusion.Common ( -- * Restreaming -- Restreaming is the act of converting from one 'Stream' -- representation to another. restreamUtf16LE , restreamUtf16BE , restreamUtf32LE , restreamUtf32BE ) where import Data.Bits ((.&.)) import Data.Text.Internal.Fusion (Step(..), Stream(..)) import Data.Text.Internal.Fusion.Types (RS(..)) import Data.Text.Internal.Unsafe.Char (ord) import Data.Text.Internal.Unsafe.Shift (shiftR) import Data.Word (Word8) restreamUtf16BE :: Stream Char -> Stream Word8 restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2) where next (RS0 s) = case next0 s of Done -> Done Skip s' -> Skip (RS0 s') Yield x s' | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $ RS1 s' (fromIntegral n) | otherwise -> Yield c1 $ RS3 s' c2 c3 c4 where n = ord x n1 = n - 0x10000 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8) c2 = fromIntegral (n1 `shiftR` 10) n2 = n1 .&. 0x3FF c3 = fromIntegral (n2 `shiftR` 8 + 0xDC) c4 = fromIntegral n2 next (RS1 s x2) = Yield x2 (RS0 s) next (RS2 s x2 x3) = Yield x2 (RS1 s x3) next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4) {-# INLINE next #-} {-# INLINE restreamUtf16BE #-} restreamUtf16LE :: Stream Char -> Stream Word8 restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2) where next (RS0 s) = case next0 s of Done -> Done Skip s' -> Skip (RS0 s') Yield x s' | n < 0x10000 -> Yield (fromIntegral n) $ RS1 s' (fromIntegral $ shiftR n 8) | otherwise -> Yield c1 $ RS3 s' c2 c3 c4 where n = ord x n1 = n - 0x10000 c2 = fromIntegral (shiftR n1 18 + 0xD8) c1 = fromIntegral (shiftR n1 10) n2 = n1 .&. 0x3FF c4 = fromIntegral (shiftR n2 8 + 0xDC) c3 = fromIntegral n2 next (RS1 s x2) = Yield x2 (RS0 s) next (RS2 s x2 x3) = Yield x2 (RS1 s x3) next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4) {-# INLINE next #-} {-# INLINE restreamUtf16LE #-} restreamUtf32BE :: Stream Char -> Stream Word8 restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2) where next (RS0 s) = case next0 s of Done -> Done Skip s' -> Skip (RS0 s') Yield x s' -> Yield c1 (RS3 s' c2 c3 c4) where n = ord x c1 = fromIntegral $ shiftR n 24 c2 = fromIntegral $ shiftR n 16 c3 = fromIntegral $ shiftR n 8 c4 = fromIntegral n next (RS1 s x2) = Yield x2 (RS0 s) next (RS2 s x2 x3) = Yield x2 (RS1 s x3) next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4) {-# INLINE next #-} {-# INLINE restreamUtf32BE #-} restreamUtf32LE :: Stream Char -> Stream Word8 restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2) where next (RS0 s) = case next0 s of Done -> Done Skip s' -> Skip (RS0 s') Yield x s' -> Yield c1 (RS3 s' c2 c3 c4) where n = ord x c4 = fromIntegral $ shiftR n 24 c3 = fromIntegral $ shiftR n 16 c2 = fromIntegral $ shiftR n 8 c1 = fromIntegral n next (RS1 s x2) = Yield x2 (RS0 s) next (RS2 s x2 x3) = Yield x2 (RS1 s x3) next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4) {-# INLINE next #-} {-# INLINE restreamUtf32LE #-}