Glade20DTD.hs

module Graphics.UI.Gtk.Glade.Glade20DTD where

import Text.XML.HaXml.XmlContent
import Text.XML.HaXml.OneOfN


{-Type decls-}

data Glade_interface = Glade_interface Glade_interface_Attrs
                                       [Requires] [Widget]
                     deriving (Eq,Show)
data Glade_interface_Attrs = Glade_interface_Attrs
    { glade_interfaceXmlns :: (Defaultable String)
    } deriving (Eq,Show)
data Requires = Requires
    { requiresLib :: String
    } deriving (Eq,Show)
data Widget = Widget Widget_Attrs [Property] (Maybe Accessibility)
                     [Signal] [Accelerator] [Child]
            deriving (Eq,Show)
data Widget_Attrs = Widget_Attrs
    { widgetClass :: String
    , widgetId :: String
    } deriving (Eq,Show)
data Property = Property Property_Attrs String
              deriving (Eq,Show)
data Property_Attrs = Property_Attrs
    { propertyName :: String
    , propertyType :: (Maybe String)
    , propertyTranslatable :: (Defaultable Property_translatable)
    , propertyContext :: (Defaultable Property_context)
    , propertyComments :: (Maybe String)
    , propertyAgent :: (Maybe String)
    } deriving (Eq,Show)
data Property_translatable = Property_translatable_yes  | 
                             Property_translatable_no
                           deriving (Eq,Show)
data Property_context = Property_context_yes  | 
                        Property_context_no
                      deriving (Eq,Show)
data Atkproperty = Atkproperty Atkproperty_Attrs [Atkproperty_]
                 deriving (Eq,Show)
data Atkproperty_Attrs = Atkproperty_Attrs
    { atkpropertyName :: String
    , atkpropertyType :: (Maybe String)
    , atkpropertyTranslatable :: (Defaultable Atkproperty_translatable)
    , atkpropertyContext :: (Defaultable Atkproperty_context)
    , atkpropertyComments :: (Maybe String)
    } deriving (Eq,Show)
data Atkproperty_ = Atkproperty_Str String
                  | Atkproperty_Accessibility Accessibility
                  deriving (Eq,Show)
data Atkproperty_translatable = Atkproperty_translatable_yes  | 
                                Atkproperty_translatable_no
                              deriving (Eq,Show)
data Atkproperty_context = Atkproperty_context_yes  | 
                           Atkproperty_context_no
                         deriving (Eq,Show)
data Atkrelation = Atkrelation
    { atkrelationTarget :: String
    , atkrelationType :: String
    } deriving (Eq,Show)
data Atkaction = Atkaction
    { atkactionAction_name :: String
    , atkactionDescription :: (Maybe String)
    } deriving (Eq,Show)
newtype Accessibility = Accessibility [Accessibility_] 		deriving (Eq,Show)
data Accessibility_ = Accessibility_Atkrelation Atkrelation
                    | Accessibility_Atkaction Atkaction
                    | Accessibility_Atkproperty Atkproperty
                    deriving (Eq,Show)
data Signal = Signal Signal_Attrs [Property]
            deriving (Eq,Show)
data Signal_Attrs = Signal_Attrs
    { signalName :: String
    , signalHandler :: String
    , signalAfter :: (Defaultable Signal_after)
    , signalObject :: (Maybe String)
    , signalLast_modification_time :: (Maybe String)
    } deriving (Eq,Show)
data Signal_after = Signal_after_yes  |  Signal_after_no
                  deriving (Eq,Show)
data Accelerator = Accelerator
    { acceleratorKey :: String
    , acceleratorModifiers :: String
    , acceleratorSignal :: String
    } deriving (Eq,Show)
data Child = Child Child_Attrs (OneOf2 Widget Placeholder)
                   (Maybe Packing)
           deriving (Eq,Show)
data Child_Attrs = Child_Attrs
    { childInternal_child :: (Maybe String)
    } deriving (Eq,Show)
newtype Packing = Packing (List1 Property) 		deriving (Eq,Show)
data Placeholder = Placeholder 		deriving (Eq,Show)


{-Instance decls-}

instance HTypeable Glade_interface where
    toHType x = Defined "glade-interface" [] []
instance XmlContent Glade_interface where
    toContents (Glade_interface as a b) =
        [CElem (Elem "glade-interface" (toAttrs as) (concatMap toContents a
                                                     ++ concatMap toContents b)) ()]
    parseContents = do
        { e@(Elem _ as _) <- element ["glade-interface"]
        ; interior e $ return (Glade_interface (fromAttrs as))
                       `apply` many parseContents `apply` many parseContents
        } `adjustErr` ("in <glade-interface>, "++)
