module Web.Willow.Common.Encoding.Utf16
(
decoderBigEndian
, decoderLittleEndian
, byteOrderMarkBigEndian
, byteOrderMarkLittleEndian
) where
import qualified Control.Applicative as A
import qualified Data.Bits as B
import qualified Data.ByteString as BS
import qualified Data.Word as W
import Data.Functor ( ($>) )
import Web.Willow.Common.Encoding.Common
import Web.Willow.Common.Parser
byteOrderMarkBigEndian
:: (A.Alternative gather, Monad gather)
=> ParserT BS.ByteString gather Encoding
byteOrderMarkBigEndian :: ParserT ByteString gather Encoding
byteOrderMarkBigEndian = ByteString -> ParserT ByteString gather ByteString
forall (trans :: * -> *) stream token.
(MonadParser trans stream token, Eq stream) =>
stream -> trans stream
chunk ([Word8] -> ByteString
BS.pack [Word8
0xFE, Word8
0xFF]) ParserT ByteString gather ByteString
-> Encoding -> ParserT ByteString gather Encoding
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Encoding
Utf16be
byteOrderMarkLittleEndian
:: (A.Alternative gather, Monad gather)
=> ParserT BS.ByteString gather Encoding
byteOrderMarkLittleEndian :: ParserT ByteString gather Encoding
byteOrderMarkLittleEndian = ByteString -> ParserT ByteString gather ByteString
forall (trans :: * -> *) stream token.
(MonadParser trans stream token, Eq stream) =>
stream -> trans stream
chunk ([Word8] -> ByteString
BS.pack [Word8
0xFF, Word8
0xFE]) ParserT ByteString gather ByteString
-> Encoding -> ParserT ByteString gather Encoding
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Encoding
Utf16le
decoderBigEndian :: TextBuilder
decoderBigEndian :: TextBuilder
decoderBigEndian = Bool -> TextBuilder
decoder Bool
True
decoderLittleEndian :: TextBuilder
decoderLittleEndian :: TextBuilder
decoderLittleEndian = Bool -> TextBuilder
decoder Bool
False
decoder
:: Bool
-> TextBuilder
decoder :: Bool -> TextBuilder
decoder Bool
bigEndian = StateT (Confidence, ()) (Parser ByteString) Word8
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT (Confidence, ()) (Parser ByteString) Word8
-> (Word8 -> TextBuilder) -> TextBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
b1 -> StateT (Confidence, ()) (Parser ByteString) Word8
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT (Confidence, ()) (Parser ByteString) Word8
-> (Word8 -> TextBuilder) -> TextBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
b2 ->
case Bool -> Word8 -> Word8 -> Word
decodeUnit Bool
bigEndian Word8
b1 Word8
b2 of
Word
unit | Word -> Word -> Word -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Word
0xDC00 Word
0xDFFF Word
unit -> [Word8] -> TextBuilder
forall state. [Word8] -> StateTextBuilder state
decoderFailure [Word8
b1, Word8
b2]
Word
unit | Word -> Word -> Word -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Word
0xD800 Word
0xDBFF Word
unit -> Bool -> Word -> Word8 -> Word8 -> TextBuilder
decoder' Bool
bigEndian Word
unit Word8
b1 Word8
b2
Word
unit -> [Word8] -> Word -> TextBuilder
forall a state.
Integral a =>
[Word8] -> a -> StateTextBuilder state
toUnicode [Word8
b1, Word8
b2] Word
unit
decoder'
:: Bool
-> Word
-> W.Word8
-> W.Word8
-> TextBuilder
decoder' :: Bool -> Word -> Word8 -> Word8 -> TextBuilder
decoder' Bool
bigEndian Word
unit1 Word8
b1 Word8
b2 = StateT (Confidence, ()) (Parser ByteString) Word8
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT (Confidence, ()) (Parser ByteString) Word8
-> (Word8 -> TextBuilder) -> TextBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
b3 -> StateT (Confidence, ()) (Parser ByteString) Word8
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next StateT (Confidence, ()) (Parser ByteString) Word8
-> (Word8 -> TextBuilder) -> TextBuilder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
b4 ->
case Bool -> Word8 -> Word8 -> Word
decodeUnit Bool
bigEndian Word8
b3 Word8
b4 of
Word
unit2 | Word -> Word -> Word -> Bool
forall a. Ord a => a -> a -> a -> Bool
range Word
0xDC00 Word
0xDFFF Word
unit2 -> [Word8] -> Word -> TextBuilder
forall a state.
Integral a =>
[Word8] -> a -> StateTextBuilder state
toUnicode [Word8
b1, Word8
b2, Word8
b3, Word8
b4] (Word -> TextBuilder) -> Word -> TextBuilder
forall a b. (a -> b) -> a -> b
$
Word
0x10000 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word -> Int -> Word
forall a. Bits a => a -> Int -> a
B.shiftL (Word
unit1 Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
0xD800) Int
10 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
unit2 Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
0xDC00
Word
_ -> Word8 -> StateT (Confidence, ()) (Parser ByteString) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push Word8
b4 StateT (Confidence, ()) (Parser ByteString) ()
-> StateT (Confidence, ()) (Parser ByteString) ()
-> StateT (Confidence, ()) (Parser ByteString) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word8 -> StateT (Confidence, ()) (Parser ByteString) ()
forall (m :: * -> *) stream token.
MonadParser m stream token =>
token -> m ()
push Word8
b3 StateT (Confidence, ()) (Parser ByteString) ()
-> TextBuilder -> TextBuilder
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Word8] -> TextBuilder
forall state. [Word8] -> StateTextBuilder state
decoderFailure [Word8
b1, Word8
b2]
decodeUnit :: Bool -> W.Word8 -> W.Word8 -> Word
decodeUnit :: Bool -> Word8 -> Word8 -> Word
decodeUnit Bool
True Word8
lead Word8
trail = Word -> Int -> Word
forall a. Bits a => a -> Int -> a
B.shiftL (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
lead) Int
8 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
trail
decodeUnit Bool
False Word8
lead Word8
trail = Word -> Int -> Word
forall a. Bits a => a -> Int -> a
B.shiftL (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
trail) Int
8 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
lead