如何将参数传递给HXT箭头以及如何使用 - <<

时间:2011-09-26 15:11:04

标签: haskell arrows hxt

我的问题如下。 我有这个xml文件来解析:

<DATAS LANG="en">
<SCENARIO ID="19864">
    <ORIGIN ID="329">
        <SCENARIO_S ERR="0"></SCENARIO_S>
        <SCENARIO_S ERR="2"></SCENARIO_S>
    </ORIGIN>
</SCENARIO>
<ERRORS>
    <ERROR ID="0" LABEL="Aggregated Major Errors" />
    <ERROR ID="2" LABEL="Banner error" />
</ERRORS>
</DATAS>

我希望得到以下输出:

[("19864","329",[0,2], ["Aggregated Major Errors", "Banner error"])]
that is 
[(Scenario ID, Origin ID, [ERR],[Errors label])]

但是下面的代码告诉我:

[("19864","329",[0,2],["","*** Exception: Maybe.fromJust: Nothing

我只想解析一次XML以检索“错误标签”和ERR。

我认为我的问题出在函数errToLab中,但没有明显的解决方案。

感谢您的帮助。

这是代码

{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}
import Text.XML.HXT.Core
import Data.Maybe

dataURL = "test.xml"

parseXML file = readDocument [ withValidate no
                         , withRemoveWS yes  -- throw away formating WS
                         ] file

atTag tag = deep (isElem >>> hasName tag)

getErrLab2 = atTag "ERRORS" >>>
  proc l -> do
     error <- atTag "ERROR"          -< l
     errID <- getAttrValue "ID"     -< error
     desc <- getAttrValue "LABEL"     -< error
     returnA -< (errID,desc)

getErr = atTag "SCENARIO_S" >>>
     proc p -> do
     err    <- getAttrValue "ERR" -< p
     returnA -< read err::Int 

getScenar2' errlab = atTag "SCENARIO" >>>
     proc l -> do
     scenarTag <- atTag "SCENARIO"     -< l
     scenName <- getAttrValue "ID"     -< l
     site     <- atTag "ORIGIN"          -< l
     siteName <- getAttrValue "ID"     -< site
     errs     <- listA getErr           -< site
     errlab   <- listA (errToLab errlab) -< site
     returnA -< (scenName,siteName,errs,errlab)

getData= atTag "DATAS" >>>
     proc p -> do 
          errlab <- getErrLab2  -< p
          datascen <- getScenar2' [errlab] -<< p
          returnA -< datascen

errToLab errlab = atTag "SCENARIO_S" >>>
     proc p -> do
          err    <- getAttrValue "ERR" -< p
          returnA -<  chercheErr err  errlab 

    where
          chercheErr "0" _  = ""
          chercheErr err taberr = fromJust.lookup err $ taberr

main = do
    site <- runX (parseXML dataURL >>> getData)
    print site

1 个答案:

答案 0 :(得分:2)

只需将错误列表提供给箭头输入。

这是一个略微编辑的版本:

{-# LANGUAGE Arrows #-}
import Text.XML.HXT.Core
import Data.Maybe

dataURL = "test.xml"

parseXML file = readDocument [ withValidate no
                             , withRemoveWS yes  -- throw away formating WS
                             ] file

atTag tag = deep (isElem >>> hasName tag)

getErrLab2 = atTag "ERRORS" >>>
    proc l -> do
    error <- atTag "ERROR"        -< l
    errID <- getAttrValue "ID"    -< error
    desc  <- getAttrValue "LABEL" -< error
    returnA -< (errID,desc)

getErr = atTag "SCENARIO_S" >>>
    proc p -> do
    err    <- getAttrValue "ERR" -< p
    returnA -< read err::Int 

getScenar2' = proc (p,errlab) -> do
    l <- atTag "SCENARIO" -< p
    scenarTag <- atTag "SCENARIO"  -< l
    scenName  <- getAttrValue "ID" -< l
    site      <- atTag "ORIGIN"    -< l
    siteName  <- getAttrValue "ID" -< site
    errs      <- listA getErr      -< site
    elab      <- listA errToLab    -< (site,errlab)
    returnA -< (scenName,siteName,errs,elab)

getData= atTag "DATAS" >>>
  proc p -> do 
      errlab <- listA getErrLab2  -< p
      getScenar2' -< (p, errlab)

errToLab = proc (s,errlab) -> do
   p    <- atTag "SCENARIO_S" -< s
   err  <- getAttrValue "ERR" -< p
   returnA -<  chercheErr err  errlab 

  where
      -- chercheErr "0" _  = ""
      chercheErr err taberr = fromJust.lookup err $ taberr

main = do
  site <- runX (parseXML dataURL >>> getData)
  print site