instance XmlAttributes Glade_interface_Attrs where
    fromAttrs as =
        Glade_interface_Attrs
          { glade_interfaceXmlns = defaultA fromAttrToStr "http://glade.gnome.org/glade-2.0.dtd" "xmlns" as
          }
    toAttrs v = catMaybes 
        [ defaultToAttr toAttrFrStr "xmlns" (glade_interfaceXmlns v)
        ]

instance HTypeable Requires where
    toHType x = Defined "requires" [] []
instance XmlContent Requires where
    toContents as =
        [CElem (Elem "requires" (toAttrs as) []) ()]
    parseContents = do
        { (Elem _ as []) <- element ["requires"]
        ; return (fromAttrs as)
        } `adjustErr` ("in <requires>, "++)
instance XmlAttributes Requires where
    fromAttrs as =
        Requires
          { requiresLib = definiteA fromAttrToStr "requires" "lib" as
          }
    toAttrs v = catMaybes 
        [ toAttrFrStr "lib" (requiresLib v)
        ]

instance HTypeable Widget where
    toHType x = Defined "widget" [] []
instance XmlContent Widget where
    toContents (Widget as a b c d e) =
        [CElem (Elem "widget" (toAttrs as) (concatMap toContents a ++
                                            maybe [] toContents b ++ concatMap toContents c ++
                                            concatMap toContents d ++ concatMap toContents e)) ()]
    parseContents = do
        { e@(Elem _ as _) <- element ["widget"]
        ; interior e $ return (Widget (fromAttrs as))
                       `apply` many parseContents `apply` optional parseContents
                       `apply` many parseContents `apply` many parseContents
                       `apply` many parseContents
        } `adjustErr` ("in <widget>, "++)
instance XmlAttributes Widget_Attrs where
    fromAttrs as =
        Widget_Attrs
          { widgetClass = definiteA fromAttrToStr "widget" "class" as
          , widgetId = definiteA fromAttrToStr "widget" "id" as
          }
    toAttrs v = catMaybes 
        [ toAttrFrStr "class" (widgetClass v)
        , toAttrFrStr "id" (widgetId v)
        ]

instance HTypeable Property where
    toHType x = Defined "property" [] []
instance XmlContent Property where
    toContents (Property as a) =
        [CElem (Elem "property" (toAttrs as) (toText a)) ()]
    parseContents = do
        { e@(Elem _ as _) <- element ["property"]
        ; interior e $ return (Property (fromAttrs as))
                       `apply` (text `onFail` return "")
        } `adjustErr` ("in <property>, "++)
instance XmlAttributes Property_Attrs where
    fromAttrs as =
        Property_Attrs
          { propertyName = definiteA fromAttrToStr "property" "name" as
          , propertyType = possibleA fromAttrToStr "type" as
          , propertyTranslatable = defaultA fromAttrToTyp Property_translatable_no "translatable" as
          , propertyContext = defaultA fromAttrToTyp Property_context_no "context" as
          , propertyComments = possibleA fromAttrToStr "comments" as
          , propertyAgent = possibleA fromAttrToStr "agent" as
          }
    toAttrs v = catMaybes 
        [ toAttrFrStr "name" (propertyName v)
        , maybeToAttr toAttrFrStr "type" (propertyType v)
        , defaultToAttr toAttrFrTyp "translatable" (propertyTranslatable v)
        , defaultToAttr toAttrFrTyp "context" (propertyContext v)
        , maybeToAttr toAttrFrStr "comments" (propertyComments v)
        , maybeToAttr toAttrFrStr "agent" (propertyAgent v)
        ]

