web-routes 0.22.0 → 0.23.0

raw patch · 5 files changed

+54/−27 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Web/Routes/Base.hs +26/−7
• Web/Routes/PathInfo.hs +3/−3
• Web/Routes/RouteT.hs +15/−11
• Web/Routes/Site.hs +9/−5
• web-routes.cabal +1/−1

@@ -17,7 +17,7 @@        ) where  import Codec.Binary.UTF8.String (encodeString, decodeString)-import Data.List (intercalate)+import Data.List (intercalate, intersperse) import Network.URI  {-@@ -240,12 +240,14 @@ \"%D7%A9%D7%9C%D7%95%D7%9D\"  -}-encodePathInfo :: [String] -> String-encodePathInfo = -  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+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 = paramsToQueryString qs+   in x pieces ++ y     where       -- reverse composition        o :: (a -> b) -> (b -> c) -> a -> c@@ -295,3 +297,20 @@   where     drop1Slash ('/':x) = x     drop1Slash x = x++paramsToQueryString :: [(String, String)] -> String+paramsToQueryString [] = ""+paramsToQueryString ps = '?' : concat (intersperse "&" (map paramToQueryString ps))+    where+      isOK :: Char -> Bool+      isOK c = isUnreserved c || (c `elem` ":@$,")++      escapeParamChar :: Char -> String+      escapeParamChar ' ' = "+"+      escapeParamChar c = escapeURIChar isOK c++      escapeParamString :: String -> String+      escapeParamString = concatMap escapeParamChar++      paramToQueryString :: (String, String) -> String+      paramToQueryString (k,v) = (escapeParamString k) ++ ('=' : escapeParamString v)

@@ -91,7 +91,7 @@   fromPathSegments :: URLParser a  toPathInfo :: (PathInfo u) => u -> String-toPathInfo = ('/' :) . encodePathInfo . toPathSegments+toPathInfo = ('/' :) . flip encodePathInfo [] . toPathSegments  -- should this fail if not all the input was consumed?   --@@ -113,10 +113,10 @@     dropSlash ('/':rs) = rs     dropSlash x        = x     -mkSitePI :: (PathInfo url) => ((url -> String) -> url -> a) -> Site url a+mkSitePI :: (PathInfo url) => ((url -> [(String, String)] -> String) -> url -> a) -> Site url a mkSitePI handler =   Site { handleSite         = handler-       , formatPathSegments = toPathSegments+       , formatPathSegments = (\x -> (x, [])) . toPathSegments        , parsePathSegments  = parseSegments fromPathSegments        } 

@@ -22,10 +22,10 @@ type Link = String  -- |monad transformer for generating URLs-newtype RouteT url m a = RouteT { unRouteT :: (url -> Link) -> m a }+newtype RouteT url m a = RouteT { unRouteT :: (url -> [(String, String)] -> Link) -> m a } --     deriving (Functor, Monad, MonadFix, MonadPlus) -- , MonadIO, MonadTrans, MonadReader (url -> Link)) -runRouteT :: RouteT url m a -> (url -> Link) -> m a+runRouteT :: RouteT url m a -> (url -> [(String, String)] -> Link) -> m a runRouteT = unRouteT  -- | Transform the computation inside a @RouteT@.@@ -33,18 +33,18 @@ mapRouteT f (RouteT m) = RouteT $ f . m  -- | Execute a computation in a modified environment-withRouteT :: ((url' -> Link) -> (url -> Link)) -> RouteT url m a -> RouteT url' m a+withRouteT :: ((url' -> [(String, String)] -> Link) -> (url -> [(String, String)] -> Link)) -> RouteT url m a -> RouteT url' m a withRouteT f (RouteT m) = RouteT $ m . f  liftRouteT :: m a -> RouteT url m a liftRouteT m = RouteT (const m) -askRouteT :: (Monad m) => RouteT url m (url -> String)+askRouteT :: (Monad m) => RouteT url m (url -> [(String, String)] -> String) askRouteT = RouteT return  instance (Functor m) => Functor (RouteT url m) where   fmap f = mapRouteT (fmap f)-  + instance (Applicative m) => Applicative (RouteT url m) where     pure = liftRouteT . pure   f <*> v = RouteT $ \ url -> unRouteT f url <*> unRouteT v url@@ -69,19 +69,23 @@  class ShowURL m where     type URL m-    showURL :: (URL m) -> m Link -- ^ convert a URL value into a Link (aka, a String)+    showURLParams :: (URL m) -> [(String, String)] -> m Link -- ^ convert a URL value into a Link (aka, a String)  instance (Monad m) => ShowURL (RouteT url m) where     type URL (RouteT url m) = url-    showURL url =+    showURLParams url params =         do showF <- askRouteT-           return (showF url)+           return (showF url params) +-- | convert a URL value into a Link (aka, a String)+showURL :: ShowURL m => URL m -> m Link  +showURL url = showURLParams url []+ -- |used to embed a RouteT into a larger parent url nestURL :: (Monad m) => (url2 -> url1) -> RouteT url2 m a -> RouteT url1 m a nestURL b = withRouteT (. b) -crossURL :: (Monad m) => (url2 -> url1) -> RouteT url1 m (url2 -> Link)-crossURL f = +crossURL :: (Monad m) => (url2 -> url1) -> [(String, String)] -> RouteT url1 m (url2 -> Link)+crossURL f params =      do showF <- askRouteT-       return $ \url2 -> showF (f url2)+       return $ \url2 -> showF (f url2) params

@@ -31,9 +31,9 @@                Well behaving applications should use this function to                generating all internal URLs.            -}-             handleSite         :: (url -> String) -> url -> a+             handleSite         :: (url -> [(String, String)] -> String) -> url -> a            -- | This function must be the inverse of 'parsePathSegments'.-           , formatPathSegments :: url -> [String]+           , formatPathSegments :: url -> ([String], [(String, String)])            -- | This function must be the inverse of 'formatPathSegments'.            , parsePathSegments  :: [String] -> Either String url            }@@ -55,6 +55,10 @@         -> String -- ^ path info, leading slash stripped         -> (Either String a) runSite approot site pathInfo =-  case parsePathSegments site $ decodePathInfo pathInfo of-    (Left errs) -> (Left errs)-    (Right url)  -> Right $ (handleSite site) (\url -> approot ++ (encodePathInfo $ formatPathSegments site url)) url+    case parsePathSegments site $ decodePathInfo pathInfo of+        (Left errs) -> (Left errs)+        (Right url) -> Right $ handleSite site go url+  where+    go url qs =+        let (pieces, qs') = formatPathSegments site url+         in approot ++ encodePathInfo pieces (qs ++ qs')

@@ -1,5 +1,5 @@ Name:             web-routes-Version:          0.22.0+Version:          0.23.0 License:          BSD3 Author:           jeremy@seereason.com Maintainer:       partners@seereason.com