Don't rely on OverloadedStrings

Test/NoOverloadedStrings.hs

@@ -0,0 +1,50 @@
+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+module Test.NoOverloadedStrings (noOverloadedTest) where
+
+import Yesod.Core hiding (Request)
+import Test.Framework (testGroup, Test)
+import Test.Framework.Providers.HUnit
+import Network.Wai.Test
+import Network.Wai
+import Data.Monoid (mempty)
+import Data.String (fromString)
+
+data Subsite = Subsite
+getSubsite = const Subsite
+mkYesodSub "Subsite" [] [parseRoutes|
+/bar BarR GET
+|]
+
+getBarR :: GHandler Subsite m ()
+getBarR = return ()
+
+data Y = Y
+mkYesod "Y" [parseRoutes|
+/ RootR GET
+/foo FooR GET
+/subsite SubsiteR Subsite getSubsite
+|]
+
+instance Yesod Y where
+    approot _ = fromString ""
+
+getRootR = return ()
+getFooR = return ()
+
+runner f = toWaiApp Y >>= runSession f
+defaultRequest = Request
+    { pathInfo = []
+    , requestHeaders = []
+    , queryString = []
+    , requestMethod = fromString "GET"
+    }
+
+case_sanity = runner $ do
+    res <- request defaultRequest
+    assertBody mempty res
+
+noOverloadedTest :: Test
+noOverloadedTest = testGroup "Test.NoOverloadedStrings"
+    [ testCase "sanity" case_sanity
+    ]

Yesod/Dispatch.hs

@@ -27,9 +27,9 @@ import Yesod.Internal.Core
 import Yesod.Handler
 import Yesod.Internal.Dispatch
 
-import Web.Routes.Quasi
+import Web.Routes.Quasi (SinglePiece, MultiPiece, Strings)
-import Web.Routes.Quasi.Parse
+import Web.Routes.Quasi.Parse (Resource (..), parseRoutes, parseRoutesFile)
-import Web.Routes.Quasi.TH
+import Web.Routes.Quasi.TH (THResource, Pieces (..), createRoutes, createRender)
 import Language.Haskell.TH.Syntax
 
 import qualified Network.Wai as W

Yesod/Internal/Dispatch.hs

@@ -24,6 +24,7 @@ import Data.Text (Text)
 import Data.Monoid (mappend)
 import qualified Blaze.ByteString.Builder
 import qualified Data.ByteString.Char8 as S8
+import qualified Data.Text
 
 {-|
 
@@ -155,21 +156,35 @@ mkSimpleExp segments [] frontVars (master, sub, toMasterRoute, mkey, constr, met
     let caseExp = rm `AppE` VarE req
     yr <- [|yesodRunner|]
     cr <- [|fmap chooseRep|]
+    pack <- [|Data.Text.pack|]
+    eq <- [|(==)|]
     let url = foldl' AppE (ConE $ mkName constr) $ frontVars []
     let runHandlerVars h = runHandler' $ cr `AppE` foldl' AppE (VarE $ mkName h) (frontVars [])
-        runHandler' h = NormalB $ yr `AppE` sub
+        runHandler' h = yr `AppE` sub
-                                     `AppE` VarE master
+                           `AppE` VarE master
-                                     `AppE` toMasterRoute
+                           `AppE` toMasterRoute
-                                     `AppE` VarE mkey
+                           `AppE` VarE mkey
-                                     `AppE` (just `AppE` url)
+                           `AppE` (just `AppE` url)
-                                     `AppE` h
+                           `AppE` h
-                                     `AppE` VarE req
+                           `AppE` VarE req
-    let match m = Match (LitP $ StringL m) (runHandlerVars $ map toLower m ++ constr) []
+    let match :: String -> Q Match
-    let clauses =
+        match m = do
-            case methods of
+            x <- newName "x"
-                [] -> [Clause [VarP req] (runHandlerVars $ "handle" ++ constr) []]
+            return $ Match
-                _ -> [Clause [VarP req] (NormalB $ CaseE caseExp $ map match methods ++
+                (VarP x)
-                                                                   [Match WildP (runHandler' badMethod') []]) []]
+                (GuardedB
+                    [ ( NormalG $ InfixE (Just $ VarE x) eq (Just $ (LitE $ StringL m)) -- FIXME need to pack, right?
+                      , runHandlerVars $ map toLower m ++ constr
+                      )
+                    ])
+                []
+    clauses <-
+        case methods of
+            [] -> return [Clause [VarP req] (NormalB $ runHandlerVars $ "handle" ++ constr) []]
+            _ -> do
+                matches <- mapM match methods
+                return [Clause [VarP req] (NormalB $ CaseE caseExp $ matches ++
+                                                               [Match WildP (NormalB $ runHandler' badMethod') []]) []]
     let exp = CaseE segments
                 [ Match
                     (ConP (mkName "[]") [])
@@ -185,10 +200,17 @@ mkSimpleExp segments (StaticPiece s:pieces) frontVars x = do
     srest <- newName "segments"
     innerExp <- mkSimpleExp (VarE srest) pieces frontVars x
     nothing <- [|Nothing|]
+    y <- newName "y"
+    pack <- [|Data.Text.pack|]
+    eq <- [|(==)|]
     let exp = CaseE segments
                 [ Match
-                    (InfixP (LitP $ StringL s) (mkName ":") (VarP srest))
+                    (InfixP (VarP y) (mkName ":") (VarP srest))
-                    (NormalB innerExp)
+                    (GuardedB
+                        [ ( NormalG $ InfixE (Just $ VarE y) eq (Just $ pack `AppE` (LitE $ StringL s))
+                          , innerExp
+                          )
+                        ])
                     []
                 , Match WildP (NormalB nothing) []
                 ]
@@ -260,10 +282,17 @@ mkSubsiteExp segments (StaticPiece s:pieces) frontVars x = do
     srest <- newName "segments"
     innerExp <- mkSubsiteExp srest pieces frontVars x
     nothing <- [|Nothing|]
+    y <- newName "y"
+    pack <- [|Data.Text.pack|]
+    eq <- [|(==)|]
     let exp = CaseE (VarE segments)
                 [ Match
-                    (InfixP (LitP $ StringL s) (mkName ":") (VarP srest))
+                    (InfixP (VarP y) (mkName ":") (VarP srest))
-                    (NormalB innerExp)
+                    (GuardedB
+                        [ ( NormalG $ InfixE (Just $ VarE y) eq (Just $ pack `AppE` (LitE $ StringL s))
+                          , innerExp
+                          )
+                        ])
                     []
                 , Match WildP (NormalB nothing) []
                 ]

runtests.hs

@@ -4,6 +4,7 @@ import Test.Exceptions
 import Test.Widget
 import Test.Media
 import Test.Links
+import Test.NoOverloadedStrings
 
 main :: IO ()
 main = defaultMain
@@ -12,4 +13,5 @@ main = defaultMain
     , widgetTest
     , mediaTest
     , linksTest
+    , noOverloadedTest
     ]

yesod-core.cabal

@@ -1,5 +1,5 @@
 name:            yesod-core
-version:         0.8.0
+version:         0.8.0.1
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -33,7 +33,7 @@ library
                    , bytestring                >= 0.9.1.4  && < 0.10
                    , text                      >= 0.5      && < 0.12
                    , template-haskell
-                   , web-routes-quasi          >= 0.7      && < 0.8
+                   , web-routes-quasi          >= 0.7.0.1  && < 0.8
                    , hamlet                    >= 0.8      && < 0.9
                    , blaze-builder             >= 0.2.1    && < 0.4
                    , transformers              >= 0.2      && < 0.3