-- File generated by DtdToHaskell.
-- manually changed to use Output type for alternatives,
-- and to escape certain fields.

module Util.Xml.OutputDTD where

import Text.XML.HaXml.XmlContent
import Text.XML.HaXml.Types ( QName (N))

import Text.XML.HaXml.Escape
import Text.XML.HaXml.Posn
import Data.Char (isSpace)

toTextEscaped :: String -> [Content ()]
toTextEscaped s = xmlEscapeContent stdXmlEscaper (toText s)

elementEscaped :: [String] -> XMLParser (Element Posn)
elementEscaped nm = do
    Elem nm as cs <- element nm
    return $ Elem nm as (xmlUnEscapeContent stdXmlEscaper cs)

{-Type decls-}

data Output
    = OPre Pre
    | OText Text
    | OImage Image
    | OLink Link
    | OAbove Above
    | OBeside Beside
    | OItemize Itemize
    | OSpace Space
    | OFigure Figure
    deriving (Eq,Show)

newtype Pre = Pre String                deriving (Eq,Show)
newtype Text = Text String              deriving (Eq,Show)
data Image = Image Image_Attrs String
           deriving (Eq,Show)
data Image_Attrs = Image_Attrs
    { imageType :: String
    , imageAlt :: String
    , imageWidth :: String
    , imageHeight :: String
    , imageUnit :: String
    } deriving (Eq,Show)
data Link = Link Link_Attrs String
          deriving (Eq,Show)
data Link_Attrs = Link_Attrs
    { linkHref :: String
    } deriving (Eq,Show)
newtype Above = Above [Output]          deriving (Eq,Show)
newtype Beside = Beside [Output]        deriving (Eq,Show)
newtype Itemize = Itemize [Output]      deriving (Eq,Show)
data Space = Space
    { spaceWidth :: String
    , spaceHeight :: String
    , spaceUnit :: String
    } deriving (Eq,Show)
data Figure = Figure Output Output
            deriving (Eq,Show)


{-Instance decls-}

instance HTypeable Pre where
    toHType x = Defined "Pre" [] []
instance XmlContent Pre where
    toContents (Pre a) =
        [CElem (elemN "Pre" [] (toTextEscaped a)) ()]
    parseContents = do
        { e@(Elem _ [] _) <- elementEscaped ["Pre"]
        ; interior e $ return (Pre) `apply` (text `onFail` return "")
        } `adjustErr` ("in <Pre>, "++)

instance HTypeable Text where
    toHType x = Defined "Text" [] []
instance XmlContent Text where
    toContents (Text a) =
        [CElem (elemN "Text" [] (toTextEscaped a)) ()]
    parseContents = do
        { e@(Elem _ [] _) <- elementEscaped ["Text"]
        ; interior e $ return (Text) `apply` (text `onFail` return "")
        } `adjustErr` ("in <Text>, "++)

instance HTypeable Image where
    toHType x = Defined "Image" [] []
instance XmlContent Image where
    toContents (Image as a) =
        [CElem (elemN "Image" (toAttrs as) (toText a)) ()]
    parseContents = do
        { e@(Elem _ as _) <- element ["Image"]
        ; interior e $ return (Image (fromAttrs as))
                       `apply` (text `onFail` return "")
        } `adjustErr` ("in <Image>, "++)
instance XmlAttributes Image_Attrs where
    fromAttrs as =
        Image_Attrs
          { imageType = definiteA fromAttrToStr "Image" "type" as
          , imageAlt = definiteA fromAttrToStr "Image" "alt" as
          , imageWidth = definiteA fromAttrToStr "Image" "width" as
          , imageHeight = definiteA fromAttrToStr "Image" "height" as
          , imageUnit = definiteA fromAttrToStr "Image" "unit" as
          }
    toAttrs v = catMaybes 
        [ toAttrFrStr "type" (imageType v)
        , toAttrFrStr "alt" (imageAlt v)
        , toAttrFrStr "width" (imageWidth v)
        , toAttrFrStr "height" (imageHeight v)
        , toAttrFrStr "unit" (imageUnit v)
        ]

instance HTypeable Link where
    toHType x = Defined "Link" [] []
