    -- | The class 'XmlContent' is a kind of replacement for Read and Show:
    --   it provides conversions between a generic XML tree representation
    --   and your own more specialised typeful Haskell data trees.
    --
    --   If you are starting with an XML DTD, use HaXml's tool DtdToHaskell
    --   to generate both the Haskell types and the corresponding instances.
    --
    --   If you are starting with a set of Haskell datatypes, use DrIFT to
    --   derive instances of this class for you:
    --       http:\/\/repetae.net\/john\/computer\/haskell\/DrIFT
    --   and _do_not_ use the current module, but rather
    --   Text.XML.HaXml.XmlContent.Haskell, for the correct matching
    --   instances for standard Haskell datatypes.

    module Text.XML.HaXml.XmlContent
      (
      -- * Re-export everything from Text.XML.HaXml.XmlContent.Parser.
        module Text.XML.HaXml.XmlContent.Parser
      , module Text.XML.HaXml.TypeMapping
      -- * Contains instances of the XmlContent classes,
      --   for the basic Haskell datatypes list and Maybe,
      --   intended for use with DtdToHaskell-generated datatypes.
      --   See the alternative instances in Text.XML.HaXml.XmlContent.Haskell
      --   if your datatypes originate in Haskell instead.
    --  , module Text.XML.HaXml.XmlContent

      -- * Whole-document conversion functions
      , toXml, fromXml
      , readXml, showXml, fpsShowXml
      , fReadXml, fWriteXml, fpsWriteXml
      , hGetXml,  hPutXml, fpsHPutXml
      ) where

    import System.IO
    import qualified Text.XML.HaXml.ByteStringPP as FPS (document)
    import qualified Data.ByteString.Lazy.Char8 as FPS

    import Text.PrettyPrint.HughesPJ (render)
    --import Text.ParserCombinators.Poly

    import Text.XML.HaXml.Types
    import Text.XML.HaXml.TypeMapping
    import Text.XML.HaXml.Posn     (Posn, posInNewCxt)
    import Text.XML.HaXml.Pretty   (document)
    import Text.XML.HaXml.Parse    (xmlParse)
    import Text.XML.HaXml.XmlContent.Parser

    ------------------------------------------------------------------------

            -- probably want to write DTD separately from value, and have
            -- easy ways to combine DTD + value into a document, or write
            -- them to separate files.

    -- | Read an XML document from a file and convert it to a fully-typed
    --   Haskell value.
    fReadXml  :: XmlContent a => FilePath -> IO a
    fReadXml :: forall a. XmlContent a => FilePath -> IO a
    fReadXml FilePath
    fp = do
        f <- ( if FilePath
    fpFilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    ==FilePath
    "-" then Handle -> IO Handle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Handle
    stdin
               else FilePath -> IOMode -> IO Handle
    openFile FilePath
    fp IOMode
    ReadMode )
        x <- hGetContents f
        let (Document _ _ y _) = xmlParse fp x
            y' = Element Posn -> Posn -> Content Posn
    forall i. Element i -> i -> Content i
    CElem Element Posn
    y (FilePath -> Maybe Posn -> Posn
    posInNewCxt FilePath
    fp Maybe Posn
    forall a. Maybe a
    Nothing)
        either fail return (fst (runParser parseContents [y']))

    -- | Write a fully-typed Haskell value to the given file as an XML
    --   document.
    fWriteXml :: XmlContent a => FilePath -> a -> IO ()
    fWriteXml :: forall a. XmlContent a => FilePath -> a -> IO ()
    fWriteXml FilePath
    fp a
    x = do
        f <- ( if FilePath
    fpFilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    ==FilePath
    "-" then Handle -> IO Handle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Handle
    stdout
               else FilePath -> IOMode -> IO Handle
    openFile FilePath
    fp IOMode
    WriteMode )
        hPutXml f False x
        hClose f

    -- | Write any Haskell value to the given file as an XML document,
    --   using the FastPackedString interface (output will not be prettified).
    fpsWriteXml :: XmlContent a => FilePath -> a -> IO ()
    fpsWriteXml :: forall a. XmlContent a => FilePath -> a -> IO ()
    fpsWriteXml FilePath
    fp a
    x = do
        f <- ( if FilePath
    fpFilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    ==FilePath
    "-" then Handle -> IO Handle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Handle
    stdout
               else FilePath -> IOMode -> IO Handle
    openFile FilePath
    fp IOMode
    WriteMode )
        fpsHPutXml f False x
        hClose f

    -- | Read a fully-typed XML document from a string.
    readXml :: XmlContent a => String -> Either String a
    readXml :: forall a. XmlContent a => FilePath -> Either FilePath a
    readXml FilePath
    s =
        let (Document Prolog
    _ SymTab EntityDef
    _ Element Posn
    y [Misc]
    _) = FilePath -> FilePath -> Document Posn
    xmlParse FilePath
    "string input" FilePath
    s in
        (Either FilePath a, [Content Posn]) -> Either FilePath a
    forall a b. (a, b) -> a
    fst (Parser (Content Posn) a
    -> [Content Posn] -> (Either FilePath a, [Content Posn])
    forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
    runParser Parser (Content Posn) a
    forall a. XmlContent a => XMLParser a
    parseContents
                       [Element Posn -> Posn -> Content Posn
    forall i. Element i -> i -> Content i
    CElem Element Posn
    y (FilePath -> Maybe Posn -> Posn
    posInNewCxt FilePath
    "string input" Maybe Posn
    forall a. Maybe a
    Nothing)])

    -- | Convert a fully-typed XML document to a string (without DTD).
    showXml :: XmlContent a => Bool -> a -> String
    showXml :: forall a. XmlContent a => Bool -> a -> FilePath
    showXml Bool
    dtd a
    x =
        case a -> [Content ()]
    forall a. XmlContent a => a -> [Content ()]
    toContents a
    x of
          [CElem Element ()
    _ ()
    _] -> (Doc -> FilePath
    render (Doc -> FilePath) -> (a -> Doc) -> a -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Document () -> Doc
    forall i. Document i -> Doc
    document (Document () -> Doc) -> (a -> Document ()) -> a -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> a -> Document ()
    forall a. XmlContent a => Bool -> a -> Document ()
    toXml Bool
    dtd) a
    x
          [Content ()]
    _ -> FilePath
    ""

    -- | Convert a fully-typed XML document to a ByteString (without DTD).
    fpsShowXml :: XmlContent a => Bool -> a -> FPS.ByteString
    fpsShowXml :: forall a. XmlContent a => Bool -> a -> ByteString
    fpsShowXml Bool
    dtd a
    x =
        case a -> [Content ()]
    forall a. XmlContent a => a -> [Content ()]
    toContents a
    x of
          [CElem Element ()
    _ ()
    _] -> (Document () -> ByteString
    forall i. Document i -> ByteString
    FPS.document (Document () -> ByteString)
    -> (a -> Document ()) -> a -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> a -> Document ()
    forall a. XmlContent a => Bool -> a -> Document ()
    toXml Bool
    dtd) a
    x
          [Content ()]
    _ -> ByteString
    FPS.empty

    -- | Convert a fully-typed XML document to a string (with or without DTD).
    toXml :: XmlContent a => Bool -> a -> Document ()
    toXml :: forall a. XmlContent a => Bool -> a -> Document ()
    toXml Bool
    dtd a
    value =
        let ht :: HType
    ht = a -> HType
    forall a. HTypeable a => a -> HType
    toHType a
    value in
        Prolog -> SymTab EntityDef -> Element () -> [Misc] -> Document ()
    forall i.
    Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
    Document (Maybe XMLDecl -> [Misc] -> Maybe DocTypeDecl -> [Misc] -> Prolog
    Prolog (XMLDecl -> Maybe XMLDecl
    forall a. a -> Maybe a
    Just (FilePath -> Maybe EncodingDecl -> Maybe Bool -> XMLDecl
    XMLDecl FilePath
    "1.0" Maybe EncodingDecl
    forall a. Maybe a
    Nothing Maybe Bool
    forall a. Maybe a
    Nothing))
                         [] (if Bool
    dtd then DocTypeDecl -> Maybe DocTypeDecl
    forall a. a -> Maybe a
    Just (HType -> DocTypeDecl
    toDTD HType
    ht) else Maybe DocTypeDecl
    forall a. Maybe a
    Nothing) [])
                 SymTab EntityDef
    forall a. SymTab a
    emptyST
                 ( case a -> [Content ()]
    forall a. XmlContent a => a -> [Content ()]
    toContents a
    value of
                     []             -> QName -> [Attribute] -> [Content ()] -> Element ()
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem (FilePath -> QName
    N FilePath
    "empty") [] []
                     [CElem Element ()
    e ()]   -> Element ()
    e
                     (CElem Element ()
    _ ():[Content ()]
    _) -> FilePath -> Element ()
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "too many XML elements in document" )
                 []

    -- | Read a Haskell value from an XML document, ignoring the DTD and
    --   using the Haskell result type to determine how to parse it.
    fromXml :: XmlContent a => Document Posn -> Either String a
    fromXml :: forall a. XmlContent a => Document Posn -> Either FilePath a
    fromXml (Document Prolog
    _ SymTab EntityDef
    _ e :: Element Posn
    e@(Elem QName
    _ [Attribute]
    _ [Content Posn]
    _) [Misc]
    _) =
      (Either FilePath a, [Content Posn]) -> Either FilePath a
    forall a b. (a, b) -> a
    fst (Parser (Content Posn) a
    -> [Content Posn] -> (Either FilePath a, [Content Posn])
    forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
    runParser Parser (Content Posn) a
    forall a. XmlContent a => XMLParser a
    parseContents [Element Posn -> Posn -> Content Posn
    forall i. Element i -> i -> Content i
    CElem Element Posn
    e (FilePath -> Maybe Posn -> Posn
    posInNewCxt FilePath
    "document" Maybe Posn
    forall a. Maybe a
    Nothing)])

    -- | Read a fully-typed XML document from a file handle.
    hGetXml :: XmlContent a => Handle -> IO a
    hGetXml :: forall a. XmlContent a => Handle -> IO a
    hGetXml Handle
    h = do
        x <- Handle -> IO FilePath
    hGetContents Handle
    h
        let (Document _ _ y _) = xmlParse "file handle" x
        either fail return
               (fst (runParser parseContents
                               [CElem y (posInNewCxt "file handle" Nothing)]))

    -- | Write a fully-typed XML document to a file handle.
    hPutXml :: XmlContent a => Handle -> Bool -> a -> IO ()
    hPutXml :: forall a. XmlContent a => Handle -> Bool -> a -> IO ()
    hPutXml Handle
    h Bool
    dtd a
    x = do
        (Handle -> FilePath -> IO ()
    hPutStrLn Handle
    h (FilePath -> IO ()) -> (a -> FilePath) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> FilePath
    render (Doc -> FilePath) -> (a -> Doc) -> a -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Document () -> Doc
    forall i. Document i -> Doc
    document (Document () -> Doc) -> (a -> Document ()) -> a -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> a -> Document ()
    forall a. XmlContent a => Bool -> a -> Document ()
    toXml Bool
    dtd) a
    x

    -- | Write a fully-typed XML document to a file handle, using the
    --   FastPackedString interface (output will not be prettified).
    fpsHPutXml :: XmlContent a => Handle -> Bool -> a -> IO ()
    fpsHPutXml :: forall a. XmlContent a => Handle -> Bool -> a -> IO ()
    fpsHPutXml Handle
    h Bool
    dtd a
    x = do
        (Handle -> ByteString -> IO ()
    FPS.hPut Handle
    h (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Document () -> ByteString
    forall i. Document i -> ByteString
    FPS.document (Document () -> ByteString)
    -> (a -> Document ()) -> a -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> a -> Document ()
    forall a. XmlContent a => Bool -> a -> Document ()
    toXml Bool
    dtd) a
    x

    ------------------------------------------------------------------------
    -- Instances for all the standard basic datatypes.
    -- DtdToHaskell uses only a small number of standard datatypes.
    ------------------------------------------------------------------------

    instance XmlContent Char where
        -- NOT in a string
        toContents :: Char -> [Content ()]
    toContents Char
    _  = FilePath -> [Content ()]
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> [Content ()]) -> FilePath -> [Content ()]
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Text.XML.HaXml.XmlContent.toContents "FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
                                FilePath
    " used on a Haskell Char"
        parseContents :: XMLParser Char
    parseContents = FilePath -> XMLParser Char
    forall a. FilePath -> Parser (Content Posn) a
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail  (FilePath -> XMLParser Char) -> FilePath -> XMLParser Char
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "Text.XML.HaXml.XmlContent.parseContents "FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
                                FilePath
    " used on a Haskell Char "
        -- Only defined for Char and no other types:
        xToChar :: Char -> Char
    xToChar   = Char -> Char
    forall a. a -> a
    id
        xFromChar :: Char -> Char
    xFromChar = Char -> Char
    forall a. a -> a
    id

    instance XmlContent a => XmlContent [a] where
        toContents :: [a] -> [Content ()]
    toContents [a]
    xs  = case a -> HType
    forall a. HTypeable a => a -> HType
    toHType a
    x of
                           (Prim FilePath
    "Char" FilePath
    _) ->
                                [Bool -> FilePath -> () -> Content ()
    forall i. Bool -> FilePath -> i -> Content i
    CString Bool
    True ((a -> Char) -> [a] -> FilePath
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Char
    forall a. XmlContent a => a -> Char
    xToChar [a]
    xs) ()]
                           HType
    _ -> (a -> [Content ()]) -> [a] -> [Content ()]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap a -> [Content ()]
    forall a. XmlContent a => a -> [Content ()]
    toContents [a]
    xs
                       where   (a
    x:[a]
    _) = [a]
    xs
        parseContents :: XMLParser [a]
    parseContents = let result :: (Either FilePath [a], [Content Posn])
    result = XMLParser [a]
    -> [Content Posn] -> (Either FilePath [a], [Content Posn])
    forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
    runParser XMLParser [a]
    p [] -- for type of result only
                            p :: XMLParser [a]
    p = case (a -> HType
    forall a. HTypeable a => a -> HType
    toHType (a -> HType)
    -> ((Either FilePath [a], [Content Posn]) -> a)
    -> (Either FilePath [a], [Content Posn])
    -> HType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> a
    forall a. HasCallStack => [a] -> a
    head ([a] -> a)
    -> ((Either FilePath [a], [Content Posn]) -> [a])
    -> (Either FilePath [a], [Content Posn])
    -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (\ (Right [a]
    x)->[a]
    x) (Either FilePath [a] -> [a])
    -> ((Either FilePath [a], [Content Posn]) -> Either FilePath [a])
    -> (Either FilePath [a], [Content Posn])
    -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Either FilePath [a], [Content Posn]) -> Either FilePath [a]
    forall a b. (a, b) -> a
    fst)
                                     (Either FilePath [a], [Content Posn])
    result of
                                  (Prim FilePath
    "Char" FilePath
    _) -> (Char -> a) -> FilePath -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> a
    forall a. XmlContent a => Char -> a
    xFromChar (FilePath -> [a])
    -> Parser (Content Posn) FilePath -> XMLParser [a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser (Content Posn) FilePath
    text
                                  HType
    _ -> Parser (Content Posn) a -> XMLParser [a]
    forall a. Parser (Content Posn) a -> Parser (Content Posn) [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many Parser (Content Posn) a
    forall a. XmlContent a => XMLParser a
    parseContents
                        in XMLParser [a]
    p
            -- comments, PIs, etc, are skipped in the individual element parser.

    instance (XmlContent a) => XmlContent (Maybe a) where
        toContents :: Maybe a -> [Content ()]
    toContents Maybe a
    m  = [Content ()] -> (a -> [Content ()]) -> Maybe a -> [Content ()]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] a -> [Content ()]
    forall a. XmlContent a => a -> [Content ()]
    toContents Maybe a
    m
        parseContents :: XMLParser (Maybe a)
    parseContents = Parser (Content Posn) a -> XMLParser (Maybe a)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional Parser (Content Posn) a
    forall a. XmlContent a => XMLParser a
    parseContents

    ------------------------------------------------------------------------