Lan*_*nbo 5 xml haskell arrows hxt
我试图使用HXT从6行的XML输入中提取一些数据.我也希望保留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>
Run Code Online (Sandbox Code Playgroud)
我一直试图聚在一起解析它.不幸的是,HXT的Wiki页面并没有太大的帮助(或者我只是忽略了一些东西).
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
Run Code Online (Sandbox Code Playgroud)
我一直得到的是
*** Exception: Prelude.head: empty list
Run Code Online (Sandbox Code Playgroud)
所以,我想,解析必须严重错误,因为我检查并正确地从查询中获取XML.
以下适用于我(以此示例为模型):
{-# 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
Run Code Online (Sandbox Code Playgroud)
测试:
$ dist/build/test/test INPUT
FindResult {resultSetNumber = "228461", resultNoRecords = 8, resultNoEntries = 8}
Run Code Online (Sandbox Code Playgroud)