xml - 在 Haskell 中为箭头函数提供参数

Question

我有一个包含一些数据的 XML 文件。该文件包含列和数据本身的描述。我可以读取列名称，但无法读取数据，因为我不明白如何将此行名称赋予将返回数据的函数。

XML 文件:

<?xml version="1.0" encoding="UTF-8"?>
<Document>
<Header>
<Project code="SOME PROJECT" label="PROJECT LABEL"></Project>
<Datatable name="LOG" label="Visits"></Datatable>
<Columns>
    <column name="study" label="Study" ordinal="1" type="TEXT"></column>
    <column name="site" label="Site" ordinal="2" type="INTEGER"></column>
    <column name="number" label="Subject" ordinal="3" type="INTEGER"></column>
    <column name="visit" label="Visit number" ordinal="4" type="CHARACTER VARYING(20)">     
 </column>
 <column name="vdate" label="Visit date (dd/mm/yyyy)." ordinal="5" type="CHARACTER   VARYING(10)"></column>
</Columns>
</Header>

<table xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">

   <row>
   <study>Some study</study>
   <site>1</site>
   <number>1</number>
   <visit>1</visit>
   <vdate>28/12/2010</vdate>
   </row>

   <row>
   <study>Some study</study>
   <site>1</site>
   <number>1</number>
   <visit>2</visit>
   <vdate>03/03/2011</vdate>
   </row>

   <row>
   <study>Some study</study>
   <site>1</site>
   <number>1</number>
   <visit>3</visit>
   <vdate>09/06/2011</vdate>
   </row>

   </table>
   </Document>

示例代码:

{-# LANGUAGE Arrows #-}

import Text.XML.HXT.Core
import Data.Tree.NTree.TypeDefs

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

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

text :: ArrowXml cat => cat (NTree XNode) String
text = getChildren >>> getText

getRowsData :: ArrowXml cat => cat (NTree XNode) [String]
getRowsData = atTag "table" >>>
    proc l ->  do
        row <- atTag "row" -< l

        study <- text <<< atTag "study" -< row
        site <- text <<< atTag "site" -< row
        returnA -< [study,site]

readTable :: ArrowXml t => t (NTree XNode) [[String]]
readTable =
    proc l -> do
        rows <- listA getRowsData -< l

        returnA -< rows

main :: IO ()
main = do
    res <- runX ( parseXML "log.xml" >>> readTable )
    print res

我的问题在 getRowsData 中。在示例代码中，我隐式给出了列名，但我希望它从列表中读取，在箭头函数中应用并返回行。

Answer 1

import Control.Arrow

组合箭头列表

我相信您正在寻找的是一种在同一输入上组合多个箭头以列出其输出的方法:

list :: Arrow a => [a b c] -> a b [c]
list [] = returnA >>^ const []
list (a:as) = (a &&& list as) >>^ uncurry (:)

(a &&& list as) 返回一对头部和尾部，然后我们后应用 >>^ 纯函数 uncurry (: )::(x,[x]) -> [x] 重新组合它们。

让我们测试一下。这里有一些玩 IO 箭头的东西。一个 monad 是一个箭头，但你必须将它包装到它的 Kleisli 类别中。 runKleisli 再次打开它，这样你就可以运行它了，但是我打字的时间太长了，所以我使用了一个中缀版本 >$> 来为它提供输入:

ask :: Kleisli IO String String
ask = Kleisli $ \xs -> putStrLn xs >> getLine

(>$>) = runKleisli

所以现在交互更容易了:

*Main> ask >$> "Hello?"
Hello?
Hello!
"Hello!"

和list 工作正常:

*Main> list [ask,ask] >$> "say something!"
say something!
OK
say something!
What do you want me to say?
["OK","What do you want me to say?"]

从 [String] 到返回 [String] 的箭头

但是您想将字符串列表转换为生成字符串列表的箭头。

appList :: Arrow a => (s -> a b c) -> [s] -> a b [c]
appList f xs = list (map f xs)

我们可以用 ask 测试的变体来测试它:

askRespond xs = Kleisli $ \thx -> do
                       putStrLn xs 
                       ans <- getLine
                       putStrLn thx
                       return ans

所以我们可以看到 appList 正在按照您想要的方式工作，通过从每个字符串中制作一个箭头，然后运行每个字符串，再次将答案组合成一个字符串:

*Main> appList askRespond ["What's your name?","What's your favourite colour?","Would you like some cheese?"]  >$> "Thanks."
What's your name?
Andrew
Thanks.
What's your favourite colour?
Green
Thanks.
Would you like some cheese?
Yes - could I have gruyere?
Thanks.
["Andrew","Green","Yes - could I have gruyere?"]

抓取多个标签内容

现在让我们将其应用于您的问题。

首先让我们做一个速记，用字符串做一个箭头:

textAtTag xs = text <<< atTag xs 

然后让我们使用appList:

getRowsData = atTag "table" 
          >>> atTag "row"
          >>> appList textAtTag ["study","site"]

我还没有测试最后一个 - 请检查!