Imported all web-routes dependencies

Yesod/Dispatch.hs

@@ -36,8 +36,8 @@ import Yesod.Internal
 import Web.Routes.Quasi
 import Web.Routes.Quasi.Parse
 import Web.Routes.Quasi.TH
-import Web.Routes.Site
 import Language.Haskell.TH.Syntax
+import Yesod.WebRoutes
 
 import qualified Network.Wai as W
 import Network.Wai.Middleware.CleanPath (cleanPathFunc)

Yesod/Helpers/Static.hs

@@ -45,13 +45,13 @@ import Data.Maybe (fromMaybe)
 import Yesod hiding (lift)
 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
 import qualified Codec.Binary.Base64Url
 import qualified Data.ByteString as S
 import qualified Data.Serialize
+import Yesod.WebRoutes
 
 #if TEST
 import Test.Framework (testGroup, Test)

Yesod/WebRoutes.hs

@@ -0,0 +1,88 @@
+-- | 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]

Yesod/Yesod.hs

@@ -49,13 +49,12 @@ import qualified Web.ClientSession as CS
 import Data.Monoid (mempty)
 import qualified Data.ByteString.UTF8 as BSU
 import Database.Persist
-import Web.Routes.Site (Site)
 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)
 import qualified Data.ByteString.Lazy as L
+import Yesod.WebRoutes
 
 #if TEST
 import Test.Framework (testGroup, Test)

yesod.cabal

@@ -30,7 +30,6 @@ library
                      text >= 0.5 && < 0.8,
                      utf8-string >= 0.3.4 && < 0.4,
                      template-haskell >= 2.4 && < 2.5,
-                     web-routes >= 0.23 && < 0.24,
                      web-routes-quasi >= 0.6 && < 0.7,
                      hamlet >= 0.5.0 && < 0.6,
                      blaze-builder >= 0.1 && < 0.2,
@@ -70,6 +69,7 @@ library
                      Yesod.Helpers.Crud
                      Yesod.Helpers.Sitemap
                      Yesod.Helpers.Static
+                     Yesod.WebRoutes
     ghc-options:     -Wall -Werror
 
 executable             yesod