punycode 1.0 → 2.0
raw patch · 6 files changed
+105/−27 lines, 6 filesdep +encoding
Dependencies added: encoding
Files
- Data/Text/Punycode.hs +2/−2
- Data/Text/Punycode/Decode.hs +59/−16
- Data/Text/Punycode/Encode.hs +0/−3
- Data/Text/Punycode/Shared.hs +5/−0
- Test/Main.hs +37/−5
- punycode.cabal +2/−1
Data/Text/Punycode.hs view
@@ -1,4 +1,4 @@-module Data.Text.Punycode (encode, decode) where+module Data.Text.Punycode (encode, PunycodeDecodeException (..), decode) where import Data.Text.Punycode.Encode (encode)-import Data.Text.Punycode.Decode (decode)+import Data.Text.Punycode.Decode (PunycodeDecodeException (..), decode)
Data/Text/Punycode/Decode.hs view
@@ -1,43 +1,68 @@-module Data.Text.Punycode.Decode (decode) where+{-# LANGUAGE DeriveDataTypeable #-} +module Data.Text.Punycode.Decode (PunycodeDecodeException (..), decode) where++import Control.Exception.Base import qualified Data.ByteString as BS import Data.Char import Data.Serialize hiding (decode) import qualified Data.Text as T-import qualified Data.Text.Encoding as TE+import Data.Typeable import Data.Word import Data.Text.Punycode.Shared +data PunycodeDecodeException+ = GenericDecodeException+ | InternalStringTooShort+ | InputTooShort+ | RightOfHyphenShouldBeAlphanumeric+ | LeftOfHyphenShouldBeBasic+ | CantStartWithDash+ | InvalidCodePoint+ deriving (Eq,Show,Typeable)++instance Exception PunycodeDecodeException+ -- | Decode a string into its unicode form-decode :: BS.ByteString -> T.Text-decode input = let Right out = runGet (inner2 initial_n 0 initial_bias before) after in out+decode :: BS.ByteString -> Either PunycodeDecodeException T.Text+decode input+ | input == BS.pack [45, 45] = Right $ T.pack "-"+ | not (BS.null input) && BS.length (BS.filter (== 45) input) == 1 && BS.head input == 45 = Left CantStartWithDash+ | T.any (not . isExtendedBasic) before = Left LeftOfHyphenShouldBeBasic+ | otherwise = case runGet (inner2 initial_n 0 initial_bias before) after of+ Right out -> out+ Left _ -> Left InputTooShort where (before, after)- | BS.any f input = (TE.decodeUtf8 $ BS.init b1, a1)+ | BS.any f input = (T.pack $ map (chr . fromIntegral) $ BS.unpack $ BS.init b1, a1) | otherwise = (T.empty, input) f = (== (fromIntegral $ ord '-')) (b1, a1) = BS.breakEnd f input -inner2 :: Int -> Int -> Int -> T.Text -> Get T.Text+inner2 :: Int -> Int -> Int -> T.Text -> Get (Either PunycodeDecodeException T.Text) inner2 n oldi bias output = do b <- isEmpty helper b where helper False = do i <- inner base 1 oldi bias helper' i- where helper' i = inner2 n' (i' + 1) bias' output'+ where helper' Nothing = return $ Left RightOfHyphenShouldBeAlphanumeric+ helper' (Just i) = case output' of+ Right output'' -> inner2 n' (i' + 1) bias' output''+ Left err -> return $ Left err where bias' = adapt (i - oldi) (T.length output + 1) (oldi == 0) n' = n + i `div` (T.length output + 1) i' = i `mod` (T.length output + 1) output' = insertInto output n' i'- helper True = return output+ helper True = return $ Right output -inner :: Int -> Int -> Int -> Int -> Get Int+inner :: Int -> Int -> Int -> Int -> Get (Maybe Int) inner k w i bias = do word8 <- getWord8 helper $ word8ToDigit word8- where helper digit- | digit < t = return i'+ where helper Nothing = return Nothing+ helper (Just digit)+ | digit < t = return $ Just i' | otherwise = inner (k + base) w' i' bias where w' = w * (base - t) i' = i + digit * w@@ -46,11 +71,29 @@ | k >= bias + tmax = tmax | otherwise = k - bias -insertInto :: T.Text -> Int -> Int -> T.Text-insertInto input n i = T.concat [T.take i input, T.singleton $ chr n, T.drop i input]+insertInto :: T.Text -> Int -> Int -> Either PunycodeDecodeException T.Text+insertInto input n i+ | T.length input < i = Left InternalStringTooShort+ | otherwise = case n' of+ Just n'' -> Right $ T.concat [T.take i input, T.singleton n'', T.drop i input]+ Nothing -> Left InvalidCodePoint+ where n' = safeChr n -word8ToDigit :: Word8 -> Int+safeChr :: Int -> Maybe Char+safeChr x+ | x >= 0 && x <= fromEnum (maxBound :: Char) = Just $ chr x+ | otherwise = Nothing++word8ToDigit :: Word8 -> Maybe Int word8ToDigit = helper . fromIntegral where helper word8- | word8 >= ord 'a' && word8 <= ord 'z' = word8 - (ord 'a')- | otherwise = 26 + word8 - (ord '0')+ | word8 >= ord 'a' && word8 <= ord 'z' = Just $ word8 - (ord 'a')+ | word8 >= ord 'A' && word8 <= ord 'Z' = Just $ word8 - (ord 'A')+ | word8 >= ord '0' && word8 <= ord '9' = Just $ 26 + word8 - (ord '0')+ | otherwise = Nothing++isExtendedBasic :: Char -> Bool+isExtendedBasic x+ | isBasic x = True+ | ord x == 128 = True+ | otherwise = False
Data/Text/Punycode/Encode.hs view
@@ -80,9 +80,6 @@ | k >= bias' + tmax = tmax | otherwise = k - bias' -isBasic :: Char -> Bool-isBasic = (< initial_n) . ord- baseToAscii :: Int -> Word8 baseToAscii i | i < 26 = fromIntegral $ i + (ord 'a')
@@ -1,5 +1,7 @@ module Data.Text.Punycode.Shared where +import Data.Char (ord)+ base :: Int base = 36 @@ -30,3 +32,6 @@ loop k delta' | delta' > ((base - tmin) * tmax) `div` 2 = loop (k + base) $ delta' `div` (base - tmin) | otherwise = k + (((base - tmin + 1) * delta') `div` (delta' + skew))++isBasic :: Char -> Bool+isBasic = (< initial_n) . ord
Test/Main.hs view
@@ -1,6 +1,9 @@ import qualified Data.ByteString as BS import Data.Char+import qualified Data.Encoding as E+import qualified Data.Encoding.BootString as EB import qualified Data.Text as T+import Data.Word (Word8) import System.Exit import Test.HUnit import Test.QuickCheck@@ -119,14 +122,43 @@ (encode $ T.pack $ map (toLower . chr) decoded)) decodeTests = TestList $ map f tests where f (decoded, encoded, testname) = TestCase (assertEqual testname- (T.pack $ map (toLower . chr) decoded)+ (Right $ T.pack $ map (toLower . chr) decoded) (decode $ BS.pack $ map (fromIntegral . ord . toLower) encoded)) +-- Work around the fact that there is no Arbitrary instance for Text+inverseTest :: String -> Bool+inverseTest s+ | all isAscii s = True+ | otherwise = case decoded of+ Left _ -> False+ Right x -> x == packed+ where packed = T.pack s+ decoded = decode $ encode packed++matchesEncodingDecodeTest :: [Word8] -> Bool+matchesEncodingDecodeTest = helper . BS.pack+ where helper s = helper1 (decode s) (E.decodeStrictByteStringExplicit EB.punycode s)+ where helper1 (Right m) (Right t) = m == T.pack t+ helper1 (Left _) (Left _) = True+ helper1 _ _ = False++matchesEncodingEncodeTest :: String -> Bool+matchesEncodingEncodeTest s = helper (encode $ T.pack s) (E.encodeStrictByteStringExplicit EB.punycode s)+ where helper m (Right t) = m == t+ helper _ _ = False++internalStringIsNeverTooShort :: [Word8] -> Bool+internalStringIsNeverTooShort s = case decode $ BS.pack s of+ Left InternalStringTooShort -> False+ _ -> True+ main :: IO () main = do- -- Work around the fact that there is no Arbitrary instance for Text- result <- quickCheckResult (\ s -> T.unpack (decode $ encode $ T.pack s) == s)+ result1 <- quickCheckWithResult (stdArgs {maxSuccess = 1000000, maxSize = 100}) inverseTest+ result2 <- quickCheckWithResult (stdArgs {maxSuccess = 1000000, maxSize = 100}) matchesEncodingDecodeTest+ result3 <- quickCheckWithResult (stdArgs {maxSuccess = 1000000, maxSize = 100}) matchesEncodingEncodeTest+ result4 <- quickCheckWithResult (stdArgs {maxSuccess = 1000000, maxSize = 100}) internalStringIsNeverTooShort counts <- runTestTT hunittests- case (errors counts, failures counts, result) of- (0, 0, Success {}) -> exitSuccess+ case (errors counts, failures counts, result1, result2, result3, result4) of+ (0, 0, Success {}, Success {}, Success {}, Success {}) -> exitSuccess _ -> exitFailure
punycode.cabal view
@@ -1,5 +1,5 @@ name: punycode-version: 1.0+version: 2.0 license: BSD3 license-file: LICENSE author: Myles C. Maxfield <myles.maxfield@gmail.com>@@ -34,6 +34,7 @@ , text , HUnit , QuickCheck+ , encoding source-repository head type: git