diff options
Diffstat (limited to 'src/Codec/Binary/Base16.hs')
-rw-r--r-- | src/Codec/Binary/Base16.hs | 102 |
1 files changed, 102 insertions, 0 deletions
diff --git a/src/Codec/Binary/Base16.hs b/src/Codec/Binary/Base16.hs new file mode 100644 index 0000000..7faf3a5 --- /dev/null +++ b/src/Codec/Binary/Base16.hs | |||
@@ -0,0 +1,102 @@ | |||
1 | -- | | ||
2 | -- Module : Codec.Binary.Base16 | ||
3 | -- Copyright : (c) 2007 Magnus Therning | ||
4 | -- License : BSD3 | ||
5 | -- | ||
6 | -- Implemented as specified in RFC 4648 (<http://tools.ietf.org/html/rfc4648>). | ||
7 | -- | ||
8 | -- Further documentation and information can be found at | ||
9 | -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. | ||
10 | module Codec.Binary.Base16 | ||
11 | ( EncIncData(..) | ||
12 | , EncIncRes(..) | ||
13 | , encodeInc | ||
14 | , encode | ||
15 | , DecIncData(..) | ||
16 | , DecIncRes(..) | ||
17 | , decodeInc | ||
18 | , decode | ||
19 | , chop | ||
20 | , unchop | ||
21 | ) where | ||
22 | |||
23 | import Codec.Binary.Util | ||
24 | |||
25 | import Control.Monad | ||
26 | import Data.Array | ||
27 | import Data.Bits | ||
28 | import Data.Maybe | ||
29 | import Data.Word | ||
30 | import qualified Data.Map as M | ||
31 | |||
32 | -- {{{1 enc/dec map | ||
33 | _encMap = | ||
34 | [ (0, '0'), (1, '1'), (2, '2'), (3, '3'), (4, '4') | ||
35 | , (5, '5'), (6, '6'), (7, '7'), (8, '8'), (9, '9') | ||
36 | , (10, 'A'), (11, 'B'), (12, 'C'), (13, 'D'), (14, 'E') | ||
37 | , (15, 'F') ] | ||
38 | |||
39 | -- {{{1 encodeArray | ||
40 | encodeArray :: Array Word8 Char | ||
41 | encodeArray = array (0, 64) _encMap | ||
42 | |||
43 | -- {{{1 decodeMap | ||
44 | decodeMap :: M.Map Char Word8 | ||
45 | decodeMap = M.fromList [(snd i, fst i) | i <- _encMap] | ||
46 | |||
47 | -- {{{1 encode | ||
48 | -- | Incremental encoder function. | ||
49 | encodeInc :: EncIncData -> EncIncRes String | ||
50 | encodeInc EDone = EFinal [] | ||
51 | encodeInc (EChunk os) = EPart (concat $ map toHex os) encodeInc | ||
52 | |||
53 | -- | Encode data. | ||
54 | encode :: [Word8] -> String | ||
55 | encode = encoder encodeInc | ||
56 | |||
57 | -- {{{1 decode | ||
58 | -- | Incremental decoder function. | ||
59 | decodeInc :: DecIncData String -> DecIncRes String | ||
60 | decodeInc d = dI [] d | ||
61 | where | ||
62 | dec2 cs = let | ||
63 | ds = map (flip M.lookup decodeMap) cs | ||
64 | es@[e1, e2] = map fromJust ds | ||
65 | o = e1 `shiftL` 4 .|. e2 | ||
66 | allJust = and . map isJust | ||
67 | in if allJust ds | ||
68 | then Just o | ||
69 | else Nothing | ||
70 | |||
71 | dI [] DDone = DFinal [] [] | ||
72 | dI lo DDone = DFail [] lo | ||
73 | dI lo (DChunk s) = doDec [] (lo ++ s) | ||
74 | where | ||
75 | doDec acc s'@(c1:c2:cs) = maybe | ||
76 | (DFail acc s') | ||
77 | (\ b -> doDec (acc ++ [b]) cs) | ||
78 | (dec2 [c1, c2]) | ||
79 | doDec acc s = DPart acc (dI s) | ||
80 | |||
81 | -- | Decode data. | ||
82 | decode :: String -> Maybe [Word8] | ||
83 | decode = decoder decodeInc | ||
84 | |||
85 | -- {{{1 chop | ||
86 | -- | Chop up a string in parts. | ||
87 | -- | ||
88 | -- The length given is rounded down to the nearest multiple of 2. | ||
89 | chop :: Int -- ^ length of individual lines | ||
90 | -> String | ||
91 | -> [String] | ||
92 | chop n "" = [] | ||
93 | chop n s = let | ||
94 | enc_len | n < 2 = 2 | ||
95 | | otherwise = n `div` 2 * 2 | ||
96 | in take enc_len s : chop n (drop enc_len s) | ||
97 | |||
98 | -- {{{1 unchop | ||
99 | -- | Concatenate the strings into one long string. | ||
100 | unchop :: [String] | ||
101 | -> String | ||
102 | unchop = foldr (++) "" | ||