Question

我有以下情况。我从探针获得周数据。数据收集在几个xml文件中（在下面的代码中内联）。我需要在一个文件中连接这些。虽然我将它们聚合在一个记录中，可以进一步翻译成单个文件。

我试图捕获的结果记录如下：

    [YS {ser = "MSG"
        , ori =[YO {site = "Bordeaux" , perfM = ["0","0"]  }
               ,YO {site = "Paris"    , perfM = ["1","1"]}]}
    ,YS {ser = "OTP"
        , ori =[YO {site = "Marseilles" , perfM = ["20","20"]}
               ,YO {site = "Lyon"       , perfM = ["21","21"]}]}
    ]

如您所见 perfM 收集所有数据。

但是下面的代码给了我这个。

    [YS {ser = "MSG"
        , ori = [YO {site = "Bordeaux", perfM = ["0"]}
                ,YO {site = "Paris", perfM =["1"]}
                ,YO {site = "Bordeaux", perfM = ["0","0"]}
                ,YO {site = "Paris", perfM = ["1","1"]}]}
    ,YS {ser = "OTP"
        , ori = [YO {site = "Marseilles"
                , perfM = ["20"]}
                ,YO {site = "Lyon", perfM =["21"]}
                ,YO {site = "Marseilles", perfM = ["20","20"]}
                ,YO {site = "Lyon", perfM = ["21","21"]}]}
    ]

我真的不清楚这里发生了什么，我应该在哪里看看。我认为它在getYearOri和addOri函数中，但到目前为止，我的所有尝试都失败了。

如果有人能给我一些关于要更改的代码的线索。

    {-# LANGUAGE Arrows, NoMonomorphismRestriction #-}

    import Text.XML.HXT.Core

    type Site = String
    type Service = String
    data YScen = YS
      { ser   :: Service
      , ori   :: [YOri]
      }
      deriving (Show,Eq)

    data YOri = YO
      {  site                 :: Site
        ,perfM                :: [String]
      }
      deriving (Show,Eq)



    xml= "<DATAS LANG='en'>\
        \ <SCENARIO ID='MSG'>\
        \   <ORIGIN ID='Bordeaux'>\
        \       <SCENARIO_M PERF_MOY='0'></SCENARIO_M>\
        \   </ORIGIN>\
        \   <ORIGIN ID='Paris'>\
        \       <SCENARIO_M PERF_MOY='1'></SCENARIO_M>\
        \   </ORIGIN>\
        \ </SCENARIO>\
        \ <SCENARIO ID='OTP'>\
        \   <ORIGIN ID='Marseilles'>\
        \       <SCENARIO_M PERF_MOY='20'></SCENARIO_M>\
        \   </ORIGIN>\
        \   <ORIGIN ID='Lyon'>\
        \       <SCENARIO_M PERF_MOY='21'></SCENARIO_M>\
        \   </ORIGIN>\
        \ </SCENARIO>\
        \</DATAS>"


    parseXML :: String -> IOStateArrow s b XmlTree
    parseXML s = readString [ withValidate no
                            , withRemoveWS yes  
                            ] s

    atTag ::  ArrowXml a =>  String -> a XmlTree XmlTree
    atTag tag = deep (isElem >>> hasName tag)


    getYearOri :: ArrowXml cat =>  [YOri] -> cat XmlTree  YOri 
    getYearOri yo = atTag "ORIGIN" >>>
      proc tagSite -> do
        siteName1 <- getAttrValue "ID"     -< tagSite

        tagScen_M <- atTag "SCENARIO_M"         -< tagSite
        perfM1     <- getAttrValue "PERF_MOY"    -< tagScen_M

        returnA -<  addOri (YO siteName1 [perfM1]) yo
        where 
            addOri::YOri -> [YOri]-> YOri
            addOri o [] = o 

            addOri o (x:xs) 
                     | site o == site x
                                = YO  {site     = site o 
                                      ,perfM    = (perfM x) ++ (perfM o)}

                     | otherwise = addOri o xs


    getYearScen :: ArrowXml cat => [YScen] -> cat XmlTree  YScen 
    getYearScen ys = atTag "SCENARIO" >>>
      proc l -> do
        scenName <- getAttrValue "ID"      -< l
        orig     <- listA (getYearOri (concat (map ori ys)))    -< l
        returnA -< addScen (YS scenName orig) ys
        where
            addScen :: YScen -> [YScen] -> YScen
            addScen sc [] = sc
            addScen sc (x:xs) 
                        | ser sc == ser x
                                    = YS {ser=ser x
                                         ,ori=(ori x) ++ (ori sc)}  
                        | otherwise = addScen sc xs

    parse :: [YScen]-> IO [YScen]
    parse ys = do
        res <- runX (parseXML xml >>> getYearScen ys)
        return res

    ysc1 = [YS "" []]

    test = do 
        ysc2 <- parse ysc1
        ysc3 <- parse ysc2
        return ysc3

Answer 1

我想我发现了自己的错误。 addScen函数不正确，应更改为

        addScen :: YScen -> [YScen] -> YScen
        addScen sc [] = sc
        addScen sc (x:xs) 
                    | ser sc == ser x
                                = YS {ser=ser sc
                                     ,ori=(ori sc) }  
                                    -- ,ori=(ori x) ++ (ori sc) <--- Error 
                    | otherwise = addScen sc xs

要找到这个，我必须阅读有关debbuging haskell和最有用的评论的文档，其中“编写小函数并测试它们。然后编写。”

我将代码分成小部分并测试它的每个部分。但与其他使用debbugger比ghc更友好的语言相比，这是乏味的。

对不起烦恼。如果有些人可能感兴趣，我会发布我的解决方案。

如何处理嵌套记录和listA箭头

1 个答案: