module Text.XML.HXT.Compilation
    ( compileDocument
    , wrapIntoModule
    )
    where

import           Language.Haskell.Syntax
import           Text.XML.HXT.Arrow
import           Text.XML.HXT.Compilation.XmlTree


compileDocument :: ArrowXml a => a XmlTree (HsQualType, HsExp)
compileDocument = uniqueNamespacesFromDeclAndQNames
                  >>>
                  ( constA (HsQualType [] (HsTyCon (UnQual (HsIdent "XmlTree"))))
                    &&&
                    arr compileXmlTree
                  )


wrapIntoModule :: Arrow a => a (Module, (HsName, (HsQualType, HsExp))) HsModule
wrapIntoModule = proc (modName, (symName, (symType, symExp))) ->
                 do let hsModule = HsModule undefined modName (Just exports) imports decls
                        exports  = [HsEVar (UnQual symName)]
                        imports  = [ HsImportDecl undefined (Module "Text.XML.HXT.Arrow") False Nothing Nothing
                                   , HsImportDecl undefined (Module "Text.XML.HXT.DOM.XmlNode") True (Just (Module "XN")) Nothing
                                   ]
                        decls    = [ HsTypeSig undefined [symName] symType
                                   , HsFunBind [HsMatch undefined symName [] (HsUnGuardedRhs symExp) []]
                                   ]
                    returnA -< hsModule