module Data.URLEncoded
(
URLEncoded
, empty
, importString
, importList
, (%=)
, (%=?)
, null
, keys
, lookup
, lookup1
, pairs
, addToURI
, export
)
where
import qualified Prelude
import Prelude hiding ( null, lookup )
import Data.List.Split ( splitOn )
import Control.Monad ( liftM )
import Control.Arrow ( (>>>) )
import Control.Monad.Error ( MonadError )
import Network.URI ( unEscapeString, escapeURIString, isUnreserved, URI(uriQuery) )
import Data.Monoid ( Monoid )
import Data.List ( intercalate )
newtype URLEncoded = URLEncoded { pairs :: [(String, String)] }
deriving (Monoid, Eq)
null :: URLEncoded -> Bool
null = Prelude.null . pairs
empty :: URLEncoded
empty = URLEncoded []
importList :: [(String, String)] -> URLEncoded
importList = URLEncoded
keys :: URLEncoded -> [String]
keys = map fst . pairs
(%=) :: String -> String -> URLEncoded
k %= v = URLEncoded [(k, v)]
(%=?) :: String -> Maybe String -> URLEncoded
k %=? v = maybe empty (k %=) v
addToURI :: URLEncoded -> URI -> URI
addToURI q u =
let initialChar = if Prelude.null (uriQuery u) then '?' else '&'
in u { uriQuery = uriQuery u ++ (initialChar:export q) }
export :: URLEncoded -> String
export q =
let esc = escapeURIString isUnreserved
encodePair (k, v) = esc k ++ "=" ++ esc v
in intercalate "&" $ map encodePair $ pairs q
instance Show URLEncoded where
showsPrec _ q = (export q ++)
importString :: MonadError e m => String -> m URLEncoded
importString = splitOn "&" >>> mapM parsePair >>> liftM URLEncoded
where parsePair p =
case break (== '=') p of
(_, []) -> fail $ "Missing value in query string: " ++ show p
(k, '=':v) -> return ( unEscapeString k
, unEscapeString v
)
unknown -> error $ "impossible: " ++ show unknown
lookup1 :: MonadError e m => String -> URLEncoded -> m String
lookup1 k = pairs >>> Prelude.lookup k >>> maybe missing return
where missing = fail $ "Key not found: " ++ show k
lookup :: String -> URLEncoded -> [String]
lookup k urlenc = [ v | (k', v) <- pairs urlenc, k' == k ]