@@ -17,6 +17,7 @@ import qualified Network.Wai as W
1717import Listing
1818import Mime
1919import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime)
20+import Data.Maybe (catMaybes)
2021
2122pathFromPieces :: FilePath -> Pieces -> FilePath
2223pathFromPieces = foldl' (\fp p -> fp </> F.fromText (fromPiece p))
@@ -49,15 +50,21 @@ webAppSettingsWithLookup :: FilePath -> ETagLookup -> StaticSettings
4950webAppSettingsWithLookup dir etagLookup =
5051 defaultWebAppSettings { ssLookupFile = webAppLookup etagLookup dir}
5152
53+fileHelperLR :: ETagLookup
54+ -> FilePath -- ^ file location
55+ -> Piece -- ^ file name
56+ -> IO LookupResult
57+fileHelperLR a b c = fmap (maybe LRNotFound LRFile) $ fileHelper a b c
58+
5259fileHelper :: ETagLookup
5360 -> FilePath -- ^ file location
5461 -> Piece -- ^ file name
55− -> IO LookupResult
62+ -> IO (Maybe File)
5663fileHelper hashFunc fp name = do
5764 efs <- try $ getFileStatus $ F.encodeString fp
5865 case efs of
59− Left (_ :: SomeException) -> return LRNotFound
60− Right fs -> return $ LRFile File
66+ Left (_ :: SomeException) -> return Nothing
67+ Right fs -> return $ Just File
6168 { fileGetSize = fromIntegral $ fileSize fs
6269 , fileToResponse = \s h -> W.ResponseFile s h (F.encodeString fp) Nothing
6370 , fileName = name
@@ -69,9 +76,12 @@ type ETagLookup = (FilePath -> IO (Maybe ByteString))
6976
7077webAppLookup :: ETagLookup -> FilePath -> Pieces -> IO LookupResult
7178webAppLookup cachedLookupHash prefix pieces =
72− fileHelper cachedLookupHash fp $ last pieces
79+ fileHelperLR cachedLookupHash fp lastPiece
7380 where
7481 fp = pathFromPieces prefix pieces
82+ lastPiece
83+ | null pieces = unsafeToPiece ""
84+ | otherwise = last pieces
7585
7686defaultFileSystemHash :: ETagLookup
7787defaultFileSystemHash fp = fmap Just $ hashFile fp
@@ -98,7 +108,7 @@ filePathToPiece = unsafeToPiece . either id id . F.toText
98108
99109isVisible :: FilePath -> Bool
100110isVisible =
101− go . F.encodeString
111+ go . F.encodeString . F.filename
102112 where
103113 go ('.':_) = False
104114 go "" = False
@@ -110,21 +120,25 @@ fileSystemLookupHash hashFunc prefix pieces = do
110120 let fp = pathFromPieces prefix pieces
111121 fe <- F.isFile fp
112122 if fe
113− then fileHelper hashFunc fp $ last pieces
123+ then fileHelperLR hashFunc fp lastPiece
114124 else do
115125 de <- F.isDirectory fp
116126 if de
117127 then do
118128 entries' <- fmap (filter isVisible) $ F.listDirectory fp
119129 entries <- forM entries' $ \fp' -> do
120− let name =
121− case toPiece $ either id id $ F.toText $ F.filename fp' of
122− Just p -> p
123− Nothing -> error "fileSystemLookupHash: FIXME"
124− mfile' <- fileHelper hashFunc fp' name
125− return $ case mfile' of
126− LRNotFound -> Left $ Folder (filePathToPiece $ F.filename fp') []
127− LRFolder f -> Left f
128− LRFile f -> Right f
129− return $ LRFolder $ Folder (error "Network.Wai.Application.Static.fileSystemLookup") entries
130+ let name = unsafeToPiece $ either id id $ F.toText $ F.filename fp'
131+ de' <- F.isDirectory fp'
132+ if de'
133+ then return $ Just $ Left name
134+ else do
135+ mfile <- fileHelper hashFunc fp' name
136+ case mfile of
137+ Nothing -> return Nothing
138+ Just file -> return $ Just $ Right file
139+ return $ LRFolder $ Folder lastPiece $ catMaybes entries
130140 else return LRNotFound
141+ where
142+ lastPiece
143+ | null pieces = unsafeToPiece ""
144+ | otherwise = last pieces