Giving parameters to arrow function in Haskell

Question

I have an XML file with some data. This file has a description of columns and the data itself. I can read column names, but I can't read data because I do not understand how to give this row names to a function which will return the data.

XML file:

<?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>

Sample code:

{-# 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

The problem for me is in getRowsData. In the sample code I gave column names implicitly, but I want it read from a list, apply in arrow function and return rows.

Answer 1

import Control.Arrow

Combining lists of Arrows

I believe what you're looking for is a way of combining multiple arrows on the same input to list their output:

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

(a &&& list as) returns a pair of the head and the tail, then we post-apply >>^ the pure function uncurry (:) :: (x,[x]) -> [x] to recombine them.

Let's test it. Here are some things to play with IO arrows. A monad is an arrow, but you have to wrap it into its Kleisli category. runKleisli unwraps it again so you can run it, but takes me too long to type, so I've used an infix version >$> to feed it the input:

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

(>$>) = runKleisli

So now it's easier to interact:

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

and list works fine:

*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?"]

From [String] to arrow returning [String]

But you want to turn a list of Strings into an arrow that produces lists of Strings.

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

We can test that with a variant on the ask test:

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

So we can see appList is working the way you want, by making an arrow out of each String, and running each, combining the answers into a string again:

*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?"]

Grabbing multiple tag contents

Now let's apply that to your problem.

First let's make a shorthand to make an arrow out of a string:

textAtTag xs = text <<< atTag xs 

Then let's use appList:

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

I haven't tested that last one - please check!