@@ -49,8 +49,12 @@ defaultListing pieces (Folder contents) = do
4949 , "a { text-decoration: none }"
5050 ]
5151 H.body $ do
52− H.h1 $ showFolder' $ filter (not . T.null . fromPiece) pieces
53− renderDirectoryContentsTable haskellSrc folderSrc fps''
52+ let hasTrailingSlash =
53+ case map fromPiece $ reverse $ pieces of
54+ "":_ -> True
55+ _ -> False
56+ H.h1 $ showFolder' hasTrailingSlash $ filter (not . T.null . fromPiece) pieces
57+ renderDirectoryContentsTable (map fromPiece pieces) haskellSrc folderSrc fps''
5458 where
5559 image x = T.unpack $ T.concat [(relativeDirFromPieces pieces), ".hidden/", x, ".png"]
5660 folderSrc = image "folder"
@@ -59,17 +63,20 @@ defaultListing pieces (Folder contents) = do
5963 showName x = x
6064
6165 -- Add a link to the root of the tree
62− showFolder' :: Pieces -> H.Html
63− showFolder' pieces = showFolder (unsafeToPiece "root" : pieces)
66+ showFolder' :: Bool -> Pieces -> H.Html
67+ showFolder' hasTrailingSlash pieces = showFolder hasTrailingSlash (unsafeToPiece "root" : pieces)
6468
65− showFolder :: Pieces -> H.Html
66− showFolder [] = "/" -- won't happen
67− showFolder [x] = H.toHtml $ showName $ fromPiece x
68− showFolder (x:xs) = do
69− let href = concat $ replicate (length xs) "../" :: String
69+ showFolder :: Bool -> Pieces -> H.Html
70+ showFolder _ [] = "/" -- won't happen
71+ showFolder _ [x] = H.toHtml $ showName $ fromPiece x
72+ showFolder hasTrailingSlash (x:xs) = do
73+ let len = length xs - (if hasTrailingSlash then 0 else 1)
74+ href
75+ | len == 0 = "."
76+ | otherwise = concat $ replicate len "../" :: String
7077 H.a ! A.href (H.toValue href) $ H.toHtml $ showName $ fromPiece x
7178 " / " :: H.Html
72− showFolder xs
79+ showFolder hasTrailingSlash xs
7380
7481-- | a function to generate an HTML table showing the contents of a directory on the disk
7582--
@@ -79,11 +86,12 @@ defaultListing pieces (Folder contents) = do
7986-- a new page template to wrap around this HTML.
8087--
8188-- see also: 'getMetaData', 'renderDirectoryContents'
82−renderDirectoryContentsTable :: String
89+renderDirectoryContentsTable :: [T.Text] -- ^ requested path info
90+ -> String
8391 -> String
8492 -> [Either FolderName File]
8593 -> H.Html
86−renderDirectoryContentsTable haskellSrc folderSrc fps =
94+renderDirectoryContentsTable pathInfo' haskellSrc folderSrc fps =
8795 H.table $ do H.thead $ do H.th ! (A.class_ "first") $ H.img ! (A.src $ H.toValue haskellSrc)
8896 H.th "Name"
8997 H.th "Modified"
@@ -110,7 +118,13 @@ renderDirectoryContentsTable haskellSrc folderSrc fps =
110118 (fromPiece -> "") -> unsafeToPiece ".."
111119 x -> x
112120 let isFile = either (const False) (const True) md
113− H.td (H.a ! A.href (H.toValue $ fromPiece name `T.append` if isFile then "" else "/") $ H.toHtml $ fromPiece name)
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]
127+ H.td (H.a ! A.href (H.toValue href) $ H.toHtml $ fromPiece name)
114128 H.td ! A.class_ "date" $ H.toHtml $
115129 case md of
116130 Right File { fileGetModified = Just t } ->