Haskell 如何正确收集Hxt程序上的命令行选项？

我已经到了论文的第3部分，这是一本Haskell XML工具箱的食谱，其中有处理M.Ohlendorf的RDF文档的示例

这是我写的程序

import Text.XML.HXT.Core
import System.Exit
import System.Environment
import Data.Maybe

main = do
  args       <- getArgs
  (al, src)  <- cmdLineOpts args
  [rc]       <- runX (processDocument al src)
  exitWith ( if rc >= c_err
             then ExitFailure (-1)
             else ExitSuccess
           )

cmdLineOpts :: [String] -> IO (Attributes, String)
cmdLineOpts []  = return ([("","")], "")
cmdLineOpts xss = return (zip [""] xss :: Attributes, last xss)

processDocument :: Attributes -> String -> IOSArrow b Int
processDocument al src =
    readDocument al src -- lecture du document en appliquant les attributes                                                                                            
    >>>
    removeAllWhiteSpace >>> propagateNamespaces
    >>>
    writeDocument al (fromMaybe "" (lookup a_output_file al))
    >>>
    getErrStatus

似乎是我对

cmdLineOpts

的实现不太合适

这里有什么问题？我怎样才能修好它

---

谢谢你的帮助

由于readDocument和writeDocument的第一个参数都是[SysConfig]，因此您可能希望使用诸如GetOpt之类的包来处理从命令行读取文本并将其转换为所需对象的管理工作。我从论文第50页获取了“可用选项”列表，并创建了一个选项类型，其中包含当前对应的SysConfigs（来自Text.XML.HXT.Arrow.XmlState.SystemConfig）。除了为手头的特定应用程序定制的部件外，其余部件（如cmdLineOpts）直接取自GetOpt文档

import System.Console.GetOpt
import System.Environment
import System.Exit 
import Text.XML.HXT.Core

data Options = Options {
    withvalidate :: SysConfig
  , withchecknamespaces :: SysConfig
  , withcanonicalize :: SysConfig
  , withremovews :: SysConfig
  , withtrace :: SysConfig
  , output_file :: String } 

defaultOptions = Options { withvalidate = (withValidate no)
                         , withchecknamespaces = (withCheckNamespaces no)
                         , withcanonicalize = (withCanonicalize no)
                         , withremovews = (withRemoveWS no)
                         , withtrace = (withTrace 0)
                         , output_file = "" } 

options :: [OptDescr (Options -> Options)]
options =
 [ Option ['V'] ["withValidate"] 
   (ReqArg (\v opts -> opts { withvalidate = withValidate (v == "yes") } ) "") 
   "perform DTD validation"
 , Option ['n'] ["withCheckNamespaces"] 
   (ReqArg (\n opts -> opts { withchecknamespaces = withCheckNamespaces (n == "yes") } ) "")
   "check namespaces"
 , Option ['c'] ["withCanonicalize"] 
   (ReqArg (\c opts -> opts { withcanonicalize = withCanonicalize (c == "yes") } ) "")
   "canonicalize document"
 , Option ['w'] ["withRemoveWS"] 
   (ReqArg (\w opts -> opts { withremovews = withRemoveWS (w == "yes") } ) "")
   "remove whitespace used for document indentation"
 , Option ['t'] ["withTrace"] 
   (ReqArg (\t opts -> opts { withtrace = withTrace (read t) } ) "")
   "set trace level" 
 , Option ['o'] ["outputFile"] 
   (ReqArg (\o opts -> opts { output_file = o } ) "") 
   "output file" ]

