Parse external document and current element in a consistent way with HXT

Update: I've now solved my main issue so I'll award the bounty to a good review of if my solution is good style or not.

Recently I've been trying to parse TMX files, which are XML files describing maps. One interesting point in the format is that you can specify external tilesets.

Since it already handled a big part of the work, I've been trying to extend the htiled library so that it handles external tilesets, but so far with no success.

So basically, the task I'm trying to accomplish here is, given two documents, map.tmx:

<?xml version="1.0" encoding="UTF-8"?>
<map version="1.0" orientation="orthogonal" width="12" height="12" tilewidth="64" tileheight="64">
 <tileset firstgid="1" source="ground.tsx"/>
 ...
</map>

and ground.tsx:

<?xml version="1.0" encoding="UTF-8"?>
<tileset name="ground" tilewidth="64" tileheight="64" spacing="32">
 <image source="ground.png" width="64" height="64"/>
 <tile id="0">
  <properties>
   <property name="sol" value=""/>
  </properties>
 </tile>
</tileset>

return the structure:

Map {..., tilesets = [Tileset { name = "ground", ...}]}

The working method to parse (internal only) tilesets is:

tilesets ∷ IOSArrow XmlTree [Tileset]
tilesets = listA tileset

tileset ∷ IOSArrow XmlTree Tileset
tileset = isElem >>> hasName "tileset" >>> proc ts → do
  tsName        ← getAttrValue "name"                        ⤙ ts
  tsInitialGid  ← getAttrR "firstgid"                        ⤙ ts
  tsTileWidth   ← getAttrR "tilewidth"                       ⤙ ts
  tsTileHeight  ← getAttrR "tileheight"                      ⤙ ts
  tsMargin      ← arr (fromMaybe 0) . getAttrMaybe "margin"  ⤙ ts
  tsSpacing     ← arr (fromMaybe 0) . getAttrMaybe "spacing" ⤙ ts
  tsImages      ← images                                     ⤙ ts
  tsTileProperties ← listA tileProperties                    ⤙ ts
  returnA ⤙ Tileset {..}
  where tileProperties ∷ IOSArrow XmlTree (Word32, Properties)
        tileProperties = getChildren >>> isElem >>> hasName "tile"
                     >>> getAttrR "id" &&& properties
        images = listA (getChildren >>> image)

I've tried to adapt the tilesets method so that it uses the current element or an external document depending on the source attribute of the current element, but to no avail:

tilesets ∷ IOSArrow XmlTree [Tileset]
tilesets = listA $ proc ts → do
  source ← isElem >>> hasName "tileset" >>> getAttrValue "source" ⤙ ts
  case source of
    "" → tileset ⤙ ts
    f → tileset ⤙ readDocument [withValidate no, withWarnings yes] f

(this is one of my many attempts).

Usually I reach a point where GHC tells me that I'm not using an arrow command or that my value is inside an arrow while it shouldn't. I get that I can't do IO (and maybe also XHT intermediate operations?) transparently in a type safe way but I'm stuck here. I'm really unsure how to proceed.

Solution

I got it to work with readFromDocument and ifA

tilesets ∷ FilePath → IOSArrow XmlTree [Tileset]
tilesets mapPath =
  listA $ getChildren >>> isElem >>> hasName "tileset"
  >>> getAttrR "firstgid" &&& ifA (hasAttr "source") (externalTileset mapPath) id
  >>> tileset

externalTileset ∷ FilePath → IOSArrow XmlTree XmlTree
externalTileset mapPath =
  arr (const (dropFileName mapPath)) &&& getAttrValue "source"
  >>> arr (uncurry (</>))
  >>> readFromDocument [ withValidate no, withWarnings yes ]
  >>> getChildren >>> isElem >>> hasName "tileset"

tileset ∷ IOSArrow (Word32, XmlTree) Tileset
tileset = proc (tsInitialGid, ts) → do
  tsName           ← getAttrValue "name"                        ⤙ ts
  tsTileWidth      ← getAttrR "tilewidth"                       ⤙ ts
  tsTileHeight     ← getAttrR "tileheight"                      ⤙ ts
  tsMargin         ← arr (fromMaybe 0) . getAttrMaybe "margin"  ⤙ ts
  tsSpacing        ← arr (fromMaybe 0) . getAttrMaybe "spacing" ⤙ ts
  tsImages         ← images                                     ⤙ ts
  tsTileProperties ← listA tileProperties                       ⤙ ts
  returnA ⤙ Tileset {..}
  where tileProperties ∷ IOSArrow XmlTree (Word32, Properties)
        tileProperties = getChildren >>> isElem >>> hasName "tile"
                         >>> getAttrR "id" &&& properties
        images = listA (getChildren >>> image)