instance XmlContent Link where
    toContents (Link as a) =
        [CElem (elemN "Link" (toAttrs as) (toTextEscaped a)) ()]
    parseContents = do
        { e@(Elem _ as _) <- elementEscaped ["Link"]
        ; interior e $ return (Link (fromAttrs as))
                       `apply` (text `onFail` return "")
        } `adjustErr` ("in <Link>, "++)
instance XmlAttributes Link_Attrs where
    fromAttrs as =
        Link_Attrs
          { linkHref = definiteA fromAttrToStr "Link" "href" as
          }
    toAttrs v = catMaybes 
        [ toAttrFrStr "href" (linkHref v)
        ]

instance HTypeable Above where
    toHType x = Defined "Above" [] []
instance XmlContent Above where
    toContents (Above a) =
        [CElem (elemN "Above" [] (concatMap toContents a)) ()]
    parseContents = do
        { e@(Elem _ [] _) <- element ["Above"]
        ; interior e $ return (Above) `apply` many parseContents
        } `adjustErr` ("in <Above>, "++)

instance HTypeable Output where
    toHType x = Defined "Output" [] []
instance XmlContent Output where
    toContents (OPre a) = toContents a
    toContents (OText a) = toContents a
    toContents (OImage a) = toContents a
    toContents (OLink a) = toContents a
    toContents (OAbove a) = toContents a
    toContents (OBeside a) = toContents a
    toContents (OItemize a) = toContents a
    toContents (OSpace a) = toContents a
    toContents (OFigure a) = toContents a
    parseContents = oneOf
        [ return (OPre) `apply` parseContents
        , return (OText) `apply` parseContents
        , return (OImage) `apply` parseContents
        , return (OLink) `apply` parseContents
        , return (OAbove) `apply` parseContents
        , return (OBeside) `apply` parseContents
        , return (OItemize) `apply` parseContents
        , return (OSpace) `apply` parseContents
        , return (OFigure) `apply` parseContents
        ] `adjustErr` ("in <Above>, "++)

instance HTypeable Beside where
    toHType x = Defined "Beside" [] []
instance XmlContent Beside where
    toContents (Beside a) =
        [CElem (elemN "Beside" [] (concatMap toContents a)) ()]
    parseContents = do
        { e@(Elem _ [] _) <- element ["Beside"]
        ; interior e $ return (Beside) `apply` many parseContents
        } `adjustErr` ("in <Beside>, "++)

instance HTypeable Itemize where
    toHType x = Defined "Itemize" [] []
instance XmlContent Itemize where
    toContents (Itemize a) =
        [CElem (elemN "Itemize" [] (concatMap toContents a)) ()]
    parseContents = do
        { e@(Elem _ [] _) <- element ["Itemize"]
        ; interior e $ return (Itemize) `apply` many parseContents
        } `adjustErr` ("in <Itemize>, "++)

instance HTypeable Space where
    toHType x = Defined "Space" [] []
instance XmlContent Space where
    toContents as =
        [CElem (elemN "Space" (toAttrs as) []) ()]
    parseContents = do
        { (Elem _ as []) <- element ["Space"]
        ; return (fromAttrs as)
        } `adjustErr` ("in <Space>, "++)
instance XmlAttributes Space where
    fromAttrs as =
        Space
          { spaceWidth = definiteA fromAttrToStr "Space" "width" as
          , spaceHeight = definiteA fromAttrToStr "Space" "height" as
          , spaceUnit = definiteA fromAttrToStr "Space" "unit" as
          }
    toAttrs v = catMaybes 
        [ toAttrFrStr "width" (spaceWidth v)
        , toAttrFrStr "height" (spaceHeight v)
        , toAttrFrStr "unit" (spaceUnit v)
        ]

instance HTypeable Figure where
    toHType x = Defined "Figure" [] []
instance XmlContent Figure where
    toContents (Figure a b) =
        [CElem (elemN "Figure" [] (toContents a ++ toContents b)) ()]
    parseContents = do
        { e@(Elem _ [] _) <- element ["Figure"]
        ; interior e $ return (Figure) `apply` parseContents
                       `apply` parseContents
        } `adjustErr` ("in <Figure>, "++)


elemN s = Elem ( Text.XML.HaXml.Types.N s )

{-Done-}
