Absolute urls in haskell with hxt (2nd version)

absurls2.hs

import Text.XML.HXT.Core
import Data.Maybe

toAbsoluteUrl
    :: ArrowXml a
    => String -> a XmlTree XmlTree
toAbsoluteUrl base =
    processAttrl (mkAbsolute mkAbsoluteUrl `when` (hasName "href" <+> hasName "src"))
  where
    mkAbsolute f = replaceChildren (xshow getChildren >>> arr (f base) `orElse` this >>> mkText)

mkAbsoluteUrl :: String -> String -> String
mkAbsoluteUrl base url = fromMaybe url (expandURIString url base)

sanitize :: String -> String -> String
sanitize baseUrl = transformTree arrows
  where
    fixUrls = toAbsoluteUrl baseUrl `when` (hasName "a" <+> hasName "img")
    arrows = processTopDown fixUrls
    
transformTree :: LA XmlTree XmlTree -> String -> String
transformTree arrows =
    concat . runLA (hread >>> selem "html" [this] >>> arrows >>> writeDocumentToString cfg)
  where
    cfg = [withOutputEncoding utf8, withOutputHTML, withRemoveWS yes]