punycode 0.5.1 → 1.0
raw patch · 5 files changed
+32/−40 lines, 5 filesdep +textdep −utf8-string
Dependencies added: text
Dependencies removed: utf8-string
Files
- Data/Text/Punycode.hs +1/−15
- Data/Text/Punycode/Decode.hs +11/−9
- Data/Text/Punycode/Encode.hs +11/−9
- Test/Main.hs +5/−3
- punycode.cabal +4/−4
Data/Text/Punycode.hs view
@@ -1,18 +1,4 @@-module Data.Text.Punycode (encode, decode, internationalize) where--import qualified Data.ByteString as BS-import qualified Data.ByteString.UTF8 as UTF8BS-import Data.Char (isAscii)+module Data.Text.Punycode (encode, decode) where import Data.Text.Punycode.Encode (encode) import Data.Text.Punycode.Decode (decode)---- | Convenience function for internationalized domain names. If there is--- at least one non-ascii character, this function will encode the input--- and prepend \"xn--\" to the output string. Otherwise, it will return the--- string untouched. Note that this function does not run nameprep (e.g. it--- operates on pre-prepped strings)-internationalize :: String -> BS.ByteString-internationalize x- | all isAscii x = UTF8BS.fromString x- | otherwise = UTF8BS.fromString "xn--" `BS.append` encode x
Data/Text/Punycode/Decode.hs view
@@ -3,20 +3,22 @@ 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.Word import Data.Text.Punycode.Shared -- | Decode a string into its unicode form-decode :: BS.ByteString -> String+decode :: BS.ByteString -> T.Text decode input = let Right out = runGet (inner2 initial_n 0 initial_bias before) after in out where (before, after)- | BS.any f input = (init $ map (chr . fromIntegral) $ BS.unpack b1, a1)- | otherwise = ("", input)+ | BS.any f input = (TE.decodeUtf8 $ BS.init b1, a1)+ | otherwise = (T.empty, input) f = (== (fromIntegral $ ord '-')) (b1, a1) = BS.breakEnd f input -inner2 :: Int -> Int -> Int -> String -> Get String+inner2 :: Int -> Int -> Int -> T.Text -> Get T.Text inner2 n oldi bias output = do b <- isEmpty helper b@@ -24,9 +26,9 @@ i <- inner base 1 oldi bias helper' i where helper' i = inner2 n' (i' + 1) bias' output'- where bias' = adapt (i - oldi) (length output + 1) (oldi == 0)- n' = n + i `div` (length output + 1)- i' = i `mod` (length output + 1)+ 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 @@ -44,8 +46,8 @@ | k >= bias + tmax = tmax | otherwise = k - bias -insertInto :: String -> Int -> Int -> String-insertInto input n i = take i input ++ [chr n] ++ drop i input+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] word8ToDigit :: Word8 -> Int word8ToDigit = helper . fromIntegral
Data/Text/Punycode/Encode.hs view
@@ -6,6 +6,8 @@ import Control.Monad.Writer import qualified Data.ByteString as BS import Data.Char+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE import Data.Word import Data.Text.Punycode.Shared@@ -17,19 +19,19 @@ } -- | Encode a string into its ascii form-encode :: String -> BS.ByteString-encode input = execWriter $ initialWriter input+encode :: T.Text -> BS.ByteString+encode = execWriter . initialWriter -initialWriter :: MonadWriter BS.ByteString m => String -> m ()+initialWriter :: MonadWriter BS.ByteString m => T.Text -> m () initialWriter input = do tell basics when (b > 0) $ tell $ BS.singleton $ fromIntegral $ ord '-'- evalStateT (inner3 (map ord input) b) $ PunycodeState { n = initial_n- , delta = 0- , bias = initial_bias- , h = b- }- where basics = BS.pack $ map (fromIntegral . ord) $ filter isBasic input+ evalStateT (inner3 (map ord $ T.unpack input) b) $ PunycodeState { n = initial_n+ , delta = 0+ , bias = initial_bias+ , h = b+ }+ where basics = TE.encodeUtf8 $ T.filter isBasic input b = BS.length basics inner3 :: (MonadState PunycodeState m, MonadWriter BS.ByteString m) => [Int] -> Int -> m ()
Test/Main.hs view
@@ -1,5 +1,6 @@ import qualified Data.ByteString as BS import Data.Char+import qualified Data.Text as T import System.Exit import Test.HUnit import Test.QuickCheck@@ -115,15 +116,16 @@ where encodeTests = TestList $ map f tests where f (decoded, encoded, testname) = TestCase (assertEqual testname (BS.pack $ map (fromIntegral . ord . toLower) encoded)- (encode $ map (toLower . chr) decoded))+ (encode $ T.pack $ map (toLower . chr) decoded)) decodeTests = TestList $ map f tests where f (decoded, encoded, testname) = TestCase (assertEqual testname- (map (toLower . chr) decoded)+ (T.pack $ map (toLower . chr) decoded) (decode $ BS.pack $ map (fromIntegral . ord . toLower) encoded)) main :: IO () main = do- result <- quickCheckResult (\ s -> decode (encode s) == s)+ -- Work around the fact that there is no Arbitrary instance for Text+ result <- quickCheckResult (\ s -> T.unpack (decode $ encode $ T.pack s) == s) counts <- runTestTT hunittests case (errors counts, failures counts, result) of (0, 0, Success {}) -> exitSuccess
punycode.cabal view
@@ -1,11 +1,11 @@ name: punycode-version: 0.5.1+version: 1.0 license: BSD3 license-file: LICENSE author: Myles C. Maxfield <myles.maxfield@gmail.com> maintainer: Myles C. Maxfield <myles.maxfield@gmail.com> synopsis: Encode unicode strings to ascii forms according to RFC 3492-description: Encode unicode strings to ascii forms according to RFC 3492. It is written in pure Haskell, as opposed to gnuidn's Data.Text.IDN.Punycode+description: Encode unicode strings to ascii forms according to RFC 3492. It is written in pure Haskell, as opposed to gnuidn's Data.Text.IDN.Punycode. Please note that Data.Encoding.BootString from the 'encoding' package also contains an implementation of the Punycode algorithm. category: Text, Web stability: Experimental cabal-version: >= 1.8@@ -17,7 +17,7 @@ , bytestring , cereal , mtl- , utf8-string+ , text exposed-modules: Data.Text.Punycode other-modules: Data.Text.Punycode.Encode , Data.Text.Punycode.Decode@@ -31,9 +31,9 @@ , bytestring , cereal , mtl+ , text , HUnit , QuickCheck- , utf8-string source-repository head type: git