query string

Yesod/Dispatch.hs

@@ -228,8 +228,10 @@ toWaiApp' y segments env = do
         types = httpAccept env
         pathSegments = filter (not . null) segments
         eurl = parsePathSegments site pathSegments
-        render u = fromMaybe
-                    (joinPath y (approot y) $ formatPathSegments site u)
+        render u qs =
+            let (ps, qs') = formatPathSegments site u
+             in fromMaybe
+                    (joinPath y (approot y) ps $ qs ++ qs')
                     (urlRenderOverride y u)
     let errorHandler' = localNoCurrent . errorHandler
     rr <- parseWaiRequest env session'

Yesod/Hamlet.hs

@@ -36,7 +36,7 @@ data PageContent url = PageContent
 -- Yesod 'Response'.
 hamletToContent :: Hamlet (Route master) -> GHandler sub master Content
 hamletToContent h = do
-    render <- getUrlRender
+    render <- getUrlRenderParams
     return $ toContent $ renderHamlet render h
 
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.

Yesod/Handler.hs

@@ -30,6 +30,7 @@ module Yesod.Handler
     , getYesod
     , getYesodSub
     , getUrlRender
+    , getUrlRenderParams
     , getCurrentRoute
     , getRouteToMaster
       -- * Special responses
@@ -73,7 +74,7 @@ import Prelude hiding (catch)
 import Yesod.Request
 import Yesod.Content
 import Yesod.Internal
-import Data.List (foldl', intercalate)
+import Data.List (foldl')
 import Data.Neither
 
 import Control.Exception hiding (Handler, catch)
@@ -93,8 +94,6 @@ import Data.ByteString.UTF8 (toString)
 import qualified Data.ByteString.Lazy.UTF8 as L
 
 import Text.Hamlet
-import Numeric (showIntAtBase)
-import Data.Char (ord, chr)
 
 -- | The type-safe URLs associated with a site argument.
 type family Route a
@@ -104,7 +103,7 @@ data HandlerData sub master = HandlerData
     , handlerSub :: sub
     , handlerMaster :: master
     , handlerRoute :: Maybe (Route sub)
-    , handlerRender :: (Route master -> String)
+    , handlerRender :: (Route master -> [(String, String)] -> String)
     , handlerToMaster :: Route sub -> Route master
     }
 
@@ -183,7 +182,13 @@ getYesod = handlerMaster <$> GHandler ask
 
 -- | Get the URL rendering function.
 getUrlRender :: GHandler sub master (Route master -> String)
-getUrlRender = handlerRender <$> GHandler ask
+getUrlRender = do
+    x <- handlerRender <$> GHandler ask
+    return $ flip x []
+
+-- | The URL rendering function with query-string parameters.
+getUrlRenderParams :: GHandler sub master (Route master -> [(String, String)] -> String)
+getUrlRenderParams = handlerRender <$> GHandler ask
 
 -- | Get the route requested by the user. If this is a 404 response- where the
 -- user requested an invalid route- this function will return 'Nothing'.
@@ -209,7 +214,7 @@ dropKeys k = filter $ \(x, _) -> x /= k
 -- 'GHandler' into an 'W.Application'. Should not be needed by users.
 runHandler :: HasReps c
            => GHandler sub master c
-           -> (Route master -> String)
+           -> (Route master -> [(String, String)] -> String)
            -> Maybe (Route sub)
            -> (Route sub -> Route master)
            -> master
@@ -268,33 +273,8 @@ redirect rt url = redirectParams rt url []
 redirectParams :: RedirectType -> Route master -> [(String, String)]
                -> GHandler sub master a
 redirectParams rt url params = do
-    r <- getUrlRender
-    redirectString rt $ r url ++ encodeUrlPairs params
-
-encodeUrlPairs :: [(String, String)] -> String
-encodeUrlPairs [] = ""
-encodeUrlPairs pairs =
-    (:) '?' $ encodeUrlPairs' pairs
-  where
-    encodeUrlPairs' = intercalate "&" . map encodeUrlPair
-    encodeUrlPair (x, []) = escape x
-    encodeUrlPair (x, y) = escape x ++ '=' : escape y
-    escape = concatMap escape'
-    escape' c
-        | 'A' < c && c < 'Z' = [c]
-        | 'a' < c && c < 'a' = [c]
-        | '0' < c && c < '9' = [c]
-        | c `elem` ".-~_" = [c]
-        | c == ' ' = "+"
-        | otherwise = '%' : myShowHex (ord c) ""
-    myShowHex :: Int -> ShowS
-    myShowHex n r =  case showIntAtBase 16 toChrHex n r of
-        []  -> "00"
-        [c] -> ['0',c]
-        s  -> s
-    toChrHex d
-        | d < 10    = chr (ord '0' + fromIntegral d)
-        | otherwise = chr (ord 'A' + fromIntegral (d - 10))
+    r <- getUrlRenderParams
+    redirectString rt $ r url params
 
 -- | Redirect to the given URL.
 redirectString :: RedirectType -> String -> GHandler sub master a
@@ -328,8 +308,8 @@ setUltDest' = do
         Just r -> do
             tm <- getRouteToMaster
             gets <- reqGetParams <$> getRequest
-            render <- getUrlRender
-            setUltDestString $ render (tm r) ++ encodeUrlPairs gets
+            render <- getUrlRenderParams
+            setUltDestString $ render (tm r) gets
 
 -- | Redirect to the ultimate destination in the user's session. Clear the
 -- value from the session.

Yesod/Helpers/Static.hs

@@ -43,6 +43,10 @@ import Data.Maybe (fromMaybe)
 import Yesod
 import Data.List (intercalate)
 import Language.Haskell.TH.Syntax
+import Web.Routes.Site
+
+import qualified Data.ByteString.Lazy as L
+import Data.Digest.Pure.MD5
 
 #if TEST
 import Test.Framework (testGroup, Test)
@@ -58,9 +62,20 @@ data Static = Static
     , staticTypes :: [(String, ContentType)]
     }
 
-mkYesodSub "Static" [] [$parseRoutes|
-*Strings StaticRoute GET
-|]
+data StaticRoute = StaticRoute [String] [(String, String)]
+    deriving (Eq, Show, Read)
+
+type instance Route Static = StaticRoute
+
+instance YesodSubSite Static master where
+    getSubSite = Site
+        { handleSite = \_ (StaticRoute ps _) m ->
+                            case m of
+                                "GET" -> Just $ fmap chooseRep $ getStaticRoute ps
+                                _ -> Nothing
+        , formatPathSegments = \(StaticRoute x y) -> (x, y)
+        , parsePathSegments = \x -> Right $ StaticRoute x []
+        }
 
 -- | Lookup files in a specific directory.
 --
@@ -132,10 +147,12 @@ staticFiles fp = do
         let name = mkName $ intercalate "_" $ map (map replace') f
         f' <- lift f
         let sr = ConE $ mkName "StaticRoute"
+        hash <- qRunIO $ fmap (show . md5) $ L.readFile $ fp ++ '/' : intercalate "/" f
+        let qs = ListE [TupE [LitE $ StringL "hash", LitE $ StringL hash]]
         return
             [ SigD name $ ConT ''Route `AppT` ConT ''Static
             , FunD name
-                [ Clause [] (NormalB $ sr `AppE` f') []
+                [ Clause [] (NormalB $ sr `AppE` f' `AppE` qs) []
                 ]
             ]
 

Yesod/Widget.hs

@@ -38,7 +38,7 @@ import Control.Monad.Trans.State
 import Yesod.Hamlet (Hamlet, hamlet, PageContent (..), Html)
 import Text.Camlet
 import Text.Jamlet
-import Yesod.Handler (Route, GHandler, getUrlRender)
+import Yesod.Handler (Route, GHandler, getUrlRenderParams)
 import Yesod.Yesod (Yesod, defaultLayout, addStaticContent)
 import Yesod.Content (RepHtml (..))
 import Control.Applicative (Applicative)
@@ -186,12 +186,12 @@ widgetToPageContent (GWidget w) = do
     let jelper :: Jamlet url -> Hamlet url
         jelper j render = lbsToHtml $ renderJamlet render j
 
-    render <- getUrlRender
+    render <- getUrlRenderParams
     let renderLoc x =
             case x of
                 Nothing -> Nothing
                 Just (Left s) -> Just s
-                Just (Right u) -> Just $ render u
+                Just (Right (u, p)) -> Just $ render u p
     cssLoc <-
         case style of
             Nothing -> return Nothing

Yesod/Yesod.hs

@@ -154,9 +154,9 @@ class Eq (Route a) => Yesod a where
 
     -- | Join the pieces of a path together into an absolute URL. This should
     -- be the inverse of 'splitPath'.
-    joinPath :: a -> String -> [String] -> String
-    joinPath _ ar pieces =
-        ar ++ '/' : encodePathInfo (fixSegs pieces)
+    joinPath :: a -> String -> [String] -> [(String, String)] -> String
+    joinPath _ ar pieces qs =
+        ar ++ '/' : encodePathInfo (fixSegs pieces) qs
       where
         fixSegs [] = []
         fixSegs [x]
@@ -177,7 +177,7 @@ class Eq (Route a) => Yesod a where
     addStaticContent :: String -- ^ filename extension
                      -> String -- ^ mime-type
                      -> L.ByteString -- ^ content
-                     -> GHandler sub a (Maybe (Either String (Route a)))
+                     -> GHandler sub a (Maybe (Either String (Route a, [(String, String)])))
     addStaticContent _ _ _ = return Nothing
 
 data AuthResult = Authorized | AuthenticationRequired | Unauthorized String

hellowidget.hs

@@ -22,7 +22,7 @@ instance Yesod HW where
         let fn = show (md5 content) ++ '.' : ext
         liftIO $ createDirectoryIfMissing True "static/tmp"
         liftIO $ L.writeFile ("static/tmp/" ++ fn) content
-        return $ Just $ Right $ StaticR $ StaticRoute ["tmp", fn]
+        return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn], [])
 
 instance YesodNic HW
 instance YesodJquery HW

yesod.cabal

@@ -30,8 +30,8 @@ library
                      text >= 0.5 && < 0.8,
                      utf8-string >= 0.3.4 && < 0.4,
                      template-haskell >= 2.4 && < 2.5,
-                     web-routes >= 0.22 && < 0.23,
-                     web-routes-quasi >= 0.5 && < 0.6,
+                     web-routes >= 0.23 && < 0.24,
+                     web-routes-quasi >= 0.6 && < 0.7,
                      hamlet >= 0.5.0 && < 0.6,
                      blaze-html >= 0.1.1 && < 0.2,
                      transformers >= 0.2 && < 0.3,