packages feed

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 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