haskell - tag - merge branches subversion

¿Cómo recolectar correctamente las opciones de línea de comando en el programa Hxt?

Question

Llegué a la sección 3 de la tesis. Un libro de cocina para Haskell XML Toolbox con ejemplos para procesar documentos RDF de M. Ohlendorf.

Aquí está el programa que escribí,

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

Pero sigo con el siguiente error

hxtuto.hs:28:17:
Couldn''t match expected type `XIOSysState -> XIOSysState''
against inferred type `(String, String)''
Expected type: SysConfigList
Inferred type: Attributes
In the first argument of `readDocument'', namely `al''
In the first argument of `(>>>)'', namely `readDocument al src''
Failed, modules loaded: none.

Parece que es mi implementación de cmdLineOpts lo que no encaja bien.

Cuál es el problema aquí ? y ¿cómo puedo solucionarlo?

Gracias por cualquier ayuda !

Answer 1

Dado que el primer parámetro para leerDocument y writeDocument es [SysConfig], es posible que desee utilizar un paquete como GetOpt para manejar el mantenimiento de la lectura de texto desde la línea de comando y transformarlo en los objetos necesarios. Tomé la lista de "opciones disponibles" de la página 50 de la tesis y creé un tipo de Opciones con las SysConfigs actuales (de Text.XML.HXT.Arrow.XmlState.SystemConfig). Excepto por las partes que se han personalizado para la aplicación específica en cuestión, el resto (p. Ej., CmdLineOpts) se tomó directamente de la documentación de 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