wai-app-static 3.1.0.1 → 3.1.1

raw patch · 7 files changed

+46/−18 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Network/Wai/Application/Static.hs +3/−2
• WaiAppStatic/Listing.hs +27/−13
• WaiAppStatic/Storage/Filesystem.hs +2/−0
• WaiAppStatic/Types.hs +3/−0
• test/WaiAppStaticTest.hs +6/−2
• wai-app-static.cabal +1/−1

@@ -1,3 +1,7 @@+## 3.1.1++* Make adding a trailing slash optional [#327](https://github.com/yesodweb/wai/issues/327) [yesod#988](https://github.com/yesodweb/yesod/issues/988)+ ## 3.1.0  * Drop system-filepath

@@ -21,6 +21,7 @@     , ssIndices     , ssMaxAge     , ssRedirectToIndex+    , ssAddTrailingSlash     ) where  import Prelude hiding (FilePath)@@ -80,14 +81,14 @@             let pieces' = setLast pieces index in             case () of               () | ssRedirectToIndex -> return $ Redirect pieces' Nothing-                 | Just path <- addTrailingSlash req ->+                 | Just path <- addTrailingSlash req, ssAddTrailingSlash ->                     return $ RawRedirect path                  | otherwise ->                     -- start the checking process over, with a new set                     checkPieces ss pieces' req         Nothing ->             case ssListing of-                Just _ | Just path <- addTrailingSlash req ->+                Just _ | Just path <- addTrailingSlash req, ssAddTrailingSlash ->                     return $ RawRedirect path                 Just listing -> do                     -- directory listings turned on, display it

@@ -49,8 +49,12 @@                                               , "a { text-decoration: none }"                                               ]              H.body $ do-                 H.h1 $ showFolder' $ filter (not . T.null . fromPiece) pieces-                 renderDirectoryContentsTable haskellSrc folderSrc fps''+                 let hasTrailingSlash =+                        case map fromPiece $ reverse $ pieces of+                            "":_ -> True+                            _ -> False+                 H.h1 $ showFolder' hasTrailingSlash $ filter (not . T.null . fromPiece) pieces+                 renderDirectoryContentsTable (map fromPiece pieces) haskellSrc folderSrc fps''   where     image x = T.unpack $ T.concat [(relativeDirFromPieces pieces), ".hidden/", x, ".png"]     folderSrc = image "folder"@@ -59,17 +63,20 @@     showName x = x      -- Add a link to the root of the tree-    showFolder' :: Pieces -> H.Html-    showFolder' pieces  = showFolder (unsafeToPiece "root" : pieces)+    showFolder' :: Bool -> Pieces -> H.Html+    showFolder' hasTrailingSlash pieces  = showFolder hasTrailingSlash (unsafeToPiece "root" : pieces) -    showFolder :: Pieces -> H.Html-    showFolder [] = "/" -- won't happen-    showFolder [x] = H.toHtml $ showName $ fromPiece x-    showFolder (x:xs) = do-        let href = concat $ replicate (length xs) "../" :: String+    showFolder :: Bool -> Pieces -> H.Html+    showFolder _ [] = "/" -- won't happen+    showFolder _ [x] = H.toHtml $ showName $ fromPiece x+    showFolder hasTrailingSlash (x:xs) = do+        let len = length xs - (if hasTrailingSlash then 0 else 1)+            href+                | len == 0 = "."+                | otherwise = concat $ replicate len "../" :: String         H.a ! A.href (H.toValue href) $ H.toHtml $ showName $ fromPiece x         " / " :: H.Html-        showFolder xs+        showFolder hasTrailingSlash xs  -- | a function to generate an HTML table showing the contents of a directory on the disk --@@ -79,11 +86,12 @@ -- a new page template to wrap around this HTML. -- -- see also: 'getMetaData', 'renderDirectoryContents'-renderDirectoryContentsTable :: String+renderDirectoryContentsTable :: [T.Text] -- ^ requested path info                              -> String+                             -> String                              -> [Either FolderName File]                              -> H.Html-renderDirectoryContentsTable haskellSrc folderSrc fps =+renderDirectoryContentsTable pathInfo' haskellSrc folderSrc fps =            H.table $ do H.thead $ do H.th ! (A.class_ "first") $ H.img ! (A.src $ H.toValue haskellSrc)                                      H.th "Name"                                      H.th "Modified"@@ -110,7 +118,13 @@                                (fromPiece -> "") -> unsafeToPiece ".."                                x -> x                    let isFile = either (const False) (const True) md-                   H.td (H.a ! A.href (H.toValue $ fromPiece name `T.append` if isFile then "" else "/") $ H.toHtml $ fromPiece name)+                       href = addCurrentDir $ fromPiece name+                       addCurrentDir x =+                           case reverse pathInfo' of+                               "":_ -> x -- has a trailing slash+                               [] -> x -- at the root+                               currentDir:_ -> T.concat [currentDir, "/", x]+                   H.td (H.a ! A.href (H.toValue href) $ H.toHtml $ fromPiece name)                    H.td ! A.class_ "date" $ H.toHtml $                        case md of                            Right File { fileGetModified = Just t } ->

@@ -46,6 +46,7 @@     , ssIndices = []     , ssRedirectToIndex = False     , ssUseHash = True+    , ssAddTrailingSlash = False     }  -- | Settings optimized for a file server. More conservative caching will be@@ -61,6 +62,7 @@     , ssIndices = map unsafeToPiece ["index.html", "index.htm"]     , ssRedirectToIndex = False     , ssUseHash = False+    , ssAddTrailingSlash = False     }  -- | Same as @defaultWebAppSettings@, but additionally uses a specialized

@@ -141,4 +141,7 @@        -- | Prefer usage of etag caching to last-modified caching.     , ssUseHash :: Bool++      -- | Force a trailing slash at the end of directories+    , ssAddTrailingSlash :: Bool     }

@@ -25,7 +25,9 @@ spec :: Spec spec = do   let webApp = flip runSession $ staticApp $ defaultWebAppSettings "test"-  let fileServerApp = flip runSession $ staticApp $ defaultFileServerSettings "test"+  let fileServerApp = flip runSession $ staticApp (defaultFileServerSettings "test")+        { ssAddTrailingSlash = True+        }    let etag = "1B2M2Y8AsgTpgAmY7PhCfg=="   let file = "a/b"@@ -134,7 +136,9 @@             case pathInfo req of                 "subPath":rest ->                     let req' = req { pathInfo = rest }-                     in (staticApp $ defaultFileServerSettings "test") req' send+                     in (staticApp (defaultFileServerSettings "test")+                            { ssAddTrailingSlash = True+                            }) req' send                 _ -> send $ responseLBS status500 []                     "urlMapApp: only works at subPath"       it "works with subpath at the root of the file server" $ urlMapApp $ do

@@ -1,5 +1,5 @@ name:            wai-app-static-version:         3.1.0.1+version:         3.1.1 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>