Вот один из подходов (мои типы немного более общие, и я не использую XPath):
{-# LANGUAGE Arrows #-}
module Main where
import qualified Data.Map as M
import Text.XML.HXT.Arrow
classes :: (ArrowXml a) => a XmlTree (M.Map String String)
classes = listA (divs >>> divs >>> pairs) >>> arr M.fromList
where
divs = getChildren >>> hasName "div"
pairs = proc div -> do
cls <- getAttrValue "class" -< div
val <- deep getText -< div
returnA -< (cls, val)
getValues :: (ArrowXml a) => [String] -> a XmlTree [(String, Maybe String)]
getValues cs = classes >>> arr (zip cs . lookupValues cs)
where lookupValues cs m = map (flip M.lookup m) cs
main = do
let xml = "<div><div class='c1'>a</div><div class='c2'>b</div>\
\<div class='c3'>123</div><div class='c4'>234</div></div>"
print =<< runX (readString [] xml >>> getValues ["c1", "c2", "c3", "c4"])
Я бы, вероятно, запустил стрелку, чтобы получить карту, а затем выполнил бы поиск, но этот способ также работает.
Чтобы ответить на ваш вопрос о listA
: divs >>> divs >>> pairs
- это стрелка списка с типом a XmlTree (String, String)
- т.е., это недетерминированное вычисление, которое принимает дерево XML и возвращает пары строк.
arr M.fromList
имеет тип a [(String, String)] (M.Map String String)
. Это означает, что мы не можем просто составить его с divs >>> divs >>> pairs
, так как типы не совпадают.
listA
решает эту проблему: она сворачивается divs >>> divs >>> pairs
в детерминированную версию с типом a XmlTree [(String, String)]
, что именно то, что нам нужно.