如何混合应用函子和箭头技术

Question

我在Andrew Birkett的博客上读到应用箭头用于XML和返回纯函数，我们可以混合使用箭头和应用函子。

我自己尝试了一下，但结果并不如我所愿。 我希望得到这个结果：

[Scenario {scenario = "11111", origin = "333", alarm = "Sonde1"},
 Scenario {scenario = "22222", origin = "444", alarm = "Sonde2"}]

但我得到了以下结果：

[Scenario {scenario = "11111", origin = "333", alarm = "Sonde1"},
 Scenario {scenario = "11111", origin = "333", alarm = "Sonde2"},
 Scenario {scenario = "11111", origin = "444", alarm = "Sonde1"},
 Scenario {scenario = "11111", origin = "444", alarm = "Sonde2"},
 Scenario {scenario = "22222", origin = "333", alarm = "Sonde1"},
 Scenario {scenario = "22222", origin = "333", alarm = "Sonde2"},
 Scenario {scenario = "22222", origin = "444", alarm = "Sonde1"},
 Scenario {scenario = "22222", origin = "444", alarm = "Sonde2"}]

我认为我的代码有问题，但我不知道在哪里查找。

以下是我的代码，如果有人能提供帮助，请告诉我。

{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}

import Text.XML.HXT.Core
import Control.Applicative
import Text.XML.HXT.Arrow.ReadDocument
import Data.Maybe
import Text.XML.HXT.XPath.Arrows
import Text.Printf


data Scenario = Scenario
  { scenario, origin, alarm    :: String
  }
  deriving (Show, Eq)


xml= "<DATAS LANG='en'>\
    \ <SCENARIO ID='11111'>\
    \   <ORIGIN ID='333'>\
    \       <SCENARIO_S ERR='0'></SCENARIO_S>\
    \       <SCENARIO_S ERR='2'></SCENARIO_S>\
    \       <ALARM_M NAME='Sonde1'></ALARM_M>\
    \   </ORIGIN>\
    \ </SCENARIO>\
    \ <SCENARIO ID='22222'>\
    \   <ORIGIN ID='444'>\
    \       <SCENARIO_S ERR='10'></SCENARIO_S>\
    \       <SCENARIO_S ERR='12'></SCENARIO_S>\
    \       <ALARM_M NAME='Sonde2'></ALARM_M>\
    \   </ORIGIN>\
    \ </SCENARIO>\
    \</DATAS>"

parseXML string = readString [ withValidate no
                         , withRemoveWS yes  -- throw away formating WS
                         ] string


parseVal tag name = WrapArrow $ getXPathTrees (printf "/DATAS/%s" tag) >>>  getAttrValue name

parseDatas = unwrapArrow $ Scenario <$> parseVal "SCENARIO"      "ID"
                                 <*> parseVal "SCENARIO/ORIGIN"        "ID"
                                 <*> parseVal "SCENARIO/ORIGIN/ALARM_M"        "NAME"

testarr1= runX (parseXML xml >>> parseDatas)

- jinkou2 jinkou2

---

添加类型将有助于您理解发生的情况。请注意，您有3个具有两个字段的字段，并且您将获得2^3=8个结果。这是由于列表单子结构的工作方式 - 它会给您笛卡尔积。 - rampion

谢谢。我花了一些时间才找到我的错误，并更好地理解了适用函子的概念。我现在没有正确的代码，可能需要改变我的数据结构以更好地匹配XML结构。 - jinkou2 jinkou2

我认为你需要使用zipList函子的适用实例，而不是默认的实例。 - Theo Belaire

@rampion -- 考虑将您的评论发布为答案？ - sclv

Answer 1

正如rampion所指出的那样，问题在于列表单子与应用单子的工作方式。看一下这个：

λ *Main > (+) <$> [1,2,3] <*> [1,2,3]
[2,3,4,3,4,5,4,5,6]

结果是将(+)应用于[1,2,3]和[1,2,3]的笛卡尔积：结果列表有9个元素。

在您的代码中，parseVal "SCENARIO" "ID"将返回一个由2个元素组成的列表，parseVal "SCENARIO/ORIGIN" "ID"和parseVal "SCENARIO/ORIGIN/ALARM_M" "NAME"也是如此。因此，结果将有8个元素。

相反，这是我会如何更改您的代码：

--- parse a generic tag
parseVal tag name = WrapArrow $ getXPathTrees (printf "%s" tag) >>>  getAttrValue name

--- parse a "SCENARIO" xml element
parseScenario = unwrapArrow $ Scenario
        <$> (WrapArrow $ getAttrValue "ID")
        <*> (parseVal "SCENARIO/ORIGIN" "ID")
        <*> (parseVal "SCENARIO/ORIGIN/ALARM_M" "NAME")

--- parse the XML, extract a list of SCENARIOS and, for each, apply parseScenario
testarr1= runX (parseXML xml >>> getXPathTrees (printf "/DATAS/SCENARIO" ) >>> parseScenario)

结果如期望的那样：

λ *Main > testarr1 
[Scenario {scenario = "11111", origin = "333", alarm = "Sonde1"},Scenario {scenario = "22222", origin = "444", alarm = "Sonde2"}]

- lbolla