    {-# LANGUAGE CPP, 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, setHost, setPort
        )
    import Options.Applicative
    import Text.Printf (printf)
    import System.Directory (canonicalizePath)
    import Control.Monad (unless)
    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 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, (***))
    #if __GLASGOW_HASKELL__ < 804
    import Data.Monoid ((<>))
    #endif

    data Args = Args
        { Args -> FilePath
    docroot :: FilePath
        , Args -> [FilePath]
    index :: [FilePath]
        , Args -> Int
    port :: Int
        , Args -> Bool
    noindex :: Bool
        , Args -> Bool
    quiet :: Bool
        , Args -> Bool
    verbose :: Bool
        , Args -> [(FilePath, FilePath)]
    mime :: [(String, String)]
        , Args -> FilePath
    host :: String
        }

    #if MIN_VERSION_optparse_applicative(0, 10, 0)
    option' :: Mod OptionFields Int -> Parser Int
    option' :: Mod OptionFields Int -> Parser Int
    option' = ReadM Int -> Mod OptionFields Int -> Parser Int
    forall a. ReadM a -> Mod OptionFields a -> Parser a
    option ReadM Int
    forall a. Read a => ReadM a
    auto
    #else
    option' = option
    #endif

    args :: Parser Args
    args :: Parser Args
    args = FilePath
    -> [FilePath]
    -> Int
    -> Bool
    -> Bool
    -> Bool
    -> [(FilePath, FilePath)]
    -> FilePath
    -> Args
    Args
        (FilePath
     -> [FilePath]
     -> Int
     -> Bool
     -> Bool
     -> Bool
     -> [(FilePath, FilePath)]
     -> FilePath
     -> Args)
    -> Parser FilePath
    -> Parser
         ([FilePath]
          -> Int
          -> Bool
          -> Bool
          -> Bool
          -> [(FilePath, FilePath)]
          -> FilePath
          -> Args)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mod OptionFields FilePath -> Parser FilePath
    forall s. IsString s => Mod OptionFields s -> Parser s
    strOption
                ( FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
    long FilePath
    "docroot"
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'd'
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
    metavar FilePath
    "DOCROOT"
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasValue f => a -> Mod f a
    value FilePath
    "."
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. FilePath -> Mod f a
    help FilePath
    "directory containing files to serve")
        Parser
      ([FilePath]
       -> Int
       -> Bool
       -> Bool
       -> Bool
       -> [(FilePath, FilePath)]
       -> FilePath
       -> Args)
    -> Parser [FilePath]
    -> Parser
         (Int
          -> Bool
          -> Bool
          -> Bool
          -> [(FilePath, FilePath)]
          -> FilePath
          -> Args)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ([FilePath] -> [FilePath]
    defIndex ([FilePath] -> [FilePath])
    -> Parser [FilePath] -> Parser [FilePath]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser FilePath -> Parser [FilePath]
    forall a. Parser a -> Parser [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many (Mod OptionFields FilePath -> Parser FilePath
    forall s. IsString s => Mod OptionFields s -> Parser s
    strOption
                ( FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
    long FilePath
    "index"
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'i'
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
    metavar FilePath
    "INDEX"
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. FilePath -> Mod f a
    help FilePath
    "index files to serve when a directory is required"
                )))
        Parser
      (Int
       -> Bool
       -> Bool
       -> Bool
       -> [(FilePath, FilePath)]
       -> FilePath
       -> Args)
    -> Parser Int
    -> Parser
         (Bool
          -> Bool -> Bool -> [(FilePath, FilePath)] -> FilePath -> Args)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Mod OptionFields Int -> Parser Int
    option'
                ( FilePath -> Mod OptionFields Int
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
    long FilePath
    "port"
               Mod OptionFields Int
    -> Mod OptionFields Int -> Mod OptionFields Int
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod OptionFields Int
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'p'
               Mod OptionFields Int
    -> Mod OptionFields Int -> Mod OptionFields Int
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Mod OptionFields Int
    forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
    metavar FilePath
    "PORT"
               Mod OptionFields Int
    -> Mod OptionFields Int -> Mod OptionFields Int
    forall a. Semigroup a => a -> a -> a
    <> Int -> Mod OptionFields Int
    forall (f :: * -> *) a. HasValue f => a -> Mod f a
    value Int
    3000)
        Parser
      (Bool
       -> Bool -> Bool -> [(FilePath, FilePath)] -> FilePath -> Args)
    -> Parser Bool
    -> Parser
         (Bool -> Bool -> [(FilePath, FilePath)] -> FilePath -> Args)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Mod FlagFields Bool -> Parser Bool
    switch
                ( FilePath -> Mod FlagFields Bool
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
    long FilePath
    "noindex"
               Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod FlagFields Bool
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'n')
        Parser (Bool -> Bool -> [(FilePath, FilePath)] -> FilePath -> Args)
    -> Parser Bool
    -> Parser (Bool -> [(FilePath, FilePath)] -> FilePath -> Args)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Mod FlagFields Bool -> Parser Bool
    switch
                ( FilePath -> Mod FlagFields Bool
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
    long FilePath
    "quiet"
               Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod FlagFields Bool
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'q')
        Parser (Bool -> [(FilePath, FilePath)] -> FilePath -> Args)
    -> Parser Bool
    -> Parser ([(FilePath, FilePath)] -> FilePath -> Args)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Mod FlagFields Bool -> Parser Bool
    switch
                ( FilePath -> Mod FlagFields Bool
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
    long FilePath
    "verbose"
               Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod FlagFields Bool
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'v')
        Parser ([(FilePath, FilePath)] -> FilePath -> Args)
    -> Parser [(FilePath, FilePath)] -> Parser (FilePath -> Args)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser (FilePath, FilePath) -> Parser [(FilePath, FilePath)]
    forall a. Parser a -> Parser [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many (FilePath -> (FilePath, FilePath)
    toPair (FilePath -> (FilePath, FilePath))
    -> Parser FilePath -> Parser (FilePath, FilePath)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mod OptionFields FilePath -> Parser FilePath
    forall s. IsString s => Mod OptionFields s -> Parser s
    strOption
                ( FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
    long FilePath
    "mime"
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'm'
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
    metavar FilePath
    "MIME"
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. FilePath -> Mod f a
    help FilePath
    "extra file extension/mime type mappings"))
        Parser (FilePath -> Args) -> Parser FilePath -> Parser Args
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Mod OptionFields FilePath -> Parser FilePath
    forall s. IsString s => Mod OptionFields s -> Parser s
    strOption
                ( FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
    long FilePath
    "host"
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> Char -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
    short Char
    'h'
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
    metavar FilePath
    "HOST"
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. HasValue f => a -> Mod f a
    value FilePath
    "*"
               Mod OptionFields FilePath
    -> Mod OptionFields FilePath -> Mod OptionFields FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Mod OptionFields FilePath
    forall (f :: * -> *) a. FilePath -> Mod f a
    help FilePath
    "interface to bind to, special values: *, *4, *6")
      where
        toPair :: FilePath -> (FilePath, FilePath)
    toPair = (FilePath -> FilePath)
    -> (FilePath, FilePath) -> (FilePath, FilePath)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (Int -> FilePath -> FilePath
    forall a. Int -> [a] -> [a]
    drop Int
    1) ((FilePath, FilePath) -> (FilePath, FilePath))
    -> (FilePath -> (FilePath, FilePath))
    -> FilePath
    -> (FilePath, FilePath)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> FilePath -> (FilePath, FilePath)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '=')
        defIndex :: [FilePath] -> [FilePath]
    defIndex [] = [FilePath
    "index.html", FilePath
    "index.htm"]
        defIndex [FilePath]
    x = [FilePath]
    x

    -- | Run with the given middleware and parsing options from the command line.
    --
    -- Since 2.0.1
    runCommandLine :: (Args -> Middleware) -> IO ()
    runCommandLine :: (Args -> Middleware) -> IO ()
    runCommandLine Args -> Middleware
    middleware = do
        clArgs :: Args
    clArgs@Args {Bool
    Int
    FilePath
    [FilePath]
    [(FilePath, FilePath)]
    docroot :: Args -> FilePath
    index :: Args -> [FilePath]
    port :: Args -> Int
    noindex :: Args -> Bool
    quiet :: Args -> Bool
    verbose :: Args -> Bool
    mime :: Args -> [(FilePath, FilePath)]
    host :: Args -> FilePath
    docroot :: FilePath
    index :: [FilePath]
    port :: Int
    noindex :: Bool
    quiet :: Bool
    verbose :: Bool
    mime :: [(FilePath, FilePath)]
    host :: FilePath
    ..} <- ParserInfo Args -> IO Args
    forall a. ParserInfo a -> IO a
    execParser (ParserInfo Args -> IO Args) -> ParserInfo Args -> IO Args
    forall a b. (a -> b) -> a -> b
    $ Parser Args -> InfoMod Args -> ParserInfo Args
    forall a. Parser a -> InfoMod a -> ParserInfo a
    info (Parser (Args -> Args)
    forall a. Parser (a -> a)
    helperOption Parser (Args -> Args) -> Parser Args -> Parser Args
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Args
    args) InfoMod Args
    forall a. InfoMod a
    fullDesc
        let mime' :: [(Text, ByteString)]
    mime' = ((FilePath, FilePath) -> (Text, ByteString))
    -> [(FilePath, FilePath)] -> [(Text, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath -> Text
    pack (FilePath -> Text)
    -> (FilePath -> ByteString)
    -> (FilePath, FilePath)
    -> (Text, ByteString)
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** FilePath -> ByteString
    S8.pack) [(FilePath, FilePath)]
    mime
        let mimeMap :: Map Text ByteString
    mimeMap = [(Text, ByteString)] -> Map Text ByteString
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(Text, ByteString)]
    mime' Map Text ByteString -> Map Text ByteString -> Map Text ByteString
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    `Map.union` Map Text ByteString
    defaultMimeMap
        FilePath
    docroot' <- FilePath -> IO FilePath
    canonicalizePath FilePath
    docroot
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    quiet (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath -> Int -> FilePath -> IO ()
    forall r. PrintfType r => FilePath -> r
    printf FilePath
    "Serving directory %s on port %d with %s index files.\n" FilePath
    docroot' Int
    port (if Bool
    noindex then FilePath
    "no" else [FilePath] -> FilePath
    forall a. Show a => a -> FilePath
    show [FilePath]
    index)
        let middle :: Middleware
    middle = GzipSettings -> Middleware
    gzip GzipSettings
    forall a. Default a => a
    def { gzipFiles :: GzipFiles
    gzipFiles = GzipFiles
    GzipCompress }
                   Middleware -> Middleware -> Middleware
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    verbose then Middleware
    logStdout else Middleware
    forall a. a -> a
    id)
                   Middleware -> Middleware -> Middleware
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Args -> Middleware
    middleware Args
    clArgs
        Settings -> Application -> IO ()
    runSettings
            ( Int -> Settings -> Settings
    setPort Int
    port
            (Settings -> Settings) -> Settings -> Settings
    forall a b. (a -> b) -> a -> b
    $ HostPreference -> Settings -> Settings
    setHost (FilePath -> HostPreference
    forall a. IsString a => FilePath -> a
    fromString FilePath
    host)
              Settings
    defaultSettings
            )
            (Application -> IO ()) -> Application -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Middleware
    middle Middleware -> Middleware
    forall a b. (a -> b) -> a -> b
    $ StaticSettings -> Application
    staticApp (FilePath -> StaticSettings
    defaultFileServerSettings (FilePath -> StaticSettings) -> FilePath -> StaticSettings
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    forall a. IsString a => FilePath -> a
    fromString FilePath
    docroot)
            { ssIndices :: [Piece]
    ssIndices = if Bool
    noindex then [] else (FilePath -> Maybe Piece) -> [FilePath] -> [Piece]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Text -> Maybe Piece
    toPiece (Text -> Maybe Piece)
    -> (FilePath -> Text) -> FilePath -> Maybe Piece
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Text
    pack) [FilePath]
    index
            , ssGetMimeType :: File -> IO ByteString
    ssGetMimeType = ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString)
    -> (File -> ByteString) -> File -> IO ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Text ByteString -> ByteString -> Text -> ByteString
    mimeByExt Map Text ByteString
    mimeMap ByteString
    defaultMimeType (Text -> ByteString) -> (File -> Text) -> File -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Piece -> Text
    fromPiece (Piece -> Text) -> (File -> Piece) -> File -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . File -> Piece
    fileName
            }
        where
          helperOption :: Parser (a -> a)
          helperOption :: forall a. Parser (a -> a)
    helperOption =
    #if MIN_VERSION_optparse_applicative(0,16,0)
            ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a.
    ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
    abortOption (Maybe FilePath -> ParseError
    ShowHelpText Maybe FilePath
    forall a. Maybe a
    Nothing) (Mod OptionFields (a -> a) -> Parser (a -> a))
    -> Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a b. (a -> b) -> a -> b
    $
    #else
            abortOption ShowHelpText $
    #endif
            [Mod OptionFields (a -> a)] -> Mod OptionFields (a -> a)
    forall a. Monoid a => [a] -> a
    mconcat [FilePath -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
    long FilePath
    "help", FilePath -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. FilePath -> Mod f a
    help FilePath
    "Show this help text", Mod OptionFields (a -> a)
    forall (f :: * -> *) a. Mod f a
    hidden]