@@ -216,13 +216,19 @@ stripTrailingSlash "/" = ""
216216stripTrailingSlash "" = ""
217217stripTrailingSlash (x:xs) = x : stripTrailingSlash xs
218218
219−type Pieces = [T.Text]
219+data Piece = Piece
220+ { pieceRaw :: FilePath
221+ , piecePretty :: T.Text
222+ }
223+ deriving (Eq, Ord)
224+type Pieces = [Piece]
225+
220226relativeDirFromPieces :: Pieces -> T.Text
221227relativeDirFromPieces pieces = T.concat $ map (const "../") (drop 1 pieces) -- last piece is not a dir
222228
223229pathFromPieces :: FilePath -> Pieces -> FilePath
224230pathFromPieces prefix pieces =
225− concat $ prefix : map ((:) '/') (map unfixPathName $ map T.unpack pieces)
231+ concat $ prefix : map ((:) '/') (map pieceRaw pieces)
226232
227233checkPieces :: (Pieces -> IO FileLookup) -- ^ file lookup function
228234 -> [T.Text] -- ^ List of default index files. Cannot contain slashes.
@@ -230,20 +236,20 @@ checkPieces :: (Pieces -> IO FileLookup) -- ^ file lookup function
230236 -> CacheSettings
231237 -> W.Request
232238 -> IO CheckPieces
233−checkPieces _ _ [".hidden", "folder.png"] _ _ =
239+checkPieces _ _ [Piece _ ".hidden", Piece _ "folder.png"] _ _ =
234240 return $ SendContent "image/png" $ L.fromChunks [$(embedFile "folder.png")]
235−checkPieces _ _ [".hidden", "haskell.png"] _ _ =
241+checkPieces _ _ [Piece _ ".hidden", Piece _ "haskell.png"] _ _ =
236242 return $ SendContent "image/png" $ L.fromChunks [$(embedFile "haskell.png")]
237243checkPieces fileLookup indices pieces cache req
238− | any unsafe pieces = return Forbidden
239− | any T.null $ safeInit pieces =
240− return $ Redirect $ filterButLast (not . T.null) pieces
244+ | any (unsafe . piecePretty) pieces = return Forbidden
245+ | any (T.null . piecePretty) $ safeInit pieces =
246+ return $ Redirect $ filterButLast (not . T.null . piecePretty) pieces
241247 | otherwise = do
242248 let (isFile, isFolder) =
243249 case () of
244250 ()
245251 | null pieces -> (True, True)
246− | T.null (last pieces) -> (False, True)
252+ | T.null $ piecePretty (last pieces) -> (False, True)
247253 | otherwise -> (True, False)
248254
249255 let fp = undefined
@@ -275,14 +281,14 @@ checkPieces fileLookup indices pieces cache req
275281 (FLFile{}, False) -> return $ Redirect $ init pieces
276282 (FLFolder folder@(Folder contents), _) -> do
277283 case checkIndices $ map feName $ filter feIsFile contents of
278− Just index -> return $ Redirect $ setLast pieces index
284+ Just index -> return $ Redirect $ setLast pieces $ Piece (T.unpack index) index
279285 Nothing ->
280286 if isFolder
281287 then return $ DirectoryResponse folder
282− else return $ Redirect $ pieces ++ [""]
288+ else return $ Redirect $ pieces ++ [Piece "" ""]
283289
284290 setLast [] x = [x]
285− setLast [""] x = [x]
291+ setLast [Piece "" ""] x = [x]
286292 setLast (a:b) x = a : setLast b x
287293
288294 checkIndices :: [T.Text] -> Maybe T.Text
@@ -366,7 +372,7 @@ fileSystemLookup prefix pieces = do
366372 return $ FLFile File
367373 { fileGetSize = fmap (fromIntegral . fileSize) $ getFileStatus fp
368374 , fileToResponse = \s h -> W.ResponseFile s h fp Nothing
369− , fileName = last pieces
375+ , fileName = piecePretty $ last pieces
370376 }
371377 else do
372378 de <- doesDirectoryExist fp
@@ -390,9 +396,11 @@ data EmbeddedEntry = EEFile S8.ByteString | EEFolder Embedded
390396
391397embeddedLookup :: Embedded -> Pieces -> IO FileLookup -- FIXME broken for unicode path names
392398embeddedLookup root pieces =
393− return $ elookup pieces root
399+ return $ elookup (map piecePretty pieces) root
394400 where
401+ elookup :: [T.Text] -> Embedded -> FileLookup
395402 elookup [] x = FLFolder $ Folder $ map toEntry $ Map.toList x
403+ elookup [""] x = elookup [] x
396404 elookup (p:ps) x =
397405 case Map.lookup p x of
398406 Nothing -> FLDoesNotExist
@@ -412,12 +420,12 @@ toEntry (name, ee) = FolderEntry
412420 , feGetMetaData = return $ Just $
413421 case ee of
414422 EEFile bs -> FileMetaData
415− { mdName = T.unpack name
423+ { mdName = name
416424 , mdModified = 0 -- FIXME
417425 , mdSize = fromIntegral $ S8.length bs
418426 }
419427 EEFolder _ -> FolderMetaData
420− { mdName = T.unpack name
428+ { mdName = name
421429 }
422430 }
423431
@@ -426,20 +434,21 @@ toEmbedded fps =
426434 go texts
427435 where
428436 texts = map (\(x, y) -> (filter (not . T.null) $ toPieces x, y)) fps
437+ toPiece fp = T.pack $ fixPathName fp
429438 toPieces "" = []
430439 toPieces x =
431440 let (y, z) = break (== '/') x
432− in T.pack y : toPieces (drop 1 z)
433− go :: [(Pieces, S8.ByteString)] -> Embedded
441+ in toPiece y : toPieces (drop 1 z)
442+ go :: [([T.Text], S8.ByteString)] -> Embedded
434443 go orig =
435444 Map.fromList $ map (second go') hoisted
436445 where
437446 next = map (\(x, y) -> (head x, (tail x, y))) orig
438− grouped :: [[(T.Text, (Pieces, S8.ByteString))]]
447+ grouped :: [[(T.Text, ([T.Text], S8.ByteString))]]
439448 grouped = groupBy ((==) `on` fst) $ sortBy (comparing fst) next
440− hoisted :: [(T.Text, [(Pieces, S8.ByteString)])]
449+ hoisted :: [(T.Text, [([T.Text], S8.ByteString)])]
441450 hoisted = map (fst . head &&& map snd) grouped
442− go' :: [(Pieces, S8.ByteString)] -> EmbeddedEntry
451+ go' :: [([T.Text], S8.ByteString)] -> EmbeddedEntry
443452 go' [([], content)] = EEFile content
444453 go' x = EEFolder $ go $ filter (\y -> not $ null $ fst y) x
445454
@@ -451,9 +460,13 @@ bsToFile name bs = File
451460 }
452461
453462staticApp :: StaticSettings -> W.Application
454−staticApp set req = do
455− let pieces = W.pathInfo req
456− staticAppPieces set pieces req
463+staticApp set req =
464+ staticAppPieces set (map toPiece $ W.pathInfo req) req
465+ where
466+ toPiece t = Piece
467+ { piecePretty = t
468+ , pieceRaw = unfixPathName $ T.unpack t
469+ }
457470
458471status304, statusNotModified :: H.Status
459472status304 = H.Status 304 "Not Modified"
@@ -501,13 +514,13 @@ staticAppPieces ss@StaticSettings{} pieces req = liftIO $ do
501514 -- TODO: set Content-Length
502515 ] lbs
503516 Redirect pieces' -> do
504− let loc = (ssMkRedirect ss) pieces' $ toByteString (H.encodePathSegments pieces')
517+ let loc = (ssMkRedirect ss) pieces' $ toByteString (H.encodePathSegments $ map piecePretty pieces')
505518
506519 let loc' =
507520 -- relativeDirFromPieces pieces = T.concat $ map (const "../") (drop 1 pieces) -- last piece is not a dir
508521 -- (ssMkRedirect ss) pieces' $ encodePathInfo pieces' []
509522 toByteString $
510− foldr mappend (H.encodePathSegments pieces') -- FIXME use Text
523+ foldr mappend (H.encodePathSegments $ map piecePretty pieces') -- FIXME is this correct?
511524 $ map (const $ copyByteString "../") $ drop 1 pieces
512525 return $ W.responseLBS H.status301
513526 [ ("Content-Type", "text/plain")
@@ -561,12 +574,12 @@ unfixPathName = S8.unpack . TE.encodeUtf8 . T.pack
561574defaultListing :: Listing
562575defaultListing pieces (Folder contents) = do
563576 fps' <- mapM feGetMetaData contents
564− let isTop = null pieces || pieces == [""]
577+ let isTop = null pieces || pieces == [Piece "" ""]
565578 let fps'' = if isTop then fps' else Just (FolderMetaData "..") : fps'
566579 return $ HU.renderHtml
567580 $ H.html $ do
568581 H.head $ do
569− let title = T.unpack $ T.intercalate "/" pieces
582+ let title = T.unpack $ T.intercalate "/" $ map piecePretty pieces
570583 let title' = if null title then "root folder" else title
571584 H.title $ H.string title'
572585 H.style $ H.string $ unlines [ "table { margin: 0 auto; width: 760px; border-collapse: collapse; font-family: 'sans-serif'; }"
@@ -584,7 +597,7 @@ defaultListing pieces (Folder contents) = do
584597 , "a { text-decoration: none }"
585598 ]
586599 H.body $ do
587− H.h1 $ showFolder $ map T.unpack $ filter (not . T.null) pieces
600+ H.h1 $ showFolder $ map (T.unpack . piecePretty) $ filter (not . T.null . piecePretty) pieces -- FIXME don't unpack
588601 renderDirectoryContentsTable haskellSrc folderSrc $ catMaybes fps''
589602 where
590603 image x = T.unpack $ T.concat [(relativeDirFromPieces pieces), ".hidden/", x, ".png"]
@@ -631,7 +644,7 @@ renderDirectoryContentsTable haskellSrc folderSrc fps =
631644 then return ()
632645 else H.img ! A.src (H.stringValue folderSrc)
633646 ! A.alt (H.stringValue "Folder")
634− H.td (H.a ! A.href (H.stringValue $ mdName' md ++ if mdIsFile md then "" else "/") $ H.string $ mdName' md)
647+ H.td (H.a ! A.href (H.stringValue $ T.unpack (mdName md) ++ if mdIsFile md then "" else "/") $ H.string $ T.unpack (mdName md))
635648 H.td ! A.class_ (H.stringValue "date") $ H.string $
636649 if mdIsFile md
637650 then formatCalendarTime defaultTimeLocale "%d-%b-%Y %X" $ mdModified md
@@ -655,17 +668,14 @@ renderDirectoryContentsTable haskellSrc folderSrc fps =
655668 addCommas' (a:b:c:d:e) = a : b : c : ',' : addCommas' (d : e)
656669 addCommas' x = x
657670
658−mdName' :: MetaData -> FilePath
659−mdName' = fixPathName . mdName
660−
661671data MetaData =
662672 FileMetaData
663− { mdName :: FilePath
673+ { mdName :: T.Text
664674 , mdModified :: EpochTime
665675 , mdSize :: FileOffset
666676 }
667677 | FolderMetaData
668− { mdName :: FilePath
678+ { mdName :: T.Text
669679 }
670680 deriving Show
671681
@@ -681,12 +691,13 @@ getMetaData _ ('.':_) = return Nothing
681691getMetaData localPath fp = do
682692 let fp' = localPath ++ '/' : fp
683693 fe <- doesFileExist fp'
694+ let fpPretty = T.pack $ fixPathName fp
684695 if fe
685696 then do
686697 fs <- getFileStatus fp'
687698 let modTime = modificationTime fs
688699 let count = fileSize fs
689− return $ Just $ FileMetaData fp modTime count
700+ return $ Just $ FileMetaData fpPretty modTime count
690701 else do
691702 de <- doesDirectoryExist fp'
692− return $ if de then Just (FolderMetaData fp) else Nothing
703+ return $ if de then Just (FolderMetaData fpPretty) else Nothing