cmdLineOpts :: [String] -> IO (Options, [String])
cmdLineOpts argv =
    case getOpt Permute options argv of
      (o, n, []) -> return (foldl (flip id) defaultOptions o, n)
      (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
    where header = "Using: [OPTION ...]"

main :: IO ()
main = do (opts, (src:_)) <- cmdLineOpts =<< getArgs 
          [rc] <- runX $ processDocument opts src
          exitWith $ if rc >= c_err then ExitFailure (-1) else ExitSuccess

processDocument :: Options -> String -> IOSArrow b Int
processDocument (Options val ns can ws tr out) src =
    readDocument [val, ns, can, ws, tr] src >>> 
    removeAllWhiteSpace >>> propagateNamespaces >>>
    writeDocument [val, ns, can, ws, tr] out >>>
    getErrStatus

import System.Console.GetOpt
导入系统。环境
导入系统。退出
导入Text.XML.HXT.Core
数据选项=选项{
withvalidate:：SysConfig
，withchecknamespaces:：SysConfig
，withcanonicalize:：SysConfig
，withremovews:：SysConfig
，withtrace:：SysConfig
，输出文件：：字符串}
defaultOptions=选项{withvalidate=（withvalidate否）
，withchecknamespaces=（withchecknamespaces否）
，with canonicalize=（with canonicalize no）
，withremovews=（withremovews否）
，withtrace=（withtrace 0）
，output_file=“”}
选项：：[OptDescr（选项->选项）]
选择权=
[选项['V'][“带验证”]
（ReqArg（\v opts->opts{withvalidate=withvalidate（v==“yes”）}）”）
“执行DTD验证”
，选项['n'][“withCheckNamespaces”]
（ReqArg（\n opts->opts{withchecknamespaces=withchecknamespaces（n==“yes”）}）”）
“检查名称空间”
，选项['c'][“带规范化”]
（ReqArg（\c opts->opts{withcanonicalize=withcanonicalize（c==“yes”）}）”
“规范化文档”
，选项['w'][“withRemoveWS”]
（ReqArg（\w opts->opts{withremovews=withremovews（w==“yes”）}）”）
“删除用于文档缩进的空白”
，选项['t'][“withTrace”]
（ReqArg（\t opts->opts{withtrace=withtrace（read t）}）”）
“设置跟踪级别”
，选项['o'][“outputFile”]
（请求参数（\o选项->选项{output\u file=o}）”）
“输出文件”]
cmdLineOpts:：[String]->IO（选项，[String]）
cmdLineOpts argv=
案例getOpt排列选项argv of
（o，n，[]）->返回（foldl（翻转id）默认选项o，n）
（u，u，errs）->ioError（userError（concat errs++usageInfo头选项））
其中header=“使用：[OPTION…””
main:：IO（）
main=do（opts，（src:u））ios箭头b Int
processDocument（选项val ns can ws tr out）src=
readDocument[val、ns、can、ws、tr]src>>>
删除所有空白>>>传播命名空间>>>
写入文件[val、ns、can、ws、tr]输出>>>
getErrStatus

这本“食谱”的日期是2007年1月6日。从那时起，函数readDocument的类型可能已经改变，因为它现在是SysConfigList->String->iostatesarrow s b XmlTree。非常感谢

ricksk8r

，这正是我从一段时间以来一直在寻找的。

import System.Console.GetOpt
import System.Environment
import System.Exit 
import Text.XML.HXT.Core

data Options = Options {
    withvalidate :: SysConfig
  , withchecknamespaces :: SysConfig
  , withcanonicalize :: SysConfig
  , withremovews :: SysConfig
  , withtrace :: SysConfig
  , output_file :: String } 

defaultOptions = Options { withvalidate = (withValidate no)
                         , withchecknamespaces = (withCheckNamespaces no)
                         , withcanonicalize = (withCanonicalize no)
                         , withremovews = (withRemoveWS no)
                         , withtrace = (withTrace 0)
                         , output_file = "" } 

options :: [OptDescr (Options -> Options)]
options =
 [ Option ['V'] ["withValidate"] 
   (ReqArg (\v opts -> opts { withvalidate = withValidate (v == "yes") } ) "") 
   "perform DTD validation"
 , Option ['n'] ["withCheckNamespaces"] 
   (ReqArg (\n opts -> opts { withchecknamespaces = withCheckNamespaces (n == "yes") } ) "")
   "check namespaces"
 , Option ['c'] ["withCanonicalize"] 
   (ReqArg (\c opts -> opts { withcanonicalize = withCanonicalize (c == "yes") } ) "")
   "canonicalize document"
 , Option ['w'] ["withRemoveWS"] 
   (ReqArg (\w opts -> opts { withremovews = withRemoveWS (w == "yes") } ) "")
   "remove whitespace used for document indentation"
 , Option ['t'] ["withTrace"] 
   (ReqArg (\t opts -> opts { withtrace = withTrace (read t) } ) "")
   "set trace level" 
 , Option ['o'] ["outputFile"] 
   (ReqArg (\o opts -> opts { output_file = o } ) "") 
   "output file" ]

cmdLineOpts :: [String] -> IO (Options, [String])
cmdLineOpts argv =
    case getOpt Permute options argv of
      (o, n, []) -> return (foldl (flip id) defaultOptions o, n)
      (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
    where header = "Using: [OPTION ...]"

main :: IO ()
main = do (opts, (src:_)) <- cmdLineOpts =<< getArgs 
          [rc] <- runX $ processDocument opts src
          exitWith $ if rc >= c_err then ExitFailure (-1) else ExitSuccess

processDocument :: Options -> String -> IOSArrow b Int
processDocument (Options val ns can ws tr out) src =
    readDocument [val, ns, can, ws, tr] src >>> 
    removeAllWhiteSpace >>> propagateNamespaces >>>
    writeDocument [val, ns, can, ws, tr] out >>>
    getErrStatus