packages feed

dataenc 0.12 → 0.12.1.0

raw patch · 17 files changed

+1106/−353 lines, 17 filesdep ~arraydep ~basedep ~containers

Dependency ranges changed: array, base, containers

Files

+ DataencQC.hs view
@@ -0,0 +1,180 @@+{-+ - Copyright : (c) 2007 Magnus Therning+ - License   : BSD3+ -}++module DataencQC+    where++import Data.Maybe+import Data.Word+import Test.QuickCheck+import Test.Framework.Providers.QuickCheck2++import qualified Codec.Binary.Uu as Uu+import qualified Codec.Binary.Uu as Xx+import qualified Codec.Binary.Base85 as Base85+import qualified Codec.Binary.Base64 as Base64+import qualified Codec.Binary.Base64Url as Base64Url+import qualified Codec.Binary.Base32 as Base32+import qualified Codec.Binary.Base32Hex as Base32Hex+import qualified Codec.Binary.Base16 as Base16+import qualified Codec.Binary.Yenc as Yenc+import qualified Codec.Binary.Hexadecimal as Hex+import qualified Codec.Binary.QuotedPrintable as QP+import qualified Codec.Binary.PythonString as Py+import qualified Codec.Binary.Url as Url++-- {{{1 Arbitrary instances+instance Arbitrary Word8 where+    arbitrary = do+        n <- choose ((fromIntegral (minBound::Word8))::Int,+                (fromIntegral (maxBound::Word8))::Int)+        return $ fromIntegral n++-- {{{1 uuencode properties+prop_uuEncode ws = ws == (fromJust . Uu.decode . Uu.encode) ws+    where types = ws::[Word8]++prop_uuChop n ws = s == (Uu.unchop . Uu.chop n) s+    where+        types = (n :: Int, ws::[Word8])+        s = Uu.encode ws++prop_uuCombined n ws = ws == (fromJust $ Uu.decode $ Uu.unchop $ Uu.chop n $ Uu.encode ws)+    where types = (n::Int, ws::[Word8])++-- {{{1 xxencode properties+prop_xxEncode ws = ws == (fromJust . Xx.decode . Xx.encode) ws+    where types = ws::[Word8]++prop_xxChop n ws = s == (Xx.unchop . Xx.chop n) s+    where+        types = (n:: Int, ws::[Word8])+        s = Xx.encode ws++prop_xxCombined n ws = ws == (fromJust $ Xx.decode $ Xx.unchop $ Xx.chop n $ Xx.encode ws)+    where types = (n::Int, ws::[Word8])++-- {{{1 base85 properties+prop_base85Encode ws = ws == (fromJust $ Base85.decode $ Base85.encode ws)+    where types = ws::[Word8]++prop_base85Chop n s = s == (Base85.unchop $ Base85.chop n s)+    where types = (n::Int, s::String)++-- {{{1 base64 properties+prop_base64Encode ws = ws == (fromJust $ Base64.decode $ Base64.encode ws)+    where types = ws::[Word8]++prop_base64Chop n s = s == (Base64.unchop $ Base64.chop n s)+    where types = (n::Int, s::String)++-- {{{1 base64url properties+prop_base64UrlEncode ws = ws == (fromJust $ Base64Url.decode $ Base64Url.encode ws)+    where types = ws::[Word8]++prop_base64UrlChop n s = s == (Base64Url.unchop $ Base64Url.chop n s)+    where types = (n::Int, s::String)++-- {{{1 base32+prop_base32Encode ws = ws == (fromJust $ Base32.decode $ Base32.encode ws)+    where types = ws::[Word8]++prop_base32Chop n s = s == (Base32.unchop $ Base32.chop n s)+    where types = (n::Int, s::String)++-- {{{1 base32hex+prop_base32HexEncode ws = ws == (fromJust $ Base32Hex.decode $ Base32Hex.encode ws)+    where types = ws::[Word8]++prop_base32HexChop n s = s == (Base32Hex.unchop $ Base32Hex.chop n s)+    where types = (n::Int, s::String)++-- {{{1 base16+prop_base16Encode ws = ws == (fromJust $ Base16.decode $ Base16.encode ws)+    where types = ws::[Word8]++prop_base16Chop n s = s == (Base16.unchop $ Base16.chop n s)+    where types = (n::Int, s::String)++-- {{{1 yEncoding+prop_yencEncode ws = ws == (fromJust $ Yenc.decode $ Yenc.encode ws)+    where types = ws ::[Word8]++prop_yencChop n ws = ws == (Yenc.unchop $ Yenc.chop n ws)+    where types = (n::Int, ws :: [Word8])++-- {{{1 hexadecimal+prop_hexEncode ws = ws == (fromJust $ Hex.decode $ Hex.encode ws)+    where types = ws :: [Word8]++prop_hexChop n s = s == (Hex.unchop $ Hex.chop n s)+    where types = (n :: Int, s :: String)++-- {{{1 qp+prop_qpEncode ws = ws == (fromJust $ QP.decode $ QP.encode ws)+    where types = ws :: [Word8]++prop_qpChop n ws = s == (QP.unchop . QP.chop n) s+    where+        types = (n::Int, ws::[Word8])+        s = QP.encode ws++prop_qpCombined n ws = ws == (fromJust $ QP.decode $ QP.unchop $ QP.chop n $ QP.encode ws)+    where types = (n::Int, ws::[Word8])++-- {{{1 py+prop_pyEncode ws = ws == (fromJust $ Py.decode $ Py.encode ws)+    where types = ws :: [Word8]++prop_pyChop n s = s == (Py.unchop $ Py.chop n s)+    where types = (n :: Int, s :: String)++prop_pyCombined n ws = ws == (fromJust $ runAll ws)+    where runAll = Py.decode . Py.unchop . Py.chop n . Py.encode++-- {{{1 url+prop_urlEncode ws = ws == (fromJust $ Url.decode $ Url.encode ws)+    where types = ws :: [Word8]++prop_urlChop n s = s == (Url.unchop $ Url.chop n s)+    where types = (n :: Int, s :: String)++prop_urlCombined n ws = ws == (fromJust $ runAll ws)+    where runAll = Url.decode . Url.unchop . Url.chop n . Url.encode++-- {{{1 all the tests+allTests =+    [ testProperty "uuEncode" prop_uuEncode+    , testProperty "uuChop" prop_uuChop+    , testProperty "uuCombined" prop_uuCombined+    , testProperty "xxEncode" prop_xxEncode+    , testProperty "xxChop" prop_xxChop+    , testProperty "xxCombined" prop_xxCombined+    , testProperty "base85Encode" prop_base85Encode+    , testProperty "base85Chop" prop_base85Chop+    , testProperty "base64Encode" prop_base64Encode+    , testProperty "base64Chop" prop_base64Chop+    , testProperty "base64UrlEncode" prop_base64UrlEncode+    , testProperty "base64UrlChop" prop_base64UrlChop+    , testProperty "base32Encode" prop_base32Encode+    , testProperty "base32Chop" prop_base32Chop+    , testProperty "base32HexEncode" prop_base32HexEncode+    , testProperty "base32HexChop" prop_base32HexChop+    , testProperty "base16Encode" prop_base16Encode+    , testProperty "base16Chop" prop_base16Chop+    , testProperty "yencEncode" prop_yencEncode+    , testProperty "yencChop" prop_yencChop+    , testProperty "hexEncode" prop_hexEncode+    , testProperty "hexChop" prop_hexChop+    , testProperty "qpEncode" prop_qpEncode+    , testProperty "qpChop" prop_qpChop+    , testProperty "qpCombined" prop_qpCombined+    , testProperty "pyEncode" prop_pyEncode+    , testProperty "pyChop" prop_pyChop+    , testProperty "pyCombined" prop_pyCombined+    , testProperty "urlEncode" prop_urlEncode+    , testProperty "urlChop" prop_urlChop+    , testProperty "urlCombined" prop_urlCombined+    ]
+ DataencUT.hs view
@@ -0,0 +1,306 @@+{-+ - Copyright : (c) 2007 Magnus Therning+ - License   : BSD3+ -}++module DataencUT+    where++import Test.HUnit+import Control.Monad+import System.Exit+import Data.Maybe+import qualified Test.Framework.Providers.API as TFAPI+import Test.Framework.Providers.HUnit++import Codec.Binary.DataEncoding+import qualified Codec.Binary.Yenc as Yenc++-- {{{1 buildTestList+-- builds a list of successful tests based on a tuple (suite, description,+-- encoded data, decoded data, codec)+buildTestList td = TestList $ concat [+    [ TestLabel (suite ++ " encode " ++ desc) (enc ~=? (encode codec dec))+    , TestLabel (suite ++ " decode " ++ desc) (dec ~=? (fromJust $ decode codec $ enc))+    ] | (suite, desc, enc, dec, codec) <- td ]++-- {{{1 unitTest2TFTest+unitTest2TFTest :: Test -> [TFAPI.Test]+unitTest2TFTest t = let+        unitTest2TFTest' desc (TestCase a) = [testCase desc a]+        unitTest2TFTest' desc (TestLabel s t) = unitTest2TFTest' (desc ++ ":" ++ s) t+        unitTest2TFTest' desc (TestList ts) = concat $ map (unitTest2TFTest' desc) ts+    in unitTest2TFTest' "" t+++-- {{{1 uuencode tests+uuTestData =+    [ ("uu", "empty", "", [], uu)+    , ("uu", "\\0", "``", [0], uu)+    , ("uu", "\\255", "_P", [255], uu)+    , ("uu", "AA", "04$", [65, 65], uu)+    , ("uu", "AAA", "04%!", [65, 65, 65], uu)+    , ("uu", "AAAA", "04%!00", [65, 65, 65, 65], uu)+    , ("uu", "Example", "17AA;7!L90", [69,120,97,109,112,108,101], uu)+    ]+uuTests = buildTestList uuTestData++uuTests2 = test+    [ "uu unchop.chop" ~: "EI2" ~=? (unchop uu $ chop uu 1 "EI2")+    , "uu unchop.chop" ~: "EI3-" ~=? (unchop uu $ chop uu 1 "EI3-")+    , "uu unchop.chop" ~: "EI3-EE" ~=? (unchop uu $ chop uu 1 "EI3-EE")+    , "uu full circle" ~: [0..255] ~=? fromJust (decode uu $ unchop uu $ chop uu 1 $ encode uu [0..255])+    , "uu full circle" ~: [0..255] ~=? fromJust (decode uu $ unchop uu $ chop uu 61 $ encode uu [0..255])+    , "uu full circle" ~: [0..255] ~=? fromJust (decode uu $ unchop uu $ chop uu 100 $ encode uu [0..255])+    ]++uuTestsFail = test+    [ "uu decode short" ~: Nothing ~=? decode uu "A"+    , "uu decode' short" ~: [Nothing] ~=? decode' uu "A"+    , "uu decode illegal" ~: Nothing ~=? decode uu "aa"+    , "uu decode' illegal" ~: [Nothing] ~=? decode' uu "aa"+    ]++-- {{{1 xxencode tests+xxTestData =+    [ ("xx", "empty", "", [], xx)+    , ("xx", "\\0", "++", [0], xx)+    , ("xx", "\\255", "zk", [255], xx)+    , ("xx", "AA", "EI2", [65, 65], xx)+    , ("xx", "AAA", "EI3-", [65, 65, 65], xx)+    , ("xx", "AAAA", "EI3-EE", [65, 65, 65, 65], xx)+    , ("xx", "Example", "FLVVPL-gNE", [69,120,97,109,112,108,101], xx)+    ]+xxTests = buildTestList xxTestData++xxTests2 = test+    [ "xx unchop.chop" ~: "EI2" ~=? (unchop xx $ chop xx 1 "EI2")+    , "xx unchop.chop" ~: "EI3-" ~=? (unchop xx $ chop xx 1 "EI3-")+    , "xx unchop.chop" ~: "EI3-EE" ~=? (unchop xx $ chop xx 1 "EI3-EE")+    , "xx full circle" ~: [0..255] ~=? fromJust (decode xx $ unchop xx $ chop xx 1 $ encode xx [0..255])+    , "xx full circle" ~: [0..255] ~=? fromJust (decode xx $ unchop xx $ chop xx 61 $ encode xx [0..255])+    , "xx full circle" ~: [0..255] ~=? fromJust (decode xx $ unchop xx $ chop xx 100 $ encode xx [0..255])+    ]++xxTestsFail = test+    [ "xx decode short" ~: Nothing ~=? decode xx "A"+    , "xx decode' short" ~: [Nothing] ~=? decode' xx "A"+    , "xx decode illegal" ~: Nothing ~=? decode xx "''"+    , "xx decode' illegal" ~: [Nothing] ~=? decode' xx "''"+    ]++-- {{{1 base85 tests+base85TestData =+    [ ("base85", "empty", "", [], base85)+    , ("base85", "f", "Ac", [102], base85)+    , ("base85", "fo", "Ao@", [102,111], base85)+    , ("base85", "foo", "AoDS", [102,111,111], base85)+    , ("base85", "foob", "AoDTs", [102,111,111,98], base85)+    , ("base85", "fooba", "AoDTs@/", [102,111,111,98,97], base85)+    , ("base85", "foobar", "AoDTs@<)", [102,111,111,98,97,114], base85)+    , ("base85", "\0", "!!", [0], base85)+    , ("base85", "foob\0\0\0\0ar", "AoDTszEW", [102,111,111,98,0,0,0,0,114], base85)+    , ("base85", "Example", "7<i6XE,9(", [69,120,97,109,112,108,101], base85)+    ]+base85Tests = buildTestList base85TestData++base85TestsFail = test+    [ "base85 decode short" ~: Nothing ~=? decode base85 "A"+    , "base85 decode' short" ~: [Nothing] ~=? decode' base85 "A"+    , "base85 decode illegal" ~: Nothing ~=? decode base85 "!z"+    , "base85 decode' illegal" ~: [Nothing] ~=? decode' base85 "!z"+    ]++-- {{{1 base64 tests+base64TestData =+    [ ("base64", "empty", "", [], base64)+    , ("base64", "f", "Zg==", [102], base64)+    , ("base64", "fo", "Zm8=", [102,111], base64)+    , ("base64", "foo", "Zm9v", [102,111,111], base64)+    , ("base64", "foob", "Zm9vYg==", [102,111,111,98], base64)+    , ("base64", "fooba", "Zm9vYmE=", [102,111,111,98,97], base64)+    , ("base64", "foobar", "Zm9vYmFy", [102,111,111,98,97,114], base64)+    , ("base64", "\0", "AA==", [0], base64)+    , ("base64", "\255", "/w==", [255], base64)+    , ("base64", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], base64)+    ]+base64Tests = buildTestList base64TestData++base64TestsFail = test+    [ "base64 decode short" ~: Nothing ~=? decode base64 "A"+    , "base64 decode' short" ~: [Nothing] ~=? decode' base64 "A"+    , "base64 decode illegal" ~: Nothing ~=? decode base64 "!!"+    , "base64 decode' illegal" ~: [Nothing] ~=? decode' base64 "!!"+    ]++-- {{{1 base64url tests+base64UrlTestData =+    [ ("base64url", "empty", "", [], base64Url)+    , ("base64url", "\0", "AA==", [0], base64Url)+    , ("base64url", "\255", "_w==", [255], base64Url)+    , ("base64url", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], base64Url)+    ]+base64UrlTests = buildTestList base64UrlTestData++-- {{{1 base32 tests+base32TestData =+    [ ("base32", "empty", "", [], base32)+    , ("base32", "f", "MY======", [102], base32)+    , ("base32", "fo", "MZXQ====", [102,111], base32)+    , ("base32", "foo", "MZXW6===", [102,111,111], base32)+    , ("base32", "foob", "MZXW6YQ=", [102,111,111,98], base32)+    , ("base32", "fooba", "MZXW6YTB", [102,111,111,98,97], base32)+    , ("base32", "foobar", "MZXW6YTBOI======", [102,111,111,98,97,114], base32)+    ]+base32Tests = buildTestList base32TestData++base32TestsFail = test+    [ "base32 decode short" ~: Nothing ~=? decode base32 "A"+    , "base32 decode' short" ~: [Nothing] ~=? decode' base32 "A"+    , "base32 decode illegal" ~: Nothing ~=? decode base32 "gh"+    , "base32 decode' illegal" ~: [Nothing] ~=? decode' base32 "gh"+    ]++-- {{{1 base32hex tests+base32HexTestData =+    [ ("base32hex", "empty", "", [], base32Hex)+    , ("base32hex", "f", "CO======", [102], base32Hex)+    , ("base32hex", "fo", "CPNG====", [102,111], base32Hex)+    , ("base32hex", "foo", "CPNMU===", [102,111,111], base32Hex)+    , ("base32hex", "foob", "CPNMUOG=", [102,111,111,98], base32Hex)+    , ("base32hex", "fooba", "CPNMUOJ1", [102,111,111,98,97], base32Hex)+    , ("base32hex", "foobar", "CPNMUOJ1E8======", [102,111,111,98,97,114], base32Hex)+    ]+base32HexTests = buildTestList base32HexTestData++base32HexTestsFail = test+    [ "base32hex decode short" ~: Nothing ~=? decode base32Hex "A"+    , "base32hex decode' short" ~: [Nothing] ~=? decode' base32Hex "A"+    , "base32hex decode illegal" ~: Nothing ~=? decode base32Hex "gh"+    , "base32hex decode' illegal" ~: [Nothing] ~=? decode' base32Hex "gh"+    ]++-- {{{1 base16 (hex)+base16TestData =+    [ ("base16", "empty", "", [], base16)+    , ("base16", "f", "66", [102], base16)+    , ("base16", "fo", "666F", [102,111], base16)+    , ("base16", "foo", "666F6F", [102,111,111], base16)+    , ("base16", "foob", "666F6F62", [102,111,111,98], base16)+    , ("base16", "fooba", "666F6F6261", [102,111,111,98,97], base16)+    , ("base16", "foobar", "666F6F626172", [102,111,111,98,97,114], base16)+    ]+base16Tests = buildTestList base16TestData++base16TestsFail = test+    [ "base16 decode short" ~: Nothing ~=? decode base16 "A"+    , "base16 decode' short" ~: [Nothing] ~=? decode' base16 "A"+    , "base16 decode illegal" ~: Nothing ~=? decode base16 "GH"+    , "base16 decode' illegal" ~: [Nothing] ~=? decode' base16 "GH"+    ]++-- {{{1 yEncoding+yencTests = test+    [ "yEnc encode empty" ~: [] ~=? Yenc.encode []+    , "yEnc decode empty" ~: Just [] ~=? Yenc.decode []+    , "yEnc encode 'f'" ~: [0x90] ~=? Yenc.encode [0x66]+    , "yEnc decode enc('f')" ~: Just [0x66] ~=? Yenc.decode [0x90]+    , "yEnc encode 'foobar'" ~: [0x90, 0x99, 0x99, 0x8c, 0x8b, 0x9c] ~=? Yenc.encode [0x66, 0x6f, 0x6f, 0x62, 0x61, 0x72]+    , "yEnc decode enc('foobar')" ~: Just [0x66, 0x6f, 0x6f, 0x62, 0x61, 0x72] ~=? Yenc.decode [0x90, 0x99, 0x99, 0x8c, 0x8b, 0x9c]+    , "yEnc encode [0xd6, 0xd7]" ~: [0x3d, 0x40, 0x01] ~=? Yenc.encode [0xd6, 0xd7]+    , "yEnc decode enc([0xd6, 0xd7])" ~:  Just [0xd6, 0xd7] ~=? Yenc.decode [0x3d, 0x40, 0x01]+    , "yEnc encode criticals" ~: [0x3d, 0x40, 0x3d, 0x4a, 0x3d, 0x4d, 0x3d, 0x7d] ~=? Yenc.encode [0xd6, 0xe0, 0xe3, 0x13]+    , "yEnc decode criticals" ~:  Just [0xd6, 0xe0, 0xe3, 0x13] ~=? Yenc.decode [0x3d, 0x40, 0x3d, 0x4a, 0x3d, 0x4d, 0x3d, 0x7d]+    , "yEnc chop" ~: [[0x3d, 0x40], [0x01, 0x3d, 0x4a]] ~=? Yenc.chop 2 [0x3d, 0x40, 0x01, 0x3d, 0x4a]+    ]++-- {{{1 hexadecimal+hexTestData =+    [ ("hex", "empty", "", [], hex)+    , ("hex", "foobar", "666F6F626172", [102,111,111,98,97,114], hex)+    ]+hexTests = buildTestList hexTestData++hexTestsFail = test+    [ "hex decode short" ~: Nothing ~=? decode hex "0"+    , "hex decode' short" ~: [Nothing] ~=? decode' hex "0"+    , "hex decode illegal" ~: Nothing ~=? decode hex "H"+    , "hex decode' illegal" ~: [Nothing] ~=? decode' hex "H"+    ]++-- {{{1 quoted-printable+qpTestData =+    [ ("qp", "empty", "", [], qp)+    , ("qp", "foo=bar", "foo=3Dbar", [102,111,111,61,98,97,114], qp)+    ]+qpTests = buildTestList qpTestData++qpTestsSucc = test+    [ "qp chop one" ~: ["foo=","=3D=","bar"] ~=? chop qp 4 "foo=3Dbar"+    ]++qpTestsFail = test+    [ "qp decode short" ~: Nothing ~=? decode qp "=4"+    , "qp decode' short" ~: [Nothing] ~=? decode' qp "=4"+    , "qp decode non-hex" ~: Nothing ~=? decode qp "=G"+    , "qp decode' non-hex" ~: [Nothing] ~=? decode' qp "=G"+    ]++-- {{{1 python string+pyTestData =+    [ ("py", "empty", "", [], py)+    , ("py", "<0x00><0x1f><0x20><0x7e><0x7f><0xff>", "\\x00\\x1F ~\\x7F\\xFF", [0x00, 0x1f, 0x20, 0x7e, 0x7f, 0xff], py)+    , ("py", "\"\'\\", "\\\"\\'\\\\", [34, 39, 92], py)+    ]+pyTests = buildTestList pyTestData++pyTestsFail = test+    [ "py decode bad char after \\" ~: Nothing ~=? decode py "\\z"+    , "py decode' bad char after \\" ~: [Nothing] ~=? decode' py "\\z"+    ]++-- {{{1 url encoding+urlTestData =+    [ ("url", "empty", "", [], url)+    , ("url", "aA", "aA", [97, 65], url)+    , ("url", "~ ", "~%20", [126, 0x20], url)+    ]+urlTests = buildTestList urlTestData++urlTestsFail = test+    [ "url decode bad char after %" ~: Nothing ~=? decode url "%ga"+    , "url decode' bad char after %" ~: [Nothing] ~=? decode' url "%ga"+    , "url decode bad char after %" ~: Nothing ~=? decode url "%%"+    , "url decode' bad char after %" ~: [Nothing] ~=? decode' url "%%"+    ]++-- {{{1 all the tests+allTests = concat+    [ unitTest2TFTest uuTests+    , unitTest2TFTest uuTests2+    , unitTest2TFTest uuTestsFail+    , unitTest2TFTest xxTests+    , unitTest2TFTest xxTests2+    , unitTest2TFTest xxTestsFail+    , unitTest2TFTest base85Tests+    , unitTest2TFTest base85TestsFail+    , unitTest2TFTest base64Tests+    , unitTest2TFTest base64TestsFail+    , unitTest2TFTest base64UrlTests+    , unitTest2TFTest base32Tests+    , unitTest2TFTest base32TestsFail+    , unitTest2TFTest base32HexTests+    , unitTest2TFTest base32HexTestsFail+    , unitTest2TFTest base16Tests+    , unitTest2TFTest base16TestsFail+    , unitTest2TFTest yencTests+    , unitTest2TFTest hexTests+    , unitTest2TFTest hexTestsFail+    , unitTest2TFTest qpTests+    , unitTest2TFTest qpTestsSucc+    , unitTest2TFTest qpTestsFail+    , unitTest2TFTest pyTests+    , unitTest2TFTest pyTestsFail+    , unitTest2TFTest urlTests+    , unitTest2TFTest urlTestsFail+    ]
+ GNUmakefile view
@@ -0,0 +1,32 @@+.PHONY: all clean markup report test++TESTS = Test+ifeq (,$(shell ghc-pkg list dataenc | grep dataenc))+GHCOPTS = -fhpc -isrc+else+GHCOPTS = -fhpc -hide-package dataenc -isrc+endif+HPC_SUM_OPTS = --exclude=Main --exclude=DataencUT --exclude=DataencQC++% : %.hs+	ghc --make $(GHCOPTS) $<++all: $(TESTS)++test: $(TESTS)+	./Test++report : test+	hpc6 sum $(HPC_SUM_OPTS) --output test.tix Test.tix+	hpc6 report test.tix++markup : test+	hpc6 sum $(HPC_SUM_OPTS) --output test.tix Test.tix+	hpc6 markup test.tix++clean:+	rm -f *~ Test *.tix *.html *.o *.hi+	rm -rf .hpc+	rm -f src/Codec/Binary/*.o+	rm -f src/Codec/Binary/*.hi+	rm -f src/Codec/Binary/*~
− QC.hs 
@@ -1,114 +0,0 @@-{-- - Copyright : (c) 2007 Magnus Therning- - License   : BSD3- -}--module Main-    where--import Data.Maybe-import Data.Word-import Test.QuickCheck--import qualified Codec.Binary.Uu as Uu-import qualified Codec.Binary.Base85 as Base85-import qualified Codec.Binary.Base64 as Base64-import qualified Codec.Binary.Base64Url as Base64Url-import qualified Codec.Binary.Base32 as Base32-import qualified Codec.Binary.Base32Hex as Base32Hex-import qualified Codec.Binary.Base16 as Base16-import qualified Codec.Binary.Yenc as Yenc---- {{{1 Arbitrary instances-instance Arbitrary Char where-    arbitrary = do-        n <- choose ((fromEnum (minBound::Char))::Int,-                (fromEnum (maxBound::Char))::Int)-        return $ toEnum n--instance Arbitrary Word8 where-    arbitrary = do-        n <- choose ((fromIntegral (minBound::Word8))::Int,-                (fromIntegral (maxBound::Word8))::Int)-        return $ fromIntegral n---- {{{1 uuencode properties-prop_uuEncode ws = ws == (fromJust . Uu.decode . Uu.encode) ws-    where types = ws::[Word8]--prop_uuChop s = properLength s ==> s == (Uu.unchop . Uu.chop 45) s-    where-        types = s::String-        properLength s = length s `mod` 4 /= 1 -- property of uuencode guarantees this--prop_uuCombined ws = ws == (fromJust $ Uu.decode $ Uu.unchop $ Uu.chop 45 $ Uu.encode ws)-    where types = ws::[Word8]---- {{{1 base85 properties-prop_base85Encode ws = ws == (fromJust $ Base85.decode $ Base85.encode ws)-    where types = ws::[Word8]--prop_base85Chop s = s == (Base85.unchop $ Base85.chop 20 s)-    where types = s::String---- {{{1 base64 properties-prop_base64Encode ws = ws == (fromJust $ Base64.decode $ Base64.encode ws)-    where types = ws::[Word8]--prop_base64Chop s = s == (Base64.unchop $ Base64.chop 4 s)-    where types = s::String---- {{{1 base64url properties-prop_base64UrlEncode ws = ws == (fromJust $ Base64Url.decode $ Base64Url.encode ws)-    where types = ws::[Word8]--prop_base64UrlChop s = s == (Base64Url.unchop $ Base64Url.chop 64 s)-    where types = s::String---- {{{1 base32-prop_base32Encode ws = ws == (fromJust $ Base32.decode $ Base32.encode ws)-    where types = ws::[Word8]--prop_base32Chop s = s == (Base32.unchop $ Base32.chop 8 s)-    where types = s::String---- {{{1 base32hex-prop_base32HexEncode ws = ws == (fromJust $ Base32Hex.decode $ Base32Hex.encode ws)-    where types = ws::[Word8]--prop_base32HexChop s = s == (Base32Hex.unchop $ Base32Hex.chop 64 s)-    where types = s::String---- {{{1 base16-prop_base16Encode ws = ws == (fromJust $ Base16.decode $ Base16.encode ws)-    where types = ws::[Word8]--prop_base16Chop s = s == (Base16.unchop $ Base16.chop 6 s)-    where types = s::String---- {{{1 yEncoding-prop_yencEncode ws = ws == (fromJust $ Yenc.decode $ Yenc.encode ws)-    where types = ws ::[Word8]--prop_yencChop ws = ws == (Yenc.unchop $ Yenc.chop 6 ws)-    where types = ws :: [Word8]---- {{{1 main-main = do-    quickCheck prop_uuEncode-    quickCheck prop_uuChop-    quickCheck prop_uuCombined-    quickCheck prop_base85Encode-    quickCheck prop_base85Chop-    quickCheck prop_base64Encode-    quickCheck prop_base64Chop-    quickCheck prop_base64UrlEncode-    quickCheck prop_base64UrlChop-    quickCheck prop_base32Encode-    quickCheck prop_base32Chop-    quickCheck prop_base32HexEncode-    quickCheck prop_base32HexChop-    quickCheck prop_base16Encode-    quickCheck prop_base16Chop-    quickCheck prop_yencEncode-    quickCheck prop_yencChop
+ Test.hs view
@@ -0,0 +1,19 @@+{-+ - Copyright : (c) 2009 Magnus Therning+ - License   : BSD3+ -}++module Main+    where++import Test.Framework++import qualified DataencQC as DQC+import qualified DataencUT as DUT++tests =+    [ testGroup "quickcheck" DQC.allTests+    , testGroup "unit test" DUT.allTests+    ]++main = defaultMain tests
− UT.hs 
@@ -1,186 +0,0 @@-{-- - Copyright : (c) 2007 Magnus Therning- - License   : BSD3- -}--module Main-    where--import Test.HUnit-import Control.Monad-import System.Exit-import Data.Maybe--import Codec.Binary.DataEncoding-import qualified Codec.Binary.Yenc as Yenc---- {{{1 buildTestList--- builds a list of successful tests based on a tuple (suite, description,--- encoded data, decoded data, codec)-buildTestList td = TestList $ concat-    [[ TestLabel (suite ++ " encode " ++ desc) (enc ~=? (encode codec dec))-     , TestLabel (suite ++ " decode " ++ desc) (dec ~=? (fromJust $ decode codec $ enc))] -        | (suite, desc, enc, dec, codec) <- td ]---- {{{1 uuencode tests-uuTestData =-    [ ("uu", "empty", "", [], uu)-    , ("uu", "\0", "``", [0], uu)-    , ("uu", "\255", "_P", [255], uu)-    , ("uu", "Example", "17AA;7!L90", [69,120,97,109,112,108,101], uu)-    ]-uuTests = buildTestList uuTestData--uuTests2 = test-    [ "chop . encode Example" ~: ["'17AA;7!L90"] ~=? (chop uu 61 . encode uu) [69,120,97,109,112,108,101]-    , "decode . unchop Example" ~: [69,120,97,109,112,108,101] ~=? fromJust ((decode uu . unchop uu) ["'17AA;7!L90"])-    ]--uuTestsFail = test-    [ "uu decode short" ~: Nothing ~=? decode uu "A"-    , "uu decode' short" ~: [Nothing] ~=? decode' uu "A"-    , "uu decode illegal" ~: Nothing ~=? decode uu "aa"-    , "uu decode' illegal" ~: [Nothing] ~=? decode' uu "aa"-    ]---- {{{1 base85 tests-base85TestData =-    [ ("base85", "empty", "", [], base85)-    , ("base85", "f", "Ac", [102], base85)-    , ("base85", "fo", "Ao@", [102,111], base85)-    , ("base85", "foo", "AoDS", [102,111,111], base85)-    , ("base85", "foob", "AoDTs", [102,111,111,98], base85)-    , ("base85", "fooba", "AoDTs@/", [102,111,111,98,97], base85)-    , ("base85", "foobar", "AoDTs@<)", [102,111,111,98,97,114], base85)-    , ("base85", "\0", "!!", [0], base85)-    , ("base85", "foob\0\0\0\0ar", "AoDTszEW", [102,111,111,98,0,0,0,0,114], base85)-    , ("base85", "Example", "7<i6XE,9(", [69,120,97,109,112,108,101], base85)-    ]-base85Tests = buildTestList base85TestData--base85TestsFail = test-    [ "base85 decode short" ~: Nothing ~=? decode base85 "A"-    , "base85 decode' short" ~: [Nothing] ~=? decode' base85 "A"-    , "base85 decode illegal" ~: Nothing ~=? decode base85 "!z"-    , "base85 decode' illegal" ~: [Nothing] ~=? decode' base85 "!z"-    ]---- {{{1 base64 tests-base64TestData =-    [ ("base64", "empty", "", [], base64)-    , ("base64", "f", "Zg==", [102], base64)-    , ("base64", "fo", "Zm8=", [102,111], base64)-    , ("base64", "foo", "Zm9v", [102,111,111], base64)-    , ("base64", "foob", "Zm9vYg==", [102,111,111,98], base64)-    , ("base64", "fooba", "Zm9vYmE=", [102,111,111,98,97], base64)-    , ("base64", "foobar", "Zm9vYmFy", [102,111,111,98,97,114], base64)-    , ("base64", "\0", "AA==", [0], base64)-    , ("base64", "\255", "/w==", [255], base64)-    , ("base64", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], base64)-    ]-base64Tests = buildTestList base64TestData--base64TestsFail = test-    [ "base64 decode short" ~: Nothing ~=? decode base64 "A"-    , "base64 decode' short" ~: [Nothing] ~=? decode' base64 "A"-    , "base64 decode illegal" ~: Nothing ~=? decode base64 "!!"-    , "base64 decode' illegal" ~: [Nothing] ~=? decode' base64 "!!"-    ]---- {{{1 base64url tests-base64UrlTestData =-    [ ("base64url", "empty", "", [], base64Url)-    , ("base64url", "\0", "AA==", [0], base64Url)-    , ("base64url", "\255", "_w==", [255], base64Url)-    , ("base64url", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], base64Url)-    ]-base64UrlTests = buildTestList base64UrlTestData---- {{{1 base32 tests-base32TestData =-    [ ("base32", "empty", "", [], base32)-    , ("base32", "f", "MY======", [102], base32)-    , ("base32", "fo", "MZXQ====", [102,111], base32)-    , ("base32", "foo", "MZXW6===", [102,111,111], base32)-    , ("base32", "foob", "MZXW6YQ=", [102,111,111,98], base32)-    , ("base32", "fooba", "MZXW6YTB", [102,111,111,98,97], base32)-    , ("base32", "foobar", "MZXW6YTBOI======", [102,111,111,98,97,114], base32)-    ]-base32Tests = buildTestList base32TestData--base32TestsFail = test-    [ "base32 decode short" ~: Nothing ~=? decode base32 "A"-    , "base32 decode' short" ~: [Nothing] ~=? decode' base32 "A"-    , "base32 decode illegal" ~: Nothing ~=? decode base32 "gh"-    , "base32 decode' illegal" ~: [Nothing] ~=? decode' base32 "gh"-    ]---- {{{1 base32hex tests-base32HexTestData =-    [ ("base32hex", "empty", "", [], base32Hex)-    , ("base32hex", "f", "CO======", [102], base32Hex)-    , ("base32hex", "fo", "CPNG====", [102,111], base32Hex)-    , ("base32hex", "foo", "CPNMU===", [102,111,111], base32Hex)-    , ("base32hex", "foob", "CPNMUOG=", [102,111,111,98], base32Hex)-    , ("base32hex", "fooba", "CPNMUOJ1", [102,111,111,98,97], base32Hex)-    , ("base32hex", "foobar", "CPNMUOJ1E8======", [102,111,111,98,97,114], base32Hex)-    ]-base32HexTests = buildTestList base32HexTestData--base32HexTestsFail = test-    [ "base32hex decode short" ~: Nothing ~=? decode base32Hex "A"-    , "base32hex decode' short" ~: [Nothing] ~=? decode' base32Hex "A"-    , "base32hex decode illegal" ~: Nothing ~=? decode base32Hex "gh"-    , "base32hex decode' illegal" ~: [Nothing] ~=? decode' base32Hex "gh"-    ]---- {{{1 base16 (hex)-base16TestData =-    [ ("base16", "empty", "", [], base16)-    , ("base16", "f", "66", [102], base16)-    , ("base16", "fo", "666F", [102,111], base16)-    , ("base16", "foo", "666F6F", [102,111,111], base16)-    , ("base16", "foob", "666F6F62", [102,111,111,98], base16)-    , ("base16", "fooba", "666F6F6261", [102,111,111,98,97], base16)-    , ("base16", "foobar", "666F6F626172", [102,111,111,98,97,114], base16)-    ]-base16Tests = buildTestList base16TestData--base16TestsFail = test-    [ "base16 decode short" ~: Nothing ~=? decode base16 "A"-    , "base16 decode' short" ~: [Nothing] ~=? decode' base16 "A"-    , "base16 decode illegal" ~: Nothing ~=? decode base16 "GH"-    , "base16 decode' illegal" ~: [Nothing] ~=? decode' base16 "GH"-    ]---- {{{1 yEncoding-yencTests = test-    [ "yEnc encode empty" ~: [] ~=? Yenc.encode []-    , "yEnc decode empty" ~: Just [] ~=? Yenc.decode []-    , "yEnc encode 'f'" ~: [0x90] ~=? Yenc.encode [0x66]-    , "yEnc decode enc('f')" ~: Just [0x66] ~=? Yenc.decode [0x90]-    , "yEnc encode 'foobar'" ~: [0x90, 0x99, 0x99, 0x8c, 0x8b, 0x9c] ~=? Yenc.encode [0x66, 0x6f, 0x6f, 0x62, 0x61, 0x72]-    , "yEnc decode enc('foobar')" ~: Just [0x66, 0x6f, 0x6f, 0x62, 0x61, 0x72] ~=? Yenc.decode [0x90, 0x99, 0x99, 0x8c, 0x8b, 0x9c]-    , "yEnc encode [0xd6, 0xd7]" ~: [0x3d, 0x40, 0x01] ~=? Yenc.encode [0xd6, 0xd7]-    , "yEnc decode enc([0xd6, 0xd7])" ~:  Just [0xd6, 0xd7] ~=? Yenc.decode [0x3d, 0x40, 0x01]-    , "yEnc encode criticals" ~: [0x3d, 0x40, 0x3d, 0x4a, 0x3d, 0x4d, 0x3d, 0x7d] ~=? Yenc.encode [0xd6, 0xe0, 0xe3, 0x13]-    , "yEnc decode criticals" ~:  Just [0xd6, 0xe0, 0xe3, 0x13] ~=? Yenc.decode [0x3d, 0x40, 0x3d, 0x4a, 0x3d, 0x4d, 0x3d, 0x7d]-    , "yEnc chop" ~: [[0x3d, 0x40], [0x01, 0x3d, 0x4a]] ~=? Yenc.chop 2 [0x3d, 0x40, 0x01, 0x3d, 0x4a]-    ]---- {{{1 test list and main-testList = TestList-    [ uuTests, uuTests2, uuTestsFail-    , base85Tests, base85TestsFail-    , base64Tests, base64TestsFail-    , base64UrlTests-    , base32Tests, base32TestsFail-    , base32HexTests, base32HexTestsFail-    , base16Tests,  base16TestsFail-    , yencTests-    ]--main :: IO ()-main = do-    counts <- runTestTT testList-    when ((errors counts, failures counts) /= (0, 0)) $ exitWith (ExitFailure 1)
dataenc.cabal view
@@ -1,5 +1,5 @@ name: dataenc-version: 0.12+version: 0.12.1.0 license: BSD3 license-file: LICENSE cabal-version: >= 1.2@@ -7,30 +7,30 @@ author: Magnus Therning maintainer: magnus@therning.org homepage: http://www.haskell.org/haskellwiki/Library/Data_encoding-copyright: Magnus Therning, 2007+copyright: Magnus Therning, 2007-2009 category: Codec synopsis: Data encoding library description: Data encoding library currently providing Uuencode, Base64,         Base64Url, Base32, Base32Hex, Base16, Base85, and yEncoding.-extra-source-files: UT.hs QC.hs--flag large_base-        description: Choose the old larger, monolithic base package.-        default: False+extra-source-files: DataencUT.hs DataencQC.hs Test.hs GNUmakefile  library         hs-source-dirs: src-        if flag(large_base)-                build-depends: base-        else-                build-depends: array, base, containers+        build-depends: array >= 0.2.0 && < 0.3, base >= 4.0.0 && < 4.1, containers >= 0.2.0 && < 0.3         exposed-modules:-                Codec.Binary.DataEncoding                 Codec.Binary.Base16-                Codec.Binary.Base32Hex                 Codec.Binary.Base32-                Codec.Binary.Uu-                Codec.Binary.Base64Url+                Codec.Binary.Base32Hex                 Codec.Binary.Base64+                Codec.Binary.Base64Url                 Codec.Binary.Base85+                Codec.Binary.DataEncoding+                Codec.Binary.Hexadecimal+                Codec.Binary.PythonString+                Codec.Binary.QuotedPrintable+                Codec.Binary.Url+                Codec.Binary.Uu+                Codec.Binary.Xx                 Codec.Binary.Yenc+        other-modules:+                Codec.Binary.Util
src/Codec/Binary/Base85.hs view
@@ -47,12 +47,12 @@ encode (0:0:0:0:bs) = "z" ++ encode bs encode (b1:b2:b3:b4:bs) = (foldr (\ i s -> (encodeArray ! i) : s) "" group) ++ (encode bs)     where-        group2Int :: Int-        group2Int = foldl (\ a b -> a `shiftL` 8 + (fromIntegral b)) 0 [b1, b2, b3, b4]-        encodeInt2Ints :: Int -> [Word8]-        encodeInt2Ints = map fromIntegral . map (`mod` 85) . take 5 . iterate (`div` 85)+        group2Word32 :: Word32+        group2Word32 = foldl (\ a b -> a `shiftL` 8 + (fromIntegral b)) 0 [b1, b2, b3, b4]+        encodeWord32ToWord8s :: Word32 -> [Word8]+        encodeWord32ToWord8s = map fromIntegral . map (`mod` 85) . take 5 . iterate (`div` 85)         adjustNReverse = reverse . map (+ 33)-        group = (adjustNReverse .encodeInt2Ints) group2Int+        group = (adjustNReverse .encodeWord32ToWord8s) group2Word32  -- {{{1 decode -- | Decode data (lazy).@@ -70,11 +70,11 @@         dec l@[Just c1, Just c2, Just c3, Just c4] = take 3 . dec $ l ++ pad 1         dec l@[Just c1, Just c2, Just c3, Just c4, Just c5] = let                 adjRev = map (flip (-) 33) [c5, c4, c3, c2, c1]-                group2Int :: [Word8] -> Int-                group2Int = foldl1 (+) . map (uncurry (*)) . zip (map (85 ^) [0..4]) . map fromIntegral-                int2Group :: Int -> [Maybe Word8]-                int2Group = map Just . map fromIntegral . reverse . take 4 . iterate (`div` 256)-            in (int2Group . group2Int) adjRev+                group2Word32 :: [Word8] -> Word32+                group2Word32 = foldl1 (+) . map (uncurry (*)) . zip (map (85 ^) [0..4]) . map fromIntegral+                word32ToGroup :: Word32 -> [Maybe Word8]+                word32ToGroup = map Just . map fromIntegral . reverse . take 4 . iterate (`div` 256)+            in (word32ToGroup . group2Word32) adjRev         dec _ = [Nothing]     in (dec . map (flip M.lookup decodeMap) $ take 5 cs) ++ decode' (drop 5 cs)
src/Codec/Binary/DataEncoding.hs view
@@ -11,18 +11,23 @@ -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.DataEncoding     ( DataCodec-    , encode-    , decode-    , decode'-    , chop-    , unchop     , base16     , base32     , base32Hex     , base64     , base64Url     , base85+    , chop+    , decode+    , decode'+    , encode+    , hex+    , py+    , qp+    , unchop+    , url     , uu+    , xx     )     where @@ -34,7 +39,12 @@ import qualified Codec.Binary.Base64 as Base64 import qualified Codec.Binary.Base64Url as Base64Url import qualified Codec.Binary.Base85 as Base85+import qualified Codec.Binary.Url as Url import qualified Codec.Binary.Uu as Uu+import qualified Codec.Binary.Xx as Xx+import qualified Codec.Binary.Hexadecimal as Hex+import qualified Codec.Binary.QuotedPrintable as QP+import qualified Codec.Binary.PythonString as Py  -- {{{1 DataCodec -- | Used to group a specific data encoding's functions.@@ -129,3 +139,63 @@     chop=Uu.chop,     unchop=Uu.unchop }++-- {{{1 xx+-- | Xxencoding, see "Codec.Binary.Xx" for more details on the+--   individual functions.+xx :: DataCodec+xx = DataCodec {+    encode=Xx.encode,+    decode=Xx.decode,+    decode'=Xx.decode',+    chop=Xx.chop,+    unchop=Xx.unchop+}++-- {{{1 hexadecimal+-- | Hexadecimal, see "Codec.Binary.Hexadecimal" for more details on the+-- individual functions.+hex :: DataCodec+hex = DataCodec+    { encode  = Hex.encode+    , decode  = Hex.decode+    , decode' = Hex.decode'+    , chop    = Hex.chop+    , unchop  = Hex.unchop+    }++-- {{{1 quoted-printable+-- | Quoted-printable, see "Codec.Binary.QuotedPrintable" for more details on+-- the individual functions.+qp :: DataCodec+qp = DataCodec+    { encode  = QP.encode+    , decode  = QP.decode+    , decode' = QP.decode'+    , chop    = QP.chop+    , unchop  = QP.unchop+    }++-- {{{1 python string+-- | Quoted-printable, see "Codec.Binary.PythonString" for more details on+-- the individual functions.+py :: DataCodec+py = DataCodec+    { encode  = Py.encode+    , decode  = Py.decode+    , decode' = Py.decode'+    , chop    = Py.chop+    , unchop  = Py.unchop+    }++-- {{{1 url encoding+-- | URL encoding, see "Codec.Binary.Url" for more details on the individual+-- functions.+url :: DataCodec+url = DataCodec+    { encode  = Url.encode+    , decode  = Url.decode+    , decode' = Url.decode'+    , chop    = Url.chop+    , unchop  = Url.unchop+    }
+ src/Codec/Binary/Hexadecimal.hs view
@@ -0,0 +1,56 @@+-- |+-- Module    : Codec.Binary.Hexadecimal+-- Copyright : (c) 2009 Magnus Therning+-- License   : BSD3+--+-- Simple hexadecimal encoding.+--+-- Further documentation and information can be found at+-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.+module Codec.Binary.Hexadecimal+    ( encode+    , decode+    , decode'+    , chop+    , unchop+    ) where++import Data.Word++import Codec.Binary.Util++-- {{{1 encode+-- | Encode data.  Each nibble of the byte is converted into one character in+-- [0-9A-F].+encode :: [Word8]+    -> String+encode [] = ""+encode (o:os) = toHex o ++ encode os++-- {{{1 decode+-- | Decode data (lazy).+decode' :: String+    -> [Maybe Word8]+decode' "" = []+decode' (hn:ln:cs) = fromHex [hn, ln] : decode' cs+decode' _ = [Nothing]++-- | Decode data (strict).+decode :: String -> Maybe [Word8]+decode = sequence . decode'++-- {{{1 chop+-- | Chop up a string in parts.+chop :: Int     -- ^ length of individual lines+    -> String+    -> [String]+chop n "" = []+chop n s = let+        enc_len | n < 2 = 2+                | otherwise = n `div` 2 * 2+    in (take enc_len s) : chop n (drop enc_len s)++-- {{{1 unchop+-- | Concatenate the list of strings into one long string.+unchop :: [String] -> String+unchop = foldr (++) ""
+ src/Codec/Binary/PythonString.hs view
@@ -0,0 +1,86 @@+-- |+-- Module    : Codec.Binary.PythonString+-- Copyright : (c) 2009 Magnus Therning+-- License   : BSD3+--+-- Implementation of python escaping.+--+-- This implementation encodes non-printable characters (0x00-0x1f, 0x7f-0xff)+-- to hex-value characters ('\xhh') while leaving printable characters as such:+--+-- @+-- \> encode [0, 10, 13, 110]+-- \"\\\\x00\\\\x0A\\\\x0Dn\"+-- \> putStrLn $ encode [0, 10, 13, 110]+-- \\x00\\x0A\\x0Dn+-- @+--+-- It also properly handles escaping of a few characters that require it:+--+-- @+-- \> encode [34, 39, 92]+-- \"\\\\\\\"\\\\\'\\\\\\\\\"+-- putStrLn $ encode [34, 39, 92]+-- \\\"\\'\\\\+-- @+--+-- Further documentation and information can be found at+-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.+module Codec.Binary.PythonString+    ( encode+    , decode+    , decode'+    , chop+    , unchop+    ) where++import Data.Char+import Data.Word++import Codec.Binary.Util++-- {{{1 encode+-- | Encode data.+encode :: [Word8]+    -> String+encode [] = ""+encode (o:os)+    | o < 0x20 || o > 0x7e = ('\\' : 'x' : toHex o) ++ encode os+    | o == 34 = "\\\"" ++ encode os+    | o == 39 = "\\'" ++ encode os+    | o == 92 = "\\\\" ++ encode os+    | otherwise = chr (fromIntegral o) : encode os++-- {{{1 decode+-- -- | Decode data (lazy).+decode' :: String+    -> [Maybe Word8]+decode' [] = []+decode' ('\\':'x':c0:c1:cs) = fromHex [c0, c1] : decode' cs+decode' ('\\':'\\':cs) = (Just $ fromIntegral $ ord '\\') : decode' cs+decode' ('\\':'\'':cs) = (Just $ fromIntegral $ ord '\'') : decode' cs+decode' ('\\':'\"':cs) = (Just $ fromIntegral $ ord '\"') : decode' cs+decode' (c:cs)+    | c /= '\\' = (Just $ fromIntegral $ ord c) : decode' cs+    | otherwise = [Nothing]++-- | Decode data (strict).+decode :: String -> Maybe [Word8]+decode = sequence . decode'++-- {{{1 chop+-- | Chop up a string in parts.+chop :: Int     -- ^ length of individual lines (values @\< 1@ are ignored)+    -> String+    -> [String]+chop n = let+        _n = max 1 n+        _chop [] = []+        _chop cs = take _n cs : (_chop $ drop _n cs)+    in _chop++-- {{{1 unchop+-- | Concatenate the list of strings into one long string.+unchop :: [String]+    -> String+unchop = foldr (++) ""
+ src/Codec/Binary/QuotedPrintable.hs view
@@ -0,0 +1,79 @@+-- |+-- Module    : Codec.Binary.QuotedPrintable+-- Copyright : (c) 2009 Magnus Therning+-- License   : BSD3+--+-- Implementation of Quoted-Printable based on RFC 2045+-- (<http://tools.ietf.org/html/rfc2045>).+--+-- This encoding encodes _everything_ that is passed in, it will not try to+-- guess the native line ending for your architecture.  In other words, if you+-- are using this to encode text you need to split it into separate lines+-- before encoding and chopping it up.+--+-- Further documentation and information can be found at+-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.+module Codec.Binary.QuotedPrintable+    ( encode+    , decode+    , decode'+    , chop+    , unchop+    ) where++import Data.Char+import Data.Word++import Codec.Binary.Util++-- {{{1 encode+-- | Encode data.+encode :: [Word8]+    -> String+encode [] = ""+encode (o:os)+    | o < 33 || o == 61 || o > 126 = ('=' : toHex o) ++ encode os+    | otherwise = chr (fromIntegral o) : encode os+++-- {{{1 decode+-- -- | Decode data (lazy).+decode' :: String+    -> [Maybe Word8]+decode' [] = []+decode' ('=':c0:c1:cs) = fromHex [c0, c1] : decode' cs+decode' (c:cs)+    | c /= '=' = (Just $ fromIntegral $ ord c) : decode' cs+    | otherwise = [Nothing]++-- | Decode data (strict).+decode :: String -> Maybe [Word8]+decode = sequence . decode'++-- {{{1 chop+-- | Chop up a string in parts.+chop :: Int     -- ^ length of individual lines (values @\< 4@ are ignored)+    -> String+    -> [String]+chop n "" = []+chop n s = let+        n' = max 3 $ n - 1+        _c i ts "" acc = ts : acc+        _c i ts tss@('=':tss') acc+            | i + 2 < n' = _c (i + 1) ('=' : ts) tss' acc+            | otherwise = _c 0 "" tss (('=' : ts) : acc)+        _c i ts tss@(c:tss') acc+            | i < n' = _c (i + 1) (c : ts) tss' acc+            | otherwise = _c 0 "" tss (('=' : ts) : acc)+    in map reverse . reverse $ _c 0 "" s []++-- {{{1 unchop+-- | Concatenate the list of strings into one long string.+unchop :: [String] -> String+unchop [] = ""+unchop (s:ss) = let+        dropLast = last s == '='+        len = length s+    in if dropLast+        then (take (len - 1) s) ++ (unchop ss)+        else s ++ (unchop ss)
+ src/Codec/Binary/Url.hs view
@@ -0,0 +1,76 @@+-- |+-- Module    : Codec.Binary.Url+-- Copyright : (c) 2009 Magnus Therning+-- License   : BSD3+--+-- URL encoding, sometimes referred to as URI encoding or percent encoding.+-- Implemented based on RFC 3986 (<http://tools.ietf.org/html/rfc3986>).+--+-- Further documentation and information can be found at+-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.++module Codec.Binary.Url+    ( encode+    , decode+    , decode'+    , chop+    , unchop+    ) where++import qualified Data.Map as M+import Data.Char(ord)+import Data.Word(Word8)++import Codec.Binary.Util(toHex,fromHex)++_unreservedChars = (zip [65..90] "ABCDEFGHIJKLMNOPQRSTUVWXYZ")+        ++ (zip [97..122] "abcdefghijklmnopqrstuvwxyz")+        ++ (zip [48..57] "0123456789")+        ++ [(45, '-'), (95, '_'), (46, '.'), (126, '~')]++encodeMap :: M.Map Word8 Char+encodeMap = M.fromList _unreservedChars++decodeMap :: M.Map Char Word8+decodeMap = M.fromList [(b, a) | (a, b) <- _unreservedChars]++-- {{{1 encode+-- | Encode data.+encode :: [Word8]+    -> String+encode [] = ""+encode (o:os) = case (M.lookup o encodeMap) of+    Just c -> c : encode os+    Nothing -> ('%' : toHex o) ++ encode os++-- {{{1 decode+-- | Decode data (lazy).+decode' :: String+    -> [Maybe Word8]+decode' [] = []+decode' ('%':c0:c1:cs) = fromHex [c0, c1] : decode' cs+decode' (c:cs)+    | c /= '%' = (Just $ fromIntegral $ ord c) : decode' cs+    | otherwise = [Nothing]++-- | Decode data (strict).+decode :: String+    -> Maybe [Word8]+decode = sequence . decode'++-- {{{1 chop+-- | Chop up a string in parts.+chop :: Int     -- ^ length of individual lines+    -> String+    -> [String]+chop n = let+        _n = max 1 n+        _chop [] = []+        _chop cs = take _n cs : (_chop $ drop _n cs)+    in _chop++-- {{{1 unchop+-- | Concatenate the strings into one long string+unchop :: [String]+    -> String+unchop = foldr (++) ""
+ src/Codec/Binary/Util.hs view
@@ -0,0 +1,41 @@+-- |+-- Module    : Codec.Binary.Util+-- Copyright : (c) 2009 Magnus Therning+-- License   : BSD3+--+-- Utility functions used in the other module.+module Codec.Binary.Util+    ( toHex+    , fromHex+    ) where++import Data.Array+import Data.Bits+import Data.Char+import Data.Word+import qualified Data.Map as M++-- {{{1 hex enc/dec assoc list and maps+hexEncMap = zip [0..] "0123456789ABCDEF"++hexEncodeArray :: Array Word8 Char+hexEncodeArray = array (0, 16) hexEncMap++hexDecodeMap :: M.Map Char Word8+hexDecodeMap = M.fromList [(b, a) | (a, b) <- hexEncMap]++-- {{{1 toHex+toHex :: Word8 -> String+toHex o = let+        hn = o `shiftR` 4+        ln = o .&. 0xf+    in [hexEncodeArray ! hn, hexEncodeArray ! ln]++-- {{{1 fromHex+fromHex :: String -> Maybe Word8+fromHex = let+        dec [Just hn, Just ln] = let+                o = hn `shiftL` 4 .|. ln+            in Just o+        dec _ = Nothing+    in dec . map ((flip M.lookup hexDecodeMap) . toUpper)
src/Codec/Binary/Uu.hs view
@@ -25,20 +25,7 @@ import qualified Data.Map as M  -- {{{1 enc/dec map-_encMap =-    [ (0, '`'), (1, '!'), (2, '"'), (3, '#'), (4, '$')-    , (5, '%'), (6, '&'), (7, '\''), (8, '('), (9, ')')-    , (10, '*'), (11, '+'), (12, ','), (13, '-'), (14, '.')-    , (15, '/'), (16, '0'), (17, '1'), (18, '2'), (19, '3')-    , (20, '4'), (21, '5'), (22, '6'), (23, '7'), (24, '8')-    , (25, '9'), (26, ':'), (27, ';'), (28, '<'), (29, '=')-    , (30, '>'), (31, '?'), (32, '@'), (33, 'A'), (34, 'B')-    , (35, 'C'), (36, 'D'), (37, 'E'), (38, 'F'), (39, 'G')-    , (40, 'H'), (41, 'I'), (42, 'J'), (43, 'K'), (44, 'L')-    , (45, 'M'), (46, 'N'), (47, 'O'), (48, 'P'), (49, 'Q')-    , (50, 'R'), (51, 'S'), (52, 'T'), (53, 'U') ,(54, 'V')-    , (55, 'W'), (56, 'X'), (57, 'Y'), (58, 'Z'), (59, '[')-    , (60, '\\'), (61, ']'), (62, '^'), (63, '_') ]+_encMap = zip [0..] "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"  -- {{{1 encodeArray encodeArray :: Array Word8 Char@@ -94,18 +81,19 @@ -- --   /Notes:/ -----   * The length of the strings in the result will be @(n -1) `div` 4 * 4@.---   The @-1@ comes from the need to prepend the length.  Keeping it to a---   multiple of 4 means that strings returned from 'encode' can be chopped---   without requiring any changes.+--   * The length of the strings in the result will be @(n -1) `div` 4 * 4 ++--   1@.  The @-1@ comes from the need to prepend the length (which explains+--   the final @+1@).  Keeping it to a multiple of 4 means that strings+--   returned from 'encode' can be chopped without requiring any changes. -- --   * The length of lines in GNU's sharutils is 61.-chop :: Int     -- ^ length (@1 < n <= 65@, not checked)+chop :: Int     -- ^ length (value should be in the range @[5..85]@)     -> String     -> [String] chop n "" = [] chop n s = let-        enc_len | n < 5 = 4+        enc_len | n < 5     = 4+                | n >= 85    = 84                 | otherwise = (n - 1) `div` 4 * 4         enc_line = take enc_len s         act_len = fromIntegral $ case (length enc_line `divMod` 4) of
+ src/Codec/Binary/Xx.hs view
@@ -0,0 +1,119 @@+-- |+-- Module    : Codec.Binary.Xx+-- Copyright : (c) 2007 Magnus Therning+-- License   : BSD3+--+-- Xxencoding is obsolete but still included for completeness.  Further+-- information on the encoding can be found at+-- <http://en.wikipedia.org/wiki/Xxencode>.  It should be noted that this+-- implementation performs no padding, due to the splitting up between encoding+-- and chopping.+--+-- Further documentation and information can be found at+-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.+module Codec.Binary.Xx+    ( encode+    , decode+    , decode'+    , chop+    , unchop+    ) where++import Control.Monad+import Data.Array+import Data.Bits+import Data.Maybe+import Data.Word+import qualified Data.Map as M++-- {{{1 enc/dec map+_encMap = zip [0..] "+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"++-- {{{1 encodeArray+encodeArray :: Array Word8 Char+encodeArray = array (0, 64) _encMap++-- {{{1 decodeMap+decodeMap :: M.Map Char Word8+decodeMap = M.fromList [(snd i, fst i) | i <- _encMap]++-- {{{1 encode+-- | Encode data.+encode :: [Word8]+    -> String+encode = let+        pad n = take n $ repeat 0+        enc [] = ""+        enc l@[o] = take 2 . enc $ l ++ pad 2+        enc l@[o1, o2] = take 3 . enc $ l ++ pad 1+        enc (o1:o2:o3:os) = let+                i1 = o1 `shiftR` 2+                i2 = (o1 `shiftL` 4 .|. o2 `shiftR` 4) .&. 0x3f+                i3 = (o2 `shiftL` 2 .|. o3 `shiftR` 6) .&. 0x3f+                i4 = o3 .&. 0x3f+            in (foldr (\ i s -> (encodeArray ! i) : s) "" [i1, i2, i3, i4]) ++ enc os+    in enc++-- {{{1 decode+-- | Decode data (lazy).+decode' :: String+    -> [Maybe Word8]+decode' = let+        pad n = take n . repeat $ Just 0+        dec [] = []+        dec l@[Just eo1, Just eo2] = take 1 . dec $ l ++ pad 2+        dec l@[Just eo1, Just eo2, Just eo3] = take 2 . dec $ l ++ pad 1+        dec (Just eo1:Just eo2:Just eo3:Just eo4:eos) = let+                o1 = eo1 `shiftL` 2 .|. eo2 `shiftR` 4+                o2 = eo2 `shiftL` 4 .|. eo3 `shiftR` 2+                o3 = eo3 `shiftL` 6 .|. eo4+            in Just o1:Just o2:Just o3:(dec eos)+        dec _ = [Nothing]+    in+        dec . map (flip M.lookup decodeMap)++-- | Decode data (strict).+decode :: String+    -> Maybe [Word8]+decode = sequence . decode'++-- {{{1 chop+-- | Chop up a string in parts.  Each string in the resulting list is prepended+--   with the length according to the xxencode \"specificiation\".+--+--   /Notes:/+--+--   * The length of the strings in the result will be @(n -1) `div` 4 * 4 ++--   1@.  The @-1@ comes from the need to prepend the length (which explains+--   the final @+1@).  Keeping it to a multiple of 4 means that strings+--   returned from 'encode' can be chopped without requiring any changes.+chop :: Int     -- ^ length (value should be in the range @[5..85]@)+    -> String+    -> [String]+chop n "" = []+chop n s = let+        enc_len | n < 5     = 4+                | n >= 85   = 84+                | otherwise = min 64 $ (n - 1) `div` 4 * 4+        enc_line = take enc_len s+        act_len = fromIntegral $ case (length enc_line `divMod` 4) of+            (l, 0) -> l * 3+            (l, 2) -> l * 3 + 1+            (l, 3) -> l * 3 + 2+        len = (encodeArray ! act_len)+    in (len : enc_line) : chop n (drop enc_len s)++-- {{{1 unchop+-- | Concatenate the strings into one long string.  Each string is assumed to+--   be prepended with the length according to the xxencode specification.+unchop :: [String]+    -> String+unchop ss = let+        singleUnchop (l:cs) = let+                act_len = fromIntegral $ decodeMap M.! l+                enc_len = case (act_len `divMod` 3) of+                    (n, 0) -> n * 4+                    (n, 1) -> n * 4 + 2+                    (n, 2) -> n * 4 + 3+            in take enc_len cs+    in foldr (\ s res -> (singleUnchop s) ++ res) "" ss
src/Codec/Binary/Yenc.hs view
@@ -50,11 +50,12 @@     -> [[Word8]] chop _ [] = [] chop n ws = let-        (p1, p2) = splitAt n ws+        _n = max n 1+        (p1, p2) = splitAt _n ws     in         if (last p1 == _equal)-            then (p1 ++ (take 1 p2)) : chop n (drop 1 p2)-            else p1 : chop n p2+            then (p1 ++ (take 1 p2)) : chop _n (drop 1 p2)+            else p1 : chop _n p2  -- {{{1 unchop -- | Concatenate the strings into one long string.