@@ -1,6 +1,7 @@
11{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
22import Network.Wai.Application.Static
3− ( StaticSettings (..), staticApp, defaultMimeTypeByExt, defaultListing
3+ ( StaticSettings (..), staticApp, defaultMimeType, defaultListing
4+ , defaultMimeTypes, mimeTypeByExt
45 )
56import Network.Wai.Handler.Warp (run)
67import System.Environment (getArgs)
@@ -11,6 +12,9 @@ import Control.Monad (unless)
1112import Network.Wai.Middleware.Autohead
1213import Network.Wai.Middleware.Debug
1314import Network.Wai.Middleware.Gzip
15+import qualified Data.Map as Map
16+import qualified Data.ByteString.Char8 as S8
17+import Control.Arrow (second)
1418
1519data Args = Args
1620 { docroot :: FilePath
@@ -19,14 +23,17 @@ data Args = Args
1923 , noindex :: Bool
2024 , quiet :: Bool
2125 , verbose :: Bool
26+ , mime :: [(String, String)]
2227 }
2328 deriving (Show, Data, Typeable)
2429
25−defaultArgs = Args "." ["index.html", "index.htm"] 3000 False False False
30+defaultArgs = Args "." ["index.html", "index.htm"] 3000 False False False []
2631
2732main :: IO ()
2833main = do
2934 Args {..} <- cmdArgs defaultArgs
35+ let mime' = map (second S8.pack) mime
36+ let mimeMap = Map.fromList mime' `Map.union` defaultMimeTypes
3037 docroot' <- canonicalizePath docroot
3138 args <- getArgs
3239 unless quiet $ printf "Serving directory %s on port %d with %s index files.\n" docroot' port (if noindex then "no" else show index)
@@ -37,5 +44,5 @@ main = do
3744 { ssFolder = docroot
3845 , ssIndices = if noindex then [] else index
3946 , ssListing = Just defaultListing
40− , ssGetMimeType = return . defaultMimeTypeByExt
47+ , ssGetMimeType = return . mimeTypeByExt mimeMap defaultMimeType
4148 }