dataenc 0.13.0.5 → 0.14
raw patch · 18 files changed
+869/−538 lines, 18 filesdep +test-framework-thPVP ok
version bump matches the API change (PVP)
Dependencies added: test-framework-th
API changes (from Hackage documentation)
- Codec.Binary.Base16: decode' :: String -> [Maybe Word8]
- Codec.Binary.Base32: decode' :: String -> [Maybe Word8]
- Codec.Binary.Base32Hex: decode' :: String -> [Maybe Word8]
- Codec.Binary.Base64: decode' :: String -> [Maybe Word8]
- Codec.Binary.Base64Url: decode' :: String -> [Maybe Word8]
- Codec.Binary.Base85: decode' :: String -> [Maybe Word8]
- Codec.Binary.DataEncoding: decode' :: DataCodec -> String -> [Maybe Word8]
- Codec.Binary.PythonString: decode' :: String -> [Maybe Word8]
- Codec.Binary.QuotedPrintable: decode' :: String -> [Maybe Word8]
- Codec.Binary.Url: decode' :: String -> [Maybe Word8]
- Codec.Binary.Uu: decode' :: String -> [Maybe Word8]
- Codec.Binary.Xx: decode' :: String -> [Maybe Word8]
- Codec.Binary.Yenc: decode' :: [Word8] -> [Maybe Word8]
+ Codec.Binary.Base16: DChunk :: i -> DecIncData i
+ Codec.Binary.Base16: DDone :: DecIncData i
+ Codec.Binary.Base16: DFail :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base16: DFinal :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base16: DPart :: [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
+ Codec.Binary.Base16: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.Base16: EDone :: EncIncData
+ Codec.Binary.Base16: EFinal :: i -> EncIncRes i
+ Codec.Binary.Base16: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.Base16: data DecIncData i
+ Codec.Binary.Base16: data DecIncRes i
+ Codec.Binary.Base16: data EncIncData
+ Codec.Binary.Base16: data EncIncRes i
+ Codec.Binary.Base16: decodeInc :: DecIncData String -> DecIncRes String
+ Codec.Binary.Base16: encodeInc :: EncIncData -> EncIncRes String
+ Codec.Binary.Base32: DChunk :: i -> DecIncData i
+ Codec.Binary.Base32: DDone :: DecIncData i
+ Codec.Binary.Base32: DFail :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base32: DFinal :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base32: DPart :: [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
+ Codec.Binary.Base32: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.Base32: EDone :: EncIncData
+ Codec.Binary.Base32: EFinal :: i -> EncIncRes i
+ Codec.Binary.Base32: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.Base32: data DecIncData i
+ Codec.Binary.Base32: data DecIncRes i
+ Codec.Binary.Base32: data EncIncData
+ Codec.Binary.Base32: data EncIncRes i
+ Codec.Binary.Base32: decodeInc :: DecIncData String -> DecIncRes String
+ Codec.Binary.Base32: encodeInc :: EncIncData -> EncIncRes String
+ Codec.Binary.Base32Hex: DChunk :: i -> DecIncData i
+ Codec.Binary.Base32Hex: DDone :: DecIncData i
+ Codec.Binary.Base32Hex: DFail :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base32Hex: DFinal :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base32Hex: DPart :: [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
+ Codec.Binary.Base32Hex: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.Base32Hex: EDone :: EncIncData
+ Codec.Binary.Base32Hex: EFinal :: i -> EncIncRes i
+ Codec.Binary.Base32Hex: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.Base32Hex: data DecIncData i
+ Codec.Binary.Base32Hex: data DecIncRes i
+ Codec.Binary.Base32Hex: data EncIncData
+ Codec.Binary.Base32Hex: data EncIncRes i
+ Codec.Binary.Base32Hex: decodeInc :: DecIncData String -> DecIncRes String
+ Codec.Binary.Base32Hex: encodeInc :: EncIncData -> EncIncRes String
+ Codec.Binary.Base64: DChunk :: i -> DecIncData i
+ Codec.Binary.Base64: DDone :: DecIncData i
+ Codec.Binary.Base64: DFail :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base64: DFinal :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base64: DPart :: [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
+ Codec.Binary.Base64: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.Base64: EDone :: EncIncData
+ Codec.Binary.Base64: EFinal :: i -> EncIncRes i
+ Codec.Binary.Base64: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.Base64: data DecIncData i
+ Codec.Binary.Base64: data DecIncRes i
+ Codec.Binary.Base64: data EncIncData
+ Codec.Binary.Base64: data EncIncRes i
+ Codec.Binary.Base64: decodeInc :: DecIncData String -> DecIncRes String
+ Codec.Binary.Base64: encodeInc :: EncIncData -> EncIncRes String
+ Codec.Binary.Base64Url: DChunk :: i -> DecIncData i
+ Codec.Binary.Base64Url: DDone :: DecIncData i
+ Codec.Binary.Base64Url: DFail :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base64Url: DFinal :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base64Url: DPart :: [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
+ Codec.Binary.Base64Url: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.Base64Url: EDone :: EncIncData
+ Codec.Binary.Base64Url: EFinal :: i -> EncIncRes i
+ Codec.Binary.Base64Url: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.Base64Url: data DecIncData i
+ Codec.Binary.Base64Url: data DecIncRes i
+ Codec.Binary.Base64Url: data EncIncData
+ Codec.Binary.Base64Url: data EncIncRes i
+ Codec.Binary.Base64Url: decodeInc :: DecIncData String -> DecIncRes String
+ Codec.Binary.Base64Url: encodeInc :: EncIncData -> EncIncRes String
+ Codec.Binary.Base85: DChunk :: i -> DecIncData i
+ Codec.Binary.Base85: DDone :: DecIncData i
+ Codec.Binary.Base85: DFail :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base85: DFinal :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Base85: DPart :: [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
+ Codec.Binary.Base85: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.Base85: EDone :: EncIncData
+ Codec.Binary.Base85: EFinal :: i -> EncIncRes i
+ Codec.Binary.Base85: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.Base85: data DecIncData i
+ Codec.Binary.Base85: data DecIncRes i
+ Codec.Binary.Base85: data EncIncData
+ Codec.Binary.Base85: data EncIncRes i
+ Codec.Binary.Base85: decodeInc :: DecIncData String -> DecIncRes String
+ Codec.Binary.Base85: encodeInc :: EncIncData -> EncIncRes String
+ Codec.Binary.PythonString: DChunk :: i -> DecIncData i
+ Codec.Binary.PythonString: DDone :: DecIncData i
+ Codec.Binary.PythonString: DFail :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.PythonString: DFinal :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.PythonString: DPart :: [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
+ Codec.Binary.PythonString: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.PythonString: EDone :: EncIncData
+ Codec.Binary.PythonString: EFinal :: i -> EncIncRes i
+ Codec.Binary.PythonString: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.PythonString: data DecIncData i
+ Codec.Binary.PythonString: data DecIncRes i
+ Codec.Binary.PythonString: data EncIncData
+ Codec.Binary.PythonString: data EncIncRes i
+ Codec.Binary.PythonString: decodeInc :: DecIncData String -> DecIncRes String
+ Codec.Binary.PythonString: encodeInc :: EncIncData -> EncIncRes String
+ Codec.Binary.QuotedPrintable: DChunk :: i -> DecIncData i
+ Codec.Binary.QuotedPrintable: DDone :: DecIncData i
+ Codec.Binary.QuotedPrintable: DFail :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.QuotedPrintable: DFinal :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.QuotedPrintable: DPart :: [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
+ Codec.Binary.QuotedPrintable: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.QuotedPrintable: EDone :: EncIncData
+ Codec.Binary.QuotedPrintable: EFinal :: i -> EncIncRes i
+ Codec.Binary.QuotedPrintable: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.QuotedPrintable: data DecIncData i
+ Codec.Binary.QuotedPrintable: data DecIncRes i
+ Codec.Binary.QuotedPrintable: data EncIncData
+ Codec.Binary.QuotedPrintable: data EncIncRes i
+ Codec.Binary.QuotedPrintable: decodeInc :: DecIncData String -> DecIncRes String
+ Codec.Binary.QuotedPrintable: encodeInc :: EncIncData -> EncIncRes String
+ Codec.Binary.Url: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.Url: EDone :: EncIncData
+ Codec.Binary.Url: EFinal :: i -> EncIncRes i
+ Codec.Binary.Url: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.Url: data DecIncData i
+ Codec.Binary.Url: data DecIncRes i
+ Codec.Binary.Url: data EncIncData
+ Codec.Binary.Url: data EncIncRes i
+ Codec.Binary.Url: decodeInc :: DecIncData String -> DecIncRes String
+ Codec.Binary.Url: encodeInc :: EncIncData -> EncIncRes String
+ Codec.Binary.Uu: DChunk :: i -> DecIncData i
+ Codec.Binary.Uu: DDone :: DecIncData i
+ Codec.Binary.Uu: DFail :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Uu: DFinal :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Uu: DPart :: [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
+ Codec.Binary.Uu: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.Uu: EDone :: EncIncData
+ Codec.Binary.Uu: EFinal :: i -> EncIncRes i
+ Codec.Binary.Uu: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.Uu: data DecIncData i
+ Codec.Binary.Uu: data DecIncRes i
+ Codec.Binary.Uu: data EncIncData
+ Codec.Binary.Uu: data EncIncRes i
+ Codec.Binary.Uu: decodeInc :: DecIncData String -> DecIncRes String
+ Codec.Binary.Uu: encodeInc :: EncIncData -> EncIncRes String
+ Codec.Binary.Xx: DChunk :: i -> DecIncData i
+ Codec.Binary.Xx: DDone :: DecIncData i
+ Codec.Binary.Xx: DFail :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Xx: DFinal :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Xx: DPart :: [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
+ Codec.Binary.Xx: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.Xx: EDone :: EncIncData
+ Codec.Binary.Xx: EFinal :: i -> EncIncRes i
+ Codec.Binary.Xx: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.Xx: data DecIncData i
+ Codec.Binary.Xx: data DecIncRes i
+ Codec.Binary.Xx: data EncIncData
+ Codec.Binary.Xx: data EncIncRes i
+ Codec.Binary.Xx: decodeInc :: DecIncData String -> DecIncRes String
+ Codec.Binary.Xx: encodeInc :: EncIncData -> EncIncRes String
+ Codec.Binary.Yenc: DChunk :: i -> DecIncData i
+ Codec.Binary.Yenc: DDone :: DecIncData i
+ Codec.Binary.Yenc: DFail :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Yenc: DFinal :: [Word8] -> i -> DecIncRes i
+ Codec.Binary.Yenc: DPart :: [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
+ Codec.Binary.Yenc: EChunk :: [Word8] -> EncIncData
+ Codec.Binary.Yenc: EDone :: EncIncData
+ Codec.Binary.Yenc: EFinal :: i -> EncIncRes i
+ Codec.Binary.Yenc: EPart :: i -> (EncIncData -> EncIncRes i) -> EncIncRes i
+ Codec.Binary.Yenc: data DecIncData i
+ Codec.Binary.Yenc: data DecIncRes i
+ Codec.Binary.Yenc: data EncIncData
+ Codec.Binary.Yenc: data EncIncRes i
+ Codec.Binary.Yenc: decodeInc :: DecIncData [Word8] -> DecIncRes [Word8]
+ Codec.Binary.Yenc: encodeInc :: EncIncData -> EncIncRes [Word8]
Files
- dataenc.cabal +5/−4
- src/Codec/Binary/Base16.hs +41/−21
- src/Codec/Binary/Base32.hs +81/−37
- src/Codec/Binary/Base32Hex.hs +81/−37
- src/Codec/Binary/Base64.hs +65/−33
- src/Codec/Binary/Base64Url.hs +95/−23
- src/Codec/Binary/Base85.hs +79/−42
- src/Codec/Binary/DataEncoding.hs +0/−13
- src/Codec/Binary/PythonString.hs +49/−26
- src/Codec/Binary/QuotedPrintable.hs +43/−21
- src/Codec/Binary/Url.hs +44/−20
- src/Codec/Binary/Util.hs +41/−0
- src/Codec/Binary/Uu.hs +62/−33
- src/Codec/Binary/Xx.hs +61/−31
- src/Codec/Binary/Yenc.hs +37/−18
- test-src/DataencQC.hs +5/−31
- test-src/DataencUT.hs +79/−144
- test-src/Test.hs +1/−4
dataenc.cabal view
@@ -1,5 +1,5 @@ name: dataenc-version: 0.13.0.5+version: 0.14 license: BSD3 license-file: LICENSE cabal-version: >= 1.6@@ -7,7 +7,7 @@ author: Magnus Therning maintainer: magnus@therning.org homepage: http://www.haskell.org/haskellwiki/Library/Data_encoding-copyright: Magnus Therning, 2007-2009+copyright: Magnus Therning, 2007-2011 category: Codec synopsis: Data encoding library description: Data encoding library currently providing Base16, Base32,@@ -42,9 +42,10 @@ executable tests main-is: Test.hs hs-source-dirs: test-src src- ghc-options: -fhpc+ -- ghc-options: -fhpc if flag(BuildTests) build-depends: test-framework, test-framework-hunit, HUnit,- test-framework-quickcheck2, QuickCheck == 2.1.*+ test-framework-quickcheck2, QuickCheck ==2.1.*,+ test-framework-th else buildable: False
src/Codec/Binary/Base16.hs view
@@ -8,13 +8,20 @@ -- Further documentation and information can be found at -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.Base16- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData(..)+ , DecIncRes(..)+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import Control.Monad import Data.Array import Data.Bits@@ -38,29 +45,42 @@ decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] -- {{{1 encode+-- | Incremental encoder function.+encodeInc :: EncIncData -> EncIncRes String+encodeInc EDone = EFinal []+encodeInc (EChunk os) = EPart (concat $ map toHex os) encodeInc+ -- | Encode data.-encode :: [Word8]- -> String-encode os = let- splitOctet o = [ o `shiftR` 4, o .&. 0xf ]- in map (encodeArray !) $ foldr ((++) . splitOctet) [] os+encode :: [Word8] -> String+encode = encoder encodeInc -- {{{1 decode--- | Decode data (lazy).-decode' :: String- -> [Maybe Word8]-decode' = let- dec [] = []- dec (Just o1 : Just o2 : os) =- Just (o1 `shiftL` 4 .|. o2) : dec os- dec _ = [Nothing]- in- dec . map (flip M.lookup decodeMap)+-- | Incremental decoder function.+decodeInc :: DecIncData String -> DecIncRes String+decodeInc d = dI [] d+ where+ dec2 cs = let+ ds = map (flip M.lookup decodeMap) cs+ es@[e1, e2] = map fromJust ds+ o = e1 `shiftL` 4 .|. e2+ allJust = and . map isJust+ in if allJust ds+ then Just o+ else Nothing --- | Decode data (strict).-decode :: String- -> Maybe [Word8]-decode = sequence . decode'+ dI [] DDone = DFinal [] []+ dI lo DDone = DFail [] lo+ dI lo (DChunk s) = doDec [] (lo ++ s)+ where+ doDec acc s'@(c1:c2:cs) = maybe+ (DFail acc s')+ (\ b -> doDec (acc ++ [b]) cs)+ (dec2 [c1, c2])+ doDec acc s = DPart acc (dI s)++-- | Decode data.+decode :: String -> Maybe [Word8]+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts.
src/Codec/Binary/Base32.hs view
@@ -9,13 +9,20 @@ -- Further documentation and information can be found at -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.Base32- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData(..)+ , DecIncRes(..)+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import Control.Monad import Data.Array import Data.Bits@@ -42,17 +49,12 @@ decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] -- {{{1 encode--- | Encode data.-encode :: [Word8]- -> String-encode = let- pad n = replicate n 0- enc [] = ""- enc l@[o] = (++ "======") . take 2 . enc $ l ++ pad 4- enc l@[o1, o2] = (++ "====") . take 4 . enc $ l ++ pad 3- enc l@[o1, o2, o3] = (++ "===") . take 5 . enc $ l ++ pad 2- enc l@[o1, o2, o3, o4] = (++ "=") . take 7 . enc $ l ++ pad 1- enc (o1 : o2 : o3 : o4 : o5 : os) = let+-- | Incremental encoder function.+encodeInc :: EncIncData -> EncIncRes String+encodeInc e = eI [] e+ where+ enc5 [o1, o2, o3, o4, o5] = map (encodeArray !) [i1, i2, i3, i4, i5, i6, i7, i8]+ where i1 = o1 `shiftR` 3 i2 = (o1 `shiftL` 2 .|. o2 `shiftR` 6) .&. 0x1f i3 = o2 `shiftR` 1 .&. 0x1f@@ -61,35 +63,77 @@ i6 = o4 `shiftR` 2 .&. 0x1f i7 = (o4 `shiftL` 3 .|. o5 `shiftR` 5) .&. 0x1f i8 = o5 .&. 0x1f- in foldr ((:) . (encodeArray !)) "" [i1, i2, i3, i4, i5, i6, i7, i8] ++ enc os- in enc + eI [] EDone = EFinal []+ eI [o1] EDone = EFinal (take 2 cs ++ "======")+ where+ cs = enc5 [o1, 0, 0, 0, 0]+ eI [o1, o2] EDone = EFinal (take 4 cs ++ "====")+ where+ cs = enc5 [o1, o2, 0, 0, 0]+ eI [o1, o2, o3] EDone = EFinal (take 5 cs ++ "===")+ where+ cs = enc5 [o1, o2, o3, 0, 0]+ eI [o1, o2, o3, o4] EDone = EFinal (take 7 cs ++ "=")+ where+ cs = enc5 [o1, o2, o3, o4, 0]+ eI lo (EChunk bs) = doEnc [] (lo ++ bs)+ where+ doEnc acc (o1:o2:o3:o4:o5:os) = doEnc (acc ++ enc5 [o1, o2, o3, o4, o5]) os+ doEnc acc os = EPart acc (eI os)++-- | Encode data.+encode :: [Word8] -> String+encode = encoder encodeInc+ -- {{{1 decode--- | Decode data (lazy).-decode' :: String- -> [Maybe Word8]-decode' = let- pad n = replicate n $ Just 0- dec [] = []- dec l@[Just eo1, Just eo2] = take 1 . dec $ l ++ pad 6- dec l@[Just eo1, Just eo2, Just eo3, Just eo4] = take 2 . dec $ l ++ pad 4- dec l@[Just eo1, Just eo2, Just eo3, Just eo4, Just eo5] = take 3 . dec $ l ++ pad 3- dec l@[Just eo1, Just eo2, Just eo3, Just eo4, Just eo5, Just eo6, Just eo7] = take 4 . dec $ l ++ pad 1- dec (Just eo1 : Just eo2 : Just eo3 : Just eo4 : Just eo5 : Just eo6 : Just eo7 : Just eo8 : eos) = let- o1 = eo1 `shiftL` 3 .|. eo2 `shiftR` 2- o2 = eo2 `shiftL` 6 .|. eo3 `shiftL` 1 .|. eo4 `shiftR` 4- o3 = eo4 `shiftL` 4 .|. eo5 `shiftR` 1- o4 = eo5 `shiftL` 7 .|. eo6 `shiftL` 2 .|. eo7 `shiftR` 3- o5 = eo7 `shiftL` 5 .|. eo8- in Just o1 : Just o2 : Just o3 : Just o4 : Just o5 : dec eos- dec _ = [Nothing]- in- dec . map (flip M.lookup decodeMap) . takeWhile (/= '=')+-- | Incremental decoder function.+decodeInc :: DecIncData String -> DecIncRes String+decodeInc d = dI [] d+ where+ dec8 cs = let+ ds = map (flip M.lookup decodeMap) cs+ es@[e1, e2, e3, e4, e5, e6, e7, e8] = map fromJust ds+ o1 = e1 `shiftL` 3 .|. e2 `shiftR` 2+ o2 = e2 `shiftL` 6 .|. e3 `shiftL` 1 .|. e4 `shiftR` 4+ o3 = e4 `shiftL` 4 .|. e5 `shiftR` 1+ o4 = e5 `shiftL` 7 .|. e6 `shiftL` 2 .|. e7 `shiftR` 3+ o5 = e7 `shiftL` 5 .|. e8+ allJust = and . map isJust+ in if allJust ds+ then Just [o1, o2, o3, o4, o5]+ else Nothing --- | Decode data (strict).+ dI [] DDone = DFinal [] []+ dI lo DDone = DFail [] lo+ dI lo (DChunk s) = doDec [] (lo ++ s)+ where+ doDec acc s@(c1:c2:'=':'=':'=':'=':'=':'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 1 bs) cs)+ (dec8 [c1, c2, 'A', 'A', 'A', 'A', 'A', 'A'])+ doDec acc s@(c1:c2:c3:c4:'=':'=':'=':'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 2 bs) cs)+ (dec8 [c1, c2, c3, c4, 'A', 'A', 'A', 'A'])+ doDec acc s@(c1:c2:c3:c4:c5:'=':'=':'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 3 bs) cs)+ (dec8 [c1, c2, c3, c4, c5, 'A', 'A', 'A'])+ doDec acc s@(c1:c2:c3:c4:c5:c6:c7:'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 4 bs) cs)+ (dec8 [c1, c2, c3, c4, c5, c6, c7, 'A'])+ doDec acc s@(c1:c2:c3:c4:c5:c6:c7:c8:cs) = maybe+ (DFail acc s)+ (\ bs -> doDec (acc ++ bs) cs)+ (dec8 [c1, c2, c3, c4, c5, c6, c7, c8])+ doDec acc s = DPart acc (dI s)++-- | Decode data. decode :: String -> Maybe [Word8]-decode = sequence . decode'+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts.
src/Codec/Binary/Base32Hex.hs view
@@ -9,13 +9,20 @@ -- Further documentation and information can be found at -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.Base32Hex- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData(..)+ , DecIncRes(..)+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import Control.Monad import Data.Array import Data.Bits@@ -44,17 +51,12 @@ decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] -- {{{1 encode--- | Encode data.-encode :: [Word8]- -> String-encode = let- pad n = replicate n 0- enc [] = ""- enc l@[o] = (++ "======") . take 2 . enc $ l ++ pad 4- enc l@[o1, o2] = (++ "====") . take 4 . enc $ l ++ pad 3- enc l@[o1, o2, o3] = (++ "===") . take 5 . enc $ l ++ pad 2- enc l@[o1, o2, o3, o4] = (++ "=") . take 7 . enc $ l ++ pad 1- enc (o1 : o2 : o3 : o4 : o5 : os) = let+-- | Incremental encoder function.+encodeInc :: EncIncData -> EncIncRes String+encodeInc e = eI [] e+ where+ enc5 [o1, o2, o3, o4, o5] = map (encodeArray !) [i1, i2, i3, i4, i5, i6, i7, i8]+ where i1 = o1 `shiftR` 3 i2 = (o1 `shiftL` 2 .|. o2 `shiftR` 6) .&. 0x1f i3 = o2 `shiftR` 1 .&. 0x1f@@ -63,35 +65,77 @@ i6 = o4 `shiftR` 2 .&. 0x1f i7 = (o4 `shiftL` 3 .|. o5 `shiftR` 5) .&. 0x1f i8 = o5 .&. 0x1f- in foldr ((:) . (encodeArray !)) "" [i1, i2, i3, i4, i5, i6, i7, i8] ++ enc os- in enc + eI [] EDone = EFinal []+ eI [o1] EDone = EFinal (take 2 cs ++ "======")+ where+ cs = enc5 [o1, 0, 0, 0, 0]+ eI [o1, o2] EDone = EFinal (take 4 cs ++ "====")+ where+ cs = enc5 [o1, o2, 0, 0, 0]+ eI [o1, o2, o3] EDone = EFinal (take 5 cs ++ "===")+ where+ cs = enc5 [o1, o2, o3, 0, 0]+ eI [o1, o2, o3, o4] EDone = EFinal (take 7 cs ++ "=")+ where+ cs = enc5 [o1, o2, o3, o4, 0]+ eI lo (EChunk bs) = doEnc [] (lo ++ bs)+ where+ doEnc acc (o1:o2:o3:o4:o5:os) = doEnc (acc ++ enc5 [o1, o2, o3, o4, o5]) os+ doEnc acc os = EPart acc (eI os)++-- | Encode data.+encode :: [Word8] -> String+encode = encoder encodeInc+ -- {{{1 decode--- | Decode data (lazy).-decode' :: String- -> [Maybe Word8]-decode' = let- pad n = replicate n $ Just 0- dec [] = []- dec l@[Just eo1, Just eo2] = take 1 . dec $ l ++ pad 6- dec l@[Just eo1, Just eo2, Just eo3, Just eo4] = take 2 . dec $ l ++ pad 4- dec l@[Just eo1, Just eo2, Just eo3, Just eo4, Just eo5] = take 3 . dec $ l ++ pad 3- dec l@[Just eo1, Just eo2, Just eo3, Just eo4, Just eo5, Just eo6, Just eo7] = take 4 . dec $ l ++ pad 1- dec (Just eo1 : Just eo2 : Just eo3 : Just eo4 : Just eo5 : Just eo6 : Just eo7 : Just eo8 : eos) = let- o1 = eo1 `shiftL` 3 .|. eo2 `shiftR` 2- o2 = eo2 `shiftL` 6 .|. eo3 `shiftL` 1 .|. eo4 `shiftR` 4- o3 = eo4 `shiftL` 4 .|. eo5 `shiftR` 1- o4 = eo5 `shiftL` 7 .|. eo6 `shiftL` 2 .|. eo7 `shiftR` 3- o5 = eo7 `shiftL` 5 .|. eo8- in Just o1 : Just o2 : Just o3 : Just o4 : Just o5 : dec eos- dec _ = [Nothing]- in- dec . map (flip M.lookup decodeMap) . takeWhile (/= '=')+-- | Incremental decoder function.+decodeInc :: DecIncData String -> DecIncRes String+decodeInc d = dI [] d+ where+ dec8 cs = let+ ds = map (flip M.lookup decodeMap) cs+ es@[e1, e2, e3, e4, e5, e6, e7, e8] = map fromJust ds+ o1 = e1 `shiftL` 3 .|. e2 `shiftR` 2+ o2 = e2 `shiftL` 6 .|. e3 `shiftL` 1 .|. e4 `shiftR` 4+ o3 = e4 `shiftL` 4 .|. e5 `shiftR` 1+ o4 = e5 `shiftL` 7 .|. e6 `shiftL` 2 .|. e7 `shiftR` 3+ o5 = e7 `shiftL` 5 .|. e8+ allJust = and . map isJust+ in if allJust ds+ then Just [o1, o2, o3, o4, o5]+ else Nothing --- | Decode data (strict).+ dI [] DDone = DFinal [] []+ dI lo DDone = DFail [] lo+ dI lo (DChunk s) = doDec [] (lo ++ s)+ where+ doDec acc s@(c1:c2:'=':'=':'=':'=':'=':'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 1 bs) cs)+ (dec8 [c1, c2, 'A', 'A', 'A', 'A', 'A', 'A'])+ doDec acc s@(c1:c2:c3:c4:'=':'=':'=':'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 2 bs) cs)+ (dec8 [c1, c2, c3, c4, 'A', 'A', 'A', 'A'])+ doDec acc s@(c1:c2:c3:c4:c5:'=':'=':'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 3 bs) cs)+ (dec8 [c1, c2, c3, c4, c5, 'A', 'A', 'A'])+ doDec acc s@(c1:c2:c3:c4:c5:c6:c7:'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 4 bs) cs)+ (dec8 [c1, c2, c3, c4, c5, c6, c7, 'A'])+ doDec acc s@(c1:c2:c3:c4:c5:c6:c7:c8:cs) = maybe+ (DFail acc s)+ (\ bs -> doDec (acc ++ bs) cs)+ (dec8 [c1, c2, c3, c4, c5, c6, c7, c8])+ doDec acc s = DPart acc (dI s)++-- | Decode data. decode :: String -> Maybe [Word8]-decode = sequence . decode'+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts.
src/Codec/Binary/Base64.hs view
@@ -9,13 +9,20 @@ -- Further documentation and information can be found at -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.Base64- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData(..)+ , DecIncRes(..)+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import Control.Monad import Data.Array import Data.Bits@@ -48,44 +55,69 @@ decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] -- {{{1 encode--- | Encode data.-encode :: [Word8]- -> String-encode = let- pad n = replicate n 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+-- | Incremental encoder function.+encodeInc :: EncIncData -> EncIncRes String+encodeInc e = eI [] e+ where+ enc3 [o1, o2, o3] = cs+ where 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 ((:) . (encodeArray !)) "" [i1, i2, i3, i4] ++ enc os- in enc+ cs = map (encodeArray !) [i1, i2, i3, i4] + eI [] EDone = EFinal []+ eI [o1] EDone = EFinal (take 2 cs ++ "==")+ where cs = enc3 [o1, 0, 0]+ eI [o1, o2] EDone = EFinal (take 3 cs ++ "=")+ where cs = enc3 [o1, o2, 0]+ eI lo (EChunk bs) = doEnc [] (lo ++ bs)+ where+ doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os+ doEnc acc os = EPart acc (eI os)++-- | Encode data.+encode :: [Word8] -> String+encode = encoder encodeInc+ -- {{{1 decode--- | Decode data (lazy).-decode' :: String- -> [Maybe Word8]-decode' = let- pad n = replicate n $ 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) . takeWhile (/= '=')+-- | Incremental decoder function.+decodeInc :: DecIncData String -> DecIncRes String+decodeInc d = dI [] d+ where+ dec4 cs = let+ ds = map (flip M.lookup decodeMap) cs+ es@[e1, e2, e3, e4] = map fromJust ds+ o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4+ o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2+ o3 = e3 `shiftL` 6 .|. e4+ allJust = and . map isJust+ in if allJust ds+ then Just [o1, o2, o3]+ else Nothing --- | Decode data (strict).-decode :: String- -> Maybe [Word8]-decode = sequence . decode'+ dI [] DDone = DFinal [] []+ dI lo DDone = DFail [] lo+ dI lo (DChunk s) = doDec [] (lo ++ s)+ where+ doDec acc s@(c1:c2:'=':'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 1 bs) cs)+ (dec4 [c1, c2, 'A', 'A'])+ doDec acc s@(c1:c2:c3:'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 2 bs) cs)+ (dec4 [c1, c2, c3, 'A'])+ doDec acc s@(c1:c2:c3:c4:cs) = maybe+ (DFail acc s)+ (\ bs -> doDec (acc ++ bs) cs)+ (dec4 [c1, c2, c3, c4])+ doDec acc s = DPart acc (dI s)++-- | Decode data.+decode :: String -> Maybe [Word8]+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts.
src/Codec/Binary/Base64Url.hs view
@@ -8,44 +8,116 @@ -- Further documentation and information can be found at -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.Base64Url- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData(..)+ , DecIncRes(..)+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import Data.Maybe import Data.Word+import Data.Bits+import Data.Array+import qualified Data.Map as M import qualified Codec.Binary.Base64 as Base64 +-- {{{1 enc/dec map+_encMap =+ [ (0, 'A'), (1, 'B'), (2, 'C'), (3, 'D'), (4, 'E')+ , (5, 'F') , (6, 'G'), (7, 'H'), (8, 'I'), (9, 'J')+ , (10, 'K'), (11, 'L'), (12, 'M'), (13, 'N'), (14, 'O')+ , (15, 'P'), (16, 'Q'), (17, 'R'), (18, 'S'), (19, 'T')+ , (20, 'U'), (21, 'V'), (22, 'W'), (23, 'X'), (24, 'Y')+ , (25, 'Z'), (26, 'a'), (27, 'b'), (28, 'c'), (29, 'd')+ , (30, 'e'), (31, 'f'), (32, 'g'), (33, 'h'), (34, 'i')+ , (35, 'j'), (36, 'k'), (37, 'l'), (38, 'm'), (39, 'n')+ , (40, 'o'), (41, 'p'), (42, 'q'), (43, 'r'), (44, 's')+ , (45, 't'), (46, 'u'), (47, 'v'), (48, 'w'), (49, 'x')+ , (50, 'y'), (51, 'z'), (52, '0'), (53, '1'), (54, '2')+ , (55, '3'), (56, '4'), (57, '5'), (58, '6'), (59, '7')+ , (60, '8'), (61, '9'), (62, '-'), (63, '_') ]++-- {{{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+-- | Incremental encoder function.+encodeInc :: EncIncData -> EncIncRes String+encodeInc e = eI [] e+ where+ enc3 [o1, o2, o3] = cs+ where+ i1 = o1 `shiftR` 2+ i2 = (o1 `shiftL` 4 .|. o2 `shiftR` 4) .&. 0x3f+ i3 = (o2 `shiftL` 2 .|. o3 `shiftR` 6) .&. 0x3f+ i4 = o3 .&. 0x3f+ cs = map (encodeArray !) [i1, i2, i3, i4]++ eI [] EDone = EFinal []+ eI [o1] EDone = EFinal (take 2 cs ++ "==")+ where cs = enc3 [o1, 0, 0]+ eI [o1, o2] EDone = EFinal (take 3 cs ++ "=")+ where cs = enc3 [o1, o2, 0]+ eI lo (EChunk bs) = doEnc [] (lo ++ bs)+ where+ doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os+ doEnc acc os = EPart acc (eI os)+ -- | Encode data.-encode :: [Word8]- -> String-encode os = let- swapUrlChar c = case c of- '+' -> '-'- '/' -> '_'- _ -> c- in map swapUrlChar $ Base64.encode os+encode :: [Word8] -> String+encode = encoder encodeInc -- {{{1 decode--- | Decode data (lazy).-decode' :: String- -> [Maybe Word8]-decode' = let- unSwapUrlChar c = case c of- '-' -> '+'- '_' -> '/'- _ -> c- in Base64.decode' . map unSwapUrlChar+-- | Incremental encoder function.+decodeInc :: DecIncData String -> DecIncRes String+decodeInc d = dI [] d+ where+ dec4 cs = let+ ds = map (flip M.lookup decodeMap) cs+ es@[e1, e2, e3, e4] = map fromJust ds+ o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4+ o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2+ o3 = e3 `shiftL` 6 .|. e4+ allJust = and . map isJust+ in if allJust ds+ then Just [o1, o2, o3]+ else Nothing --- | Decode data (strict).-decode :: String- -> Maybe [Word8]-decode = sequence . decode'+ dI [] (DDone) = DFinal [] []+ dI lo (DDone) = DFail [] lo+ dI lo (DChunk s) = doDec [] (lo ++ s)+ where+ doDec acc s@(c1:c2:'=':'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 1 bs) cs)+ (dec4 [c1, c2, 'A', 'A'])+ doDec acc s@(c1:c2:c3:'=':cs) = maybe+ (DFail acc s)+ (\ bs -> DFinal (acc ++ take 2 bs) cs)+ (dec4 [c1, c2, c3, 'A'])+ doDec acc s@(c1:c2:c3:c4:cs) = maybe+ (DFail acc s)+ (\ bs -> doDec (acc ++ bs) cs)+ (dec4 [c1, c2, c3, c4])+ doDec acc s = DPart acc (dI s)++-- | Decode data.+decode :: String -> Maybe [Word8]+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts.
src/Codec/Binary/Base85.hs view
@@ -8,13 +8,20 @@ -- Further documentation and information can be found at -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.Base85- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData(..)+ , DecIncRes(..)+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import Data.Array import Data.Bits import Data.Char@@ -35,55 +42,85 @@ decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] -- {{{1 encode+-- | Incremental encoder function.+encodeInc :: EncIncData -> EncIncRes String+encodeInc e = eI [] e+ where+ enc4 [0, 0, 0, 0] = "z"+ enc4 [20, 20, 20, 20] = "y"+ enc4 os@[o1, o2, o3, o4] = map (encodeArray !) group+ where+ group2Word32 = foldl (\ a b -> a `shiftL` 8 + fromIntegral b) 0 os+ encodeWord32ToWord8s :: Word32 -> [Word8]+ encodeWord32ToWord8s =+ map (fromIntegral . (`mod` 85)) . take 5 . iterate (`div` 85)+ adjustNReverse = reverse . map (+ 33)+ group = (adjustNReverse .encodeWord32ToWord8s) group2Word32++ eI [] EDone = EFinal []+ eI [o1] EDone = EFinal (take 2 cs)+ where+ cs = enc4 [o1, 0, 0, 1]+ eI [o1, o2] EDone = EFinal (take 3 cs)+ where+ cs = enc4 [o1, o2, 0, 1]+ eI [o1, o2, o3] EDone = EFinal (take 4 cs)+ where+ cs = enc4 [o1, o2, o3, 1]+ eI lo (EChunk bs) = doEnc [] (lo ++ bs)+ where+ doEnc acc (o1:o2:o3:o4:os) = doEnc (acc ++ enc4 [o1, o2, o3, o4]) os+ doEnc acc os = EPart acc (eI os)+ -- | Encode data. -- -- The result will not be enclosed in \<~ ~\>.-encode :: [Word8]- -> String-encode [] = ""-encode [b1] = take 2 $ encode [b1, 0, 0, 1]-encode [b1, b2] = take 3 $ encode [b1, b2, 0, 1]-encode [b1, b2, b3] = take 4 $ encode [b1, b2, b3, 1]-encode (0 : 0 : 0 : 0 : bs) = 'z' : encode bs-encode (b1 : b2 : b3 : b4 : bs) = foldr ((:) . (encodeArray !)) "" group ++ encode bs- where- group2Word32 :: Word32- group2Word32 = foldl (\ a b -> a `shiftL` 8 + fromIntegral b) 0 [b1, b2, b3, b4]- encodeWord32ToWord8s :: Word32 -> [Word8]- encodeWord32ToWord8s = map (fromIntegral . (`mod` 85)) . take 5 . iterate (`div` 85)- adjustNReverse = reverse . map (+ 33)- group = (adjustNReverse .encodeWord32ToWord8s) group2Word32+encode :: [Word8] -> String+encode = encoder encodeInc -- {{{1 decode--- | Decode data (lazy).------ The input must not be enclosed in \<~ ~\>.-decode' :: String- -> [Maybe Word8]-decode' [] = []-decode' ('z' : cs) = Just 0 : Just 0 : Just 0 : Just 0 : decode' cs-decode' cs = let- pad n = replicate n $ Just 0- dec :: [Maybe Word8] -> [Maybe Word8]- dec l@[Just c1, Just c2] = take 1 . dec $ l ++ pad 3- dec l@[Just c1, Just c2, Just c3] = take 2 . dec $ l ++ pad 2- 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]- group2Word32 :: [Word8] -> Word32+-- | Incremental decoder function.+decodeInc :: DecIncData String -> DecIncRes String+decodeInc d = dI [] d+ where+ dec5 cs = let+ ds = map (flip M.lookup decodeMap) cs+ es@[e1, e2, e3, e4, e5] = map fromJust ds+ adjRev = map (\ i -> i - 33) [e5, e4, e3, e2, e1] group2Word32 = foldl1 (+) . zipWith (*) (map (85 ^) [0..4]) . map fromIntegral- word32ToGroup :: Word32 -> [Maybe Word8]- word32ToGroup = map (Just . 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)+ word32ToGroup :: Word32 -> [Word8]+ word32ToGroup = map fromIntegral . reverse . take 4 . iterate (`div` 256)+ allJust = and . map isJust+ in if allJust ds+ then Just $ word32ToGroup $ group2Word32 adjRev+ else Nothing --- | Decode data (strict).+ dI lo (DChunk s) = doDec [] (lo ++ s)+ dI [] DDone = DFinal [] []+ dI cs@[c1, c2] DDone = case doDec [] (cs ++ "uuu") of+ (DPart r _) -> DFinal (take 1 r) []+ f -> f+ dI cs@[c1, c2, c3] DDone = case doDec [] (cs ++ "uu") of+ (DPart r _) -> DFinal (take 2 r) []+ f -> f+ dI cs@[c1, c2, c3, c4] DDone = case doDec [] (cs ++ "u") of+ (DPart r _) -> DFinal (take 3 r) []+ f -> f+ dI lo DDone = DFail [] lo++ doDec acc ('z':cs) = doDec (acc ++ [0, 0, 0, 0]) cs+ doDec acc ('y':cs) = doDec (acc ++ [20, 20, 20, 20]) cs+ doDec acc s@(c1:c2:c3:c4:c5:cs) = maybe+ (DFail acc s)+ (\ bs -> doDec (acc ++ bs) cs)+ (dec5 [c1, c2, c3, c4, c5])+ doDec acc cs = DPart acc (dI cs)++-- | Decode data. -- -- The input must not be enclosed in \<~ ~\>.-decode :: String- -> Maybe [Word8]-decode = sequence . decode'+decode :: String -> Maybe [Word8]+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts.
src/Codec/Binary/DataEncoding.hs view
@@ -19,7 +19,6 @@ , base85 , chop , decode- , decode' , encode , py , qp@@ -49,7 +48,6 @@ data DataCodec = DataCodec { encode :: [Word8] -> String, decode :: String -> Maybe [Word8],- decode' :: String -> [Maybe Word8], chop :: Int -> String -> [String], unchop :: [String] -> String }@@ -61,7 +59,6 @@ base16 = DataCodec { encode=Base16.encode, decode=Base16.decode,- decode'=Base16.decode', chop=Base16.chop, unchop=Base16.unchop }@@ -73,7 +70,6 @@ base32 = DataCodec { encode=Base32.encode, decode=Base32.decode,- decode'=Base32.decode', chop=Base32.chop, unchop=Base32.unchop }@@ -85,7 +81,6 @@ base32Hex = DataCodec { encode=Base32Hex.encode, decode=Base32Hex.decode,- decode'=Base32Hex.decode', chop=Base32Hex.chop, unchop=Base32Hex.unchop }@@ -97,7 +92,6 @@ base64 = DataCodec { encode=Base64.encode, decode=Base64.decode,- decode'=Base64.decode', chop=Base64.chop, unchop=Base64.unchop }@@ -109,7 +103,6 @@ base64Url = DataCodec { encode=Base64Url.encode, decode=Base64Url.decode,- decode'=Base64Url.decode', chop=Base64Url.chop, unchop=Base64Url.unchop }@@ -121,7 +114,6 @@ base85 = DataCodec { encode=Base85.encode, decode=Base85.decode,- decode'=Base85.decode', chop=Base85.chop, unchop=Base85.unchop }@@ -133,7 +125,6 @@ uu = DataCodec { encode=Uu.encode, decode=Uu.decode,- decode'=Uu.decode', chop=Uu.chop, unchop=Uu.unchop }@@ -145,7 +136,6 @@ xx = DataCodec { encode=Xx.encode, decode=Xx.decode,- decode'=Xx.decode', chop=Xx.chop, unchop=Xx.unchop }@@ -157,7 +147,6 @@ qp = DataCodec { encode = QP.encode , decode = QP.decode- , decode' = QP.decode' , chop = QP.chop , unchop = QP.unchop }@@ -169,7 +158,6 @@ py = DataCodec { encode = Py.encode , decode = Py.decode- , decode' = Py.decode' , chop = Py.chop , unchop = Py.unchop }@@ -181,7 +169,6 @@ url = DataCodec { encode = Url.encode , decode = Url.decode- , decode' = Url.decode' , chop = Url.chop , unchop = Url.unchop }
src/Codec/Binary/PythonString.hs view
@@ -27,46 +27,69 @@ -- Further documentation and information can be found at -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.PythonString- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData(..)+ , DecIncRes(..)+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import Data.Char+import Data.Maybe import Data.Word -import Codec.Binary.Util- -- {{{1 encode+-- | Incremental encoder function.+encodeInc :: EncIncData -> EncIncRes String+encodeInc e = eI e+ where+ enc [] = []+ enc (o:os)+ | o < 0x20 || o > 0x7e = ('\\' : 'x' : toHex o) ++ enc os+ | o == 34 = "\\\"" ++ enc os+ | o == 39 = "\\'" ++ enc os+ | o == 92 = "\\\\" ++ enc os+ | otherwise = chr (fromIntegral o) : enc os++ eI EDone = EFinal []+ eI (EChunk bs) = EPart (enc bs) encodeInc+ -- | 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+encode :: [Word8] -> String+encode = encoder encodeInc -- {{{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]+-- | Incremental decoder function.+decodeInc :: DecIncData String -> DecIncRes String+decodeInc d = dI [] d+ where+ dI [] DDone = DFinal [] []+ dI lo DDone = DFail [] lo+ dI lo (DChunk s) = doDec [] (lo ++ s)+ where+ doDec acc [] = DPart acc (dI [])+ doDec acc s'@('\\':'x':c0:c1:cs) = let+ o = fromHex [c0, c1]+ in if isJust o+ then doDec (acc ++ [fromJust o]) cs+ else DFail acc s'+ doDec acc s'@('\\':'\\':cs) = doDec (acc ++ [fromIntegral $ ord '\\']) cs+ doDec acc s'@('\\':'\'':cs) = doDec (acc ++ [fromIntegral $ ord '\'']) cs+ doDec acc s'@('\\':'\"':cs) = doDec (acc ++ [fromIntegral $ ord '\"']) cs+ doDec acc s'@(c:cs)+ | c /= '\\' = doDec (acc ++ [fromIntegral $ ord c]) cs+ | otherwise = DPart acc (dI s') --- | Decode data (strict).+-- | Decode data. decode :: String -> Maybe [Word8]-decode = sequence . decode'+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts.
src/Codec/Binary/QuotedPrintable.hs view
@@ -14,41 +14,63 @@ -- Further documentation and information can be found at -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.QuotedPrintable- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData(..)+ , DecIncRes(..)+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import Data.Char+import Data.Maybe 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+-- | Incremental encoder function.+encodeInc :: EncIncData -> EncIncRes String+encodeInc e = eI e+ where+ enc [] = []+ enc (o:os)+ | o < 33 || o == 61 || o > 126 = ('=' : toHex o) ++ enc os+ | otherwise = chr (fromIntegral o) : enc os + eI EDone = EFinal []+ eI (EChunk bs) = EPart (enc bs) encodeInc +-- | Encode data.+encode :: [Word8] -> String+encode = encoder encodeInc+ -- {{{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]+-- | Incremental decoder function.+decodeInc :: DecIncData String -> DecIncRes String+decodeInc d = dI [] d+ where+ dI [] DDone = DFinal [] []+ dI lo DDone = DFail [] lo+ dI lo (DChunk s) = doDec [] (lo ++ s)+ where+ doDec acc [] = DPart acc (dI [])+ doDec acc s'@('=':c0:c1:cs) = let+ o = fromHex [c0, c1]+ in if isJust o+ then doDec (acc ++ [fromJust o]) cs+ else DFail acc s'+ doDec acc s'@(c:cs)+ | c /= '=' = doDec (acc ++ [fromIntegral $ ord c]) cs+ | otherwise = DPart acc (dI s') --- | Decode data (strict).+-- | Decode data. decode :: String -> Maybe [Word8]-decode = sequence . decode'+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts.
src/Codec/Binary/Url.hs view
@@ -10,19 +10,26 @@ -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.Url- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData+ , DecIncRes+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import qualified Data.Map as M import Data.Char(ord) import Data.Word(Word8)--import Codec.Binary.Util(toHex,fromHex)+import Data.Maybe(isJust, fromJust) +-- {{{1 enc/dec map _unreservedChars = zip [65..90] "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ++ zip [97..122] "abcdefghijklmnopqrstuvwxyz" ++ zip [48..57] "0123456789"@@ -35,28 +42,45 @@ decodeMap = M.fromList [(b, a) | (a, b) <- _unreservedChars] -- {{{1 encode+-- | Incremental decoder function.+encodeInc :: EncIncData -> EncIncRes String+encodeInc e = eI e+ where+ enc [] = []+ enc (o : os) = case (M.lookup o encodeMap) of+ Just c -> c : enc os+ Nothing -> ('%' : toHex o) ++ enc os++ eI EDone = EFinal []+ eI (EChunk bs) = EPart (enc bs) encodeInc+ -- | 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+encode :: [Word8] -> String+encode = encoder encodeInc -- {{{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]+-- | Incremental decoder function.+decodeInc :: DecIncData String -> DecIncRes String+decodeInc d = dI [] d+ where+ dI [] DDone = DFinal [] []+ dI lo DDone = DFail [] lo+ dI lo (DChunk s) = doDec [] (lo ++ s)+ where+ doDec acc [] = DPart acc (dI [])+ doDec acc s'@('%':c0:c1:cs) = let+ o = fromHex [c0, c1]+ in if isJust o+ then doDec (acc ++ [fromJust o]) cs+ else DFail acc s'+ doDec acc s'@(c:cs)+ | c /= '%' = doDec (acc ++ [fromIntegral $ ord c]) cs+ | otherwise = DPart acc (dI s') --- | Decode data (strict).+-- | Decode data. decode :: String -> Maybe [Word8]-decode = sequence . decode'+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts.
src/Codec/Binary/Util.hs view
@@ -7,6 +7,12 @@ module Codec.Binary.Util ( toHex , fromHex+ , EncIncData(..)+ , EncIncRes(..)+ , DecIncData(..)+ , DecIncRes(..)+ , encoder+ , decoder ) where import Data.Array@@ -39,3 +45,38 @@ in Just o dec _ = Nothing in dec . map (flip M.lookup hexDecodeMap . toUpper)++-- {{{1 incremental coding+-- | Data type for the incremental encoding functions.+data EncIncData = EChunk [Word8] -- ^ a chunk of data to be encoded+ | EDone -- ^ the signal to the encoder that the stream of data is ending++-- | Data type for the result of calling the incremental encoding functions.+data EncIncRes i = EPart i (EncIncData -> EncIncRes i) -- ^ a partial result together with the continuation to use for further encoding+ | EFinal i -- ^ the final result of encoding (the response to 'EDone')++encoder f os = case f (EChunk os) of+ EPart r1 f' -> case f' EDone of+ EFinal r2 -> r1 ++ r2++-- | Data type for the incremental decoding functions.+data DecIncData i = DChunk i -- ^ a chunk of data to be decoded+ | DDone -- ^ the signal to the decoder that the stream of data is ending++-- | Data type for the result of calling the incremental encoding functions.+data DecIncRes i = DPart [Word8] (DecIncData i -> DecIncRes i) -- ^ a partial result together with the continuation to user for further decoding+ | DFinal [Word8] i -- ^ the final result of decoding (the response to 'DDone')+ | DFail [Word8] i -- ^ a partial result for a failed decoding, together with the remainder of the data passed in so far++decoder :: (DecIncData i -> DecIncRes i) -> i -> Maybe [Word8]+decoder f s = let+ d = f (DChunk s)+ in case d of+ DFinal da _ -> Just da+ DFail _ _ -> Nothing+ DPart da f -> let+ d' = f DDone+ in case d' of+ DFinal da' _ -> Just $ da ++ da'+ DFail _ _ -> Nothing+ DPart _ _ -> Nothing -- should never happen
src/Codec/Binary/Uu.hs view
@@ -10,13 +10,20 @@ -- Further documentation and information can be found at -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.Uu- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData(..)+ , DecIncRes(..)+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import Control.Monad import Data.Array import Data.Bits@@ -36,44 +43,66 @@ decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] -- {{{1 encode--- | Encode data.-encode :: [Word8]- -> String-encode = let- pad n = replicate n 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+-- | Incremental encoder function.+encodeInc :: EncIncData -> EncIncRes String+encodeInc e = eI [] e+ where+ enc3 [o1, o2, o3] = map (encodeArray !) [i1, i2, i3, i4]+ where 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 ((:) . (encodeArray !)) "" [i1, i2, i3, i4] ++ enc os- in enc + eI [] EDone = EFinal []+ eI [o1] EDone = EFinal $ take 2 $ enc3 [o1, 0, 0]+ eI [o1, o2] EDone = EFinal $ take 3 $ enc3 [o1, o2, 0]+ eI lo (EChunk bs) = doEnc [] (lo ++ bs)+ where+ doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os+ doEnc acc os = EPart acc (eI os)++-- | Encode data.+encode :: [Word8] -> String+encode = encoder encodeInc+ -- {{{1 decode--- | Decode data (lazy).-decode' :: String- -> [Maybe Word8]-decode' = let- pad n = replicate n $ 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)+-- | Incremental decoder function.+decodeInc :: DecIncData String -> DecIncRes String+decodeInc d = dI [] d+ where+ dec4 cs = let+ ds = map (flip M.lookup decodeMap) cs+ [e1, e2, e3, e4] = map fromJust ds+ o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4+ o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2+ o3 = e3 `shiftL` 6 .|. e4+ allJust = and . map isJust+ in if allJust ds+ then Just [o1, o2, o3]+ else Nothing --- | Decode data (strict).-decode :: String- -> Maybe [Word8]-decode = sequence . decode'+ dI [] DDone = DFinal [] []+ dI lo@[c1, c2] DDone = maybe+ (DFail [] lo)+ (\ bs -> DFinal (take 1 bs) [])+ (dec4 [c1, c2, '`', '`'])+ dI lo@[c1, c2, c3] DDone = maybe+ (DFail [] lo)+ (\ bs -> DFinal (take 2 bs) [])+ (dec4 [c1, c2, c3, '`'])+ dI lo DDone = DFail [] lo+ dI lo (DChunk s) = doDec [] (lo ++ s)+ where+ doDec acc s'@(c1:c2:c3:c4:cs) = maybe+ (DFail acc s')+ (\ bs -> doDec (acc ++ bs) cs)+ (dec4 [c1, c2, c3, c4])+ doDec acc s' = DPart acc (dI s')++-- | Decode data.+decode :: String -> Maybe [Word8]+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts. Each string in the resulting list is prepended
src/Codec/Binary/Xx.hs view
@@ -12,13 +12,20 @@ -- Further documentation and information can be found at -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.Xx- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData(..)+ , DecIncRes(..)+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import Control.Monad import Data.Array import Data.Bits@@ -38,44 +45,67 @@ decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] -- {{{1 encode--- | Encode data.-encode :: [Word8]- -> String-encode = let- pad n = replicate n 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+-- | Incremental encoder function.+encodeInc :: EncIncData -> EncIncRes String+encodeInc e = eI [] e+ where+ enc3 [o1, o2, o3] = map (encodeArray !) [i1, i2, i3, i4]+ where 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 ((:) . (encodeArray !)) "" [i1, i2, i3, i4] ++ enc os- in enc + eI [] EDone = EFinal []+ eI [o1] EDone = EFinal $ take 2 $ enc3 [o1, 0, 0]+ eI [o1, o2] EDone = EFinal $ take 3 $ enc3 [o1, o2, 0]+ eI lo (EChunk bs) = doEnc [] (lo ++ bs)+ where+ doEnc acc (o1:o2:o3:os) = doEnc (acc ++ enc3 [o1, o2, o3]) os+ doEnc acc os = EPart acc (eI os)++-- | Encode data.+encode :: [Word8] -> String+encode = encoder encodeInc+ -- {{{1 decode--- | Decode data (lazy).-decode' :: String- -> [Maybe Word8]-decode' = let- pad n = replicate n $ 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)+-- | Incremental decoder function.+decodeInc :: DecIncData String -> DecIncRes String+decodeInc d = dI [] d+ where+ dec4 cs = let+ ds = map (flip M.lookup decodeMap) cs+ [e1, e2, e3, e4] = map fromJust ds+ o1 = e1 `shiftL` 2 .|. e2 `shiftR` 4+ o2 = e2 `shiftL` 4 .|. e3 `shiftR` 2+ o3 = e3 `shiftL` 6 .|. e4+ allJust = and . map isJust+ in if allJust ds+ then Just [o1, o2, o3]+ else Nothing --- | Decode data (strict).+ dI [] DDone = DFinal [] []+ dI lo@[c1, c2] DDone = maybe+ (DFail [] lo)+ (\ bs -> DFinal (take 1 bs) [])+ (dec4 [c1, c2, '+', '+'])+ dI lo@[c1, c2, c3] DDone = maybe+ (DFail [] lo)+ (\ bs -> DFinal (take 2 bs) [])+ (dec4 [c1, c2, c3, '+'])+ dI lo DDone = DFail [] lo+ dI lo (DChunk s) = doDec [] (lo ++ s)+ where+ doDec acc s'@(c1:c2:c3:c4:cs) = maybe+ (DFail acc s')+ (\ bs -> doDec (acc ++ bs) cs)+ (dec4 [c1, c2, c3, c4])+ doDec acc s' = DPart acc (dI s')++-- | Decode data. decode :: String -> Maybe [Word8]-decode = sequence . decode'+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts. Each string in the resulting list is prepended
src/Codec/Binary/Yenc.hs view
@@ -9,39 +9,58 @@ -- Further documentation and information can be found at -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. module Codec.Binary.Yenc- ( encode+ ( EncIncData(..)+ , EncIncRes(..)+ , encodeInc+ , encode+ , DecIncData(..)+ , DecIncRes(..)+ , decodeInc , decode- , decode' , chop , unchop ) where +import Codec.Binary.Util+ import Data.Word _criticalsIn = [0xd6, 0xe0, 0xe3, 0x13] _equal = 0x3d -- {{{1 encode+-- | Incremental encoder function.+encodeInc :: EncIncData -> EncIncRes [Word8]+encodeInc e = eI e+ where+ enc [] = []+ enc (o:os)+ | o `elem` _criticalsIn = _equal : o + 106 : enc os+ | otherwise = o + 42 : enc os++ eI EDone = EFinal []+ eI (EChunk bs) = EPart (enc bs) encodeInc+ -- | Encode data.-encode :: [Word8]- -> [Word8]-encode (d : ds)- | d `elem` _criticalsIn = _equal : d + 106 : encode ds- | otherwise = d + 42 : encode ds-encode _ = []+encode :: [Word8] -> [Word8]+encode = encoder encodeInc -- {{{1 decode--- | Decode data (lazy).-decode' :: [Word8]- -> [Maybe Word8]-decode' (0x3d : d : ds) = Just (d + 150) : decode' ds-decode' (d : ds) = Just (d + 214) : decode' ds-decode' _ = []+-- | Incremental decoder function.+decodeInc :: DecIncData [Word8] -> DecIncRes [Word8]+decodeInc d = dI [] d+ where+ dI [] DDone = DFinal [] []+ dI lo DDone = DFail [] lo+ dI lo (DChunk s) = doDec [] (lo ++ s)+ where+ doDec acc (0x3d:d:ds) = doDec (acc ++ [d + 150]) ds+ doDec acc (d:ds) = doDec (acc ++ [d + 214]) ds+ doDec acc s' = DPart acc (dI s') --- | Decode data (strict).-decode :: [Word8]- -> Maybe [Word8]-decode = sequence . decode'+-- | Decode data.+decode :: [Word8] -> Maybe [Word8]+decode = decoder decodeInc -- {{{1 chop -- | Chop up a string in parts.
test-src/DataencQC.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -XTemplateHaskell #-}+ {- - Copyright : (c) 2007 Magnus Therning - License : BSD3@@ -6,6 +8,8 @@ module DataencQC where +import Test.Framework.TH+ import Data.Maybe import Data.Word import Test.QuickCheck@@ -137,34 +141,4 @@ 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 "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- ]+allTests = $(testGroupGenerator)
test-src/DataencUT.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -XTemplateHaskell #-} {- - Copyright : (c) 2007 Magnus Therning - License : BSD3@@ -11,27 +12,16 @@ import System.Exit import Data.Maybe import qualified Test.Framework.Providers.API as TFAPI+import Test.Framework.TH 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) = concatMap (unitTest2TFTest' desc) ts- in unitTest2TFTest' "" t-+-- {{{1 checkAssertions+checkAssertions (suite, desc, enc, dec, codec) = do+ enc @=? encode codec dec+ dec @=? fromJust (decode codec enc) -- {{{1 uuencode tests uuTestData =@@ -43,23 +33,19 @@ , ("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+case_uuTests = mapM_ checkAssertions 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])- ]+case_uuTests2 = do+ "EI2" @=? unchop uu (chop uu 1 "EI2")+ "EI3-" @=? unchop uu (chop uu 1 "EI3-")+ "EI3-EE" @=? unchop uu (chop uu 1 "EI3-EE")+ [0..255] @=? fromJust (decode uu $ unchop uu $ chop uu 1 $ encode uu [0..255])+ [0..255] @=? fromJust (decode uu $ unchop uu $ chop uu 61 $ encode uu [0..255])+ [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"- ]+case_uuTestsFail = do+ Nothing @=? decode uu "A"+ Nothing @=? decode uu "aa" -- {{{1 xxencode tests xxTestData =@@ -71,23 +57,19 @@ , ("xx", "AAAA", "EI3-EE", [65, 65, 65, 65], xx) , ("xx", "Example", "FLVVPL-gNE", [69,120,97,109,112,108,101], xx) ]-xxTests = buildTestList xxTestData+case_xxTest = mapM_ checkAssertions 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])- ]+case_xxTests2 = do+ "EI2" @=? unchop xx (chop xx 1 "EI2")+ "EI3-" @=? unchop xx (chop xx 1 "EI3-")+ "EI3-EE" @=? unchop xx (chop xx 1 "EI3-EE")+ [0..255] @=? fromJust (decode xx $ unchop xx $ chop xx 1 $ encode xx [0..255])+ [0..255] @=? fromJust (decode xx $ unchop xx $ chop xx 61 $ encode xx [0..255])+ [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 "''"- ]+case_xxTestsFail = do+ Nothing @=? decode xx "A"+ Nothing @=? decode xx "''" -- {{{1 base85 tests base85TestData =@@ -101,15 +83,16 @@ , ("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)+ , ("base85", "zeros", "z", [0, 0, 0, 0], base85)+ , ("base85", "spaces", "y", [20, 20, 20, 20], base85) ]-base85Tests = buildTestList base85TestData+case_base85Tests = mapM_ checkAssertions 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"- ]+case_base85TestsFail = do+ Nothing @=? decode base85 "A"+ Nothing @=? decode base85 "!z"+ Nothing @=? decode base85 "!z!"+ Nothing @=? decode base85 "!z!z" -- {{{1 base64 tests base64TestData =@@ -124,14 +107,11 @@ , ("base64", "\255", "/w==", [255], base64) , ("base64", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], base64) ]-base64Tests = buildTestList base64TestData+case_base64Tests = mapM_ checkAssertions 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 "!!"- ]+case_base64TestsFail = do+ Nothing @=? decode base64 "A"+ Nothing @=? decode base64 "!!" -- {{{1 base64url tests base64UrlTestData =@@ -140,7 +120,7 @@ , ("base64url", "\255", "_w==", [255], base64Url) , ("base64url", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], base64Url) ]-base64UrlTests = buildTestList base64UrlTestData+case_base64UrlTests = mapM_ checkAssertions base64UrlTestData -- {{{1 base32 tests base32TestData =@@ -152,14 +132,11 @@ , ("base32", "fooba", "MZXW6YTB", [102,111,111,98,97], base32) , ("base32", "foobar", "MZXW6YTBOI======", [102,111,111,98,97,114], base32) ]-base32Tests = buildTestList base32TestData+case_base32Tests = mapM_ checkAssertions 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"- ]+case_base32TestsFail = do+ Nothing @=? decode base32 "A"+ Nothing @=? decode base32 "gh" -- {{{1 base32hex tests base32HexTestData =@@ -171,14 +148,11 @@ , ("base32hex", "fooba", "CPNMUOJ1", [102,111,111,98,97], base32Hex) , ("base32hex", "foobar", "CPNMUOJ1E8======", [102,111,111,98,97,114], base32Hex) ]-base32HexTests = buildTestList base32HexTestData+case_base32HexTests = mapM_ checkAssertions 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"- ]+case_base32HexTestsFail = do+ Nothing @=? decode base32Hex "A"+ Nothing @=? decode base32Hex "gh" -- {{{1 base16 (hex) base16TestData =@@ -190,47 +164,39 @@ , ("base16", "fooba", "666F6F6261", [102,111,111,98,97], base16) , ("base16", "foobar", "666F6F626172", [102,111,111,98,97,114], base16) ]-base16Tests = buildTestList base16TestData+case_base16Tests = mapM_ checkAssertions 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"- ]+case_base16TestsFail = do+ Nothing @=? decode base16 "A"+ 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]- ]+case_yencTests = do+ [] @=? Yenc.encode []+ Just [] @=? Yenc.decode []+ [0x90] @=? Yenc.encode [0x66]+ Just [0x66] @=? Yenc.decode [0x90]+ [0x90, 0x99, 0x99, 0x8c, 0x8b, 0x9c] @=? Yenc.encode [0x66, 0x6f, 0x6f, 0x62, 0x61, 0x72]+ Just [0x66, 0x6f, 0x6f, 0x62, 0x61, 0x72] @=? Yenc.decode [0x90, 0x99, 0x99, 0x8c, 0x8b, 0x9c]+ [0x3d, 0x40, 0x01] @=? Yenc.encode [0xd6, 0xd7]+ Just [0xd6, 0xd7] @=? Yenc.decode [0x3d, 0x40, 0x01]+ [0x3d, 0x40, 0x3d, 0x4a, 0x3d, 0x4d, 0x3d, 0x7d] @=? Yenc.encode [0xd6, 0xe0, 0xe3, 0x13]+ Just [0xd6, 0xe0, 0xe3, 0x13] @=? Yenc.decode [0x3d, 0x40, 0x3d, 0x4a, 0x3d, 0x4d, 0x3d, 0x7d]+ [[0x3d, 0x40], [0x01, 0x3d, 0x4a]] @=? Yenc.chop 2 [0x3d, 0x40, 0x01, 0x3d, 0x4a] -- {{{1 quoted-printable qpTestData = [ ("qp", "empty", "", [], qp) , ("qp", "foo=bar", "foo=3Dbar", [102,111,111,61,98,97,114], qp) ]-qpTests = buildTestList qpTestData+case_qpTests = mapM_ checkAssertions qpTestData -qpTestsSucc = test- [ "qp chop one" ~: ["foo=","=3D=","bar"] ~=? chop qp 4 "foo=3Dbar"- ]+case_qpTestsSucc = do+ ["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"- ]+case_qpTestsFail = do+ Nothing @=? decode qp "=4"+ Nothing @=? decode qp "=G" -- {{{1 python string pyTestData =@@ -238,12 +204,10 @@ , ("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+case_pyTests = mapM_ checkAssertions pyTestData -pyTestsFail = test- [ "py decode bad char after \\" ~: Nothing ~=? decode py "\\z"- , "py decode' bad char after \\" ~: [Nothing] ~=? decode' py "\\z"- ]+case_pyTestsFail = do+ Nothing @=? decode py "\\z" -- {{{1 url encoding urlTestData =@@ -251,40 +215,11 @@ , ("url", "aA", "aA", [97, 65], url) , ("url", "~ ", "~%20", [126, 0x20], url) ]-urlTests = buildTestList urlTestData+case_urlTests = mapM_ checkAssertions 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 "%%"- ]+case_urlTestsFail = do+ Nothing @=? decode url "%ga"+ 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 qpTests- , unitTest2TFTest qpTestsSucc- , unitTest2TFTest qpTestsFail- , unitTest2TFTest pyTests- , unitTest2TFTest pyTestsFail- , unitTest2TFTest urlTests- , unitTest2TFTest urlTestsFail- ]+allTests = $(testGroupGenerator)
test-src/Test.hs view
@@ -11,9 +11,6 @@ import qualified DataencQC as DQC import qualified DataencUT as DUT -tests =- [ testGroup "quickcheck" DQC.allTests- , testGroup "unit test" DUT.allTests- ]+tests = [ DQC.allTests , DUT.allTests ] main = defaultMain tests