f0caeb2 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Make adding a trailing slash optional (fixes #327)

f0caeb2Michael Snoyman11 years ago

wai-app-static/ChangeLog.md+4

compare with master

unifiedsplit

@@ -1,3 +1,7 @@

1+## 3.1.1

3+* Make adding a trailing slash optional [#327](https://github.com/yesodweb/wai/issues/327) [yesod#988](https://github.com/yesodweb/yesod/issues/988)

1## 3.1.0

5## 3.1.0

3* Drop system-filepath

7* Drop system-filepath

wai-app-static/Network/Wai/Application/Static.hs+3−2

@@ -21,6 +21,7 @@ module Network.Wai.Application.Static

21 , ssIndices

22 , ssMaxAge

23 , ssRedirectToIndex

24+ , ssAddTrailingSlash

24 ) where

25 ) where

26import Prelude hiding (FilePath)

27import Prelude hiding (FilePath)

@@ -80,14 +81,14 @@ serveFolder ss@StaticSettings {..} pieces req folder@Folder {..} =

80 let pieces' = setLast pieces index in

81 let pieces' = setLast pieces index in

81 case () of

82 case () of

82 () | ssRedirectToIndex -> return $ Redirect pieces' Nothing

83 () | ssRedirectToIndex -> return $ Redirect pieces' Nothing

83− | Just path <- addTrailingSlash req ->

84+ | Just path <- addTrailingSlash req, ssAddTrailingSlash ->

84 return $ RawRedirect path

85 return $ RawRedirect path

85 | otherwise ->

86 | otherwise ->

86 -- start the checking process over, with a new set

87 -- start the checking process over, with a new set

87 checkPieces ss pieces' req

88 checkPieces ss pieces' req

88 Nothing ->

89 Nothing ->

89 case ssListing of

90 case ssListing of

90− Just _ | Just path <- addTrailingSlash req ->

91+ Just _ | Just path <- addTrailingSlash req, ssAddTrailingSlash ->

91 return $ RawRedirect path

92 return $ RawRedirect path

92 Just listing -> do

93 Just listing -> do

93 -- directory listings turned on, display it

94 -- directory listings turned on, display it

wai-app-static/WaiAppStatic/Listing.hs+27−13

@@ -49,8 +49,12 @@ defaultListing pieces (Folder contents) = do

49 , "a { text-decoration: none }"

50 ]

51 H.body $ do

52+ let hasTrailingSlash =

53+ case map fromPiece $ reverse $ pieces of

54+ "":_ -> True

55+ _ -> False

52− H.h1 $ showFolder' $ filter (not . T.null . fromPiece) pieces

56+ H.h1 $ showFolder' hasTrailingSlash $ filter (not . T.null . fromPiece) pieces

53− renderDirectoryContentsTable haskellSrc folderSrc fps''

57+ renderDirectoryContentsTable (map fromPiece pieces) haskellSrc folderSrc fps''

54 where

58 where

55 image x = T.unpack $ T.concat [(relativeDirFromPieces pieces), ".hidden/", x, ".png"]

59 image x = T.unpack $ T.concat [(relativeDirFromPieces pieces), ".hidden/", x, ".png"]

56 folderSrc = image "folder"

60 folderSrc = image "folder"

@@ -59,17 +63,20 @@ defaultListing pieces (Folder contents) = do

59 showName x = x

63 showName x = x

61 -- Add a link to the root of the tree

65 -- Add a link to the root of the tree

62− showFolder' :: Pieces -> H.Html

66+ showFolder' :: Bool -> Pieces -> H.Html

63− showFolder' pieces = showFolder (unsafeToPiece "root" : pieces)

67+ showFolder' hasTrailingSlash pieces = showFolder hasTrailingSlash (unsafeToPiece "root" : pieces)

65− showFolder :: Pieces -> H.Html

69+ showFolder :: Bool -> Pieces -> H.Html

66− showFolder [] = "/" -- won't happen

70+ showFolder _ [] = "/" -- won't happen

67− showFolder [x] = H.toHtml $ showName $ fromPiece x

71+ showFolder _ [x] = H.toHtml $ showName $ fromPiece x

68− showFolder (x:xs) = do

72+ showFolder hasTrailingSlash (x:xs) = do

73+ let len = length xs - (if hasTrailingSlash then 0 else 1)

74+ href

75+ | len == 0 = "."

69− let href = concat $ replicate (length xs) "../" :: String

76+ | otherwise = concat $ replicate len "../" :: String

