{-# LANGUAGE DeriveDataTypeable #-}
module Data.Encoding.UTF32
(UTF32(..))
where
import Data.Encoding.Base
import Data.Encoding.ByteSink
import Data.Encoding.ByteSource
import Data.Encoding.Exception
import Data.Char
import Data.Typeable
data UTF32
= UTF32
| UTF32BE
| UTF32LE
deriving (UTF32 -> UTF32 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTF32 -> UTF32 -> Bool
$c/= :: UTF32 -> UTF32 -> Bool
== :: UTF32 -> UTF32 -> Bool
$c== :: UTF32 -> UTF32 -> Bool
Eq,Int -> UTF32 -> ShowS
[UTF32] -> ShowS
UTF32 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTF32] -> ShowS
$cshowList :: [UTF32] -> ShowS
show :: UTF32 -> String
$cshow :: UTF32 -> String
showsPrec :: Int -> UTF32 -> ShowS
$cshowsPrec :: Int -> UTF32 -> ShowS
Show,Typeable)
instance Encoding UTF32 where
encodeChar :: forall (m :: * -> *). ByteSink m => UTF32 -> Char -> m ()
encodeChar UTF32
UTF32LE Char
ch = forall (m :: * -> *). ByteSink m => Word32 -> m ()
pushWord32le (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
ch)
encodeChar UTF32
_ Char
ch = forall (m :: * -> *). ByteSink m => Word32 -> m ()
pushWord32be (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
ch)
decodeChar :: forall (m :: * -> *). ByteSource m => UTF32 -> m Char
decodeChar UTF32
UTF32LE = do
Word32
wrd <- forall (m :: * -> *). ByteSource m => m Word32
fetchWord32le
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
wrd
decodeChar UTF32
_ = do
Word32
wrd <- forall (m :: * -> *). ByteSource m => m Word32
fetchWord32be
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Char
chr forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
wrd
encode :: forall (m :: * -> *). ByteSink m => UTF32 -> String -> m ()
encode UTF32
UTF32 String
str = do
forall enc (m :: * -> *).
(Encoding enc, ByteSink m) =>
enc -> Char -> m ()
encodeChar UTF32
UTF32 Char
'\xFEFF'
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall enc (m :: * -> *).
(Encoding enc, ByteSink m) =>
enc -> Char -> m ()
encodeChar UTF32
UTF32) String
str
encode UTF32
enc String
str = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall enc (m :: * -> *).
(Encoding enc, ByteSink m) =>
enc -> Char -> m ()
encodeChar UTF32
enc) String
str
decode :: forall (m :: * -> *). ByteSource m => UTF32 -> m String
decode UTF32
UTF32 = do
Word32
ch <- forall (m :: * -> *). ByteSource m => m Word32
fetchWord32be
case Word32
ch of
Word32
0x0000FEFF -> forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
untilM forall (m :: * -> *). ByteSource m => m Bool
sourceEmpty (forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m Char
decodeChar UTF32
UTF32BE)
Word32
0xFFFE0000 -> forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
untilM forall (m :: * -> *). ByteSource m => m Bool
sourceEmpty (forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m Char
decodeChar UTF32
UTF32LE)
Word32
_ -> do
String
rest <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
untilM forall (m :: * -> *). ByteSource m => m Bool
sourceEmpty (forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m Char
decodeChar UTF32
UTF32)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int -> Char
chr forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ch)forall a. a -> [a] -> [a]
:String
rest)
decode UTF32
enc = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
untilM forall (m :: * -> *). ByteSource m => m Bool
sourceEmpty (forall enc (m :: * -> *).
(Encoding enc, ByteSource m) =>
enc -> m Char
decodeChar UTF32
enc)
encodeable :: UTF32 -> Char -> Bool
encodeable UTF32
_ Char
_ = Bool
True