Minor fixes
This commit is contained in:
parent
26209f9aeb
commit
cc09c071a6
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user