@@ -3,7 +3,7 @@ import Network.Wai.Application.Static (staticApp, defaultFileServerSettings)
33import Network.Wai.Handler.Warp
44 ( runSettings, defaultSettings, settingsHost, settingsPort
55 )
6−import System.Console.CmdArgs hiding (def)
6+import Options.Applicative
77import Text.Printf (printf)
88import System.Directory (canonicalizePath)
99import Control.Monad (unless)
@@ -18,6 +18,7 @@ import Data.String (fromString)
1818import Network.Mime (defaultMimeMap, mimeByExt, defaultMimeType)
1919import WaiAppStatic.Types (ssIndices, toPiece, ssGetMimeType, fileName, fromPiece)
2020import Data.Maybe (mapMaybe)
21+import Control.Arrow (second)
2122
2223data Args = Args
2324 { docroot :: FilePath
@@ -29,14 +30,57 @@ data Args = Args
2930 , mime :: [(String, String)]
3031 , host :: String
3132 }
32− deriving (Show, Data, Typeable)
33+
34+args :: Parser Args
35+args = Args
36+ <$> strOption
37+ ( long "docroot"
38+ <> short 'd'
39+ <> metavar "DOCROOT"
40+ <> value "."
41+ <> help "directory containing files to serve")
42+ <*> (defIndex <$> many (strOption
43+ ( long "index"
44+ <> short 'i'
45+ <> metavar "INDEX"
46+ <> help "index files to serve when a directory is required"
47+ )))
48+ <*> option
49+ ( long "port"
50+ <> short 'p'
51+ <> metavar "PORT"
52+ <> value 3000)
53+ <*> switch
54+ ( long "noindex"
55+ <> short 'n')
56+ <*> switch
57+ ( long "quiet"
58+ <> short 'q')
59+ <*> switch
60+ ( long "verbose"
61+ <> short 'v')
62+ <*> many (toPair <$> strOption
63+ ( long "mime"
64+ <> short 'm'
65+ <> metavar "MIME"
66+ <> help "extra file extension/mime type mappings"))
67+ <*> strOption
68+ ( long "host"
69+ <> short 'h'
70+ <> metavar "HOST"
71+ <> value "*"
72+ <> help "interface to bind to, special values: *, *4, *6")
73+ where
74+ toPair = second (drop 1) . break (== '=')
75+ defIndex [] = ["index.html", "index.htm"]
76+ defIndex x = x
3377
3478defaultArgs :: Args
3579defaultArgs = Args "." ["index.html", "index.htm"] 3000 False False False [] "*"
3680
3781main :: IO ()
3882main = do
39− Args {..} <- cmdArgs defaultArgs
83+ Args {..} <- execParser $ info (helper <*> args) fullDesc
4084 let mime' = map (pack *** S8.pack) mime
4185 let mimeMap = Map.fromList mime' `Map.union` defaultMimeMap
4286 docroot' <- canonicalizePath docroot