    {-# 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, 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 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)
    import Data.Monoid ((<>))

    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' = 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 "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 '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 "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 "."
               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 "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 (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 (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 "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 '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 "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 "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 (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 "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 '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 "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 3000)
        Parser
      (Bool
       -> Bool -> Bool -> [(FilePath, FilePath)] -> FilePath -> Args)
    -> Parser Bool
    -> Parser
         (Bool -> Bool -> [(FilePath, FilePath)] -> FilePath -> Args)
    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 "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 'n')
        Parser (Bool -> Bool -> [(FilePath, FilePath)] -> FilePath -> Args)
    -> Parser Bool
    -> Parser (Bool -> [(FilePath, FilePath)] -> FilePath -> Args)
    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 "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 'q')
        Parser (Bool -> [(FilePath, FilePath)] -> FilePath -> Args)
    -> Parser Bool
    -> Parser ([(FilePath, FilePath)] -> FilePath -> Args)
    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 "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 'v')
        Parser ([(FilePath, FilePath)] -> FilePath -> Args)
    -> Parser [(FilePath, FilePath)] -> Parser (FilePath -> Args)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser (FilePath, FilePath) -> Parser [(FilePath, FilePath)]
    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 "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 '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 "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 "extra file extension/mime type mappings"))
        Parser (FilePath -> Args) -> Parser FilePath -> Parser Args
    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 "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 '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 "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 "*"
               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 "interface to bind to, special values: *, *4, *6")
      where
        toPair :: FilePath -> (FilePath, FilePath)
    toPair = (FilePath -> FilePath)
    -> (FilePath, FilePath) -> (FilePath, FilePath)
    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 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
    == '=')
        defIndex :: [FilePath] -> [FilePath]
    defIndex [] = ["index.html", "index.htm"]
        defIndex x :: [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 middleware :: Args -> Middleware
    middleware = do
        args :: Args
    args@Args {..} <- 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 (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 (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 "Serving directory %s on port %d with %s index files.\n" FilePath
    docroot' Int
    port (if Bool
    noindex then "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
    args)
        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 (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 :: Parser (a -> a)
    helperOption =
            ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a.
    ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
    abortOption ParseError
    ShowHelpText (Mod OptionFields (a -> a) -> Parser (a -> a))
    -> Mod OptionFields (a -> a) -> Parser (a -> a)
    forall a b. (a -> b) -> a -> b
    $
            [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 "help", FilePath -> Mod OptionFields (a -> a)
    forall (f :: * -> *) a. FilePath -> Mod f a
    help "Show this help text", Mod OptionFields (a -> a)
    forall (f :: * -> *) a. Mod f a
    hidden]