    -- | 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 a set of Haskell datatypes, use DrIFT to
    --   derive instances of this class for you:
    --       http:\/\/repetae.net\/john\/computer\/haskell\/DrIFT
    --   and use the current module for instances of the standard Haskell
    --   datatypes list, Maybe, and so on.
    --
    --   If you are starting with an XML DTD, use HaXml's tool DtdToHaskell
    --   to generate both the Haskell types and the corresponding instances,
    --   but _do_not_ use the current module for instances: use
    --   Text.XML.HaXml.XmlContent instead.

    module Text.XML.HaXml.XmlContent.Haskell
      (
      -- * Re-export everything from Text.XML.HaXml.XmlContent.Parser.
        module Text.XML.HaXml.XmlContent.Parser
      -- * Instances (only) for the XmlContent class, for datatypes that
      --   originated in Haskell, rather than from a DTD definition.
    --  , module Text.XML.HaXml.XmlContent.Haskell

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

      ) where

    import System.IO
    import Data.List (isPrefixOf, isSuffixOf)
    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.Namespaces
    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.Verbatim (Verbatim(verbatim))
    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 (HType
    ht, a -> [Content ()]
    forall a. XmlContent a => a -> [Content ()]
    toContents a
    value) of
                     (Tuple [HType]
    _, [Content ()]
    cs)       -> QName -> [Attribute] -> [Content ()] -> Element ()
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem (FilePath -> QName
    N (FilePath -> QName) -> FilePath -> QName
    forall a b. (a -> b) -> a -> b
    $ HType -> ShowS
    showHType HType
    ht FilePath
    "") [] [Content ()]
    cs
                     (Defined FilePath
    _ [HType]
    _ [Constr]
    _, [Content ()]
    cs) -> QName -> [Attribute] -> [Content ()] -> Element ()
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem (FilePath -> QName
    N (FilePath -> QName) -> FilePath -> QName
    forall a b. (a -> b) -> a -> b
    $ HType -> ShowS
    showHType HType
    ht FilePath
    "-XML") [] [Content ()]
    cs
                     (HType
    _, [CElem Element ()
    e ()])   -> Element ()
    e )
                 []

    -- | 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
    n [Attribute]
    _ [Content Posn]
    cs) [Misc]
    _)
      | FilePath
    "tuple" FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` QName -> FilePath
    localName QName
    n = (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 [Content Posn]
    cs)
      | FilePath
    "-XML"  FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` QName -> FilePath
    localName QName
    n = (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 [Content Posn]
    cs)
      | Bool
    otherwise = (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.
    -- These are for Haskell datatypes being derived to go to XML.
    -- DtdToHaskell does not use these instances.
    ------------------------------------------------------------------------

    instance XmlContent Bool where
        toContents :: Bool -> [Content ()]
    toContents Bool
    b   = [Element () -> () -> Content ()
    forall i. Element i -> i -> Content i
    CElem (QName -> [Attribute] -> [Content ()] -> Element ()
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem (FilePath -> QName
    N FilePath
    "bool") [FilePath -> FilePath -> Attribute
    mkAttr FilePath
    "value" (Bool -> FilePath
    forall a. Show a => a -> FilePath
    show Bool
    b)] []) ()]
        parseContents :: XMLParser Bool
    parseContents = do { e <- [FilePath] -> XMLParser (Element Posn)
    element [FilePath
    "bool"] ; return (attval e) }

    instance XmlContent Int where
        toContents :: Int -> [Content ()]
    toContents Int
    i   = [Element () -> () -> Content ()
    forall i. Element i -> i -> Content i
    CElem (QName -> [Attribute] -> [Content ()] -> Element ()
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem (FilePath -> QName
    N FilePath
    "int") [FilePath -> FilePath -> Attribute
    mkAttr FilePath
    "value" (Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    i)] []) ()]
        parseContents :: XMLParser Int
    parseContents = do { e <- [FilePath] -> XMLParser (Element Posn)
    element [FilePath
    "int"] ; return (attval e) }

    instance XmlContent Integer where
        toContents :: Integer -> [Content ()]
    toContents Integer
    i   = [Element () -> () -> Content ()
    forall i. Element i -> i -> Content i
    CElem (QName -> [Attribute] -> [Content ()] -> Element ()
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem (FilePath -> QName
    N FilePath
    "integer") [FilePath -> FilePath -> Attribute
    mkAttr FilePath
    "value" (Integer -> FilePath
    forall a. Show a => a -> FilePath
    show Integer
    i)] []) ()]
        parseContents :: XMLParser Integer
    parseContents = do { e <- [FilePath] -> XMLParser (Element Posn)
    element [FilePath
    "integer"] ; return (attval e) }

    instance XmlContent Float where
        toContents :: Float -> [Content ()]
    toContents Float
    i   = [Element () -> () -> Content ()
    forall i. Element i -> i -> Content i
    CElem (QName -> [Attribute] -> [Content ()] -> Element ()
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem (FilePath -> QName
    N FilePath
    "float") [FilePath -> FilePath -> Attribute
    mkAttr FilePath
    "value" (Float -> FilePath
    forall a. Show a => a -> FilePath
    show Float
    i)] []) ()]
        parseContents :: XMLParser Float
    parseContents = do { e <- [FilePath] -> XMLParser (Element Posn)
    element [FilePath
    "float"] ; return (attval e) }

    instance XmlContent Double where
        toContents :: Double -> [Content ()]
    toContents Double
    i   = [Element () -> () -> Content ()
    forall i. Element i -> i -> Content i
    CElem (QName -> [Attribute] -> [Content ()] -> Element ()
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem (FilePath -> QName
    N FilePath
    "double") [FilePath -> FilePath -> Attribute
    mkAttr FilePath
    "value" (Double -> FilePath
    forall a. Show a => a -> FilePath
    show Double
    i)] []) ()]
        parseContents :: XMLParser Double
    parseContents = do { e <- [FilePath] -> XMLParser (Element Posn)
    element [FilePath
    "double"] ; return (attval e) }

    instance XmlContent Char where
        -- NOT in a string
        toContents :: Char -> [Content ()]
    toContents Char
    c   = [Element () -> () -> Content ()
    forall i. Element i -> i -> Content i
    CElem (QName -> [Attribute] -> [Content ()] -> Element ()
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem (FilePath -> QName
    N FilePath
    "char") [FilePath -> FilePath -> Attribute
    mkAttr FilePath
    "value" [Char
    c]] []) ()]
        parseContents :: XMLParser Char
    parseContents = do { (Elem _ [(N "value",AttValue [Left [c]])] [])
                                 <- [FilePath] -> XMLParser (Element Posn)
    element [FilePath
    "char"]
                           ; return c
                           }
        -- 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
    _) ->
                                [FilePath -> [Content ()] -> Content ()
    forall a. XmlContent a => a -> [Content ()] -> Content ()
    mkElem FilePath
    "string" [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 ()] -> Content ()
    forall a. XmlContent a => a -> [Content ()] -> Content ()
    mkElem [a]
    xs ((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 = ([Content Posn] -> Result [Content Posn] [a]) -> XMLParser [a]
    forall t a. ([t] -> Result [t] a) -> Parser t a
    P (\[Content Posn]
    x ->
            case [Content Posn]
    x of
                (CString Bool
    _ FilePath
    s Posn
    _:[Content Posn]
    cs)
                       -> [Content Posn] -> [a] -> Result [Content Posn] [a]
    forall z a. z -> a -> Result z a
    Success [Content Posn]
    cs ((Char -> a) -> FilePath -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> a
    forall a. XmlContent a => Char -> a
    xFromChar FilePath
    s)
                (CElem (Elem (N FilePath
    "string") [] [CString Bool
    _ FilePath
    s Posn
    _]) Posn
    _:[Content Posn]
    cs)
                       -> [Content Posn] -> [a] -> Result [Content Posn] [a]
    forall z a. z -> a -> Result z a
    Success [Content Posn]
    cs ((Char -> a) -> FilePath -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> a
    forall a. XmlContent a => Char -> a
    xFromChar FilePath
    s)
                (CElem (Elem (N FilePath
    "string") [] []) Posn
    _:[Content Posn]
    cs)
                       -> [Content Posn] -> [a] -> Result [Content Posn] [a]
    forall z a. z -> a -> Result z a
    Success [Content Posn]
    cs []
                (CElem (Elem (N FilePath
    e) [] [Content Posn]
    xs) Posn
    _:[Content Posn]
    cs) | FilePath
    "list" FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` FilePath
    e
                       -> [Content Posn] -> Result [Content Posn] [a]
    forall {a}.
    XmlContent a =>
    [Content Posn] -> Result [Content Posn] [a]
    scanElements [Content Posn]
    xs
                       where
                      -- scanElements :: [Content] -> (Either String [a],[Content])
                         scanElements :: [Content Posn] -> Result [Content Posn] [a]
    scanElements [] = [Content Posn] -> [a] -> Result [Content Posn] [a]
    forall z a. z -> a -> Result z a
    Success [Content Posn]
    cs []
                         scanElements [Content Posn]
    es =
                            case 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 [Content Posn]
    es of
                                (Left FilePath
    msg, [Content Posn]
    es') -> [Content Posn] -> FilePath -> Result [Content Posn] [a]
    forall z a. z -> FilePath -> Result z a
    Failure [Content Posn]
    es' FilePath
    msg
                                (Right a
    y, [Content Posn]
    es') ->
                                    case [Content Posn] -> Result [Content Posn] [a]
    scanElements [Content Posn]
    es' of
                                        Failure [Content Posn]
    ds FilePath
    msg -> [Content Posn] -> FilePath -> Result [Content Posn] [a]
    forall z a. z -> FilePath -> Result z a
    Failure [Content Posn]
    ds FilePath
    msg
                                        Success [Content Posn]
    ds [a]
    ys  -> [Content Posn] -> [a] -> Result [Content Posn] [a]
    forall z a. z -> a -> Result z a
    Success [Content Posn]
    ds (a
    ya -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ys)
                (CElem (Elem QName
    e [Attribute]
    _ [Content Posn]
    _) Posn
    pos: [Content Posn]
    cs)
                       -> [Content Posn] -> FilePath -> Result [Content Posn] [a]
    forall z a. z -> FilePath -> Result z a
    Failure [Content Posn]
    cs (FilePath
    "Expected a <list-...>, but found a <"
                                      FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++QName -> FilePath
    printableName QName
    e
                                      FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++FilePath
    "> at\n"FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Posn -> FilePath
    forall a. Show a => a -> FilePath
    show Posn
    pos)
                (CRef Reference
    r Posn
    pos: [Content Posn]
    cs)
                       -> [Content Posn] -> FilePath -> Result [Content Posn] [a]
    forall z a. z -> FilePath -> Result z a
    Failure [Content Posn]
    cs (FilePath
    "Expected a <list-...>, but found a ref "
                                      FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Reference -> FilePath
    forall a. Verbatim a => a -> FilePath
    verbatim Reference
    rFilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++FilePath
    " at\n"FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Posn -> FilePath
    forall a. Show a => a -> FilePath
    show Posn
    pos)
                (Content Posn
    _:[Content Posn]
    cs) -> (\ (P [Content Posn] -> Result [Content Posn] [a]
    p)-> [Content Posn] -> Result [Content Posn] [a]
    p) XMLParser [a]
    forall a. XmlContent a => XMLParser a
    parseContents [Content Posn]
    cs  -- skip comments etc.
                []     -> [Content Posn] -> FilePath -> Result [Content Posn] [a]
    forall z a. z -> FilePath -> Result z a
    Failure [] FilePath
    "Ran out of input XML whilst secondary parsing"
            )

    instance XmlContent () where
        toContents :: () -> [Content ()]
    toContents ()  = [Element () -> () -> Content ()
    forall i. Element i -> i -> Content i
    CElem (QName -> [Attribute] -> [Content ()] -> Element ()
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem (FilePath -> QName
    N FilePath
    "unit") [] []) ()]
        parseContents :: XMLParser ()
    parseContents = do { [FilePath] -> XMLParser (Element Posn)
    element [FilePath
    "unit"]; () -> XMLParser ()
    forall a. a -> Parser (Content Posn) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () }

    instance (XmlContent a) => XmlContent (Maybe a) where
        toContents :: Maybe a -> [Content ()]
    toContents Maybe a
    m   = [Maybe a -> [Content ()] -> Content ()
    forall a. XmlContent a => a -> [Content ()] -> Content ()
    mkElem 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 = do
            { e <- (FilePath -> FilePath -> Bool)
    -> [FilePath] -> XMLParser (Element Posn)
    elementWith ((FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf) [FilePath
    "maybe"]
            ; case e of (Elem QName
    _ [] []) -> Maybe a -> XMLParser (Maybe a)
    forall a. a -> Parser (Content Posn) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
                        (Elem QName
    _ [] [Content Posn]
    _)  -> (a -> Maybe a) -> Parser (Content Posn) a -> XMLParser (Maybe a)
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Maybe a
    forall a. a -> Maybe a
    Just (Element Posn -> Parser (Content Posn) a -> Parser (Content Posn) a
    forall a. Element Posn -> XMLParser a -> XMLParser a
    interior Element Posn
    e Parser (Content Posn) a
    forall a. XmlContent a => XMLParser a
    parseContents)
            }

    instance (XmlContent a, XmlContent b) => XmlContent (Either a b) where
        toContents :: Either a b -> [Content ()]
    toContents v :: Either a b
    v@(Left a
    aa) =
            [FilePath -> [Content ()] -> Content ()
    mkElemC (Int -> HType -> FilePath
    showConstr Int
    0 (Either a b -> HType
    forall a. HTypeable a => a -> HType
    toHType Either a b
    v)) (a -> [Content ()]
    forall a. XmlContent a => a -> [Content ()]
    toContents a
    aa)]
        toContents v :: Either a b
    v@(Right b
    ab) =
            [FilePath -> [Content ()] -> Content ()
    mkElemC (Int -> HType -> FilePath
    showConstr Int
    1 (Either a b -> HType
    forall a. HTypeable a => a -> HType
    toHType Either a b
    v)) (b -> [Content ()]
    forall a. XmlContent a => a -> [Content ()]
    toContents b
    ab)]
        parseContents :: XMLParser (Either a b)
    parseContents =
            (FilePath -> FilePath -> Bool)
    -> FilePath -> XMLParser (Either a b) -> XMLParser (Either a b)
    forall a.
    (FilePath -> FilePath -> Bool)
    -> FilePath -> XMLParser a -> XMLParser a
    inElementWith ((FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf) FilePath
    "Left"  ((a -> Either a b)
    -> Parser (Content Posn) a -> XMLParser (Either a b)
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Either a b
    forall a b. a -> Either a b
    Left  Parser (Content Posn) a
    forall a. XmlContent a => XMLParser a
    parseContents)
              XMLParser (Either a b)
    -> XMLParser (Either a b) -> XMLParser (Either a b)
    forall t a. Parser t a -> Parser t a -> Parser t a
    `onFail`
            (FilePath -> FilePath -> Bool)
    -> FilePath -> XMLParser (Either a b) -> XMLParser (Either a b)
    forall a.
    (FilePath -> FilePath -> Bool)
    -> FilePath -> XMLParser a -> XMLParser a
    inElementWith ((FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf) FilePath
    "Right" ((b -> Either a b)
    -> Parser (Content Posn) b -> XMLParser (Either a b)
    forall a b.
    (a -> b) -> Parser (Content Posn) a -> Parser (Content Posn) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap b -> Either a b
    forall a b. b -> Either a b
    Right Parser (Content Posn) b
    forall a. XmlContent a => XMLParser a
    parseContents)

    --    do{ e@(Elem t [] _) <- element ["Left","Right"]
    --      ; case t of
    --          _ | "Left"  `isPrefixOf` t -> fmap Left  (interior e parseContents)
    --            | "Right" `isPrefixOf` t -> fmap Right (interior e parseContents)
    --      }

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