diff options
Diffstat (limited to 'src/Codec/Binary/Url.hs')
-rw-r--r-- | src/Codec/Binary/Url.hs | 100 |
1 files changed, 100 insertions, 0 deletions
diff --git a/src/Codec/Binary/Url.hs b/src/Codec/Binary/Url.hs new file mode 100644 index 0000000..b2c57ee --- /dev/null +++ b/src/Codec/Binary/Url.hs | |||
@@ -0,0 +1,100 @@ | |||
1 | -- | | ||
2 | -- Module : Codec.Binary.Url | ||
3 | -- Copyright : (c) 2009 Magnus Therning | ||
4 | -- License : BSD3 | ||
5 | -- | ||
6 | -- URL encoding, sometimes referred to as URI encoding or percent encoding. | ||
7 | -- Implemented based on RFC 3986 (<http://tools.ietf.org/html/rfc3986>). | ||
8 | -- | ||
9 | -- Further documentation and information can be found at | ||
10 | -- <http://www.haskell.org/haskellwiki/Library/Data_encoding>. | ||
11 | |||
12 | module Codec.Binary.Url | ||
13 | ( EncIncData(..) | ||
14 | , EncIncRes(..) | ||
15 | , encodeInc | ||
16 | , encode | ||
17 | , DecIncData | ||
18 | , DecIncRes | ||
19 | , decodeInc | ||
20 | , decode | ||
21 | , chop | ||
22 | , unchop | ||
23 | ) where | ||
24 | |||
25 | import Codec.Binary.Util | ||
26 | |||
27 | import qualified Data.Map as M | ||
28 | import Data.Char(ord) | ||
29 | import Data.Word(Word8) | ||
30 | import Data.Maybe(isJust, fromJust) | ||
31 | |||
32 | -- {{{1 enc/dec map | ||
33 | _unreservedChars = zip [65..90] "ABCDEFGHIJKLMNOPQRSTUVWXYZ" | ||
34 | ++ zip [97..122] "abcdefghijklmnopqrstuvwxyz" | ||
35 | ++ zip [48..57] "0123456789" | ||
36 | ++ [(45, '-'), (95, '_'), (46, '.'), (126, '~')] | ||
37 | |||
38 | encodeMap :: M.Map Word8 Char | ||
39 | encodeMap = M.fromList _unreservedChars | ||
40 | |||
41 | decodeMap :: M.Map Char Word8 | ||
42 | decodeMap = M.fromList [(b, a) | (a, b) <- _unreservedChars] | ||
43 | |||
44 | -- {{{1 encode | ||
45 | -- | Incremental decoder function. | ||
46 | encodeInc :: EncIncData -> EncIncRes String | ||
47 | encodeInc e = eI e | ||
48 | where | ||
49 | enc [] = [] | ||
50 | enc (o : os) = case (M.lookup o encodeMap) of | ||
51 | Just c -> c : enc os | ||
52 | Nothing -> ('%' : toHex o) ++ enc os | ||
53 | |||
54 | eI EDone = EFinal [] | ||
55 | eI (EChunk bs) = EPart (enc bs) encodeInc | ||
56 | |||
57 | -- | Encode data. | ||
58 | encode :: [Word8] -> String | ||
59 | encode = encoder encodeInc | ||
60 | |||
61 | -- {{{1 decode | ||
62 | -- | Incremental decoder function. | ||
63 | decodeInc :: DecIncData String -> DecIncRes String | ||
64 | decodeInc d = dI [] d | ||
65 | where | ||
66 | dI [] DDone = DFinal [] [] | ||
67 | dI lo DDone = DFail [] lo | ||
68 | dI lo (DChunk s) = doDec [] (lo ++ s) | ||
69 | where | ||
70 | doDec acc [] = DPart acc (dI []) | ||
71 | doDec acc s'@('%':c0:c1:cs) = let | ||
72 | o = fromHex [c0, c1] | ||
73 | in if isJust o | ||
74 | then doDec (acc ++ [fromJust o]) cs | ||
75 | else DFail acc s' | ||
76 | doDec acc s'@(c:cs) | ||
77 | | c /= '%' = doDec (acc ++ [fromIntegral $ ord c]) cs | ||
78 | | otherwise = DPart acc (dI s') | ||
79 | |||
80 | -- | Decode data. | ||
81 | decode :: String | ||
82 | -> Maybe [Word8] | ||
83 | decode = decoder decodeInc | ||
84 | |||
85 | -- {{{1 chop | ||
86 | -- | Chop up a string in parts. | ||
87 | chop :: Int -- ^ length of individual lines | ||
88 | -> String | ||
89 | -> [String] | ||
90 | chop n = let | ||
91 | _n = max 1 n | ||
92 | _chop [] = [] | ||
93 | _chop cs = take _n cs : _chop (drop _n cs) | ||
94 | in _chop | ||
95 | |||
96 | -- {{{1 unchop | ||
97 | -- | Concatenate the strings into one long string | ||
98 | unchop :: [String] | ||
99 | -> String | ||
100 | unchop = foldr (++) "" | ||