{-# 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 Char -> Stream Word8
restreamUtf16BE (Stream s -> Step s Char
next0 s
s0 Size
len) = (RS s -> Step (RS s) Word8) -> RS s -> Size -> Stream Word8
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream RS s -> Step (RS s) Word8
next (s -> RS s
forall s. s -> RS s
RS0 s
s0) (Size
len Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
2)
  where
    next :: RS s -> Step (RS s) Word8
next (RS0 s
s) = case s -> Step s Char
next0 s
s of
        Step s Char
Done -> Step (RS s) Word8
forall s a. Step s a
Done
        Skip s
s' -> RS s -> Step (RS s) Word8
forall s a. s -> Step s a
Skip (s -> RS s
forall s. s -> RS s
RS0 s
s')
        Yield Char
x s
s'
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 -> Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield (Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
8) (RS s -> Step (RS s) Word8) -> RS s -> Step (RS s) Word8
forall a b. (a -> b) -> a -> b
$
                             s -> Word8 -> RS s
forall s. s -> Word8 -> RS s
RS1 s
s' (Int -> Word8
intToWord8 Int
n)
            | Bool
otherwise   -> Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
c1 (RS s -> Step (RS s) Word8) -> RS s -> Step (RS s) Word8
forall a b. (a -> b) -> a -> b
$ s -> Word8 -> Word8 -> Word8 -> RS s
forall s. s -> Word8 -> Word8 -> Word8 -> RS s
RS3 s
s' Word8
c2 Word8
c3 Word8
c4
            where
              n :: Int
n  = Char -> Int
ord Char
x
              n1 :: Int
n1 = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
              c1 :: Word8
c1 = Int -> Word8
intToWord8 (Int
n1 Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xD8)
              c2 :: Word8
c2 = Int -> Word8
intToWord8 (Int
n1 Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
10)
              n2 :: Int
n2 = Int
n1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3FF
              c3 :: Word8
c3 = Int -> Word8
intToWord8 (Int
n2 Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
`shiftR` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xDC)
              c4 :: Word8
c4 = Int -> Word8
intToWord8 Int
n2
    next (RS1 s
s Word8
x2)       = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> RS s
forall s. s -> RS s
RS0 s
s)
    next (RS2 s
s Word8
x2 Word8
x3)    = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> Word8 -> RS s
forall s. s -> Word8 -> RS s
RS1 s
s Word8
x3)
    next (RS3 s
s Word8
x2 Word8
x3 Word8
x4) = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> Word8 -> Word8 -> RS s
forall s. s -> Word8 -> Word8 -> RS s
RS2 s
s Word8
x3 Word8
x4)
    {-# INLINE next #-}
{-# INLINE restreamUtf16BE #-}

restreamUtf16LE :: Stream Char -> Stream Word8
restreamUtf16LE :: Stream Char -> Stream Word8
restreamUtf16LE (Stream s -> Step s Char
next0 s
s0 Size
len) = (RS s -> Step (RS s) Word8) -> RS s -> Size -> Stream Word8
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream RS s -> Step (RS s) Word8
next (s -> RS s
forall s. s -> RS s
RS0 s
s0) (Size
len Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
2)
  where
    next :: RS s -> Step (RS s) Word8
next (RS0 s
s) = case s -> Step s Char
next0 s
s of
        Step s Char
Done -> Step (RS s) Word8
forall s a. Step s a
Done
        Skip s
s' -> RS s -> Step (RS s) Word8
forall s a. s -> Step s a
Skip (s -> RS s
forall s. s -> RS s
RS0 s
s')
        Yield Char
x s
s'
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 -> Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield (Int -> Word8
intToWord8 Int
n) (RS s -> Step (RS s) Word8) -> RS s -> Step (RS s) Word8
forall a b. (a -> b) -> a -> b
$
                             s -> Word8 -> RS s
forall s. s -> Word8 -> RS s
RS1 s
s' (Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
shiftR Int
n Int
8)
            | Bool
otherwise   -> Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
c1 (RS s -> Step (RS s) Word8) -> RS s -> Step (RS s) Word8
forall a b. (a -> b) -> a -> b
$ s -> Word8 -> Word8 -> Word8 -> RS s
forall s. s -> Word8 -> Word8 -> Word8 -> RS s
RS3 s
s' Word8
c2 Word8
c3 Word8
c4
          where
            n :: Int
n  = Char -> Int
ord Char
x
            n1 :: Int
n1 = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
            c2 :: Word8
c2 = Int -> Word8
intToWord8 (Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
shiftR Int
n1 Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xD8)
            c1 :: Word8
c1 = Int -> Word8
intToWord8 (Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
shiftR Int
n1 Int
10)
            n2 :: Int
n2 = Int
n1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3FF
            c4 :: Word8
c4 = Int -> Word8
intToWord8 (Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
shiftR Int
n2 Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xDC)
            c3 :: Word8
c3 = Int -> Word8
intToWord8 Int
n2
    next (RS1 s
s Word8
x2)       = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> RS s
forall s. s -> RS s
RS0 s
s)
    next (RS2 s
s Word8
x2 Word8
x3)    = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> Word8 -> RS s
forall s. s -> Word8 -> RS s
RS1 s
s Word8
x3)
    next (RS3 s
s Word8
x2 Word8
x3 Word8
x4) = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> Word8 -> Word8 -> RS s
forall s. s -> Word8 -> Word8 -> RS s
RS2 s
s Word8
x3 Word8
x4)
    {-# INLINE next #-}
{-# INLINE restreamUtf16LE #-}

restreamUtf32BE :: Stream Char -> Stream Word8
restreamUtf32BE :: Stream Char -> Stream Word8
restreamUtf32BE (Stream s -> Step s Char
next0 s
s0 Size
len) = (RS s -> Step (RS s) Word8) -> RS s -> Size -> Stream Word8
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream RS s -> Step (RS s) Word8
next (s -> RS s
forall s. s -> RS s
RS0 s
s0) (Size
len Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
2)
  where
    next :: RS s -> Step (RS s) Word8
next (RS0 s
s) = case s -> Step s Char
next0 s
s of
        Step s Char
Done       -> Step (RS s) Word8
forall s a. Step s a
Done
        Skip s
s'    -> RS s -> Step (RS s) Word8
forall s a. s -> Step s a
Skip (s -> RS s
forall s. s -> RS s
RS0 s
s')
        Yield Char
x s
s' -> Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
c1 (s -> Word8 -> Word8 -> Word8 -> RS s
forall s. s -> Word8 -> Word8 -> Word8 -> RS s
RS3 s
s' Word8
c2 Word8
c3 Word8
c4)
          where
            n :: Int
n  = Char -> Int
ord Char
x
            c1 :: Word8
c1 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
shiftR Int
n Int
24
            c2 :: Word8
c2 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
shiftR Int
n Int
16
            c3 :: Word8
c3 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
shiftR Int
n Int
8
            c4 :: Word8
c4 = Int -> Word8
intToWord8 Int
n
    next (RS1 s
s Word8
x2)       = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> RS s
forall s. s -> RS s
RS0 s
s)
    next (RS2 s
s Word8
x2 Word8
x3)    = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> Word8 -> RS s
forall s. s -> Word8 -> RS s
RS1 s
s Word8
x3)
    next (RS3 s
s Word8
x2 Word8
x3 Word8
x4) = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> Word8 -> Word8 -> RS s
forall s. s -> Word8 -> Word8 -> RS s
RS2 s
s Word8
x3 Word8
x4)
    {-# INLINE next #-}
{-# INLINE restreamUtf32BE #-}

restreamUtf32LE :: Stream Char -> Stream Word8
restreamUtf32LE :: Stream Char -> Stream Word8
restreamUtf32LE (Stream s -> Step s Char
next0 s
s0 Size
len) = (RS s -> Step (RS s) Word8) -> RS s -> Size -> Stream Word8
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream RS s -> Step (RS s) Word8
next (s -> RS s
forall s. s -> RS s
RS0 s
s0) (Size
len Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
2)
  where
    next :: RS s -> Step (RS s) Word8
next (RS0 s
s) = case s -> Step s Char
next0 s
s of
        Step s Char
Done       -> Step (RS s) Word8
forall s a. Step s a
Done
        Skip s
s'    -> RS s -> Step (RS s) Word8
forall s a. s -> Step s a
Skip (s -> RS s
forall s. s -> RS s
RS0 s
s')
        Yield Char
x s
s' -> Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
c1 (s -> Word8 -> Word8 -> Word8 -> RS s
forall s. s -> Word8 -> Word8 -> Word8 -> RS s
RS3 s
s' Word8
c2 Word8
c3 Word8
c4)
          where
            n :: Int
n  = Char -> Int
ord Char
x
            c4 :: Word8
c4 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
shiftR Int
n Int
24
            c3 :: Word8
c3 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
shiftR Int
n Int
16
            c2 :: Word8
c2 = Int -> Word8
intToWord8 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. UnsafeShift a => a -> Int -> a
shiftR Int
n Int
8
            c1 :: Word8
c1 = Int -> Word8
intToWord8 Int
n
    next (RS1 s
s Word8
x2)       = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> RS s
forall s. s -> RS s
RS0 s
s)
    next (RS2 s
s Word8
x2 Word8
x3)    = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> Word8 -> RS s
forall s. s -> Word8 -> RS s
RS1 s
s Word8
x3)
    next (RS3 s
s Word8
x2 Word8
x3 Word8
x4) = Word8 -> RS s -> Step (RS s) Word8
forall s a. a -> s -> Step s a
Yield Word8
x2 (s -> Word8 -> Word8 -> RS s
forall s. s -> Word8 -> Word8 -> RS s
RS2 s
s Word8
x3 Word8
x4)
    {-# INLINE next #-}
{-# INLINE restreamUtf32LE #-}

intToWord8 :: Int -> Word8
intToWord8 :: Int -> Word8
intToWord8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral