module Text.XML.HaXml.Wrappers
( fix2Args
, processXmlWith
) where
import System
import IO
import List (isSuffixOf)
import Text.XML.HaXml.Types (Document(..),Content(..))
import Text.XML.HaXml.Combinators (CFilter)
import Text.XML.HaXml.Posn (Posn,posInNewCxt)
import Text.XML.HaXml.Parse (xmlParse)
import Text.XML.HaXml.Html.Parse (htmlParse)
import Text.XML.HaXml.Pretty as PP(document)
import Text.PrettyPrint.HughesPJ (render)
fix2Args :: IO (String,String)
fix2Args = do
args <- getArgs
case length args of
0 -> return ("-", "-")
1 -> return (args!!0, "-")
2 -> return (args!!0, args!!1)
_ -> do prog <- getProgName
putStrLn ("Usage: "++prog++" [infile] [outfile]")
exitFailure
processXmlWith :: CFilter Posn -> IO ()
processXmlWith f = do
(inf,outf) <- fix2Args
input <- if inf=="-" then getContents else readFile inf
o <- if outf=="-" then return stdout else openFile outf WriteMode
parse <- if ".html" `isSuffixOf` inf || ".htm" `isSuffixOf` inf
then return (htmlParse inf)
else return (xmlParse inf)
( hPutStrLn o . render . PP.document . onContent inf f . parse ) input
hFlush o
where
onContent :: FilePath -> (CFilter Posn) -> Document Posn -> Document Posn
onContent file filter (Document p s e m) =
case filter (CElem e (posInNewCxt file Nothing)) of
[CElem e' _] -> Document p s e' m
[] -> error "produced no output"
_ -> error "produced more than one output"