From 191b406fd57585d0fa34d8e44eb0394a0d9fecd1 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 4 Aug 2010 23:07:27 +0300
Subject: [PATCH] joinPath

---
 Yesod/Dispatch.hs | 25 +------------------------
 Yesod/Yesod.hs    | 13 +++++++++++++
 2 files changed, 14 insertions(+), 24 deletions(-)

diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs
index adbe0e56..5154ca70 100644
--- a/Yesod/Dispatch.hs
+++ b/Yesod/Dispatch.hs
@@ -18,8 +18,6 @@ module Yesod.Dispatch
     , toWaiApp
     , basicHandler
     , basicHandler'
-      -- * Utilities
-    , fullRender
 #if TEST
     , testSuite
 #endif
@@ -46,7 +44,6 @@ import qualified Network.Wai.Handler.CGI as CGI
 import System.Environment (getEnvironment)
 
 import qualified Data.ByteString.Char8 as B
-import Web.Routes (encodePathInfo)
 
 import qualified Data.ByteString.UTF8 as S
 
@@ -232,7 +229,7 @@ toWaiApp' y segments env = do
         pathSegments = filter (not . null) segments
         eurl = parsePathSegments site pathSegments
         render u = fromMaybe
-                    (fullRender (approot y) (formatPathSegments site) u)
+                    (joinPath y (approot y) $ formatPathSegments site u)
                     (urlRenderOverride y u)
     let errorHandler' = localNoCurrent . errorHandler
     rr <- parseWaiRequest env session'
@@ -268,19 +265,6 @@ toWaiApp' y segments env = do
         hs''' = ("Content-Type", S.fromString ct) : hs''
     return $ W.Response s hs''' c
 
--- | Fully render a route to an absolute URL. Since Yesod does this for you
--- internally, you will rarely need access to this. However, if you need to
--- generate links /outside/ of the Handler monad, this may be useful.
---
--- For example, if you want to generate an e-mail which links to your site,
--- this is the function you would want to use.
-fullRender :: String -- ^ approot, no trailing slash
-           -> (url -> [String])
-           -> url
-           -> String
-fullRender ar render route =
-    ar ++ '/' : encodePathInfo (fixSegs $ render route)
-
 httpAccept :: W.Request -> [ContentType]
 httpAccept = map B.unpack
            . parseHttpAccept
@@ -316,13 +300,6 @@ basicHandler' port mhost y = do
             SS.run port app
         Just _ -> CGI.run app
 
-fixSegs :: [String] -> [String]
-fixSegs [] = []
-fixSegs [x]
-    | any (== '.') x = [x]
-    | otherwise = [x, ""] -- append trailing slash
-fixSegs (x:xs) = x : fixSegs xs
-
 parseWaiRequest :: W.Request
                 -> [(String, String)] -- ^ session
                 -> IO Request
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
index 2fcbd7ab..a792c321 100644
--- a/Yesod/Yesod.hs
+++ b/Yesod/Yesod.hs
@@ -44,6 +44,7 @@ import Control.Monad.Trans.Class (MonadTrans (..))
 import Control.Monad.Attempt (Failure)
 import qualified Data.ByteString as S
 import qualified Network.Wai.Middleware.CleanPath
+import Web.Routes (encodePathInfo)
 
 -- | This class is automatically instantiated when you use the template haskell
 -- mkYesod function. You should never need to deal with it directly.
@@ -150,6 +151,18 @@ class Eq (Route a) => Yesod a where
     splitPath :: a -> S.ByteString -> Either S.ByteString [String]
     splitPath _ = Network.Wai.Middleware.CleanPath.splitPath
 
+    -- | 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)
+      where
+        fixSegs [] = []
+        fixSegs [x]
+            | any (== '.') x = [x]
+            | otherwise = [x, ""] -- append trailing slash
+        fixSegs (x:xs) = x : fixSegs xs
+
 data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
     deriving (Eq, Show, Read)