命令行程序：参数、环境变量与选项解析¶

module Main (main) where

import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)

main :: IO ()
main = do
  args <- getArgs
  case args of
    [path] -> run False path
    ["-v", path] -> run True path
    _ -> do
      hPutStrLn stderr "用法: manual [-v] FILE"
      exitFailure
  where
    run verbose path = do
      content <- readFile path
      if verbose
        then putStrLn (path ++ ": " ++ show (length (lines content)) ++ " 行")
        else print (length (lines content))

data OptDescr a = Option
  [Char]        -- 短选项字符，如 ['o']
  [String]      -- 长选项名，如 ["output"]
  (ArgDescr a)  -- 是否带参数，以及如何得到一个 a
  String        -- 帮助文本

data ArgDescr a
  = NoArg a                            -- 不带参数，如 -v
  | ReqArg (String -> a) String        -- 必须带参数，如 -o FILE；第二项是参数的占位名
  | OptArg (Maybe String -> a) String  -- 参数可选

getOpt :: ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
--                                                    选项值  普通参数  错误信息

usageInfo :: String -> [OptDescr a] -> String

module Main (main) where

import System.Console.GetOpt
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)

data Options = Options
  { optVerbose :: Bool
  , optOutput :: Maybe FilePath
  } deriving (Show)

defaultOptions :: Options
defaultOptions = Options { optVerbose = False, optOutput = Nothing }

-- 每个选项解析出来的值是一个修改 Options 的函数
options :: [OptDescr (Options -> Options)]
options =
  [ Option ['v'] ["verbose"] (NoArg (\o -> o { optVerbose = True })) "输出详细信息"
  , Option ['o'] ["output"] (ReqArg (\f o -> o { optOutput = Just f }) "FILE") "把结果写入 FILE"
  ]

main :: IO ()
main = do
  args <- getArgs
  -- Permute 表示选项和普通参数可以任意交错
  case getOpt Permute options args of
    (actions, files, []) -> do
      let opts = foldl (flip id) defaultOptions actions
      print opts
      print files
    (_, _, errs) -> do
      hPutStrLn stderr (concat errs ++ usageInfo "用法: getopt [选项] [文件...]" options)
      exitFailure

switch    :: Mod FlagFields Bool -> Parser Bool           -- 开关，如 -v
strOption :: Mod OptionFields String -> Parser String     -- 带字符串参数的选项，如 -o FILE
option    :: ReadM a -> Mod OptionFields a -> Parser a    -- 带参数并转换类型，option auto 按 Read 解析
argument  :: ReadM a -> Mod ArgumentFields a -> Parser a  -- 位置参数，argument str 取原始字符串

strOption (long "output" <> short 'o' <> metavar "FILE" <> help "把结果写入 FILE")

Options <$> switch (long "lines" <> short 'l')
        <*> switch (long "words" <> short 'w')
        <*> strOption (long "output" <> short 'o' <> metavar "FILE")

class Applicative f => Alternative f where
  empty :: f a
  (<|>) :: f a -> f a -> f a   -- 先试左边，失败了再试右边

module Main (main) where

import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Options.Applicative

data Output = ToStdout | ToFile FilePath
  deriving (Show)

data Options = Options
  { optLines :: Bool
  , optWords :: Bool
  , optChars :: Bool
  , optOutput :: Output
  , optFiles :: [FilePath]
  } deriving (Show)

-- 描述单个选项：用 <> 把各项修饰拼在一起；二选一：用 <|>
outputParser :: Parser Output
outputParser =
  ToFile <$> strOption (long "output" <> short 'o' <> metavar "FILE" <> help "把结果写入 FILE")
    <|> pure ToStdout

-- 合并多个选项：用 <$> 和 <*> 把它们组成一个 Options
optionsParser :: Parser Options
optionsParser =
  Options
    <$> switch (long "lines" <> short 'l' <> help "统计行数")
    <*> switch (long "words" <> short 'w' <> help "统计单词数")
    <*> switch (long "chars" <> short 'c' <> help "统计字符数")
    <*> outputParser
    <*> many (argument str (metavar "FILE..."))

count :: Options -> T.Text -> String
count opts content = unwords (map show selected)
  where
    -- 没有指定任何统计项时，三项全部输出
    showAll = not (optLines opts || optWords opts || optChars opts)
    selected =
      [length (T.lines content) | optLines opts || showAll]
        ++ [length (T.words content) | optWords opts || showAll]
        ++ [T.length content | optChars opts || showAll]

main :: IO ()
main = do
  opts <- execParser (info (helper <*> optionsParser) (progDesc "统计行数、单词数和字符数"))
  results <- case optFiles opts of
    [] -> do
      content <- TIO.getContents
      return [count opts content]
    files -> mapM (\path -> do
                      content <- TIO.readFile path
                      return (count opts content ++ "\t" ++ path)) files
  let output = unlines results
  case optOutput opts of
    ToStdout -> putStr output
    ToFile path -> writeFile path output