-- |
-- Module    : Codec.Binary.Url
-- Copyright : (c) 2009 Magnus Therning
-- License   : BSD3
--
-- URL encoding, sometimes referred to as URI encoding or percent encoding.
-- Implemented based on RFC 3986 (<http://tools.ietf.org/html/rfc3986>).
--
-- Further documentation and information can be found at
-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.

module Codec.Binary.Url
    ( EncIncData(..)
    , EncIncRes(..)
    , encodeInc
    , encode
    , DecIncData
    , DecIncRes
    , decodeInc
    , decode
    , chop
    , unchop
    ) where

import Codec.Binary.Util

import qualified Data.Map as M
import Data.Char(ord)
import Data.Word(Word8)
import Data.Maybe(isJust, fromJust)

-- {{{1 enc/dec map
_unreservedChars :: [(Word8, Char)]
_unreservedChars = [Word8] -> [Char] -> [(Word8, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word8
65..Word8
90] [Char]
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
        [(Word8, Char)] -> [(Word8, Char)] -> [(Word8, Char)]
forall a. [a] -> [a] -> [a]
++ [Word8] -> [Char] -> [(Word8, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word8
97..Word8
122] [Char]
"abcdefghijklmnopqrstuvwxyz"
        [(Word8, Char)] -> [(Word8, Char)] -> [(Word8, Char)]
forall a. [a] -> [a] -> [a]
++ [Word8] -> [Char] -> [(Word8, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word8
48..Word8
57] [Char]
"0123456789"
        [(Word8, Char)] -> [(Word8, Char)] -> [(Word8, Char)]
forall a. [a] -> [a] -> [a]
++ [(Word8
45, Char
'-'), (Word8
95, Char
'_'), (Word8
46, Char
'.'), (Word8
126, Char
'~')]

encodeMap :: M.Map Word8 Char
encodeMap :: Map Word8 Char
encodeMap = [(Word8, Char)] -> Map Word8 Char
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Word8, Char)]
_unreservedChars

decodeMap :: M.Map Char Word8
decodeMap :: Map Char Word8
decodeMap = [(Char, Word8)] -> Map Char Word8
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Char
b, Word8
a) | (Word8
a, Char
b) <- [(Word8, Char)]
_unreservedChars]

-- {{{1 encode
-- | Incremental decoder function.
encodeInc :: EncIncData -> EncIncRes String
encodeInc :: EncIncData -> EncIncRes [Char]
encodeInc EncIncData
e = EncIncData -> EncIncRes [Char]
eI EncIncData
e
    where
        enc :: [Word8] -> [Char]
enc [] = []
        enc (Word8
o : [Word8]
os) = case (Word8 -> Map Word8 Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Word8
o Map Word8 Char
encodeMap) of
            Just Char
c -> Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Word8] -> [Char]
enc [Word8]
os
            Maybe Char
Nothing -> (Char
'%' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Word8 -> [Char]
toHex Word8
o) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Word8] -> [Char]
enc [Word8]
os

        eI :: EncIncData -> EncIncRes [Char]
eI EncIncData
EDone = [Char] -> EncIncRes [Char]
forall i. i -> EncIncRes i
EFinal []
        eI (EChunk [Word8]
bs) = [Char] -> (EncIncData -> EncIncRes [Char]) -> EncIncRes [Char]
forall i. i -> (EncIncData -> EncIncRes i) -> EncIncRes i
EPart ([Word8] -> [Char]
enc [Word8]
bs) EncIncData -> EncIncRes [Char]
encodeInc

-- | Encode data.
encode :: [Word8] -> String
encode :: [Word8] -> [Char]
encode = (EncIncData -> EncIncRes [Char]) -> [Word8] -> [Char]
forall {a}. (EncIncData -> EncIncRes [a]) -> [Word8] -> [a]
encoder EncIncData -> EncIncRes [Char]
encodeInc

-- {{{1 decode
-- | Incremental decoder function.
decodeInc :: DecIncData String -> DecIncRes String
decodeInc :: DecIncData [Char] -> DecIncRes [Char]
decodeInc DecIncData [Char]
d = [Char] -> DecIncData [Char] -> DecIncRes [Char]
dI [] DecIncData [Char]
d
    where
        dI :: [Char] -> DecIncData [Char] -> DecIncRes [Char]
dI [] DecIncData [Char]
DDone = [Word8] -> [Char] -> DecIncRes [Char]
forall i. [Word8] -> i -> DecIncRes i
DFinal [] []
        dI [Char]
lo DecIncData [Char]
DDone = [Word8] -> [Char] -> DecIncRes [Char]
forall i. [Word8] -> i -> DecIncRes i
DFail [] [Char]
lo
        dI [Char]
lo (DChunk [Char]
s) = [Word8] -> [Char] -> DecIncRes [Char]
doDec [] ([Char]
lo [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
            where
                doDec :: [Word8] -> [Char] -> DecIncRes [Char]
doDec [Word8]
acc [] = [Word8]
-> (DecIncData [Char] -> DecIncRes [Char]) -> DecIncRes [Char]
forall i. [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
DPart [Word8]
acc ([Char] -> DecIncData [Char] -> DecIncRes [Char]
dI [])
                doDec [Word8]
acc s' :: [Char]
s'@(Char
'%':Char
c0:Char
c1:[Char]
cs) = let
                        o :: Maybe Word8
o = [Char] -> Maybe Word8
fromHex [Char
c0, Char
c1]
                    in if Maybe Word8 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Word8
o
                        then [Word8] -> [Char] -> DecIncRes [Char]
doDec ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Maybe Word8 -> Word8
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word8
o]) [Char]
cs
                        else [Word8] -> [Char] -> DecIncRes [Char]
forall i. [Word8] -> i -> DecIncRes i
DFail [Word8]
acc [Char]
s'
                doDec [Word8]
acc s' :: [Char]
s'@(Char
c:[Char]
cs)
                    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'%' = [Word8] -> [Char] -> DecIncRes [Char]
doDec ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c]) [Char]
cs
                    | Bool
otherwise = [Word8]
-> (DecIncData [Char] -> DecIncRes [Char]) -> DecIncRes [Char]
forall i. [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
DPart [Word8]
acc ([Char] -> DecIncData [Char] -> DecIncRes [Char]
dI [Char]
s')

-- | Decode data.
decode :: String
    -> Maybe [Word8]
decode :: [Char] -> Maybe [Word8]
decode = (DecIncData [Char] -> DecIncRes [Char]) -> [Char] -> Maybe [Word8]
forall i. (DecIncData i -> DecIncRes i) -> i -> Maybe [Word8]
decoder DecIncData [Char] -> DecIncRes [Char]
decodeInc

-- {{{1 chop
-- | Chop up a string in parts.
chop :: Int     -- ^ length of individual lines
    -> String
    -> [String]
chop :: Int -> [Char] -> [[Char]]
chop Int
n = let
        _n :: Int
_n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n
        _chop :: [a] -> [[a]]
_chop [] = []
        _chop [a]
cs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
_n [a]
cs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
_chop (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
_n [a]
cs)
    in [Char] -> [[Char]]
forall {a}. [a] -> [[a]]
_chop

-- {{{1 unchop
-- | Concatenate the strings into one long string
unchop :: [String]
    -> String
unchop :: [[Char]] -> [Char]
unchop = ([Char] -> [Char] -> [Char]) -> [Char] -> [[Char]] -> [Char]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) [Char]
""