wai-app-static 2.0.0.5 → 2.0.1
raw patch · 3 files changed
+113/−53 lines, 3 filesdep +optparse-applicativedep −cmdargs
Dependencies added: optparse-applicative
Dependencies removed: cmdargs
Files
- WaiAppStatic/CmdLine.hs +105/−0
- app/warp-static.hs +3/−49
- wai-app-static.cabal +5/−4
+ WaiAppStatic/CmdLine.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}+-- | Command line version of wai-app-static, used for the warp-static server.+module WaiAppStatic.CmdLine+ ( runCommandLine+ , Args (..)+ ) where++import Network.Wai (Middleware)+import Network.Wai.Application.Static (staticApp, defaultFileServerSettings)+import Network.Wai.Handler.Warp+ ( runSettings, defaultSettings, settingsHost, settingsPort+ )+import Options.Applicative+import Text.Printf (printf)+import System.Directory (canonicalizePath)+import Control.Monad (unless)+import Network.Wai.Middleware.Autohead+import Network.Wai.Middleware.RequestLogger (logStdout)+import Network.Wai.Middleware.Gzip+import qualified Data.Map as Map+import qualified Data.ByteString.Char8 as S8+import Control.Arrow ((***))+import Data.Text (pack)+import Data.String (fromString)+import Network.Mime (defaultMimeMap, mimeByExt, defaultMimeType)+import WaiAppStatic.Types (ssIndices, toPiece, ssGetMimeType, fileName, fromPiece)+import Data.Maybe (mapMaybe)+import Control.Arrow (second)++data Args = Args+ { docroot :: FilePath+ , index :: [FilePath]+ , port :: Int+ , noindex :: Bool+ , quiet :: Bool+ , verbose :: Bool+ , mime :: [(String, String)]+ , host :: String+ }++args :: Parser Args+args = Args+ <$> strOption+ ( long "docroot"+ <> short 'd'+ <> metavar "DOCROOT"+ <> value "."+ <> help "directory containing files to serve")+ <*> (defIndex <$> many (strOption+ ( long "index"+ <> short 'i'+ <> metavar "INDEX"+ <> help "index files to serve when a directory is required"+ )))+ <*> option+ ( long "port"+ <> short 'p'+ <> metavar "PORT"+ <> value 3000)+ <*> switch+ ( long "noindex"+ <> short 'n')+ <*> switch+ ( long "quiet"+ <> short 'q')+ <*> switch+ ( long "verbose"+ <> short 'v')+ <*> many (toPair <$> strOption+ ( long "mime"+ <> short 'm'+ <> metavar "MIME"+ <> help "extra file extension/mime type mappings"))+ <*> strOption+ ( long "host"+ <> short 'h'+ <> metavar "HOST"+ <> value "*"+ <> help "interface to bind to, special values: *, *4, *6")+ where+ toPair = second (drop 1) . break (== '=')+ defIndex [] = ["index.html", "index.htm"]+ defIndex x = x++-- | Run with the given middleware and parsing options from the command line.+--+-- Since 2.0.1+runCommandLine :: (Args -> Middleware) -> IO ()+runCommandLine middleware = do+ args@Args {..} <- execParser $ info (helper <*> args) fullDesc+ let mime' = map (pack *** S8.pack) mime+ let mimeMap = Map.fromList mime' `Map.union` defaultMimeMap+ docroot' <- canonicalizePath docroot+ unless quiet $ printf "Serving directory %s on port %d with %s index files.\n" docroot' port (if noindex then "no" else show index)+ let middle = gzip def { gzipFiles = GzipCompress }+ . (if verbose then logStdout else id)+ . autohead+ . (middleware args)+ runSettings defaultSettings+ { settingsPort = port+ , settingsHost = fromString host+ } $ middle $ staticApp (defaultFileServerSettings $ fromString docroot)+ { ssIndices = if noindex then [] else mapMaybe (toPiece . pack) index+ , ssGetMimeType = return . mimeByExt mimeMap defaultMimeType . fromPiece . fileName+ }
app/warp-static.hs view
@@ -1,53 +1,7 @@ {-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}-import Network.Wai.Application.Static (staticApp, defaultFileServerSettings)-import Network.Wai.Handler.Warp- ( runSettings, defaultSettings, settingsHost, settingsPort- )-import System.Console.CmdArgs hiding (def)-import Text.Printf (printf)-import System.Directory (canonicalizePath)-import Control.Monad (unless)-import Network.Wai.Middleware.Autohead-import Network.Wai.Middleware.RequestLogger (logStdout)-import Network.Wai.Middleware.Gzip-import qualified Data.Map as Map-import qualified Data.ByteString.Char8 as S8-import Control.Arrow ((***))-import Data.Text (pack)-import Data.String (fromString)-import Network.Mime (defaultMimeMap, mimeByExt, defaultMimeType)-import WaiAppStatic.Types (ssIndices, toPiece, ssGetMimeType, fileName, fromPiece)-import Data.Maybe (mapMaybe)--data Args = Args- { docroot :: FilePath- , index :: [FilePath]- , port :: Int- , noindex :: Bool- , quiet :: Bool- , verbose :: Bool- , mime :: [(String, String)]- , host :: String- }- deriving (Show, Data, Typeable)+module Main (main) where -defaultArgs :: Args-defaultArgs = Args "." ["index.html", "index.htm"] 3000 False False False [] "*"+import WaiAppStatic.CmdLine (runCommandLine) main :: IO ()-main = do- Args {..} <- cmdArgs defaultArgs- let mime' = map (pack *** S8.pack) mime- let mimeMap = Map.fromList mime' `Map.union` defaultMimeMap- docroot' <- canonicalizePath docroot- unless quiet $ printf "Serving directory %s on port %d with %s index files.\n" docroot' port (if noindex then "no" else show index)- let middle = gzip def { gzipFiles = GzipCompress }- . (if verbose then logStdout else id)- . autohead- runSettings defaultSettings- { settingsPort = port- , settingsHost = fromString host- } $ middle $ staticApp (defaultFileServerSettings $ fromString docroot)- { ssIndices = if noindex then [] else mapMaybe (toPiece . pack) index- , ssGetMimeType = return . mimeByExt mimeMap defaultMimeType . fromPiece . fileName- }+main = runCommandLine (const id)
wai-app-static.cabal view
@@ -1,5 +1,5 @@ name: wai-app-static-version: 2.0.0.5+version: 2.0.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -50,12 +50,16 @@ , template-haskell >= 2.7 , zlib >= 0.5 , filepath+ , wai-extra >= 2.0 && < 2.2+ , optparse-applicative >= 0.7+ , warp >= 2.0 && < 2.2 exposed-modules: Network.Wai.Application.Static WaiAppStatic.Storage.Filesystem WaiAppStatic.Storage.Embedded WaiAppStatic.Listing WaiAppStatic.Types+ WaiAppStatic.CmdLine other-modules: Util WaiAppStatic.Storage.Embedded.Runtime WaiAppStatic.Storage.Embedded.TH@@ -69,10 +73,7 @@ Main-is: warp-static.hs hs-source-dirs: app Build-depends: base >= 4 && < 5- , warp >= 2.0 && < 2.2 , wai-app-static >= 2.0 && < 2.1- , wai-extra >= 2.0 && < 2.2- , cmdargs >= 0.6.7 , directory >= 1.0 , containers >= 0.2 , bytestring >= 0.9.1.4