instance XmlAttrType Property_translatable where
    fromAttrToTyp n (n',v)
        | n==n'     = translate (attr2str v)
        | otherwise = Nothing
      where translate "yes" = Just Property_translatable_yes
            translate "no" = Just Property_translatable_no
            translate _ = Nothing
    toAttrFrTyp n Property_translatable_yes = Just (n, str2attr "yes")
    toAttrFrTyp n Property_translatable_no = Just (n, str2attr "no")

instance XmlAttrType Property_context where
    fromAttrToTyp n (n',v)
        | n==n'     = translate (attr2str v)
        | otherwise = Nothing
      where translate "yes" = Just Property_context_yes
            translate "no" = Just Property_context_no
            translate _ = Nothing
    toAttrFrTyp n Property_context_yes = Just (n, str2attr "yes")
    toAttrFrTyp n Property_context_no = Just (n, str2attr "no")

instance HTypeable Atkproperty where
    toHType x = Defined "atkproperty" [] []
instance XmlContent Atkproperty where
    toContents (Atkproperty as a) =
        [CElem (Elem "atkproperty" (toAttrs as) (concatMap toContents a)) ()]
    parseContents = do
        { e@(Elem _ as _) <- element ["atkproperty"]
        ; interior e $ return (Atkproperty (fromAttrs as))
                       `apply` many parseContents
        } `adjustErr` ("in <atkproperty>, "++)
instance XmlAttributes Atkproperty_Attrs where
    fromAttrs as =
        Atkproperty_Attrs
          { atkpropertyName = definiteA fromAttrToStr "atkproperty" "name" as
          , atkpropertyType = possibleA fromAttrToStr "type" as
          , atkpropertyTranslatable = defaultA fromAttrToTyp Atkproperty_translatable_no "translatable" as
          , atkpropertyContext = defaultA fromAttrToTyp Atkproperty_context_no "context" as
          , atkpropertyComments = possibleA fromAttrToStr "comments" as
          }
    toAttrs v = catMaybes 
        [ toAttrFrStr "name" (atkpropertyName v)
        , maybeToAttr toAttrFrStr "type" (atkpropertyType v)
        , defaultToAttr toAttrFrTyp "translatable" (atkpropertyTranslatable v)
        , defaultToAttr toAttrFrTyp "context" (atkpropertyContext v)
        , maybeToAttr toAttrFrStr "comments" (atkpropertyComments v)
        ]

instance HTypeable Atkproperty_ where
    toHType x = Defined "atkproperty" [] []
instance XmlContent Atkproperty_ where
    toContents (Atkproperty_Str a) = toText a
    toContents (Atkproperty_Accessibility a) = toContents a
    parseContents = oneOf
        [ return (Atkproperty_Str) `apply` (text `onFail` return "")
        , return (Atkproperty_Accessibility) `apply` parseContents
        ] `adjustErr` ("in <atkproperty>, "++)

instance XmlAttrType Atkproperty_translatable where
    fromAttrToTyp n (n',v)
        | n==n'     = translate (attr2str v)
        | otherwise = Nothing
      where translate "yes" = Just Atkproperty_translatable_yes
            translate "no" = Just Atkproperty_translatable_no
            translate _ = Nothing
    toAttrFrTyp n Atkproperty_translatable_yes = Just (n, str2attr "yes")
    toAttrFrTyp n Atkproperty_translatable_no = Just (n, str2attr "no")

instance XmlAttrType Atkproperty_context where
    fromAttrToTyp n (n',v)
        | n==n'     = translate (attr2str v)
        | otherwise = Nothing
      where translate "yes" = Just Atkproperty_context_yes
            translate "no" = Just Atkproperty_context_no
            translate _ = Nothing
    toAttrFrTyp n Atkproperty_context_yes = Just (n, str2attr "yes")
    toAttrFrTyp n Atkproperty_context_no = Just (n, str2attr "no")

instance HTypeable Atkrelation where
    toHType x = Defined "atkrelation" [] []
instance XmlContent Atkrelation where
    toContents as =
        [CElem (Elem "atkrelation" (toAttrs as) []) ()]
    parseContents = do
        { (Elem _ as []) <- element ["atkrelation"]
        ; return (fromAttrs as)
        } `adjustErr` ("in <atkrelation>, "++)
instance XmlAttributes Atkrelation where
    fromAttrs as =
        Atkrelation
          { atkrelationTarget = definiteA fromAttrToStr "atkrelation" "target" as
          , atkrelationType = definiteA fromAttrToStr "atkrelation" "type" as
          }
    toAttrs v = catMaybes 
        [ toAttrFrStr "target" (atkrelationTarget v)
        , toAttrFrStr "type" (atkrelationType v)
        ]

instance HTypeable Atkaction where
    toHType x = Defined "atkaction" [] []
instance XmlContent Atkaction where
    toContents as =
        [CElem (Elem "atkaction" (toAttrs as) []) ()]
    parseContents = do
        { (Elem _ as []) <- element ["atkaction"]
        ; return (fromAttrs as)
        } `adjustErr` ("in <atkaction>, "++)
instance XmlAttributes Atkaction where
    fromAttrs as =
        Atkaction
          { atkactionAction_name = definiteA fromAttrToStr "atkaction" "action_name" as
          , atkactionDescription = possibleA fromAttrToStr "description" as
          }
    toAttrs v = catMaybes 
        [ toAttrFrStr "action_name" (atkactionAction_name v)
        , maybeToAttr toAttrFrStr "description" (atkactionDescription v)
        ]

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

instance HTypeable Accessibility_ where
    toHType x = Defined "accessibility" [] []
instance XmlContent Accessibility_ where
    toContents (Accessibility_Atkrelation a) = toContents a
    toContents (Accessibility_Atkaction a) = toContents a
    toContents (Accessibility_Atkproperty a) = toContents a
    parseContents = oneOf
        [ return (Accessibility_Atkrelation) `apply` parseContents
        , return (Accessibility_Atkaction) `apply` parseContents
        , return (Accessibility_Atkproperty) `apply` parseContents
        ] `adjustErr` ("in <accessibility>, "++)

instance HTypeable Signal where
    toHType x = Defined "signal" [] []
instance XmlContent Signal where
    toContents (Signal as a) =
        [CElem (Elem "signal" (toAttrs as) (concatMap toContents a)) ()]
    parseContents = do
        { e@(Elem _ as _) <- element ["signal"]
        ; interior e $ return (Signal (fromAttrs as))
                       `apply` many parseContents
        } `adjustErr` ("in <signal>, "++)
instance XmlAttributes Signal_Attrs where
    fromAttrs as =
        Signal_Attrs
          { signalName = definiteA fromAttrToStr "signal" "name" as
          , signalHandler = definiteA fromAttrToStr "signal" "handler" as
          , signalAfter = defaultA fromAttrToTyp Signal_after_no "after" as
          , signalObject = possibleA fromAttrToStr "object" as
          , signalLast_modification_time = possibleA fromAttrToStr "last_modification_time" as
          }
    toAttrs v = catMaybes 
        [ toAttrFrStr "name" (signalName v)
        , toAttrFrStr "handler" (signalHandler v)
        , defaultToAttr toAttrFrTyp "after" (signalAfter v)
        , maybeToAttr toAttrFrStr "object" (signalObject v)
        , maybeToAttr toAttrFrStr "last_modification_time" (signalLast_modification_time v)
        ]

instance XmlAttrType Signal_after where
    fromAttrToTyp n (n',v)
        | n==n'     = translate (attr2str v)
        | otherwise = Nothing
      where translate "yes" = Just Signal_after_yes
            translate "no" = Just Signal_after_no
            translate _ = Nothing
    toAttrFrTyp n Signal_after_yes = Just (n, str2attr "yes")
    toAttrFrTyp n Signal_after_no = Just (n, str2attr "no")

instance HTypeable Accelerator where
    toHType x = Defined "accelerator" [] []
instance XmlContent Accelerator where
    toContents as =
        [CElem (Elem "accelerator" (toAttrs as) []) ()]
    parseContents = do
        { (Elem _ as []) <- element ["accelerator"]
        ; return (fromAttrs as)
        } `adjustErr` ("in <accelerator>, "++)
instance XmlAttributes Accelerator where
    fromAttrs as =
        Accelerator
          { acceleratorKey = definiteA fromAttrToStr "accelerator" "key" as
          , acceleratorModifiers = definiteA fromAttrToStr "accelerator" "modifiers" as
          , acceleratorSignal = definiteA fromAttrToStr "accelerator" "signal" as
          }
    toAttrs v = catMaybes 
        [ toAttrFrStr "key" (acceleratorKey v)
        , toAttrFrStr "modifiers" (acceleratorModifiers v)
        , toAttrFrStr "signal" (acceleratorSignal v)
        ]

instance HTypeable Child where
    toHType x = Defined "child" [] []
instance XmlContent Child where
    toContents (Child as a b) =
        [CElem (Elem "child" (toAttrs as) (toContents a ++
                                           maybe [] toContents b)) ()]
    parseContents = do
        { e@(Elem _ as _) <- element ["child"]
        ; interior e $ return (Child (fromAttrs as)) `apply` parseContents
                       `apply` optional parseContents
        } `adjustErr` ("in <child>, "++)
instance XmlAttributes Child_Attrs where
    fromAttrs as =
        Child_Attrs
          { childInternal_child = possibleA fromAttrToStr "internal-child" as
          }
    toAttrs v = catMaybes 
        [ maybeToAttr toAttrFrStr "internal-child" (childInternal_child v)
        ]

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

instance HTypeable Placeholder where
    toHType x = Defined "placeholder" [] []
instance XmlContent Placeholder where
    toContents Placeholder =
        [CElem (Elem "placeholder" [] []) ()]
    parseContents = do
        { (Elem _ as []) <- element ["placeholder"]
        ; return Placeholder
        } `adjustErr` ("in <placeholder>, "++)



{-Done-}