module URLEncoding(urlDecodeUnicode,decodeQuery) where

import Data.Bits (shiftL, (.|.))
import Data.Char (chr,digitToInt,isHexDigit)

-- | Decode hexadecimal escapes
urlDecodeUnicode :: String -> String
urlDecodeUnicode :: String -> String
urlDecodeUnicode [] = String
""
urlDecodeUnicode (Char
'%':Char
'u':Char
x1:Char
x2:Char
x3:Char
x4:String
s)
    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isHexDigit [Char
x1,Char
x2,Char
x3,Char
x4] =
    Int -> Char
chr (    Char -> Int
digitToInt Char
x1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
12
         Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Char -> Int
digitToInt Char
x2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8
         Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Char -> Int
digitToInt Char
x3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
4
         Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Char -> Int
digitToInt Char
x4) Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
urlDecodeUnicode String
s
urlDecodeUnicode (Char
'%':Char
x1:Char
x2:String
s) | Char -> Bool
isHexDigit Char
x1 Bool -> Bool -> Bool
&& Char -> Bool
isHexDigit Char
x2 =
    Int -> Char
chr (    Char -> Int
digitToInt Char
x1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
4
         Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Char -> Int
digitToInt Char
x2) Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
urlDecodeUnicode String
s
urlDecodeUnicode (Char
c:String
s) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
urlDecodeUnicode String
s

--------------------------------------------------------------------------------

type Query = [(String,String)]

-- | Decode application/x-www-form-urlencoded
decodeQuery :: String -> Query
decodeQuery :: String -> Query
decodeQuery = (String -> (String, String)) -> [String] -> Query
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> (String, String) -> (String, String)
forall t b. (t -> b) -> (t, t) -> (b, b)
aboth String -> String
decode ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> (String, String)
forall a. Eq a => a -> [a] -> ([a], [a])
breakAt Char
'=') ([String] -> Query) -> (String -> [String]) -> String -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (String, String)) -> String -> [String]
forall a b. ([a] -> (b, [a])) -> [a] -> [b]
chopList (Char -> String -> (String, String)
forall a. Eq a => a -> [a] -> ([a], [a])
breakAt Char
'&')

aboth :: (t -> b) -> (t, t) -> (b, b)
aboth t -> b
f (t
x,t
y) = (t -> b
f t
x,t -> b
f t
y)

-- | Decode "+" and hexadecimal escapes
decode :: String -> String
decode [] = []
decode (Char
'%':Char
'u':Char
d1:Char
d2:Char
d3:Char
d4:String
cs)
    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isHexDigit [Char
d1,Char
d2,Char
d3,Char
d4] = Int -> Char
chr(Char -> Char -> Char -> Char -> Int
fromhex4 Char
d1 Char
d2 Char
d3 Char
d4)Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
decode String
cs
decode (Char
'%':Char
d1:Char
d2:String
cs)
    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isHexDigit [Char
d1,Char
d2] = Int -> Char
chr(Char -> Char -> Int
fromhex2 Char
d1 Char
d2)Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
decode String
cs
decode (Char
'+':String
cs) = Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
decode String
cs
decode (Char
c:String
cs) = Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
decode String
cs

fromhex4 :: Char -> Char -> Char -> Char -> Int
fromhex4 Char
d1 Char
d2 Char
d3 Char
d4 = Int
256Int -> Int -> Int
forall a. Num a => a -> a -> a
*Char -> Char -> Int
fromhex2 Char
d1 Char
d2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Char -> Char -> Int
fromhex2 Char
d3 Char
d4
fromhex2 :: Char -> Char -> Int
fromhex2 Char
d1 Char
d2 = Int
16Int -> Int -> Int
forall a. Num a => a -> a -> a
*Char -> Int
digitToInt Char
d1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Char -> Int
digitToInt Char
d2


-- From hbc-library ListUtil ---------------------------------------------------

-- Repeatedly extract (and transform) values until a predicate hold.  Return the list of values.
unfoldr :: (a -> (b, a)) -> (a -> Bool) -> a -> [b]
unfoldr :: (a -> (b, a)) -> (a -> Bool) -> a -> [b]
unfoldr a -> (b, a)
f a -> Bool
p a
x | a -> Bool
p a
x       = []
              | Bool
otherwise = b
yb -> [b] -> [b]
forall a. a -> [a] -> [a]
:(a -> (b, a)) -> (a -> Bool) -> a -> [b]
forall a b. (a -> (b, a)) -> (a -> Bool) -> a -> [b]
unfoldr a -> (b, a)
f a -> Bool
p a
x'
                              where (b
y, a
x') = a -> (b, a)
f a
x

chopList :: ([a] -> (b, [a])) -> [a] -> [b]
chopList :: ([a] -> (b, [a])) -> [a] -> [b]
chopList [a] -> (b, [a])
f [a]
l = ([a] -> (b, [a])) -> ([a] -> Bool) -> [a] -> [b]
forall a b. (a -> (b, a)) -> (a -> Bool) -> a -> [b]
unfoldr [a] -> (b, [a])
f [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
l

breakAt :: (Eq a) => a -> [a] -> ([a], [a])
breakAt :: a -> [a] -> ([a], [a])
breakAt a
_ [] = ([], [])
breakAt a
x (a
x':[a]
xs) =
    if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x' then
        ([], [a]
xs)
    else
        let ([a]
ys, [a]
zs) = a -> [a] -> ([a], [a])
forall a. Eq a => a -> [a] -> ([a], [a])
breakAt a
x [a]
xs
        in  (a
x'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys, [a]
zs)