module Network.Salvia.Handlers.Directory (
hDirectory
, hDirectoryResource
) where
import Control.Monad.State
import Data.List (sort)
import Data.Record.Label
import Misc.Misc (bool)
import Network.Protocol.Http
import Network.Protocol.Uri (path)
import Network.Salvia.Handlers.File (hResource)
import Network.Salvia.Handlers.Redirect
import Network.Salvia.Httpd
import System.Directory (doesDirectoryExist, getDirectoryContents)
hDirectory :: Handler ()
hDirectory = hResource hDirectoryResource
hDirectoryResource :: ResourceHandler ()
hDirectoryResource dirName = do
(u, p) <- bothM (uri % request) (getM path)
if (null p) || last p /= '/'
then hRedirect (lmod path (++"/") u)
else dirHandler dirName
dirHandler:: ResourceHandler ()
dirHandler dirName = do
p <- getM (path % uri % request)
filenames <- lift $ getDirectoryContents dirName
processed <- lift $ mapM (processFilename dirName) (sort filenames)
let b = listing p processed
enterM response $ do
setM contentType ("text/html", Nothing)
setM contentLength (Just $ fromIntegral $ length b)
setM status OK
sendStr b
-- Add trailing slash to a directory name.
processFilename :: FilePath -> FilePath -> IO FilePath
processFilename d f = bool (f ++ "/") f `liftM` doesDirectoryExist (d ++ f)
-- Turn a list of filenames into HTML directory listing.
listing :: FilePath -> [FilePath] -> String
listing dirName fileNames =
concat [
"Index of "
, dirName
, "Index of "
, dirName
, "
"
, fileNames >>= \f -> concat ["- ", f, "
"]
, "
"
]