diff --git a/Data/Encoding/ByteSink.hs b/Data/Encoding/ByteSink.hs --- a/Data/Encoding/ByteSink.hs +++ b/Data/Encoding/ByteSink.hs @@ -12,9 +12,10 @@ import Control.Throws import Control.Exception.Extensible import Control.Applicative -import Control.Monad.State -import Control.Monad.Identity -import Control.Monad.Reader +import Control.Monad (ap, liftM) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.State (StateT, modify) +import Control.Monad.Reader (ReaderT, ask) import Foreign.Ptr (Ptr,plusPtr,minusPtr) import Foreign.Marshal.Alloc (mallocBytes,reallocBytes,free) import Foreign.Storable (poke) @@ -85,11 +86,11 @@ fmap = liftM instance Applicative PutME where - pure = return + pure x = PutME $ Right (pure (),x) (<*>) = ap instance Monad PutME where - return x = PutME $ Right (return (),x) + return = pure (PutME x) >>= g = PutME $ do (m,r) <- x let (PutME ng) = g r @@ -126,11 +127,11 @@ fmap = liftM instance Applicative StrictSink where - pure = return + pure x = StrictS $ \cstr pos max -> return (x,cstr,pos,max) (<*>) = ap instance Monad StrictSink where - return x = StrictS $ \cstr pos max -> return (x,cstr,pos,max) + return = pure (StrictS f) >>= g = StrictS (\cstr pos max -> do (res,ncstr,npos,nmax) <- f cstr pos max let StrictS g' = g res @@ -159,11 +160,11 @@ fmap = liftM instance Applicative StrictSinkE where - pure = return + pure = StrictSinkE . return . Right (<*>) = ap instance Monad StrictSinkE where - return = StrictSinkE . return . Right + return = pure (StrictSinkE s) >>= g = StrictSinkE $ do res <- s case res of @@ -193,11 +194,11 @@ fmap = liftM instance Applicative StrictSinkExplicit where - pure = return + pure = (StrictSinkExplicit).return.Right (<*>) = ap instance Monad StrictSinkExplicit where - return = (StrictSinkExplicit).return.Right + return = pure (StrictSinkExplicit sink) >>= f = StrictSinkExplicit (do res <- sink diff --git a/Data/Encoding/ByteSource.hs b/Data/Encoding/ByteSource.hs --- a/Data/Encoding/ByteSource.hs +++ b/Data/Encoding/ByteSource.hs @@ -9,9 +9,11 @@ import Data.Maybe import Data.Word import Control.Applicative as A -import Control.Monad.State -import Control.Monad.Identity -import Control.Monad.Reader +import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.State (StateT (..), get, gets, put) +import Control.Monad.Identity (Identity) +import Control.Monad.Reader (ReaderT, ask) import Control.Exception.Extensible import Control.Throws import qualified Data.ByteString as BS diff --git a/Data/Encoding/Preprocessor/XMLMapping.hs b/Data/Encoding/Preprocessor/XMLMapping.hs --- a/Data/Encoding/Preprocessor/XMLMapping.hs +++ b/Data/Encoding/Preprocessor/XMLMapping.hs @@ -33,28 +33,28 @@ , characterMappingNormalization :: (Defaultable CharacterMapping_normalization) } deriving (Eq,Show) data CharacterMapping_bidiOrder = CharacterMapping_bidiOrder_logical - | CharacterMapping_bidiOrder_RTL | + | CharacterMapping_bidiOrder_RTL | CharacterMapping_bidiOrder_LTR deriving (Eq,Show) data CharacterMapping_combiningOrder = CharacterMapping_combiningOrder_before | CharacterMapping_combiningOrder_after deriving (Eq,Show) data CharacterMapping_normalization = CharacterMapping_normalization_undetermined - | CharacterMapping_normalization_neither | - CharacterMapping_normalization_NFC | - CharacterMapping_normalization_NFD | + | CharacterMapping_normalization_neither | + CharacterMapping_normalization_NFC | + CharacterMapping_normalization_NFD | CharacterMapping_normalization_NFC_NFD deriving (Eq,Show) data Stateful_siso = Stateful_siso Validity Validity deriving (Eq,Show) -newtype History = History (List1 Modified) deriving (Eq,Show) +newtype History = History (List1 Modified) deriving (Eq,Show) data Modified = Modified Modified_Attrs String deriving (Eq,Show) data Modified_Attrs = Modified_Attrs { modifiedVersion :: String , modifiedDate :: String } deriving (Eq,Show) -newtype Validity = Validity (List1 State) deriving (Eq,Show) +newtype Validity = Validity (List1 State) deriving (Eq,Show) data State = State { stateType :: String , stateNext :: String @@ -112,10 +112,10 @@ { escapeSequence :: String , escapeName :: String } deriving (Eq,Show) -newtype Si = Si (List1 Designator) deriving (Eq,Show) -newtype So = So (List1 Designator) deriving (Eq,Show) -newtype Ss2 = Ss2 (List1 Designator) deriving (Eq,Show) -newtype Ss3 = Ss3 (List1 Designator) deriving (Eq,Show) +newtype Si = Si (List1 Designator) deriving (Eq,Show) +newtype So = So (List1 Designator) deriving (Eq,Show) +newtype Ss2 = Ss2 (List1 Designator) deriving (Eq,Show) +newtype Ss3 = Ss3 (List1 Designator) deriving (Eq,Show) data Designator = Designator { designatorSequence :: String , designatorName :: String @@ -153,7 +153,7 @@ , characterMappingCombiningOrder = defaultA fromAttrToTyp CharacterMapping_combiningOrder_after "combiningOrder" as , characterMappingNormalization = defaultA fromAttrToTyp CharacterMapping_normalization_undetermined "normalization" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ toAttrFrStr "id" (characterMappingId v) , toAttrFrStr "version" (characterMappingVersion v) , maybeToAttr toAttrFrStr "description" (characterMappingDescription v) @@ -275,7 +275,7 @@ { modifiedVersion = definiteA fromAttrToStr "modified" "version" as , modifiedDate = definiteA fromAttrToStr "modified" "date" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ toAttrFrStr "version" (modifiedVersion v) , toAttrFrStr "date" (modifiedDate v) ] @@ -308,7 +308,7 @@ , stateE = possibleA fromAttrToTyp "e" as , stateMax = possibleA fromAttrToStr "max" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ toAttrFrStr "type" (stateType v) , toAttrFrStr "next" (stateNext v) , toAttrFrTyp "s" (stateS v) @@ -337,7 +337,7 @@ { assignmentsSub = defaultA fromAttrToStr "1A" "sub" as , assignmentsSub1 = possibleA fromAttrToStr "sub1" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ defaultToAttr toAttrFrStr "sub" (assignmentsSub v) , maybeToAttr toAttrFrStr "sub1" (assignmentsSub1 v) ] @@ -358,7 +358,7 @@ , aC = possibleA fromAttrToStr "c" as , aV = possibleA fromAttrToStr "v" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ toAttrFrTyp "b" (aB v) , toAttrFrTyp "u" (aU v) , maybeToAttr toAttrFrStr "c" (aC v) @@ -384,7 +384,7 @@ , fubRc = possibleA fromAttrToStr "rc" as , fubV = possibleA fromAttrToStr "v" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ toAttrFrTyp "b" (fubB v) , toAttrFrTyp "u" (fubU v) , maybeToAttr toAttrFrStr "c" (fubC v) @@ -409,7 +409,7 @@ , fbuU = definiteA fromAttrToTyp "fbu" "u" as , fbuV = possibleA fromAttrToStr "v" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ toAttrFrTyp "b" (fbuB v) , toAttrFrTyp "u" (fbuU v) , maybeToAttr toAttrFrStr "v" (fbuV v) @@ -431,7 +431,7 @@ , sub1C = possibleA fromAttrToStr "c" as , sub1V = possibleA fromAttrToStr "v" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ toAttrFrTyp "u" (sub1U v) , maybeToAttr toAttrFrStr "c" (sub1C v) , maybeToAttr toAttrFrStr "v" (sub1V v) @@ -457,7 +457,7 @@ , rangeBMax = definiteA fromAttrToTyp "range" "bMax" as , rangeV = possibleA fromAttrToStr "v" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ toAttrFrTyp "bFirst" (rangeBFirst v) , toAttrFrTyp "bLast" (rangeBLast v) , toAttrFrTyp "uFirst" (rangeUFirst v) @@ -493,7 +493,7 @@ Default2022 { default2022Name = definiteA fromAttrToStr "default2022" "name" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ toAttrFrStr "name" (default2022Name v) ] @@ -512,7 +512,7 @@ { escapeSequence = definiteA fromAttrToStr "escape" "sequence" as , escapeName = definiteA fromAttrToStr "escape" "name" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ toAttrFrStr "sequence" (escapeSequence v) , toAttrFrStr "name" (escapeName v) ] @@ -572,7 +572,7 @@ { designatorSequence = definiteA fromAttrToStr "designator" "sequence" as , designatorName = definiteA fromAttrToStr "designator" "name" as } - toAttrs v = catMaybes + toAttrs v = catMaybes [ toAttrFrStr "sequence" (designatorSequence v) , toAttrFrStr "name" (designatorName v) ] diff --git a/Data/Static.hs b/Data/Static.hs --- a/Data/Static.hs +++ b/Data/Static.hs @@ -56,7 +56,7 @@ ) #endif - gen Nothing = gen (-1::Word32) + gen Nothing = gen (complement (0 :: Word32)) gen (Just c) = gen (fromIntegral (ord c)::Word32) instance StaticElement a => StaticElement (a,a) where diff --git a/encoding.cabal b/encoding.cabal --- a/encoding.cabal +++ b/encoding.cabal @@ -1,5 +1,5 @@ Name: encoding -Version: 0.8.8 +Version: 0.8.9 Author: Henning Günther Maintainer: daniel@wagner-home.com License: BSD3 @@ -34,7 +34,7 @@ Custom-Setup Setup-Depends: base >=3 && <5, - Cabal >= 2.0, + Cabal >= 2.0 && < 3.11, containers, filepath, ghc-prim, @@ -44,11 +44,11 @@ Build-Depends: array >=0.4 && <0.6, base >=4 && <5, binary >=0.7 && <0.10, - bytestring >=0.9 && <0.12, + bytestring >=0.9 && <0.13, containers >=0.4 && <0.7, extensible-exceptions >=0.1 && <0.2, - ghc-prim >=0.3 && <0.10, - mtl >=2.0 && <2.3, + ghc-prim >=0.3 && <0.12, + mtl >=2.0 && <2.4, regex-compat >=0.71 && <0.96 Default-Language: Haskell2010 @@ -189,7 +189,7 @@ build-depends: base , bytestring , encoding - , HUnit - , QuickCheck + , HUnit <=1.7 + , QuickCheck <=2.15 ghc-options: -threaded -rtsopts -with-rtsopts=-N Default-Language: Haskell2010 diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -3,16 +3,16 @@ import Test.Tests hunitTests = - [ ("utf8Tests", utf8Tests) - , ("utf16Tests", utf16Tests) - , ("punycodeTests", punycodeTests) - , ("isoTests", isoTests) - , ("jisTests", jisTests) - , ("gb18030Tests", gb18030Tests) - ] + [ ("utf8Tests", utf8Tests) + , ("utf16Tests", utf16Tests) + , ("punycodeTests", punycodeTests) + , ("isoTests", isoTests) + , ("jisTests", jisTests) + , ("gb18030Tests", gb18030Tests) + ] main = do - identityTests - forM_ hunitTests $ \(name, test) -> do - putStrLn $ "running " ++ name - runTestTT test >>= print + identityTests + forM_ hunitTests $ \(name, test) -> do + putStrLn $ "running " ++ name + runTestTT test >>= print diff --git a/tests/Test/Tester.hs b/tests/Test/Tester.hs --- a/tests/Test/Tester.hs +++ b/tests/Test/Tester.hs @@ -13,14 +13,14 @@ import System.IO.Encoding data EncodingTest - = forall enc. (Encoding enc,Show enc) => - EncodingTest enc String [Word8] - | forall enc. (Encoding enc,Show enc) => - EncodingFileTest enc FilePath FilePath - | forall enc. (Encoding enc,Show enc) => - DecodingError enc [Word8] DecodingException - | forall enc. (Encoding enc,Show enc) => - EncodingError enc String EncodingException + = forall enc. (Encoding enc,Show enc) => + EncodingTest enc String [Word8] + | forall enc. (Encoding enc,Show enc) => + EncodingFileTest enc FilePath FilePath + | forall enc. (Encoding enc,Show enc) => + DecodingError enc [Word8] DecodingException + | forall enc. (Encoding enc,Show enc) => + EncodingError enc String EncodingException instance Testable EncodingTest where test (EncodingTest enc src trg) @@ -39,7 +39,7 @@ str_trg <- (let ?enc = UTF8 in readFile trg) str_src @?= str_trg --bsrc @=? (encodeLazyByteString enc str_trg) - + test (DecodingError enc src ex) = TestLabel (show enc ++ " decoding error") (TestCase $ decodeStrictByteStringExplicit enc (BS.pack src) @=? Left ex) diff --git a/tests/Test/Tests.hs b/tests/Test/Tests.hs --- a/tests/Test/Tests.hs +++ b/tests/Test/Tests.hs @@ -70,173 +70,173 @@ utf8Tests :: Test utf8Tests = TestList $ map test $ concat [[EncodingTest enc "\x0041\x2262\x0391\x002E" - [0x41,0xE2,0x89,0xA2,0xCE,0x91,0x2E] - ,EncodingTest enc "\xD55C\xAD6D\xC5B4" - [0xED,0x95,0x9C,0xEA,0xB5,0xAD,0xEC,0x96,0xB4] - ,EncodingTest enc "\x65E5\x672C\x8A9E" - [0xE6,0x97,0xA5,0xE6,0x9C,0xAC,0xE8,0xAA,0x9E] - ,EncodingTest enc "\x233B4" - [0xF0,0xA3,0x8E,0xB4] - ,EncodingTest enc "" - [] - -- First possible sequence of a certain length - ,EncodingTest enc "\x0000" - [0x00] - ,EncodingTest enc "\x0080" - [0xC2,0x80] - ,EncodingTest enc "\x0800" - [0xE0,0xA0,0x80] - ,EncodingTest enc "\x10000" - [0xF0,0x90,0x80,0x80] - -- Last possible sequence of a certain length - ,EncodingTest enc "\x007F" - [0x7F] - ,EncodingTest enc "\x07FF" - [0xDF,0xBF] - ,EncodingTest enc "\xFFFF" - [0xEF,0xBF,0xBF] - -- Other boundaries - ,EncodingTest enc "\xD7FF" - [0xED,0x9F,0xBF] - ,EncodingTest enc "\xE000" - [0xEE,0x80,0x80] - ,EncodingTest enc "\xFFFD" - [0xEF,0xBF,0xBD] - -- Illegal starting characters - ,DecodingError enc - [0x65,0x55,0x85] - (IllegalCharacter 0x85) - -- Unexpected end - ,DecodingError enc - [0x41,0xE2,0x89,0xA2,0xCE] - UnexpectedEnd - ,DecodingError enc - [0x41,0xE2,0x89] - UnexpectedEnd - ,DecodingError enc - [0x41,0xE2] - UnexpectedEnd + [0x41,0xE2,0x89,0xA2,0xCE,0x91,0x2E] + ,EncodingTest enc "\xD55C\xAD6D\xC5B4" + [0xED,0x95,0x9C,0xEA,0xB5,0xAD,0xEC,0x96,0xB4] + ,EncodingTest enc "\x65E5\x672C\x8A9E" + [0xE6,0x97,0xA5,0xE6,0x9C,0xAC,0xE8,0xAA,0x9E] + ,EncodingTest enc "\x233B4" + [0xF0,0xA3,0x8E,0xB4] + ,EncodingTest enc "" + [] + -- First possible sequence of a certain length + ,EncodingTest enc "\x0000" + [0x00] + ,EncodingTest enc "\x0080" + [0xC2,0x80] + ,EncodingTest enc "\x0800" + [0xE0,0xA0,0x80] + ,EncodingTest enc "\x10000" + [0xF0,0x90,0x80,0x80] + -- Last possible sequence of a certain length + ,EncodingTest enc "\x007F" + [0x7F] + ,EncodingTest enc "\x07FF" + [0xDF,0xBF] + ,EncodingTest enc "\xFFFF" + [0xEF,0xBF,0xBF] + -- Other boundaries + ,EncodingTest enc "\xD7FF" + [0xED,0x9F,0xBF] + ,EncodingTest enc "\xE000" + [0xEE,0x80,0x80] + ,EncodingTest enc "\xFFFD" + [0xEF,0xBF,0xBD] + -- Illegal starting characters + ,DecodingError enc + [0x65,0x55,0x85] + (IllegalCharacter 0x85) + -- Unexpected end + ,DecodingError enc + [0x41,0xE2,0x89,0xA2,0xCE] + UnexpectedEnd + ,DecodingError enc + [0x41,0xE2,0x89] + UnexpectedEnd + ,DecodingError enc + [0x41,0xE2] + UnexpectedEnd ] | enc <- [UTF8,UTF8Strict] ]++ - [DecodingError UTF8 [0xFE] (IllegalCharacter 0xFE) - ,DecodingError UTF8 [0xFF] (IllegalCharacter 0xFF) - -- Overlong representations of '/' - ,DecodingError UTF8Strict [0xC0,0xAF] - (IllegalRepresentation [0xC0,0xAF]) - ,DecodingError UTF8Strict [0xE0,0x80,0xAF] - (IllegalRepresentation [0xE0,0x80,0xAF]) - ,DecodingError UTF8Strict [0xF0,0x80,0x80,0xAF] - (IllegalRepresentation [0xF0,0x80,0x80,0xAF]) - -- Maximum overlong sequences - ,DecodingError UTF8Strict [0xC1,0xBF] - (IllegalRepresentation [0xC1,0xBF]) - ,DecodingError UTF8Strict [0xE0,0x9F,0xBF] - (IllegalRepresentation [0xE0,0x9F,0xBF]) - ,DecodingError UTF8Strict [0xF0,0x8F,0xBF,0xBF] - (IllegalRepresentation [0xF0,0x8F,0xBF,0xBF]) - -- Overlong represenations of '\NUL' - ,DecodingError UTF8Strict [0xC0,0x80] - (IllegalRepresentation [0xC0,0x80]) - ,DecodingError UTF8Strict [0xE0,0x80,0x80] - (IllegalRepresentation [0xE0,0x80,0x80]) - ,DecodingError UTF8Strict [0xF0,0x80,0x80,0x80] - (IllegalRepresentation [0xF0,0x80,0x80,0x80]) - -- Invalid extends - -- 2 of 2 - ,DecodingError UTF8Strict [0xCC,0x1C,0xE0] - (IllegalCharacter 0x1C) - -- 2 of 3 - ,DecodingError UTF8Strict [0xE3,0x6C,0xB3] - (IllegalCharacter 0x6C) - -- 3 of 3 - ,DecodingError UTF8Strict [0xE3,0xB4,0x6D] - (IllegalCharacter 0x6D) - -- 2 of 4 - ,DecodingError UTF8Strict [0xF2,0x6C,0xB3,0xB3] - (IllegalCharacter 0x6C) - -- 3 of 4 - ,DecodingError UTF8Strict [0xF2,0xB3,0x6C,0xB3] - (IllegalCharacter 0x6C) - -- 4 of 4 - ,DecodingError UTF8Strict [0xF2,0xB3,0xB3,0x6C] - (IllegalCharacter 0x6C) - ] + [DecodingError UTF8 [0xFE] (IllegalCharacter 0xFE) + ,DecodingError UTF8 [0xFF] (IllegalCharacter 0xFF) + -- Overlong representations of '/' + ,DecodingError UTF8Strict [0xC0,0xAF] + (IllegalRepresentation [0xC0,0xAF]) + ,DecodingError UTF8Strict [0xE0,0x80,0xAF] + (IllegalRepresentation [0xE0,0x80,0xAF]) + ,DecodingError UTF8Strict [0xF0,0x80,0x80,0xAF] + (IllegalRepresentation [0xF0,0x80,0x80,0xAF]) + -- Maximum overlong sequences + ,DecodingError UTF8Strict [0xC1,0xBF] + (IllegalRepresentation [0xC1,0xBF]) + ,DecodingError UTF8Strict [0xE0,0x9F,0xBF] + (IllegalRepresentation [0xE0,0x9F,0xBF]) + ,DecodingError UTF8Strict [0xF0,0x8F,0xBF,0xBF] + (IllegalRepresentation [0xF0,0x8F,0xBF,0xBF]) + -- Overlong represenations of '\NUL' + ,DecodingError UTF8Strict [0xC0,0x80] + (IllegalRepresentation [0xC0,0x80]) + ,DecodingError UTF8Strict [0xE0,0x80,0x80] + (IllegalRepresentation [0xE0,0x80,0x80]) + ,DecodingError UTF8Strict [0xF0,0x80,0x80,0x80] + (IllegalRepresentation [0xF0,0x80,0x80,0x80]) + -- Invalid extends + -- 2 of 2 + ,DecodingError UTF8Strict [0xCC,0x1C,0xE0] + (IllegalCharacter 0x1C) + -- 2 of 3 + ,DecodingError UTF8Strict [0xE3,0x6C,0xB3] + (IllegalCharacter 0x6C) + -- 3 of 3 + ,DecodingError UTF8Strict [0xE3,0xB4,0x6D] + (IllegalCharacter 0x6D) + -- 2 of 4 + ,DecodingError UTF8Strict [0xF2,0x6C,0xB3,0xB3] + (IllegalCharacter 0x6C) + -- 3 of 4 + ,DecodingError UTF8Strict [0xF2,0xB3,0x6C,0xB3] + (IllegalCharacter 0x6C) + -- 4 of 4 + ,DecodingError UTF8Strict [0xF2,0xB3,0xB3,0x6C] + (IllegalCharacter 0x6C) + ] utf16Tests :: Test utf16Tests = TestList $ map test $ - [EncodingTest UTF16BE "z" - [0x00,0x7A] - ,EncodingTest UTF16BE "\x6C34" - [0x6C,0x34] - ,EncodingTest UTF16BE "\x1D11E" - [0xD8,0x34,0xDD,0x1E] - ,EncodingTest UTF16 "\x6C34z\x1D11E" - [0xFE,0xFF,0x6C,0x34,0x00,0x7A,0xD8,0x34,0xDD,0x1E] - ,EncodingTest UTF16BE "˨" - [0x02,0xE8] - ,DecodingError UTF16LE [0x65,0xDC] - (IllegalCharacter 0xDC) - ,DecodingError UTF16BE [0xDC,0x33] - (IllegalCharacter 0xDC) - ,DecodingError UTF16BE [0xD9,0x78,0xDA,0x33] - (IllegalCharacter 0xDA) - ,DecodingError UTF16BE [0xD9,0x78,0xDA,0x66] - (IllegalCharacter 0xDA) - ] + [EncodingTest UTF16BE "z" + [0x00,0x7A] + ,EncodingTest UTF16BE "\x6C34" + [0x6C,0x34] + ,EncodingTest UTF16BE "\x1D11E" + [0xD8,0x34,0xDD,0x1E] + ,EncodingTest UTF16 "\x6C34z\x1D11E" + [0xFE,0xFF,0x6C,0x34,0x00,0x7A,0xD8,0x34,0xDD,0x1E] + ,EncodingTest UTF16BE "˨" + [0x02,0xE8] + ,DecodingError UTF16LE [0x65,0xDC] + (IllegalCharacter 0xDC) + ,DecodingError UTF16BE [0xDC,0x33] + (IllegalCharacter 0xDC) + ,DecodingError UTF16BE [0xD9,0x78,0xDA,0x33] + (IllegalCharacter 0xDA) + ,DecodingError UTF16BE [0xD9,0x78,0xDA,0x66] + (IllegalCharacter 0xDA) + ] punycodeTests :: Test punycodeTests = TestList $ map test $ - [EncodingTest punycode "abcdef" - (map (fromIntegral.ord) "abcdef-") - ,EncodingTest punycode "abæcdöef" - (map (fromIntegral.ord) "abcdef-qua4k") - ,EncodingTest punycode "schön" - (map (fromIntegral.ord) "schn-7qa") - ,EncodingTest punycode "ยจฆฟคฏข" - (map (fromIntegral.ord) "22cdfh1b8fsa") - ,EncodingTest punycode "☺" - (map (fromIntegral.ord) "74h") - -- taken from http://tools.ietf.org/html/rfc3492#section-7 - -- Arabic (Egyptian) - ,punyTest "ليهمابتكلموشعربي؟" - "egbpdaj6bu4bxfgehfvwxn" - -- Chinese (simplified) - ,punyTest "他们为什么不说中文" - "ihqwcrb4cv8a8dqg056pqjye" - -- Chinese (traditional) - ,punyTest "他們爲什麽不說中文" - "ihqwctvzc91f659drss3x8bo0yb" - -- Czech - ,punyTest "Pročprostěnemluvíčesky" - "Proprostnemluvesky-uyb24dma41a" - -- Hebrew - ,punyTest "למההםפשוטלאמדבריםעברית" - "4dbcagdahymbxekheh6e0a7fei0b" - -- Hindi (Devanagari) - ,punyTest "\x92F\x939\x932\x94B\x917\x939\x93F\x928\x94D\x926\x940\x915\x94D\x92F\x94B\x902\x928\x939\x940\x902\x92C\x94B\x932\x938\x915\x924\x947\x939\x948\x902" - "i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd" - -- Japanese (kanji and hiragana) - ,punyTest "なぜみんな日本語を話してくれないのか" - "n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa" - -- Korean (Hangul syllables) - ,punyTest "세계의모든사람들이한국어를이해한다면얼마나좋을까" - "989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c" - -- Russian (Cyrillic) - ,punyTest "почемужеонинеговорятпорусски" - "b1abfaaepdrnnbgefbadotcwatmq2g4l" -- I think the ietf made a mistake there - -- Spanish - ,punyTest "PorquénopuedensimplementehablarenEspañol" - "PorqunopuedensimplementehablarenEspaol-fmd56a" - -- Vietnamese - ,punyTest "TạisaohọkhôngthểchỉnóitiếngViệt" - "TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g" - {-,punyTest "foo\xC2\xAD\xCD\x8F\xE1\xA0\x86\xE1\xA0\x8B\ - \bar\xE2\x80\x8B\xE2\x81\xA0\ - \baz\xEF\xB8\x80\xEF\xB8\x88\xEF\xB8\x8F\xEF\xBB\xBF" - "foobarbaz"-} - ] - where punyTest str outp = EncodingTest punycode str (map (fromIntegral.ord) outp) + [EncodingTest punycode "abcdef" + (map (fromIntegral.ord) "abcdef-") + ,EncodingTest punycode "abæcdöef" + (map (fromIntegral.ord) "abcdef-qua4k") + ,EncodingTest punycode "schön" + (map (fromIntegral.ord) "schn-7qa") + ,EncodingTest punycode "ยจฆฟคฏข" + (map (fromIntegral.ord) "22cdfh1b8fsa") + ,EncodingTest punycode "☺" + (map (fromIntegral.ord) "74h") + -- taken from http://tools.ietf.org/html/rfc3492#section-7 + -- Arabic (Egyptian) + ,punyTest "ليهمابتكلموشعربي؟" + "egbpdaj6bu4bxfgehfvwxn" + -- Chinese (simplified) + ,punyTest "他们为什么不说中文" + "ihqwcrb4cv8a8dqg056pqjye" + -- Chinese (traditional) + ,punyTest "他們爲什麽不說中文" + "ihqwctvzc91f659drss3x8bo0yb" + -- Czech + ,punyTest "Pročprostěnemluvíčesky" + "Proprostnemluvesky-uyb24dma41a" + -- Hebrew + ,punyTest "למההםפשוטלאמדבריםעברית" + "4dbcagdahymbxekheh6e0a7fei0b" + -- Hindi (Devanagari) + ,punyTest "\x92F\x939\x932\x94B\x917\x939\x93F\x928\x94D\x926\x940\x915\x94D\x92F\x94B\x902\x928\x939\x940\x902\x92C\x94B\x932\x938\x915\x924\x947\x939\x948\x902" + "i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd" + -- Japanese (kanji and hiragana) + ,punyTest "なぜみんな日本語を話してくれないのか" + "n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa" + -- Korean (Hangul syllables) + ,punyTest "세계의모든사람들이한국어를이해한다면얼마나좋을까" + "989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c" + -- Russian (Cyrillic) + ,punyTest "почемужеонинеговорятпорусски" + "b1abfaaepdrnnbgefbadotcwatmq2g4l" -- I think the ietf made a mistake there + -- Spanish + ,punyTest "PorquénopuedensimplementehablarenEspañol" + "PorqunopuedensimplementehablarenEspaol-fmd56a" + -- Vietnamese + ,punyTest "TạisaohọkhôngthểchỉnóitiếngViệt" + "TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g" + {-,punyTest "foo\xC2\xAD\xCD\x8F\xE1\xA0\x86\xE1\xA0\x8B\ + \bar\xE2\x80\x8B\xE2\x81\xA0\ + \baz\xEF\xB8\x80\xEF\xB8\x88\xEF\xB8\x8F\xEF\xBB\xBF" + "foobarbaz"-} + ] + where punyTest str outp = EncodingTest punycode str (map (fromIntegral.ord) outp) isoTests :: Test isoTests = TestList $ map test $ @@ -282,4 +282,4 @@ {-big5Tests :: Test big5Tests = test (EncodingFileTest BIG5 "data/BIG5" "data/BIG5.UTF-8")-} - +