Simplify XML parsing using HXT Here is code that will output maven coordinates from given pom.xml file. How can I remove boilerplate (possibly convert it to xml picklers)?

import Control.Lens ((&amp;))
import Text.XML.HXT.Core
import System.Environment (getArgs)
import Text.XML.HXT.Arrow.XmlArrow
import Control.Monad (liftM)
import Data.Maybe
import Control.Applicative

main = do
  (filename:_) &lt;- getArgs
  _groupId &lt;- extractOne filename $ project &gt;&gt;&gt; groupId
  _artifactId &lt;- extractOne filename $ project &gt;&gt;&gt; artifactId
  _version &lt;- extractOne filename $ project &gt;&gt;&gt; version
  _parentGroupId &lt;- extractOne filename $ project &gt;&gt;&gt; parent &gt;&gt;&gt; groupId
  _parentArtifactId &lt;- extractOne filename $ project &gt;&gt;&gt; parent &gt;&gt;&gt; artifactId
  _parentVersion &lt;- extractOne filename $ project &gt;&gt;&gt; parent &gt;&gt;&gt; version
  let coordinate = (,,) &lt;$&gt; _groupId &lt;*&gt; _artifactId &lt;*&gt; _version
      parentCoordinate = (,,) &lt;$&gt; _parentGroupId &lt;*&gt; _parentArtifactId &lt;*&gt; _parentVersion
      in do
        print coordinate
        print parentCoordinate

extract :: String -&gt; IOSArrow XmlTree a -&gt; IO [a]
extract filename cat = runX $ readDocument [withValidate no] filename &gt;&gt;&gt; cat

extractOne :: String -&gt; IOSArrow XmlTree a -&gt; IO (Maybe a)
extractOne filename cat = extract filename cat &gt;&gt;= return . listToMaybe

version :: ArrowXml a =&gt; a XmlTree String
version = getChildren &gt;&gt;&gt; hasName "version" &gt;&gt;&gt; getChildren &gt;&gt;&gt; getText

artifactId :: ArrowXml a =&gt; a XmlTree String
artifactId = getChildren &gt;&gt;&gt; hasName "artifactId" &gt;&gt;&gt; getChildren &gt;&gt;&gt; getText

groupId :: ArrowXml a =&gt; a XmlTree String
groupId = getChildren &gt;&gt;&gt; hasName "groupId" &gt;&gt;&gt; getChildren &gt;&gt;&gt; getText

parent :: ArrowXml a =&gt; a XmlTree XmlTree
parent = getChildren &gt;&gt;&gt; hasName "parent"

project :: ArrowXml a =&gt; a XmlTree XmlTree
project = getChildren &gt;&gt;&gt; hasName "project"
The main issue I see is that the code opens the XML file six times to
read a single value each time.  Edit:  With a bit more a work I have a
now a rather nice solution for this.  The original minified version is
below.

So the point here is to only read the file once, then filter the tree in
two stages, once for the top-level coordinate and once for the "parent"
node below.  By combining the two stages with &amp;&amp;&amp; and handling the
edge-cases of missing values, the output is same (I hope) and
performance, as well as the number of lines is improved significantly.
(There is still potential for reduction in at least the coordinate
function, but I'll leave that to a kind editor for now.)

import Control.Lens ((&amp;))
import Text.XML.HXT.Core
import System.Environment (getArgs)
import Text.XML.HXT.Arrow.XmlArrow
import Control.Monad (liftM)
import Data.Maybe
import Control.Applicative

type Coordinate = (String, String, String)

main = do
  (filename:_) &lt;- getArgs
  (coordinate, parentCoordinate):_ &lt;- runX (readFileDoc filename &gt;&gt;&gt; coordinatesFilter)
  print coordinate
  print parentCoordinate

readFileDoc = readDocument [withValidate no]

coordinatesFilter :: ArrowXml a =&gt; a XmlTree (Maybe Coordinate, Maybe Coordinate)
coordinatesFilter =
  project &gt;&gt;&gt;
  maybeSelector coordinate &amp;&amp;&amp;
  maybeSelector (parent &gt;&gt;&gt; coordinate)

maybeSelector :: ArrowList a =&gt; a b c -&gt; a b (Maybe c)
maybeSelector selector = withDefault (selector &gt;&gt;&gt; arr Just) Nothing

namedChildren :: ArrowXml a =&gt; String -&gt; a XmlTree XmlTree
namedChildren name = getChildren &gt;&gt;&gt; hasName name

project :: ArrowXml a =&gt; a XmlTree XmlTree
project = namedChildren "project"

parent :: ArrowXml a =&gt; a XmlTree XmlTree
parent = namedChildren "parent"

field :: ArrowXml a =&gt; String -&gt; a XmlTree String
field name = namedChildren name &gt;&gt;&gt; getChildren &gt;&gt;&gt; getText

threeAndSelector :: Arrow a =&gt; (t -&gt; a b c) -&gt; t -&gt; t -&gt; t -&gt; a b (c, c, c)
threeAndSelector f a b c = (f a &amp;&amp;&amp; f b &amp;&amp;&amp; f c) &gt;&gt;&gt; arr (\(x, (y, z)) -&gt; (x, y, z))

coordinate :: ArrowXml a =&gt; a XmlTree Coordinate
coordinate = threeAndSelector field "groupId" "artifactId" "version"