如何用数据类型构造函数将HXT的整个匹配列表包裹起来

Question

我目前正在学习HXT，通过使用它来解析GPX文件。一个例子在这里。到目前为止，我有以下内容：

import Data.Time
import Text.XML.HXT.Core
data Gpx    = Gpx [Trk]           deriving (Show)
data Trk    = Trk [TrkSeg]        deriving (Show)
data TrkSeg = TrkSeg [TrkPt]      deriving (Show)
data TrkPt  = TrkPt Double Double deriving (Show)
parseGpx =
  getChildren >>> isElem >>> hasName "gpx" >>>
  getChildren >>> isElem >>> hasName "trk" >>>
  parseGpxTrk >>> arr Gpx
parseGpxTrk = undefined
parseGpxTrkSegs = undefined

您可以看到它是不完整的，但仍应键入检查。不幸的是，我已经遇到了一个错误：

Couldn't match type ‘Trk’ with ‘[Trk]’
Expected type: Trk -> Gpx
  Actual type: [Trk] -> Gpx
In the first argument of ‘arr’, namely ‘Gpx’
In the second argument of ‘(>>>)’, namely ‘arr Gpx’

这个错误说的是我试图通过parseGpxTrk箭头从arr Gpx构造器传递每个匹配的项目，但是我实际想要的是通过arr Gpx构造函数将整个匹配列表传递。

那么，我如何获得HXT（或一般箭头？）以通过我的arr Gpx构造函数作为 list 传递匹配项，而不是通过 arr Gpx constructor在列表中传递每个条目？

Answer 1

这是一个对我来说似乎不错的解决方案

{-# LANGUAGE Arrows #-}
import Data.Maybe
import Text.Read
import Text.XML.HXT.Core
import Control.Applicative
data Gpx    = Gpx [Trk]           deriving (Show)
data Trk    = Trk [TrkSeg]        deriving (Show)
data TrkSeg = TrkSeg [TrkPt]      deriving (Show)
data TrkPt  = TrkPt Double Double deriving (Show)

最棘手的可能是parseTrkPt，因为为了正确地做到这一点，您必须将解析String S到Double，这可能会失败。我决定让它返回Maybe TrkPt，然后再处理它：

elemsNamed :: ArrowXml cat => String -> cat XmlTree XmlTree
elemsNamed name = isElem >>> hasName name
parseTrkPt :: ArrowXml cat => cat XmlTree (Maybe TrkPt)
parseTrkPt = elemsNamed "trkpt" >>>
    proc trkpt -> do
        lat <- getAttrValue "lat" -< trkpt
        lon <- getAttrValue "lon" -< trkpt
        returnA -< TrkPt <$> readMaybe lat <*> readMaybe lon

我还在这里使用了proc语法，因为我认为它更加清洁。TrkPt <$> readMaybe lat <*> readMaybe lon具有类型Maybe TrkPt，如果readMaybe S中的任何一个返回Nothing，则将返回Nothing。我们现在可以汇总所有成功的结果：

parseTrkSeg :: (ArrowXml cat, ArrowList cat) => cat XmlTree TrkSeg
parseTrkSeg =
    elemsNamed "trkseg" >>>
    (getChildren >>> parseTrkPt >>. catMaybes) >. TrkSeg

括号在这里很重要，我花了一段时间才弄清楚那部分。根据您放置帕伦斯的位置，您将获得不同的结果，例如[TrkSeg [TrkPt a b], TrkSeg [TrkPt c d]]而不是[TrkSeg [TrkPt a b, TrkPt c d]]。隔壁的解析器都遵循类似的模式很简单：

parseTrk :: ArrowXml cat => cat XmlTree Trk
parseTrk =
    elemsNamed "trk" >>>
    (getChildren >>> parseTrkSeg) >. Trk
parseGpx :: ArrowXml cat => cat XmlTree Gpx
parseGpx =
    elemsNamed "gpx" >>>
    (getChildren >>> parseTrk) >. Gpx

然后，您可以很简单地运行它，尽管您必须仍然钻探通过根元素：

main :: IO ()
main = do
    gpxs <- runX $ readDocument [withRemoveWS yes] "ana.gpx"
                >>> getChildren
                >>> parseGpx
    -- Pretty print the document
    forM_ gpxs $ (Gpx trks) -> do
        putStrLn "GPX:"
        forM_ trks $ (Trk segs) -> do
            putStrLn "tTRK:"
            forM_ segs $ (TrkSeg pts) -> do
                putStrLn "ttSEG:"
                forM_ pts $ pt -> do
                    putStr "ttt"
                    print pt

诀窍是使用ArrowList Typeclass中的方法，尤其是具有a b c -> ([c] -> d) -> a b d类型的>.。它汇总了ArrowList中的元素，将其传递到将其转换为新类型的函数，然后在该新类型d上输出新的ArrowList。

如果您愿意，您甚至可以为最近3个解析器抽取一点：

nestedListParser :: ArrowXml cat => String -> cat XmlTree a -> ([a] -> b) -> cat XmlTree b
nestedListParser name subparser constructor
    =   elemsNamed name
    >>> (getChildren >>> subparser)
    >.  constructor
parseTrkSeg :: (ArrowXml cat, ArrowList cat) => cat XmlTree TrkSeg
parseTrkSeg = nestedListParser "trkseg" (parseTrkPt >>. catMaybes) TrkSeg
parseTrk :: ArrowXml cat => cat XmlTree Trk
parseTrk = nestedListParser "trk" parseTrkSeg Trk
parseGpx :: ArrowXml cat => cat XmlTree Gpx
parseGpx = nestedListParser "gpx" parseTrk Gpx

，如果您想完成GPX文件的其余语法，这可能会派上用场。