absolute urls in haskell with hxt

absurls.hs

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

mkAbsRefs
    :: ArrowXml a
    => String -> a XmlTree XmlTree
mkAbsRefs base =
    processTopDown
        (editRef "a" "href" -- (2)
          >>>
         editRef "img" "src" -- (3)
          >>>
         editRef "link" "href" -- (4)
          >>>
         editRef "script" "src" -- (5)
         )
  where
    editRef en an -- (1)
     =
        processAttrl (changeAttrValue (absHRef base) `when` hasName an) `when`
        (isElem >>> hasName en)
      where
        absHRef :: String -> String -> String
        absHRef base url = fromMaybe url . expandURIString url $ base
        
sanitize base = concat . runLA (hread >>> mkAbsRefs base >>> writeDocumentToString cfg)
  where
    cfg = [withOutputEncoding utf8, withOutputHTML, withRemoveWS yes]