-- | 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
    Handle
f <- ( if FilePath
fpforall a. Eq a => a -> a -> Bool
==FilePath
"-" then forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdin
           else FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
ReadMode )
    FilePath
x <- Handle -> IO FilePath
hGetContents Handle
f
    let (Document Prolog
_ SymTab EntityDef
_ Element Posn
y [Misc]
_) = FilePath -> FilePath -> Document Posn
xmlParse FilePath
fp FilePath
x
        y' :: Content Posn
y' = forall i. Element i -> i -> Content i
CElem Element Posn
y (FilePath -> Maybe Posn -> Posn
posInNewCxt FilePath
fp forall a. Maybe a
Nothing)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a, b) -> a
fst (forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser forall a. XmlContent a => XMLParser a
parseContents [Content Posn
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
    Handle
f <- ( if FilePath
fpforall a. Eq a => a -> a -> Bool
==FilePath
"-" then forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdout
           else FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
WriteMode )
    forall a. XmlContent a => Handle -> Bool -> a -> IO ()
hPutXml Handle
f Bool
False a
x
    Handle -> IO ()
hClose Handle
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
    Handle
f <- ( if FilePath
fpforall a. Eq a => a -> a -> Bool
==FilePath
"-" then forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdout
           else FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
WriteMode )
    forall a. XmlContent a => Handle -> Bool -> a -> IO ()
fpsHPutXml Handle
f Bool
False a
x
    Handle -> IO ()
hClose Handle
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
    forall a b. (a, b) -> a
fst (forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser forall a. XmlContent a => XMLParser a
parseContents
                   [forall i. Element i -> i -> Content i
CElem Element Posn
y (FilePath -> Maybe Posn -> Posn
posInNewCxt FilePath
"string input" 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 forall a. XmlContent a => a -> [Content ()]
toContents a
x of
      [CElem Element ()
_ ()
_] -> (Doc -> FilePath
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Document i -> Doc
document forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. XmlContent a => a -> [Content ()]
toContents a
x of
      [CElem Element ()
_ ()
_] -> (forall i. Document i -> ByteString
FPS.document forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. HTypeable a => a -> HType
toHType a
value in
    forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
Document (Maybe XMLDecl -> [Misc] -> Maybe DocTypeDecl -> [Misc] -> Prolog
Prolog (forall a. a -> Maybe a
Just (FilePath -> Maybe EncodingDecl -> Maybe Bool -> XMLDecl
XMLDecl FilePath
"1.0" forall a. Maybe a
Nothing forall a. Maybe a
Nothing))
                     [] (if Bool
dtd then forall a. a -> Maybe a
Just (HType -> DocTypeDecl
toDTD HType
ht) else forall a. Maybe a
Nothing) [])
             forall a. SymTab a
emptyST
             ( case (HType
ht, forall a. XmlContent a => a -> [Content ()]
toContents a
value) of
                 (Tuple [HType]
_, [Content ()]
cs)       -> forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N forall a b. (a -> b) -> a -> b
$ HType -> ShowS
showHType HType
ht FilePath
"") [] [Content ()]
cs
                 (Defined FilePath
_ [HType]
_ [Constr]
_, [Content ()]
cs) -> forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N 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" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` QName -> FilePath
localName QName
n = forall a b. (a, b) -> a
fst (forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser forall a. XmlContent a => XMLParser a
parseContents [Content Posn]
cs)
  | FilePath
"-XML"  forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` QName -> FilePath
localName QName
n = forall a b. (a, b) -> a
fst (forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser forall a. XmlContent a => XMLParser a
parseContents [Content Posn]
cs)
  | Bool
otherwise = forall a b. (a, b) -> a
fst (forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser forall a. XmlContent a => XMLParser a
parseContents
                               [forall i. Element i -> i -> Content i
CElem Element Posn
e (FilePath -> Maybe Posn -> Posn
posInNewCxt FilePath
"document" 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
    FilePath
x <- Handle -> IO FilePath
hGetContents Handle
h
    let (Document Prolog
_ SymTab EntityDef
_ Element Posn
y [Misc]
_) = FilePath -> FilePath -> Document Posn
xmlParse FilePath
"file handle" FilePath
x
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return
           (forall a b. (a, b) -> a
fst (forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser forall a. XmlContent a => XMLParser a
parseContents
                           [forall i. Element i -> i -> Content i
CElem Element Posn
y (FilePath -> Maybe Posn -> Posn
posInNewCxt FilePath
"file handle" forall a. Maybe a
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> FilePath
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Document i -> Doc
document forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Document i -> ByteString
FPS.document forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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   = [forall i. Element i -> i -> Content i
CElem (forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N FilePath
"bool") [FilePath -> FilePath -> Attribute
mkAttr FilePath
"value" (forall a. Show a => a -> FilePath
show Bool
b)] []) ()]
    parseContents :: XMLParser Bool
parseContents = do { Element Posn
e <- [FilePath] -> XMLParser (Element Posn)
element [FilePath
"bool"] ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a i. Read a => Element i -> a
attval Element Posn
e) }

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

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

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

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

instance XmlContent Char where
    -- NOT in a string
    toContents :: Char -> [Content ()]
toContents Char
c   = [forall i. Element i -> i -> Content i
CElem (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 QName
_ [(N FilePath
"value",AttValue [Left [Char
c]])] [])
                             <- [FilePath] -> XMLParser (Element Posn)
element [FilePath
"char"]
                       ; forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
                       }
    -- Only defined for Char and no other types:
    xToChar :: Char -> Char
xToChar   = forall a. a -> a
id
    xFromChar :: Char -> Char
xFromChar = forall a. a -> a
id

instance XmlContent a => XmlContent [a] where
    toContents :: [a] -> [Content ()]
toContents [a]
xs  = case forall a. HTypeable a => a -> HType
toHType a
x of
                       (Prim FilePath
"Char" FilePath
_) ->
                            [forall a. XmlContent a => a -> [Content ()] -> Content ()
mkElem FilePath
"string" [forall i. Bool -> FilePath -> i -> Content i
CString Bool
True (forall a b. (a -> b) -> [a] -> [b]
map forall a. XmlContent a => a -> Char
xToChar [a]
xs) ()]]
                       HType
_ -> [forall a. XmlContent a => a -> [Content ()] -> Content ()
mkElem [a]
xs (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. XmlContent a => a -> [Content ()]
toContents [a]
xs)]
                   where   (a
x:[a]
_) = [a]
xs
    parseContents :: XMLParser [a]
parseContents = 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)
                   -> forall z a. z -> a -> Result z a
Success [Content Posn]
cs (forall a b. (a -> b) -> [a] -> [b]
map forall a. XmlContent a => Char -> a
xFromChar FilePath
s)
            (CElem (Elem (N FilePath
"string") [] [CString Bool
_ FilePath
s Posn
_]) Posn
_:[Content Posn]
cs)
                   -> forall z a. z -> a -> Result z a
Success [Content Posn]
cs (forall a b. (a -> b) -> [a] -> [b]
map forall a. XmlContent a => Char -> a
xFromChar FilePath
s)
            (CElem (Elem (N FilePath
"string") [] []) Posn
_:[Content Posn]
cs)
                   -> 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" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
e
                   -> 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 [] = forall z a. z -> a -> Result z a
Success [Content Posn]
cs []
                     scanElements [Content Posn]
es =
                        case forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser forall a. XmlContent a => XMLParser a
parseContents [Content Posn]
es of
                            (Left FilePath
msg, [Content Posn]
es') -> 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 -> forall z a. z -> FilePath -> Result z a
Failure [Content Posn]
ds FilePath
msg
                                    Success [Content Posn]
ds [a]
ys  -> forall z a. z -> a -> Result z a
Success [Content Posn]
ds (a
yforall a. a -> [a] -> [a]
:[a]
ys)
            (CElem (Elem QName
e [Attribute]
_ [Content Posn]
_) Posn
pos: [Content Posn]
cs)
                   -> forall z a. z -> FilePath -> Result z a
Failure [Content Posn]
cs (FilePath
"Expected a <list-...>, but found a <"
                                  forall a. [a] -> [a] -> [a]
++QName -> FilePath
printableName QName
e
                                  forall a. [a] -> [a] -> [a]
++FilePath
"> at\n"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> FilePath
show Posn
pos)
            (CRef Reference
r Posn
pos: [Content Posn]
cs)
                   -> forall z a. z -> FilePath -> Result z a
Failure [Content Posn]
cs (FilePath
"Expected a <list-...>, but found a ref "
                                  forall a. [a] -> [a] -> [a]
++forall a. Verbatim a => a -> FilePath
verbatim Reference
rforall a. [a] -> [a] -> [a]
++FilePath
" at\n"forall a. [a] -> [a] -> [a]
++ 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) forall a. XmlContent a => XMLParser a
parseContents [Content Posn]
cs  -- skip comments etc.
            []     -> forall z a. z -> FilePath -> Result z a
Failure [] FilePath
"Ran out of input XML whilst secondary parsing"
        )

instance XmlContent () where
    toContents :: () -> [Content ()]
toContents ()  = [forall i. Element i -> i -> Content i
CElem (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"]; forall (m :: * -> *) a. Monad m => a -> m a
return () }


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

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