diff options
Diffstat (limited to 'src/Codec/Binary/QuotedPrintable.hs')
-rw-r--r-- | src/Codec/Binary/QuotedPrintable.hs | 101 |
1 files changed, 101 insertions, 0 deletions
diff --git a/src/Codec/Binary/QuotedPrintable.hs b/src/Codec/Binary/QuotedPrintable.hs new file mode 100644 index 0000000..c953209 --- /dev/null +++ b/src/Codec/Binary/QuotedPrintable.hs | |||
@@ -0,0 +1,101 @@ | |||
1 | -- | | ||
2 | -- Module : Codec.Binary.QuotedPrintable | ||
3 | -- Copyright : (c) 2009 Magnus Therning | ||
4 | -- License : BSD3 | ||
5 | -- | ||
6 | -- Implementation of Quoted-Printable based on RFC 2045 | ||
7 | -- (<http://tools.ietf.org/html/rfc2045>). | ||
8 | -- | ||
9 | -- This encoding encodes _everything_ that is passed in, it will not try to | ||
10 | -- guess the native line ending for your architecture. In other words, if you | ||
11 | -- are using this to encode text you need to split it into separate lines | ||
12 | -- before encoding and chopping it up. | ||
13 | -- | ||
14 | -- Further documentation and information can be found at | ||
15 | -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. | ||
16 | module Codec.Binary.QuotedPrintable | ||
17 | ( EncIncData(..) | ||
18 | , EncIncRes(..) | ||
19 | , encodeInc | ||
20 | , encode | ||
21 | , DecIncData(..) | ||
22 | , DecIncRes(..) | ||
23 | , decodeInc | ||
24 | , decode | ||
25 | , chop | ||
26 | , unchop | ||
27 | ) where | ||
28 | |||
29 | import Codec.Binary.Util | ||
30 | |||
31 | import Data.Char | ||
32 | import Data.Maybe | ||
33 | import Data.Word | ||
34 | |||
35 | -- {{{1 encode | ||
36 | -- | Incremental encoder function. | ||
37 | encodeInc :: EncIncData -> EncIncRes String | ||
38 | encodeInc e = eI e | ||
39 | where | ||
40 | enc [] = [] | ||
41 | enc (o:os) | ||
42 | | o < 33 || o == 61 || o > 126 = ('=' : toHex o) ++ enc os | ||
43 | | otherwise = chr (fromIntegral o) : enc os | ||
44 | |||
45 | eI EDone = EFinal [] | ||
46 | eI (EChunk bs) = EPart (enc bs) encodeInc | ||
47 | |||
48 | -- | Encode data. | ||
49 | encode :: [Word8] -> String | ||
50 | encode = encoder encodeInc | ||
51 | |||
52 | -- {{{1 decode | ||
53 | -- | Incremental decoder function. | ||
54 | decodeInc :: DecIncData String -> DecIncRes String | ||
55 | decodeInc d = dI [] d | ||
56 | where | ||
57 | dI [] DDone = DFinal [] [] | ||
58 | dI lo DDone = DFail [] lo | ||
59 | dI lo (DChunk s) = doDec [] (lo ++ s) | ||
60 | where | ||
61 | doDec acc [] = DPart acc (dI []) | ||
62 | doDec acc s'@('=':c0:c1:cs) = let | ||
63 | o = fromHex [c0, c1] | ||
64 | in if isJust o | ||
65 | then doDec (acc ++ [fromJust o]) cs | ||
66 | else DFail acc s' | ||
67 | doDec acc s'@(c:cs) | ||
68 | | c /= '=' = doDec (acc ++ [fromIntegral $ ord c]) cs | ||
69 | | otherwise = DPart acc (dI s') | ||
70 | |||
71 | -- | Decode data. | ||
72 | decode :: String -> Maybe [Word8] | ||
73 | decode = decoder decodeInc | ||
74 | |||
75 | -- {{{1 chop | ||
76 | -- | Chop up a string in parts. | ||
77 | chop :: Int -- ^ length of individual lines (values @\< 4@ are ignored) | ||
78 | -> String | ||
79 | -> [String] | ||
80 | chop n "" = [] | ||
81 | chop n s = let | ||
82 | n' = max 3 $ n - 1 | ||
83 | _c i ts "" acc = ts : acc | ||
84 | _c i ts tss@('=' : tss') acc | ||
85 | | i + 2 < n' = _c (i + 1) ('=' : ts) tss' acc | ||
86 | | otherwise = _c 0 "" tss (('=' : ts) : acc) | ||
87 | _c i ts tss@(c : tss') acc | ||
88 | | i < n' = _c (i + 1) (c : ts) tss' acc | ||
89 | | otherwise = _c 0 "" tss (('=' : ts) : acc) | ||
90 | in map reverse . reverse $ _c 0 "" s [] | ||
91 | |||
92 | -- {{{1 unchop | ||
93 | -- | Concatenate the list of strings into one long string. | ||
94 | unchop :: [String] -> String | ||
95 | unchop [] = "" | ||
96 | unchop (s : ss) = let | ||
97 | dropLast = last s == '=' | ||
98 | len = length s | ||
99 | in if dropLast | ||
100 | then take (len - 1) s ++ unchop ss | ||
101 | else s ++ unchop ss | ||