git.iko.soy/typeable/wai
on warp-3.2.27-conn-closed-by-pear help sign in
typeable/wai/wai-app-static/WaiAppStatic/CmdLine.hs
117 lines 3.8 kB history raw
1{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
2-- | Command line version of wai-app-static, used for the warp-static server.
3module WaiAppStatic.CmdLine
4 ( runCommandLine
5 , Args (..)
6 ) where
8import Network.Wai (Middleware)
9import Network.Wai.Application.Static (staticApp, defaultFileServerSettings)
10import Network.Wai.Handler.Warp
11 ( runSettings, defaultSettings, setHost, setPort
12 )
13import Options.Applicative
14import Text.Printf (printf)
15import System.Directory (canonicalizePath)
16import Control.Monad (unless)
17import Network.Wai.Middleware.RequestLogger (logStdout)
18import Network.Wai.Middleware.Gzip
19import qualified Data.Map as Map
20import qualified Data.ByteString.Char8 as S8
21import Control.Arrow ((***))
22import Data.Text (pack)
23import Data.String (fromString)
24import Network.Mime (defaultMimeMap, mimeByExt, defaultMimeType)
25import WaiAppStatic.Types (ssIndices, toPiece, ssGetMimeType, fileName, fromPiece)
26import Data.Maybe (mapMaybe)
27import Control.Arrow (second)
28import Data.Monoid ((<>))
30data Args = Args
31 { docroot :: FilePath
32 , index :: [FilePath]
33 , port :: Int
34 , noindex :: Bool
35 , quiet :: Bool
36 , verbose :: Bool
37 , mime :: [(String, String)]
38 , host :: String
39 }
41#if MIN_VERSION_optparse_applicative(0, 10, 0)
42option' = option auto
43#else
44option' = option
45#endif
47args :: Parser Args
48args = Args
49 <$> strOption
50 ( long "docroot"
51 <> short 'd'
52 <> metavar "DOCROOT"
53 <> value "."
54 <> help "directory containing files to serve")
55 <*> (defIndex <$> many (strOption
56 ( long "index"
57 <> short 'i'
58 <> metavar "INDEX"
59 <> help "index files to serve when a directory is required"
60 )))
61 <*> option'
62 ( long "port"
63 <> short 'p'
64 <> metavar "PORT"
65 <> value 3000)
66 <*> switch
67 ( long "noindex"
68 <> short 'n')
69 <*> switch
70 ( long "quiet"
71 <> short 'q')
72 <*> switch
73 ( long "verbose"
74 <> short 'v')
75 <*> many (toPair <$> strOption
76 ( long "mime"
77 <> short 'm'
78 <> metavar "MIME"
79 <> help "extra file extension/mime type mappings"))
80 <*> strOption
81 ( long "host"
82 <> short 'h'
83 <> metavar "HOST"
84 <> value "*"
85 <> help "interface to bind to, special values: *, *4, *6")
86 where
87 toPair = second (drop 1) . break (== '=')
88 defIndex [] = ["index.html", "index.htm"]
89 defIndex x = x
91-- | Run with the given middleware and parsing options from the command line.
92--
93-- Since 2.0.1
94runCommandLine :: (Args -> Middleware) -> IO ()
95runCommandLine middleware = do
96 args@Args {..} <- execParser $ info (helperOption <*> args) fullDesc
97 let mime' = map (pack *** S8.pack) mime
98 let mimeMap = Map.fromList mime' `Map.union` defaultMimeMap
99 docroot' <- canonicalizePath docroot
100 unless quiet $ printf "Serving directory %s on port %d with %s index files.\n" docroot' port (if noindex then "no" else show index)
101 let middle = gzip def { gzipFiles = GzipCompress }
102 . (if verbose then logStdout else id)
103 . (middleware args)
104 runSettings
105 ( setPort port
106 $ setHost (fromString host)
107 defaultSettings
108 )
109 $ middle $ staticApp (defaultFileServerSettings $ fromString docroot)
110 { ssIndices = if noindex then [] else mapMaybe (toPiece . pack) index
111 , ssGetMimeType = return . mimeByExt mimeMap defaultMimeType . fromPiece . fileName
112 }
113 where
114 helperOption :: Parser (a -> a)
115 helperOption =
116 abortOption ShowHelpText $
117 mconcat [long "help", help "Show this help text", hidden]