89 lines
3.2 KiB
Haskell
89 lines
3.2 KiB
Haskell
-- | This module should be removed when web-routes incorporates necessary support.
|
|
module Yesod.WebRoutes
|
|
( encodePathInfo
|
|
, Site (..)
|
|
) where
|
|
|
|
import Codec.Binary.UTF8.String (encodeString)
|
|
import Data.List (intercalate)
|
|
import Network.URI
|
|
|
|
encodePathInfo :: [String] -> [(String, String)] -> String
|
|
encodePathInfo pieces qs =
|
|
let x = map encodeString `o` -- utf-8 encode the data characters in path components (we have not added any delimiters yet)
|
|
map (escapeURIString (\c -> isUnreserved c || c `elem` ":@&=+$,")) `o` -- percent encode the characters
|
|
map (\str -> case str of "." -> "%2E" ; ".." -> "%2E%2E" ; _ -> str) `o` -- encode . and ..
|
|
intercalate "/" -- add in the delimiters
|
|
y = showParams qs
|
|
in x pieces ++ y
|
|
where
|
|
-- reverse composition
|
|
o :: (a -> b) -> (b -> c) -> a -> c
|
|
o = flip (.)
|
|
|
|
{-|
|
|
|
|
A site groups together the three functions necesary to make an application:
|
|
|
|
* A function to convert from the URL type to path segments.
|
|
|
|
* A function to convert from path segments to the URL, if possible.
|
|
|
|
* A function to return the application for a given URL.
|
|
|
|
There are two type parameters for Site: the first is the URL datatype, the
|
|
second is the application datatype. The application datatype will depend upon
|
|
your server backend.
|
|
-}
|
|
data Site url a
|
|
= Site {
|
|
{-|
|
|
Return the appropriate application for a given URL.
|
|
|
|
The first argument is a function which will give an appropriate
|
|
URL (as a String) for a URL datatype. This is usually
|
|
constructed by a combination of 'formatPathSegments' and the
|
|
prepending of an absolute application root.
|
|
|
|
Well behaving applications should use this function to
|
|
generating all internal URLs.
|
|
-}
|
|
handleSite :: (url -> [(String, String)] -> String) -> url -> a
|
|
-- | This function must be the inverse of 'parsePathSegments'.
|
|
, formatPathSegments :: url -> ([String], [(String, String)])
|
|
-- | This function must be the inverse of 'formatPathSegments'.
|
|
, parsePathSegments :: [String] -> Either String url
|
|
}
|
|
|
|
showParams :: [(String, String)] -> String
|
|
showParams [] = ""
|
|
showParams z =
|
|
'?' : intercalate "&" (map go z)
|
|
where
|
|
go (x, "") = go' x
|
|
go (x, y) = go' x ++ '=' : go' y
|
|
go' = concatMap encodeUrlChar
|
|
|
|
-- | Taken straight from web-encodings; reimplemented here to avoid extra
|
|
-- dependencies.
|
|
encodeUrlChar :: Char -> String
|
|
encodeUrlChar c
|
|
-- List of unreserved characters per RFC 3986
|
|
-- Gleaned from http://en.wikipedia.org/wiki/Percent-encoding
|
|
| 'A' <= c && c <= 'Z' = [c]
|
|
| 'a' <= c && c <= 'z' = [c]
|
|
| '0' <= c && c <= '9' = [c]
|
|
encodeUrlChar c@'-' = [c]
|
|
encodeUrlChar c@'_' = [c]
|
|
encodeUrlChar c@'.' = [c]
|
|
encodeUrlChar c@'~' = [c]
|
|
encodeUrlChar ' ' = "+"
|
|
encodeUrlChar y =
|
|
let (a, c) = fromEnum y `divMod` 16
|
|
b = a `mod` 16
|
|
showHex' x
|
|
| x < 10 = toEnum $ x + (fromEnum '0')
|
|
| x < 16 = toEnum $ x - 10 + (fromEnum 'A')
|
|
| otherwise = error $ "Invalid argument to showHex: " ++ show x
|
|
in ['%', showHex' b, showHex' c]
|