70 H.a ! A.href (H.toValue href) $ H.toHtml $ showName $ fromPiece x

77 H.a ! A.href (H.toValue href) $ H.toHtml $ showName $ fromPiece x

71 " / " :: H.Html

78 " / " :: H.Html

72− showFolder xs

79+ showFolder hasTrailingSlash xs

74-- | a function to generate an HTML table showing the contents of a directory on the disk

81-- | a function to generate an HTML table showing the contents of a directory on the disk

75--

82--

@@ -79,11 +86,12 @@ defaultListing pieces (Folder contents) = do

79-- a new page template to wrap around this HTML.

86-- a new page template to wrap around this HTML.

80--

87--

81-- see also: 'getMetaData', 'renderDirectoryContents'

88-- see also: 'getMetaData', 'renderDirectoryContents'

82−renderDirectoryContentsTable :: String

89+renderDirectoryContentsTable :: [T.Text] -- ^ requested path info

90+ -> String

83 -> String

91 -> String

84 -> [Either FolderName File]

92 -> [Either FolderName File]

85 -> H.Html

93 -> H.Html

86−renderDirectoryContentsTable haskellSrc folderSrc fps =

94+renderDirectoryContentsTable pathInfo' haskellSrc folderSrc fps =

87 H.table $ do H.thead $ do H.th ! (A.class_ "first") $ H.img ! (A.src $ H.toValue haskellSrc)

95 H.table $ do H.thead $ do H.th ! (A.class_ "first") $ H.img ! (A.src $ H.toValue haskellSrc)

88 H.th "Name"

96 H.th "Name"

89 H.th "Modified"

97 H.th "Modified"

@@ -110,7 +118,13 @@ renderDirectoryContentsTable haskellSrc folderSrc fps =

110 (fromPiece -> "") -> unsafeToPiece ".."

118 (fromPiece -> "") -> unsafeToPiece ".."

111 x -> x

119 x -> x

112 let isFile = either (const False) (const True) md

120 let isFile = either (const False) (const True) md

121+ href = addCurrentDir $ fromPiece name

122+ addCurrentDir x =

123+ case reverse pathInfo' of

124+ "":_ -> x -- has a trailing slash

125+ [] -> x -- at the root

126+ currentDir:_ -> T.concat [currentDir, "/", x]

113− H.td (H.a ! A.href (H.toValue $ fromPiece name `T.append` if isFile then "" else "/") $ H.toHtml $ fromPiece name)

127+ H.td (H.a ! A.href (H.toValue href) $ H.toHtml $ fromPiece name)

114 H.td ! A.class_ "date" $ H.toHtml $

128 H.td ! A.class_ "date" $ H.toHtml $

115 case md of

129 case md of

116 Right File { fileGetModified = Just t } ->

130 Right File { fileGetModified = Just t } ->

wai-app-static/WaiAppStatic/Storage/Filesystem.hs+2

@@ -46,6 +46,7 @@ defaultWebAppSettings root = StaticSettings

46 , ssIndices = []

47 , ssRedirectToIndex = False

48 , ssUseHash = True

49+ , ssAddTrailingSlash = False

49 }

50 }

51-- | Settings optimized for a file server. More conservative caching will be

52-- | Settings optimized for a file server. More conservative caching will be

@@ -61,6 +62,7 @@ defaultFileServerSettings root = StaticSettings

61 , ssIndices = map unsafeToPiece ["index.html", "index.htm"]

62 , ssIndices = map unsafeToPiece ["index.html", "index.htm"]

62 , ssRedirectToIndex = False

63 , ssRedirectToIndex = False

63 , ssUseHash = False

64 , ssUseHash = False

65+ , ssAddTrailingSlash = False

64 }

66 }

66-- | Same as @defaultWebAppSettings@, but additionally uses a specialized

68-- | Same as @defaultWebAppSettings@, but additionally uses a specialized

wai-app-static/WaiAppStatic/Types.hs+3

@@ -141,4 +141,7 @@ data StaticSettings = StaticSettings

141

142 -- | Prefer usage of etag caching to last-modified caching.

143 , ssUseHash :: Bool

144+

145+ -- | Force a trailing slash at the end of directories

146+ , ssAddTrailingSlash :: Bool

144 }

147 }

wai-app-static/wai-app-static.cabal+1−1

@@ -1,5 +1,5 @@

1name: wai-app-static

2−version: 3.1.0.1

2+version: 3.1.1

3license: MIT

4license-file: LICENSE

5author: Michael Snoyman <michael@snoyman.com>