git.iko.soy/typeable/wai
on warp/1.3.7.2 help sign in
typeable/wai/warp-static/warp.hs
53 lines 2.0 kB history raw
1{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
2import Network.Wai.Application.Static (staticApp, defaultFileServerSettings)
3import Network.Wai.Handler.Warp
4 ( runSettings, defaultSettings, settingsHost, settingsPort
5 )
6import System.Console.CmdArgs hiding (def)
7import Text.Printf (printf)
8import System.Directory (canonicalizePath)
9import Control.Monad (unless)
10import Network.Wai.Middleware.Autohead
11import Network.Wai.Middleware.RequestLogger (logStdout)
12import Network.Wai.Middleware.Gzip
13import qualified Data.Map as Map
14import qualified Data.ByteString.Char8 as S8
15import Control.Arrow ((***))
16import Data.Text (pack)
17import Data.String (fromString)
18import Network.Mime (defaultMimeMap, mimeByExt, defaultMimeType)
19import WaiAppStatic.Types (ssIndices, toPiece, ssGetMimeType, fileName, fromPiece)
20import Data.Maybe (mapMaybe)
22data 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)
34defaultArgs :: Args
35defaultArgs = Args "." ["index.html", "index.htm"] 3000 False False False [] "*"
37main :: IO ()
38main = 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
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 }