Получение данных из простого XML - PullRequest
Новая
       39

Получение данных из простого XML

5 голосов
/ 01 июля 2011

Я пытаюсь извлечь некоторые данные из XML-ввода с 6 строками, используя HXT. Я тоже хочу сохранить HXT из-за интеграции Curl и потому, что у меня есть другие XML-файлы с тысячами строк, позже.

Мой XML выглядит так: 

<?xml version = "1.0" encoding = "UTF-8"?>
<find>
    <set_number>228461</set_number>
    <no_records>000000008</no_records>
    <no_entries>000000008</no_entries>
</find>

И я пытался понять, как это разобрать. К сожалению, вики-страница HXT не сильно помогла (или я просто что-то упустил). 

data FindResult = FindResult {
        resultSetNumber :: String,
        resultNoRecords :: Int,
        resultNoEntries :: Int
    } deriving (Eq, Show)

resultParser :: ArrowXml a => a XmlTree FindResult
resultParser = hasName "find" >>> getChildren >>> proc x -> do
    setNumber <- isElem >>> hasName "set_number" >>> getChildren >>> getText -< x
    noRecords <- isElem >>> hasName "no_records" >>> getChildren >>> getText -< x
    noEntries <- isElem >>> hasName "no_entries" >>> getChildren >>> getText -< x
    returnA -< FindResult setNumber (read noRecords) (read noEntries)

find str = return . head =<< (runX $ readDocument [withValidate no, withCurl []] query >>> resultParser)
    where query = "http://" ++ server ++ "/find?request=" ++ str

То, что я всегда получаю, это 

*** Exception: Prelude.head: empty list

так что, я думаю, синтаксический анализ должен идти ужасно неправильно, так как я проверил и правильно получил XML из запроса.

1 Ответ

6 голосов
/ 01 июля 2011

У меня работает следующее (смоделировано после этот пример ): 

{-# LANGUAGE Arrows #-}

module Main
       where

import Text.XML.HXT.Core
import System.Environment

data FindResult = FindResult {
        resultSetNumber :: String,
        resultNoRecords :: Int,
        resultNoEntries :: Int
    } deriving (Eq, Show)

resultParser :: ArrowXml a => a XmlTree FindResult
resultParser =
  deep (isElem >>> hasName "find") >>> proc x -> do
    setNumber <- getText <<< getChildren <<< deep (hasName "set_number") -< x
    noRecords <- getText <<< getChildren <<< deep (hasName "no_records") -< x
    noEntries <- getText <<< getChildren <<< deep (hasName "no_entries") -< x
    returnA -< FindResult setNumber (read noRecords) (read noEntries)

main :: IO ()
main = do [src] <- getArgs
          res <- runX $ ( readDocument [withValidate no] src >>> resultParser)
          print . head $ res

Тестирование: 

$ dist/build/test/test INPUT
FindResult {resultSetNumber = "228461", resultNoRecords = 8, resultNoEntries = 8}
...