Minor fixes

This commit is contained in:
Michael Snoyman 2010-11-19 12:02:11 +02:00
parent 26209f9aeb
commit cc09c071a6
2 changed files with 13 additions and 16 deletions

View File

@ -55,7 +55,6 @@ import Control.Monad.Trans.Class (MonadTrans (..))
import Control.Failure (Failure) import Control.Failure (Failure)
import qualified Data.ByteString as S import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
import qualified Network.Wai.Middleware.CleanPath
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Data.Monoid import Data.Monoid
import Control.Monad.Trans.Writer import Control.Monad.Trans.Writer
@ -64,7 +63,6 @@ import Text.Hamlet
import Text.Cassius import Text.Cassius
import Text.Julius import Text.Julius
import Web.Routes import Web.Routes
import Network.URI (unEscapeString)
#if TEST #if TEST
import Test.Framework (testGroup, Test) import Test.Framework (testGroup, Test)
@ -207,18 +205,18 @@ class Eq (Route a) => Yesod a where
-- | Add a trailing slash if it is missing. Empty string is left alone. -- | Add a trailing slash if it is missing. Empty string is left alone.
ats :: String -> String ats :: String -> String
ats [] = [] ats [] = []
ats s = ats t =
if last s == '/' || dbs (reverse s) if last t == '/' || dbs (reverse t)
then s then t
else s ++ "/" else t ++ "/"
-- | Remove a trailing slash if the last piece has a period. -- | Remove a trailing slash if the last piece has a period.
rts :: String -> String rts :: String -> String
rts [] = [] rts [] = []
rts s = rts t =
if last s == '/' && dbs (tail $ reverse s) if last t == '/' && dbs (tail $ reverse t)
then init s then init t
else s else t
-- | Is there a period before a slash here? -- | Is there a period before a slash here?
dbs :: String -> Bool dbs :: String -> Bool
@ -239,8 +237,8 @@ class Eq (Route a) => Yesod a where
| anyButLast (== '.') x = [x] | anyButLast (== '.') x = [x]
| otherwise = [x, ""] -- append trailing slash | otherwise = [x, ""] -- append trailing slash
fixSegs (x:xs) = x : fixSegs xs fixSegs (x:xs) = x : fixSegs xs
anyButLast p [] = False anyButLast _ [] = False
anyButLast p [_] = False anyButLast _ [_] = False
anyButLast p (x:xs) = p x || anyButLast p xs anyButLast p (x:xs) = p x || anyButLast p xs
-- | This function is used to store some static content to be served as an -- | This function is used to store some static content to be served as an
@ -317,8 +315,8 @@ applyLayout' title body = fmap chooseRep $ defaultLayout $ do
defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
defaultErrorHandler NotFound = do defaultErrorHandler NotFound = do
r <- waiRequest r <- waiRequest
let path' = bsToChars $ pathInfo r let path' = bsToChars $ W.pathInfo r
applyLayout' "Not Found" [hamlet| applyLayout' "Not Found"
#if GHC7 #if GHC7
[hamlet| [hamlet|
#else #else
@ -327,8 +325,6 @@ defaultErrorHandler NotFound = do
%h1 Not Found %h1 Not Found
%p $path'$ %p $path'$
|] |]
where
pathInfo = W.pathInfo
defaultErrorHandler (PermissionDenied msg) = defaultErrorHandler (PermissionDenied msg) =
applyLayout' "Permission Denied" applyLayout' "Permission Denied"
#if GHC7 #if GHC7

View File

@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
-- | Settings are centralized, as much as possible, into this file. This -- | Settings are centralized, as much as possible, into this file. This
-- includes database connection settings, static file locations, etc. -- includes database connection settings, static file locations, etc.
-- In addition, you can configure a number of different aspects of Yesod -- In addition, you can configure a number of different aspects of Yesod