diff --git a/Data/Encoding.hs b/Data/Encoding.hs --- a/Data/Encoding.hs +++ b/Data/Encoding.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ExistentialQuantification,CPP #-} module Data.Encoding (Encoding(..) ,EncodingException(..) @@ -5,13 +6,19 @@ ,recode ,recodeLazy ,DynEncoding() +#ifndef USE_HPC ,encodingFromString + ,encodingFromStringMaybe +#endif ) where import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as Lazy (ByteString) +import Data.Typeable import Data.Encoding.Base + +#ifndef USE_HPC import Data.Encoding.ASCII import Data.Encoding.UTF8 import Data.Encoding.UTF16 @@ -41,10 +48,13 @@ import Data.Encoding.CP1257 import Data.Encoding.CP1258 import Data.Encoding.KOI8R +import Data.Encoding.KOI8U import Data.Encoding.GB18030 +#endif -- | An untyped encoding. Used in 'System.IO.Encoding.getSystemEncoding'. -data DynEncoding = forall t. (Encoding t,Show t) => DynEncoding t +data DynEncoding = forall t. (Encoding t,Show t,Typeable t,Eq t) + => DynEncoding t instance Encoding DynEncoding where encode (DynEncoding enc) = encode enc @@ -57,6 +67,11 @@ instance Show DynEncoding where show (DynEncoding enc) = "DynEncoding "++show enc +instance Eq DynEncoding where + (DynEncoding enc1) == (DynEncoding enc2) = case cast enc2 of + Nothing -> False + Just renc2 -> enc1 == renc2 + -- | This decodes a string from one encoding and encodes it into another. recode :: (Encoding from,Encoding to) => from -> to -> ByteString -> ByteString recode enc_f enc_t bs = encode enc_t (decode enc_f bs) @@ -64,36 +79,46 @@ recodeLazy :: (Encoding from,Encoding to) => from -> to -> Lazy.ByteString -> Lazy.ByteString recodeLazy enc_f enc_t bs = encodeLazy enc_t (decodeLazy enc_f bs) +#ifndef USE_HPC +-- | Like 'encodingFromString' but returns 'Nothing' instead of throwing an error +encodingFromStringMaybe :: String -> Maybe DynEncoding +encodingFromStringMaybe "ASCII" = Just $ DynEncoding ASCII +encodingFromStringMaybe "UTF-8" = Just $ DynEncoding UTF8 +encodingFromStringMaybe "UTF-16" = Just $ DynEncoding UTF16 +encodingFromStringMaybe "UTF-32" = Just $ DynEncoding UTF32 +encodingFromStringMaybe "KOI8-R" = Just $ DynEncoding KOI8R +encodingFromStringMaybe "KOI8-U" = Just $ DynEncoding KOI8U +encodingFromStringMaybe "ISO-8859-1" = Just $ DynEncoding ISO88591 +encodingFromStringMaybe "ISO-8859-2" = Just $ DynEncoding ISO88592 +encodingFromStringMaybe "ISO-8859-3" = Just $ DynEncoding ISO88593 +encodingFromStringMaybe "ISO-8859-4" = Just $ DynEncoding ISO88594 +encodingFromStringMaybe "ISO-8859-5" = Just $ DynEncoding ISO88595 +encodingFromStringMaybe "ISO-8859-6" = Just $ DynEncoding ISO88596 +encodingFromStringMaybe "ISO-8859-7" = Just $ DynEncoding ISO88597 +encodingFromStringMaybe "ISO-8859-8" = Just $ DynEncoding ISO88598 +encodingFromStringMaybe "ISO-8859-9" = Just $ DynEncoding ISO88599 +encodingFromStringMaybe "ISO-8859-10" = Just $ DynEncoding ISO885910 +encodingFromStringMaybe "ISO-8859-11" = Just $ DynEncoding ISO885911 +encodingFromStringMaybe "ISO-8859-13" = Just $ DynEncoding ISO885913 +encodingFromStringMaybe "ISO-8859-14" = Just $ DynEncoding ISO885914 +encodingFromStringMaybe "ISO-8859-15" = Just $ DynEncoding ISO885915 +encodingFromStringMaybe "ISO-8859-16" = Just $ DynEncoding ISO885916 +encodingFromStringMaybe "CP1250" = Just $ DynEncoding CP1250 +encodingFromStringMaybe "CP1251" = Just $ DynEncoding CP1251 +encodingFromStringMaybe "CP1252" = Just $ DynEncoding CP1252 +encodingFromStringMaybe "CP1253" = Just $ DynEncoding CP1253 +encodingFromStringMaybe "CP1254" = Just $ DynEncoding CP1254 +encodingFromStringMaybe "CP1255" = Just $ DynEncoding CP1255 +encodingFromStringMaybe "CP1256" = Just $ DynEncoding CP1256 +encodingFromStringMaybe "CP1257" = Just $ DynEncoding CP1257 +encodingFromStringMaybe "CP1258" = Just $ DynEncoding CP1258 +encodingFromStringMaybe "GB18030" = Just $ DynEncoding GB18030 +encodingFromStringMaybe _ = Nothing + -- | Takes the name of an encoding and creates a dynamic encoding from it. encodingFromString :: String -> DynEncoding -encodingFromString "ASCII" = DynEncoding ASCII -encodingFromString "UTF-8" = DynEncoding UTF8 -encodingFromString "UTF-16" = DynEncoding UTF16 -encodingFromString "UTF-32" = DynEncoding UTF32 -encodingFromString "KOI8-R" = DynEncoding KOI8R -encodingFromString "ISO-8859-1" = DynEncoding ISO88591 -encodingFromString "ISO-8859-2" = DynEncoding ISO88592 -encodingFromString "ISO-8859-3" = DynEncoding ISO88593 -encodingFromString "ISO-8859-4" = DynEncoding ISO88594 -encodingFromString "ISO-8859-5" = DynEncoding ISO88595 -encodingFromString "ISO-8859-6" = DynEncoding ISO88596 -encodingFromString "ISO-8859-7" = DynEncoding ISO88597 -encodingFromString "ISO-8859-8" = DynEncoding ISO88598 -encodingFromString "ISO-8859-9" = DynEncoding ISO88599 -encodingFromString "ISO-8859-10"= DynEncoding ISO885910 -encodingFromString "ISO-8859-11"= DynEncoding ISO885911 -encodingFromString "ISO-8859-13"= DynEncoding ISO885913 -encodingFromString "ISO-8859-14"= DynEncoding ISO885914 -encodingFromString "ISO-8859-15"= DynEncoding ISO885915 -encodingFromString "ISO-8859-16"= DynEncoding ISO885916 -encodingFromString "CP1250" = DynEncoding CP1250 -encodingFromString "CP1251" = DynEncoding CP1251 -encodingFromString "CP1252" = DynEncoding CP1252 -encodingFromString "CP1253" = DynEncoding CP1253 -encodingFromString "CP1254" = DynEncoding CP1254 -encodingFromString "CP1255" = DynEncoding CP1255 -encodingFromString "CP1256" = DynEncoding CP1256 -encodingFromString "CP1257" = DynEncoding CP1257 -encodingFromString "CP1258" = DynEncoding CP1258 -encodingFromString "GB18030" = DynEncoding GB18030 -encodingFromString str = error $ "Unknown encoding: "++show str +encodingFromString str = maybe + (error $ "Data.Encoding.encodingFromString: Unknown encoding: "++show str) + id + (encodingFromStringMaybe str) +#endif diff --git a/Data/Encoding/ASCII.hs b/Data/Encoding/ASCII.hs --- a/Data/Encoding/ASCII.hs +++ b/Data/Encoding/ASCII.hs @@ -1,7 +1,8 @@ +{-# LANGUAGE DeriveDataTypeable #-} -- | ASCII (American Standard Code for Information Interchange) is the -- \"normal\" computer encoding using the byte values 0-127 to represent -- characters. Refer to for --- more informations. +-- more information. module Data.Encoding.ASCII (ASCII(..)) where @@ -13,8 +14,9 @@ import qualified Data.ByteString.Lazy as Lazy import Data.Encoding.Base import Data.Word +import Data.Typeable -data ASCII = ASCII deriving Show +data ASCII = ASCII deriving (Show,Eq,Typeable) charToASCII :: Char -> Word8 charToASCII ch = if ch < '\128' diff --git a/Data/Encoding/Base.hs b/Data/Encoding/Base.hs --- a/Data/Encoding/Base.hs +++ b/Data/Encoding/Base.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.Base (Encoding(..) @@ -114,7 +114,7 @@ data EncodingException = HasNoRepresentation Char -- ^ Thrown if a specific character -- is not representable in an encoding. - deriving (Show,Typeable) + deriving (Eq,Show,Typeable) -- | This exception type is thrown whenever something went wrong during the -- decoding-process. @@ -124,7 +124,9 @@ | UnexpectedEnd -- ^ more bytes were needed to allow a -- successfull decoding. | OutOfRange -- ^ the decoded value was out of the unicode range - deriving (Show,Typeable) + | IllegalRepresentation [Word8] -- ^ The character sequence encodes a + -- character, but is illegal. + deriving (Eq,Show,Typeable) decodingArray :: FilePath -> Q Exp decodingArray file = do diff --git a/Data/Encoding/BootString.hs b/Data/Encoding/BootString.hs --- a/Data/Encoding/BootString.hs +++ b/Data/Encoding/BootString.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} {- | This implements BootString en- and decoding, the foundation of Punycode -} module Data.Encoding.BootString @@ -8,6 +9,8 @@ import Data.ByteString.Char8 (pack,unpack) import Data.List (unfoldr,partition) import Data.Char (ord,chr) +import Data.Typeable +import Control.Exception (throwDyn) data BootString = BootString {base :: Int @@ -18,6 +21,7 @@ ,init_bias :: Int ,init_n :: Int } + deriving (Show,Eq,Typeable) punycode :: BootString punycode = BootString @@ -41,7 +45,7 @@ | otherwise = norep where n = ord c - norep = error $ "No puny representation for "++show c + norep = throwDyn (HasNoRepresentation c) punyChar :: Int -> Char punyChar c @@ -50,14 +54,13 @@ | c < 36 = chr $ 0x30+c-26 | otherwise = norep where - norep = error $ "No char representation for puny value "++show c + norep = throwDyn OutOfRange -threshold :: BootString -> Int -> Int -> Int -threshold bs bias pos - | r > tmax bs = tmax bs - | r < tmin bs = tmin bs - where - r = (base bs)*(pos+1)-bias +getT :: BootString -> Int -> Int -> Int +getT bs k bias + | k <= bias + (tmin bs) = tmin bs + | k >= bias + (tmax bs) = tmax bs + | otherwise = k-bias adapt :: BootString -> Int -> Int -> Bool -> Int adapt bs delta numpoints firsttime = let @@ -67,32 +70,33 @@ delta2 = delta1 + (delta1 `div` numpoints) (rd,rk) = head $ filter ((<=((base bs - tmin bs) * (tmax bs)) `div` 2).fst) - $ iterate (\(d,k) -> (d `div` (base bs - tmin bs),k+1)) (delta2,0) + $ iterate (\(d,k) -> (d `div` (base bs - tmin bs),k+(base bs))) (delta2,0) in rk + (((base bs - tmin bs +1) * rd) `div` (rd + skew bs)) decodeValue :: BootString -> Int -> Int -> Int -> Int -> [Int] -> (Int,[Int]) -decodeValue bs bias i k w (x:xs) = let +decodeValue bs bias i k w (x:xs) + | x >= base bs = throwDyn OutOfRange + | x > (maxBound - i) `div` w = throwDyn OutOfRange + | x < t = (ni,xs) + | w > maxBound `div` (base bs - t) = throwDyn OutOfRange + | otherwise = decodeValue bs bias ni (k+base bs) (w*(base bs - t)) xs + where ni = i + x*w - t = if k <= bias + (tmin bs) - then tmin bs - else (if k >= bias + (tmax bs) - then tmax bs - else k-bias) - in if x < t - then (ni,xs) - else decodeValue bs bias ni (k+base bs) (w*(base bs - t)) xs + t = getT bs k bias decodeValues :: BootString -> Int -> [Int] -> [(Char,Int)] decodeValues bs len xs = decodeValues' bs (init_n bs) 0 (init_bias bs) len xs decodeValues' :: BootString -> Int -> Int -> Int -> Int -> [Int] -> [(Char,Int)] decodeValues' bs n i bias len [] = [] -decodeValues' bs n i bias len xs = let +decodeValues' bs n i bias len xs + | dn > maxBound - n = throwDyn OutOfRange + | otherwise = (chr $ nn,nni):decodeValues' bs nn (nni+1) + (adapt bs (ni-i) (len+1) (i==0)) (len+1) rst + where (ni,rst) = decodeValue bs bias i (base bs) 1 xs (dn,nni) = ni `divMod` (len+1) nn = n + dn - in (chr $ nn,nni):decodeValues' bs nn (nni+1) - (adapt bs (ni-i) (len+1) (i==0)) (len+1) rst insertDeltas :: [(Char,Int)] -> String -> String insertDeltas [] str = str @@ -105,11 +109,7 @@ encodeValue :: BootString -> Int -> Int -> Int -> Int -> [Int] encodeValue bs bias delta n c = unfoldr (\(q,k,out) -> let - t = if k <= bias + tmin bs - then tmin bs - else (if k >= bias + tmax bs - then tmax bs - else k - bias) + t = getT bs k bias (nq,dc) = (q-t) `divMod` (base bs - t) in if out then Nothing diff --git a/Data/Encoding/CP1250.hs b/Data/Encoding/CP1250.hs --- a/Data/Encoding/CP1250.hs +++ b/Data/Encoding/CP1250.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} +{- | This module implements Windows Codepage number 1250 which encodes languages that use latin script. + See for more information. + -} module Data.Encoding.CP1250 (CP1250(..)) where @@ -8,8 +12,9 @@ import Data.Encoding.Base import Prelude hiding (lookup,all) import Control.Exception (throwDyn) +import Data.Typeable -data CP1250 = CP1250 deriving Show +data CP1250 = CP1250 deriving (Eq,Show,Typeable) instance Encoding CP1250 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/CP1251.hs b/Data/Encoding/CP1251.hs --- a/Data/Encoding/CP1251.hs +++ b/Data/Encoding/CP1251.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} +{- | This module implements Windows Codepage number 1251 which encodes languages that use the cyrillic alphabet. + See for more information. + -} module Data.Encoding.CP1251 (CP1251(..)) where @@ -8,8 +12,9 @@ import Data.Encoding.Base import Prelude hiding (lookup,all) import Control.Exception (throwDyn) +import Data.Typeable -data CP1251 = CP1251 deriving Show +data CP1251 = CP1251 deriving (Eq,Show,Typeable) instance Encoding CP1251 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/CP1252.hs b/Data/Encoding/CP1252.hs --- a/Data/Encoding/CP1252.hs +++ b/Data/Encoding/CP1252.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} +{- | This module implements Windows Codepage number 1252 which is a superset of ISO 8859-1. + See for more information. + -} module Data.Encoding.CP1252 (CP1252(..)) where @@ -8,8 +12,9 @@ import Data.Encoding.Base import Prelude hiding (lookup,all) import Control.Exception (throwDyn) +import Data.Typeable -data CP1252 = CP1252 deriving Show +data CP1252 = CP1252 deriving (Eq,Show,Typeable) instance Encoding CP1252 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/CP1253.hs b/Data/Encoding/CP1253.hs --- a/Data/Encoding/CP1253.hs +++ b/Data/Encoding/CP1253.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} +{- | This module implements Windows Codepage number 1253 which encodes modern greek. + See for more information. + -} module Data.Encoding.CP1253 (CP1253(..)) where @@ -8,8 +12,9 @@ import Data.Encoding.Base import Prelude hiding (lookup,all) import Control.Exception (throwDyn) +import Data.Typeable -data CP1253 = CP1253 deriving Show +data CP1253 = CP1253 deriving (Eq,Show,Typeable) instance Encoding CP1253 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/CP1254.hs b/Data/Encoding/CP1254.hs --- a/Data/Encoding/CP1254.hs +++ b/Data/Encoding/CP1254.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} +{- | This module implements Windows Codepage number 1254 which encodes the turkish language. + See for more information. + -} module Data.Encoding.CP1254 (CP1254(..)) where @@ -8,8 +12,9 @@ import Data.Encoding.Base import Prelude hiding (lookup,all) import Control.Exception (throwDyn) +import Data.Typeable -data CP1254 = CP1254 deriving Show +data CP1254 = CP1254 deriving (Eq,Show,Typeable) instance Encoding CP1254 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/CP1255.hs b/Data/Encoding/CP1255.hs --- a/Data/Encoding/CP1255.hs +++ b/Data/Encoding/CP1255.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} +{- | This module implements Windows Codepage number 1255 which encodes the hebrew language. + See for more information. + -} module Data.Encoding.CP1255 (CP1255(..)) where @@ -8,8 +12,9 @@ import Data.Encoding.Base import Prelude hiding (lookup,all) import Control.Exception (throwDyn) +import Data.Typeable -data CP1255 = CP1255 deriving Show +data CP1255 = CP1255 deriving (Eq,Show,Typeable) instance Encoding CP1255 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/CP1256.hs b/Data/Encoding/CP1256.hs --- a/Data/Encoding/CP1256.hs +++ b/Data/Encoding/CP1256.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} +{- | This module implements Windows Codepage number 1256 which encodes languages which use the arabic script. + See for more information. + -} module Data.Encoding.CP1256 (CP1256(..)) where @@ -8,8 +12,9 @@ import Data.Encoding.Base import Prelude hiding (lookup,all) import Control.Exception (throwDyn) +import Data.Typeable -data CP1256 = CP1256 deriving Show +data CP1256 = CP1256 deriving (Eq,Show,Typeable) instance Encoding CP1256 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/CP1257.hs b/Data/Encoding/CP1257.hs --- a/Data/Encoding/CP1257.hs +++ b/Data/Encoding/CP1257.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} +{- | This module implements Windows Codepage number 1257 which encodes the estonian, latvian and lithuanian language. + See for more information. + -} module Data.Encoding.CP1257 (CP1257(..)) where @@ -8,8 +12,9 @@ import Data.Encoding.Base import Prelude hiding (lookup,all) import Control.Exception (throwDyn) +import Data.Typeable -data CP1257 = CP1257 deriving Show +data CP1257 = CP1257 deriving (Eq,Show,Typeable) instance Encoding CP1257 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/CP1258.hs b/Data/Encoding/CP1258.hs --- a/Data/Encoding/CP1258.hs +++ b/Data/Encoding/CP1258.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} +{- | This module implements Windows Codepage number 1258 which encodes the vietnamese language. + See for more information. + -} module Data.Encoding.CP1258 (CP1258(..)) where @@ -8,8 +12,9 @@ import Data.Encoding.Base import Prelude hiding (lookup,all) import Control.Exception (throwDyn) +import Data.Typeable -data CP1258 = CP1258 deriving Show +data CP1258 = CP1258 deriving (Eq,Show,Typeable) instance Encoding CP1258 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/GB18030.hs b/Data/Encoding/GB18030.hs --- a/Data/Encoding/GB18030.hs +++ b/Data/Encoding/GB18030.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,DeriveDataTypeable #-} {- | GB18030 is a chinese character encoding that is mandatory in china (if you - don\'t implement it, you\'re not allowed to sell your software there). -} @@ -13,6 +14,7 @@ import Data.Encoding.Base import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import Data.Typeable #if __GLASGOW_HASKELL__>=608 import Data.ByteString.Unsafe (unsafeIndex) @@ -22,7 +24,7 @@ import Data.Encoding.GB18030Data -data GB18030 = GB18030 deriving Show +data GB18030 = GB18030 deriving (Eq,Show,Typeable) instance Encoding GB18030 where encode _ = encodeMultibyte encodeGB diff --git a/Data/Encoding/GB18030Data.hs b/Data/Encoding/GB18030Data.hs --- a/Data/Encoding/GB18030Data.hs +++ b/Data/Encoding/GB18030Data.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE CPP, MagicHash #-} module Data.Encoding.GB18030Data where import Data.ByteString(ByteString) diff --git a/Data/Encoding/Helper/Template.hs b/Data/Encoding/Helper/Template.hs --- a/Data/Encoding/Helper/Template.hs +++ b/Data/Encoding/Helper/Template.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell #-} {- This module is used to create arrays from lists in template haskell -} module Data.Encoding.Helper.Template where diff --git a/Data/Encoding/ISO88591.hs b/Data/Encoding/ISO88591.hs --- a/Data/Encoding/ISO88591.hs +++ b/Data/Encoding/ISO88591.hs @@ -1,5 +1,6 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} {- | Implements ISO\/IEC 8859-1 alias latin-1 encoding. See - for further informations. + for further information. -} module Data.Encoding.ISO88591 (ISO88591(..) @@ -9,8 +10,9 @@ import Data.Char(ord,chr) import Data.Word import Control.Exception +import Data.Typeable -data ISO88591 = ISO88591 deriving Show +data ISO88591 = ISO88591 deriving (Eq,Show,Typeable) enc :: Char -> Word8 enc c = if ord c < 256 diff --git a/Data/Encoding/ISO885910.hs b/Data/Encoding/ISO885910.hs --- a/Data/Encoding/ISO885910.hs +++ b/Data/Encoding/ISO885910.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO885910 (ISO885910(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO885910 = ISO885910 deriving Show +data ISO885910 = ISO885910 deriving (Eq,Show,Typeable) enc :: Char -> Word8 enc c = case lookup c encodeMap of diff --git a/Data/Encoding/ISO885911.hs b/Data/Encoding/ISO885911.hs --- a/Data/Encoding/ISO885911.hs +++ b/Data/Encoding/ISO885911.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO885911 (ISO885911(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO885911 = ISO885911 deriving Show +data ISO885911 = ISO885911 deriving (Eq,Show,Typeable) enc :: Char -> Word8 enc c = case lookup c encodeMap of diff --git a/Data/Encoding/ISO885913.hs b/Data/Encoding/ISO885913.hs --- a/Data/Encoding/ISO885913.hs +++ b/Data/Encoding/ISO885913.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO885913 (ISO885913(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO885913 = ISO885913 deriving Show +data ISO885913 = ISO885913 deriving (Eq,Show,Typeable) enc :: Char -> Word8 enc c = case lookup c encodeMap of diff --git a/Data/Encoding/ISO885914.hs b/Data/Encoding/ISO885914.hs --- a/Data/Encoding/ISO885914.hs +++ b/Data/Encoding/ISO885914.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO885914 (ISO885914(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO885914 = ISO885914 deriving Show +data ISO885914 = ISO885914 deriving (Eq,Show,Typeable) enc :: Char -> Word8 enc c = case lookup c encodeMap of diff --git a/Data/Encoding/ISO885915.hs b/Data/Encoding/ISO885915.hs --- a/Data/Encoding/ISO885915.hs +++ b/Data/Encoding/ISO885915.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO885915 (ISO885915(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO885915 = ISO885915 deriving Show +data ISO885915 = ISO885915 deriving (Eq,Show,Typeable) enc :: Char -> Word8 enc c = case lookup c encodeMap of diff --git a/Data/Encoding/ISO885916.hs b/Data/Encoding/ISO885916.hs --- a/Data/Encoding/ISO885916.hs +++ b/Data/Encoding/ISO885916.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO885916 (ISO885916(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO885916 = ISO885916 deriving Show +data ISO885916 = ISO885916 deriving (Eq,Show,Typeable) enc :: Char -> Word8 enc c = case lookup c encodeMap of diff --git a/Data/Encoding/ISO88592.hs b/Data/Encoding/ISO88592.hs --- a/Data/Encoding/ISO88592.hs +++ b/Data/Encoding/ISO88592.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} {- | Implements ISO\/IEC 8859-2 alias latin-2 encoding. See for further informations. -} @@ -11,8 +12,9 @@ import Data.ByteString hiding (length,map) import Prelude hiding (lookup,all) import Control.Exception +import Data.Typeable -data ISO88592 = ISO88592 deriving Show +data ISO88592 = ISO88592 deriving (Eq,Show,Typeable) enc :: Char -> Word8 enc c = case lookup c encodeMap of diff --git a/Data/Encoding/ISO88593.hs b/Data/Encoding/ISO88593.hs --- a/Data/Encoding/ISO88593.hs +++ b/Data/Encoding/ISO88593.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} {- | Implements ISO 8859-3 encoding, alias latin-3, alias south european -} module Data.Encoding.ISO88593 @@ -9,8 +10,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO88593 = ISO88593 deriving Show +data ISO88593 = ISO88593 deriving (Eq,Show,Typeable) enc :: Char -> Word8 enc c = case lookup c encodeMap of diff --git a/Data/Encoding/ISO88594.hs b/Data/Encoding/ISO88594.hs --- a/Data/Encoding/ISO88594.hs +++ b/Data/Encoding/ISO88594.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO88594 (ISO88594(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO88594 = ISO88594 deriving Show +data ISO88594 = ISO88594 deriving (Eq,Show,Typeable) enc :: Char -> Word8 enc c = case lookup c encodeMap of diff --git a/Data/Encoding/ISO88595.hs b/Data/Encoding/ISO88595.hs --- a/Data/Encoding/ISO88595.hs +++ b/Data/Encoding/ISO88595.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO88595 (ISO88595(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO88595 = ISO88595 deriving Show +data ISO88595 = ISO88595 deriving (Eq,Show,Typeable) instance Encoding ISO88595 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/ISO88596.hs b/Data/Encoding/ISO88596.hs --- a/Data/Encoding/ISO88596.hs +++ b/Data/Encoding/ISO88596.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO88596 (ISO88596(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO88596 = ISO88596 deriving Show +data ISO88596 = ISO88596 deriving (Eq,Show,Typeable) instance Encoding ISO88596 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/ISO88597.hs b/Data/Encoding/ISO88597.hs --- a/Data/Encoding/ISO88597.hs +++ b/Data/Encoding/ISO88597.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO88597 (ISO88597(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO88597 = ISO88597 deriving Show +data ISO88597 = ISO88597 deriving (Eq,Show,Typeable) instance Encoding ISO88597 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/ISO88598.hs b/Data/Encoding/ISO88598.hs --- a/Data/Encoding/ISO88598.hs +++ b/Data/Encoding/ISO88598.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO88598 (ISO88598(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO88598 = ISO88598 deriving Show +data ISO88598 = ISO88598 deriving (Eq,Show,Typeable) instance Encoding ISO88598 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/ISO88599.hs b/Data/Encoding/ISO88599.hs --- a/Data/Encoding/ISO88599.hs +++ b/Data/Encoding/ISO88599.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP,TemplateHaskell,DeriveDataTypeable #-} module Data.Encoding.ISO88599 (ISO88599(..)) where @@ -7,8 +8,9 @@ import Data.Encoding.Base import Prelude hiding (lookup) import Control.Exception (throwDyn) +import Data.Typeable -data ISO88599 = ISO88599 deriving Show +data ISO88599 = ISO88599 deriving (Eq,Show,Typeable) instance Encoding ISO88599 where encode _ = encodeSinglebyte (\c -> case lookup c encodeMap of diff --git a/Data/Encoding/KOI8R.hs b/Data/Encoding/KOI8R.hs --- a/Data/Encoding/KOI8R.hs +++ b/Data/Encoding/KOI8R.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{- | This module implements KOI8-R encoding which covers the russian and bulgarian alphabet. + See for more information. + -} module Data.Encoding.KOI8R (KOI8R(..)) where @@ -8,10 +12,11 @@ import Data.Map hiding (map,(!)) import Data.Word import Prelude hiding (lookup) +import Data.Typeable import Data.Encoding.Base -data KOI8R = KOI8R deriving Show +data KOI8R = KOI8R deriving (Eq,Show,Typeable) koi8rArr :: UArray Word8 Char koi8rArr = listArray (128,255) koi8rList @@ -36,7 +41,8 @@ ,'\x042e','\x0410','\x0411','\x0426','\x0414','\x0415','\x0424','\x0413' ,'\x0425','\x0418','\x0419','\x041a','\x041b','\x041c','\x041d','\x041e' ,'\x041f','\x042f','\x0420','\x0421','\x0422','\x0423','\x0416','\x0412' - ,'\x042c','\x042b','\x0417','\x0428','\x042d','\x0429','\x0427','\x042a'] + ,'\x042c','\x042b','\x0417','\x0428','\x042d','\x0429','\x0427','\x042a' + ] koi8rDecode :: Word8 -> Char koi8rDecode ch diff --git a/Data/Encoding/KOI8U.hs b/Data/Encoding/KOI8U.hs new file mode 100644 --- /dev/null +++ b/Data/Encoding/KOI8U.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{- | This module implements KOI8-U encoding which covers the ukrainian alphabet. + See for more information. + -} +module Data.Encoding.KOI8U + (KOI8U(..)) where + +import Control.Exception (throwDyn) +import Data.Word +import Data.Array.Unboxed +import Data.Encoding.Base +import Data.Char (chr,ord) +import Data.Map (Map,fromList,lookup,member) +import qualified Data.ByteString.Lazy as Lazy +import Prelude hiding (lookup) +import Data.Typeable + +data KOI8U = KOI8U deriving (Eq,Show,Typeable) + +koi8uArr :: UArray Word8 Char +koi8uArr = listArray (128,255) koi8uList + +koi8uMap :: Map Char Word8 +koi8uMap = fromList (zip koi8uList [0..]) + +koi8uList :: [Char] +koi8uList = + ['\x2500','\x2502','\x250c','\x2510','\x2514','\x2518','\x251c','\x2524' + ,'\x252c','\x2534','\x253c','\x2580','\x2584','\x2588','\x258c','\x2590' + ,'\x2591','\x2592','\x2593','\x2320','\x25a0','\x2219','\x221a','\x2248' + ,'\x2264','\x2265','\x00a0','\x2321','\x00b0','\x00b2','\x00b7','\x00f7' + ,'\x2550','\x2551','\x2552','\x0451','\x0454','\x2554','\x0456','\x0457' + ,'\x2557','\x2558','\x2559','\x255a','\x255b','\x0491','\x255d','\x255e' + ,'\x255f','\x2560','\x2561','\x0401','\x0403','\x2563','\x0406','\x0407' + ,'\x2566','\x2567','\x2568','\x2569','\x256a','\x0490','\x256c','\x00a9' + ,'\x044e','\x0430','\x0431','\x0446','\x0434','\x0435','\x0444','\x0433' + ,'\x0445','\x0438','\x0439','\x043a','\x043b','\x043c','\x043d','\x043e' + ,'\x043f','\x044f','\x0440','\x0441','\x0442','\x0443','\x0436','\x0432' + ,'\x044c','\x044b','\x0437','\x0448','\x044d','\x0449','\x0447','\x044a' + ,'\x042e','\x0410','\x0411','\x0426','\x0414','\x0415','\x0424','\x0413' + ,'\x0425','\x0418','\x0419','\x041a','\x041b','\x041c','\x041d','\x041e' + ,'\x041f','\x042f','\x0420','\x0421','\x0422','\x0423','\x0416','\x0412' + ,'\x042c','\x042b','\x0417','\x0428','\x042d','\x0429','\x0427','\x042a' + ] + +koi8uDecode :: Word8 -> Char +koi8uDecode ch + | ch < 128 = chr $ fromIntegral ch + | otherwise = koi8uArr!ch + +koi8uEncode :: Char -> Word8 +koi8uEncode ch + | ch < '\128' = fromIntegral $ ord ch + | otherwise = case lookup ch koi8uMap of + Just w -> w + Nothing -> throwDyn (HasNoRepresentation ch) + +instance Encoding KOI8U where + encode _ = encodeSinglebyte koi8uEncode + encodeLazy _ = encodeSinglebyteLazy koi8uEncode + encodable _ c = (c < '\128') || (member c koi8uMap) + decode _ = decodeSinglebyte koi8uDecode + decodeLazy _ str = concatMap (decodeSinglebyte koi8uDecode) (Lazy.toChunks str) + decodable _ = const True diff --git a/Data/Encoding/UTF16.hs b/Data/Encoding/UTF16.hs --- a/Data/Encoding/UTF16.hs +++ b/Data/Encoding/UTF16.hs @@ -1,4 +1,6 @@ -{- | This module implements UTF-16 encoding and decoding as in RFC 2781 +{-# LANGUAGE DeriveDataTypeable #-} +{- | This module implements UTF-16 encoding and decoding as in RFC 2781. + See for more information. -} module Data.Encoding.UTF16 (UTF16(..) @@ -9,17 +11,18 @@ import Data.Bits import Data.Int import Data.Word -import Data.ByteString +import Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Prelude hiding (length) import Control.Exception import Data.Dynamic (toDyn) +import Data.Typeable data UTF16 - = UTF16 - | UTF16BE - | UTF16LE - deriving (Eq,Show) + = UTF16 -- ^ Decodes big and little endian, encodes big endian. + | UTF16BE -- ^ Big endian decoding and encoding, fails if the string isn\'t actually big endian. + | UTF16LE -- ^ Little endian decoding and encoding. + deriving (Eq,Show,Typeable) utf16enc :: Bool -> (EncodeState,String) -> Maybe (Word8,(EncodeState,String)) utf16enc _ (Done,[]) = Nothing @@ -78,11 +81,14 @@ UTF16 -> Put2 0xFE 0xFF _ -> Done,str) encodable _ c = ord c <= 0x0010FFFF - decode _ str = case findByteOrder str of - Nothing -> decode' True 0 + decode bo str = case findByteOrder str of + Nothing -> decode' (bo/=UTF16LE) 0 Just big -> decode' big 2 where - decode' be i = c:decode' be (i+took) + l = BS.length str + decode' be i = if i>=l + then [] + else c:decode' be (i+took) where (c,took) = mapException (\ex -> case ex of ErrorCall _ -> DynException (toDyn UnexpectedEnd) @@ -91,11 +97,14 @@ s2 = index str (i+1) s3 = index str (i+2) s4 = index str (i+3) - decodeLazy _ str = case findByteOrderLazy str of - Nothing -> decode' True 0 + decodeLazy bo str = case findByteOrderLazy str of + Nothing -> decode' (bo/=UTF16LE) 0 Just big -> decode' big 2 where - decode' be i = c:decode' be (i+took) + l = LBS.length str + decode' be i = if i>=l + then [] + else c:decode' be (i+took) where (c,took) = mapException (\ex -> case ex of ErrorCall _ -> DynException (toDyn UnexpectedEnd) @@ -104,8 +113,8 @@ s2 = LBS.index str (i+1) s3 = LBS.index str (i+2) s4 = LBS.index str (i+3) - decodable _ str = case findByteOrder str of - Nothing -> check' True (length str) 0 + decodable bo str = case findByteOrder str of + Nothing -> check' (bo/=UTF16LE) (length str) 0 Just big -> check' big (length str) 2 where check' be m i diff --git a/Data/Encoding/UTF32.hs b/Data/Encoding/UTF32.hs --- a/Data/Encoding/UTF32.hs +++ b/Data/Encoding/UTF32.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{- | This module implements UTF-32 encoding and decoding. + See for more information. + -} module Data.Encoding.UTF32 (UTF32(..)) where @@ -7,18 +11,46 @@ import Data.Encoding.Base import Data.Word import Control.Exception (throwDyn) +import Data.Typeable +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS -data UTF32 = UTF32 deriving Show +data UTF32 + = UTF32 -- ^ Detects big or little endian through the use of the BOM (Byte Order Mask) character. Defaults to big endian if not present. + | UTF32BE -- ^ Encodes and decodes using the big endian encoding. + | UTF32LE -- ^ Encodes and decodes using the little endian encoding. + deriving (Eq,Show,Typeable) +bom :: Char +bom = '\xFEFF' + instance Encoding UTF32 where - encode _ = encodeMultibyte encodeUTF32 - encodeLazy _ = encodeMultibyteLazy encodeUTF32 + encode UTF32 str = encodeMultibyte encodeUTF32be (bom:str) + encode UTF32LE str = encodeMultibyte encodeUTF32le str + encode UTF32BE str = encodeMultibyte encodeUTF32be str + encodeLazy UTF32 str = encodeMultibyteLazy encodeUTF32be (bom:str) + encodeLazy UTF32LE str = encodeMultibyteLazy encodeUTF32le str + encodeLazy UTF32BE str = encodeMultibyteLazy encodeUTF32be str encodable _ c = ord c < 0x0010FFFF - decode _ = decodeMultibyte decodeUTF32 - decodeLazy _ = decodeMultibyteLazy decodeUTF32 + decode UTF32 str = let + (start,rest) = BS.splitAt 4 str + in case BS.unpack start of + [0x00,0x00,0xFE,0xFF] -> decode UTF32BE rest + [0xFE,0xFF,0x00,0x00] -> decode UTF32LE rest + _ -> decode UTF32BE str + decode UTF32LE str = decodeMultibyte decodeUTF32le str + decode UTF32BE str = decodeMultibyte decodeUTF32be str + decodeLazy UTF32 str = let + (start,rest) = LBS.splitAt 4 str + in case LBS.unpack start of + [0x00,0x00,0xFE,0xFF] -> decodeLazy UTF32BE rest + [0xFE,0xFF,0x00,0x00] -> decodeLazy UTF32LE rest + _ -> decodeLazy UTF32BE str + decodeLazy UTF32LE str = decodeMultibyteLazy decodeUTF32le str + decodeLazy UTF32BE str = decodeMultibyteLazy decodeUTF32be str -encodeUTF32 :: Char -> (Word8,EncodeState) -encodeUTF32 ch = let +encodeUTF32be :: Char -> (Word8,EncodeState) +encodeUTF32be ch = let w = ord ch w1 = fromIntegral $ w `shiftR` 24 w2 = fromIntegral $ w `shiftR` 16 @@ -26,11 +58,33 @@ w4 = fromIntegral $ w in (w1,Put3 w2 w3 w4) -decodeUTF32 :: [Word8] -> (Char,[Word8]) -decodeUTF32 (w1:w2:w3:w4:rest) = (chr $ - (fromIntegral w1 `shiftL` 24) .|. - (fromIntegral w2 `shiftL` 16) .|. - (fromIntegral w3 `shiftL` 8) .|. - (fromIntegral w4),rest) -decodeUTF32 _ = throwDyn UnexpectedEnd +encodeUTF32le :: Char -> (Word8,EncodeState) +encodeUTF32le ch = let + w = ord ch + w1 = fromIntegral $ w `shiftR` 24 + w2 = fromIntegral $ w `shiftR` 16 + w3 = fromIntegral $ w `shiftR` 8 + w4 = fromIntegral $ w + in (w4,Put3 w3 w2 w1) + +decodeUTF32be :: [Word8] -> (Char,[Word8]) +decodeUTF32be (w1:w2:w3:w4:rest) = let + v = (fromIntegral w1 `shiftL` 24) .|. + (fromIntegral w2 `shiftL` 16) .|. + (fromIntegral w3 `shiftL` 8) .|. + (fromIntegral w4) + in if v < 0x0010FFFF + then (chr v,rest) + else throwDyn (IllegalRepresentation [w1,w2,w3,w4]) +decodeUTF32be _ = throwDyn UnexpectedEnd +decodeUTF32le :: [Word8] -> (Char,[Word8]) +decodeUTF32le (w1:w2:w3:w4:rest) = let + v = (fromIntegral w4 `shiftL` 24) .|. + (fromIntegral w3 `shiftL` 16) .|. + (fromIntegral w2 `shiftL` 8) .|. + (fromIntegral w1) + in if v < 0x0010FFFF + then (chr v,rest) + else throwDyn (IllegalRepresentation [w1,w2,w3,w4]) +decodeUTF32le _ = throwDyn UnexpectedEnd diff --git a/Data/Encoding/UTF8.hs b/Data/Encoding/UTF8.hs --- a/Data/Encoding/UTF8.hs +++ b/Data/Encoding/UTF8.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE DeriveDataTypeable #-} {- | This module implements UTF-8 encoding and decoding as in RFC 3629. + See for more information. -} module Data.Encoding.UTF8 (UTF8(..)) where @@ -10,8 +12,12 @@ import Data.Word import Prelude hiding (length) import Control.Exception +import Data.Typeable -data UTF8 = UTF8 deriving Show +data UTF8 + = UTF8 -- ^ Very forgiving decoding mechanism, accepts everything that it can make any sense of. + | UTF8Strict -- ^ More strict decoding, doesn\'t accept sequences that have a too long representation and checks bits that aren\'t used in the decoding. + deriving (Eq,Show,Typeable) encodeUTF8 :: Char -> (Word8,EncodeState) encodeUTF8 x @@ -53,10 +59,58 @@ .|. ((fromIntegral $ w2 .&. 0x3F) `shiftL` 12) .|. ((fromIntegral $ w3 .&. 0x3F) `shiftL` 6) .|. (fromIntegral $ w4 .&. 0x3F),rest4) + _ -> throwDyn UnexpectedEnd | otherwise = throwDyn (IllegalCharacter w1) +decodeUTF8Strict :: [Word8] -> (Char,[Word8]) +decodeUTF8Strict ~(w1:rest1) + | w1<=0x7F = (chr $ fromIntegral w1,rest1) + | w1<=0xBF = throwDyn (IllegalCharacter w1) + | w1<=0xDF = case rest1 of + (w2:rest2) + | invalidExtend w2 -> throwDyn (IllegalCharacter w2) + | otherwise -> let + v1 = w1 .&. 0x1F + in if v1 <= 1 + then throwDyn (IllegalRepresentation [w1,w2]) + else (chr $ ((fromIntegral v1) `shiftL` 6) + .|. (fromIntegral (w2 .&. 0x3F)),rest2) + _ -> throwDyn UnexpectedEnd + | w1<=0xEF = case rest1 of + (w2:w3:rest3) + | invalidExtend w2 -> throwDyn (IllegalCharacter w2) + | invalidExtend w3 -> throwDyn (IllegalCharacter w3) + | otherwise -> let + v1 = w1 .&. 0x0F + v2 = w2 .&. 0x3F + in if v1 == 0 && v2 < 0x20 + then throwDyn (IllegalRepresentation [w1,w2,w3]) + else (chr $ ((fromIntegral v1) `shiftL` 12) + .|. ((fromIntegral v2) `shiftL` 6) + .|. (fromIntegral $ w3 .&. 0x3F),rest3) + _ -> throwDyn UnexpectedEnd + | w1<=0xF7 = case rest1 of + (w2:w3:w4:rest4) + | invalidExtend w2 -> throwDyn (IllegalCharacter w2) + | invalidExtend w3 -> throwDyn (IllegalCharacter w3) + | invalidExtend w4 -> throwDyn (IllegalCharacter w4) + | otherwise -> let + v1 = w1 .&. 0x07 + v2 = w2 .&. 0x3F + in if v1 == 0 && v2 < 0x10 + then throwDyn (IllegalRepresentation [w1,w2,w3,w4]) + else (chr $ ((fromIntegral $ w1 .&. 0x07) `shiftL` 18) + .|. ((fromIntegral $ w2 .&. 0x3F) `shiftL` 12) + .|. ((fromIntegral $ w3 .&. 0x3F) `shiftL` 6) + .|. (fromIntegral $ w4 .&. 0x3F),rest4) + _ -> throwDyn UnexpectedEnd + | otherwise = throwDyn (IllegalCharacter w1) + where + invalidExtend wrd = wrd .&. 0xC0 /= 0x80 + data UTF8AnalyzeState = Skip !Int + | CheckAndSkip !Word8 !Int | Ok | Failed deriving Eq @@ -65,9 +119,11 @@ encode _ = encodeMultibyte encodeUTF8 encodeLazy _ = encodeMultibyteLazy encodeUTF8 encodable _ c = ord c <= 0x0010FFFF - decode _ = decodeMultibyte decodeUTF8 - decodeLazy _ = decodeMultibyteLazy decodeUTF8 - decodable _ str = (foldl' (\st w -> case st of + decode UTF8 = decodeMultibyte decodeUTF8 + decode UTF8Strict = decodeMultibyte decodeUTF8Strict + decodeLazy UTF8 = decodeMultibyteLazy decodeUTF8 + decodeLazy UTF8Strict = decodeMultibyteLazy decodeUTF8Strict + decodable UTF8 str = (foldl' (\st w -> case st of Ok | w<=0x7F -> Ok | w<=0xBF -> Failed | w<=0xDF -> Skip 0 @@ -78,3 +134,24 @@ Skip n -> if w .&. 0xC0 == 0x80 then (if n == 0 then Ok else Skip (n-1)) else Failed) Ok str) == Ok + decodable UTF8Strict str = (foldl' (\st w -> case st of + Ok | w<=0x7F -> Ok + | w<=0xBF -> Failed + | w<=0xDF -> if w .&. 0x1F <= 1 + then Failed + else Skip 0 + | w<=0xEF -> if w .&. 0x0F == 0 + then CheckAndSkip 0x20 1 + else Skip 1 + | w<=0xF7 -> if w .&. 0x07 == 0 + then CheckAndSkip 0x10 2 + else Skip 2 + | otherwise -> Failed + Failed -> Failed + Skip n -> if w .&. 0xC0 == 0x80 + then (if n == 0 then Ok else Skip (n-1)) + else Failed + CheckAndSkip chk n -> if w .&. 0xC0 == 0x80 && w .&. 0x3F >= chk + then (if n == 0 then Ok else Skip (n-1)) + else Failed + ) Ok str) == Ok diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,11 @@ +Changes from 0.3 to 0.4 +----------------------- + +* A new, strict UTF-8 decoder +* Minor bugs fixed in UTF-16 and BootString +* Test cases for UTF-8, UTF-16 and BootString +* Added KOI8U encoding + Changes from 0.2 to 0.3 ----------------------- diff --git a/encoding.cabal b/encoding.cabal --- a/encoding.cabal +++ b/encoding.cabal @@ -1,5 +1,5 @@ Name: encoding -Version: 0.3 +Version: 0.4 Author: Henning Günther Maintainer: h.guenther@tu-bs.de License: BSD3 @@ -10,6 +10,7 @@ Category: Codec Homepage: http://code.haskell.org/encoding/ Cabal-Version: >=1.2 +Build-Type: Simple Extra-Source-Files: 8859-2.TXT 8859-3.TXT @@ -83,6 +84,7 @@ Data.Encoding.CP1257 Data.Encoding.CP1258 Data.Encoding.KOI8R + Data.Encoding.KOI8U Data.Encoding.GB18030 System.IO.Encoding Other-Modules: