@@ -1,53 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
2−import Network.Wai.Application.Static (staticApp, defaultFileServerSettings)
3−import Network.Wai.Handler.Warp
4− ( runSettings, defaultSettings, settingsHost, settingsPort
5− )
6−import System.Console.CmdArgs hiding (def)
7−import Text.Printf (printf)
8−import System.Directory (canonicalizePath)
9−import Control.Monad (unless)
10−import Network.Wai.Middleware.Autohead
11−import Network.Wai.Middleware.RequestLogger (logStdout)
12−import Network.Wai.Middleware.Gzip
13−import qualified Data.Map as Map
14−import qualified Data.ByteString.Char8 as S8
15−import Control.Arrow ((***))
16−import Data.Text (pack)
17−import Data.String (fromString)
18−import Network.Mime (defaultMimeMap, mimeByExt, defaultMimeType)
19−import WaiAppStatic.Types (ssIndices, toPiece, ssGetMimeType, fileName, fromPiece)
20−import Data.Maybe (mapMaybe)
21−
22−data Args = Args
23− { docroot :: FilePath
24− , index :: [FilePath]
25− , port :: Int
26− , noindex :: Bool
27− , quiet :: Bool
28− , verbose :: Bool
29− , mime :: [(String, String)]
30− , host :: String
31− }
32− deriving (Show, Data, Typeable)
33−
34−defaultArgs :: Args
35−defaultArgs = Args "." ["index.html", "index.htm"] 3000 False False False [] "*"
36−
37−main :: IO ()
38−main = do
39− Args {..} <- cmdArgs defaultArgs
40− let mime' = map (pack *** S8.pack) mime
41− let mimeMap = Map.fromList mime' `Map.union` defaultMimeMap
42− docroot' <- canonicalizePath docroot
43− unless quiet $ printf "Serving directory %s on port %d with %s index files.\n" docroot' port (if noindex then "no" else show index)
44− let middle = gzip def { gzipFiles = GzipCompress }
45− . (if verbose then logStdout else id)
46− . autohead
47− runSettings defaultSettings
48− { settingsPort = port
49− , settingsHost = fromString host
50− } $ middle $ staticApp (defaultFileServerSettings $ fromString docroot)
51− { ssIndices = if noindex then [] else mapMaybe (toPiece . pack) index
52− , ssGetMimeType = return . mimeByExt mimeMap defaultMimeType . fromPiece . fileName
53− }