    {-# LANGUAGE CPP #-}
    #define dummy   -- just to ensure that cpp gets called on this file
    module Text.XML.HaXml.Wrappers
      ( fix2Args
      , processXmlWith
      , onContent
      ) where

    -- imports required for processXmlWith and fix2Args
    import Prelude hiding (filter)
    import System.Exit
    import System.Environment
    import System.IO
    import Data.List  (isSuffixOf)
    import Control.Monad (when)

    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.XML.HaXml.Version
    import Text.PrettyPrint.HughesPJ  (render)

    -- | This useful auxiliary checks the commandline arguments for two
    --   filenames, the input and output file respectively.  If either
    --   is missing, it is replaced by '-', which can be interpreted by the
    --   caller as stdin and\/or stdout.
    fix2Args :: IO (String,String)
    fix2Args :: IO (String, String)
    fix2Args = do
      args <- IO [String]
    getArgs
      when ("--version" `elem` args) $ do
          putStrLn $ "part of HaXml-" ++ version
          exitSuccess
      when ("--help" `elem` args) $ do
          putStrLn "See http://projects.haskell.org/HaXml"
          exitSuccess
      case length args of
        Int
    0 -> (String, String) -> IO (String, String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    "-",     String
    "-")
        Int
    1 -> (String, String) -> IO (String, String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String]
    args[String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !!Int
    0, String
    "-")
        Int
    2 -> (String, String) -> IO (String, String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String]
    args[String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !!Int
    0, [String]
    args[String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !!Int
    1)
        Int
    _ -> do prog <- IO String
    getProgName
                putStrLn ("Usage: "++prog++" [infile] [outfile]")
                exitFailure

    -- | The wrapper @processXmlWith@ returns an IO () computation
    --   that collects the filenames (or stdin\/stdout) to use when
    --   reading\/writing XML documents.  Its CFilter argument
    --   is applied to transform the XML document from the input and
    --   write it to the output.  No DTD is attached to the output.
    --
    --   If the input filename ends with .html or .htm, it is parsed using
    --   the error-correcting HTML parser rather than the strict XML parser.
    processXmlWith :: CFilter Posn -> IO ()
    processXmlWith :: CFilter Posn -> IO ()
    processXmlWith CFilter Posn
    f = do
      (inf,outf) <- IO (String, String)
    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 :: String -> CFilter Posn -> Document Posn -> Document Posn
    onContent String
    file CFilter Posn
    filter (Document Prolog
    p SymTab EntityDef
    s Element Posn
    e [Misc]
    m) =
            case CFilter Posn
    filter (Element Posn -> Posn -> Content Posn
    forall i. Element i -> i -> Content i
    CElem Element Posn
    e (String -> Maybe Posn -> Posn
    posInNewCxt String
    file Maybe Posn
    forall a. Maybe a
    Nothing)) of
                [CElem Element Posn
    e' Posn
    _] -> Prolog
    -> SymTab EntityDef -> Element Posn -> [Misc] -> Document Posn
    forall i.
    Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
    Document Prolog
    p SymTab EntityDef
    s Element Posn
    e' [Misc]
    m
                []           -> String -> Document Posn
    forall a. HasCallStack => String -> a
    error (String -> Document Posn) -> String -> Document Posn
    forall a b. (a -> b) -> a -> b
    $ String
    "filtering"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    fileString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "produced no output"
                [Content Posn]
    _            -> String -> Document Posn
    forall a. HasCallStack => String -> a
    error (String -> Document Posn) -> String -> Document Posn
    forall a b. (a -> b) -> a -> b
    $ String
    "filtering"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    fileString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                        String
    "produced more than one output document"

    -- | The wrapper @onContent@ simply applies a given content filter to a
    --   document.  Ambiguous or empty results raise an error exception.
    onContent :: CFilter i -> Document i -> Document i
    onContent :: forall i. CFilter i -> Document i -> Document i
    onContent CFilter i
    filter (Document Prolog
    p SymTab EntityDef
    s Element i
    e [Misc]
    m) =
        case CFilter i
    filter (Element i -> i -> Content i
    forall i. Element i -> i -> Content i
    CElem Element i
    e i
    forall a. HasCallStack => a
    undefined) of
          [CElem Element i
    e' i
    _] -> Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
    forall i.
    Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
    Document Prolog
    p SymTab EntityDef
    s Element i
    e' [Misc]
    m
          []           -> String -> Document i
    forall a. HasCallStack => String -> a
    error String
    "onContent: produced no output"
          [Content i]
    _            -> String -> Document i
    forall a. HasCallStack => String -> a
    error String
    "onContent: produced more than one output"