module GXL where import Text.XML.HaXml.XmlContent import Text.XML.HaXml.OneOfN {-Type decls-} data Gxl = Gxl Gxl_Attrs [Graph] deriving (Eq,Show) data Gxl_Attrs = Gxl_Attrs { gxlXmlns'xlink :: (Defaultable String) } deriving (Eq,Show) data Type = Type { typeXlink'type :: (Defaultable Type_xlink'type) , typeXlink'href :: String } deriving (Eq,Show) data Type_xlink'type = Type_xlink'type_simple deriving (Eq,Show) data Graph = Graph Graph_Attrs (Maybe Type) [Attr] [(OneOf3 Node Edge Rel)] deriving (Eq,Show) data Graph_Attrs = Graph_Attrs { graphId :: String , graphRole :: (Maybe String) , graphEdgeids :: (Defaultable Graph_edgeids) , graphHypergraph :: (Defaultable Graph_hypergraph) , graphEdgemode :: (Defaultable Graph_edgemode) } deriving (Eq,Show) data Graph_edgeids = Graph_edgeids_true | Graph_edgeids_false deriving (Eq,Show) data Graph_hypergraph = Graph_hypergraph_true | Graph_hypergraph_false deriving (Eq,Show) data Graph_edgemode = Graph_edgemode_directed | Graph_edgemode_undirected | Graph_edgemode_defaultdirected | Graph_edgemode_defaultundirected deriving (Eq,Show) data Node = Node Node_Attrs (Maybe Type) [Attr] [Graph] deriving (Eq,Show) data Node_Attrs = Node_Attrs { nodeId :: String } deriving (Eq,Show) data Edge = Edge Edge_Attrs (Maybe Type) [Attr] [Graph] deriving (Eq,Show) data Edge_Attrs = Edge_Attrs { edgeId :: (Maybe String) , edgeFrom :: String , edgeTo :: String , edgeFromorder :: (Maybe String) , edgeToorder :: (Maybe String) , edgeIsdirected :: (Maybe Edge_isdirected) } deriving (Eq,Show) data Edge_isdirected = Edge_isdirected_true | Edge_isdirected_false deriving (Eq,Show) data Rel = Rel Rel_Attrs (Maybe Type) [Attr] [Graph] [Relend] deriving (Eq,Show) data Rel_Attrs = Rel_Attrs { relId :: (Maybe String) , relIsdirected :: (Maybe Rel_isdirected) } deriving (Eq,Show) data Rel_isdirected = Rel_isdirected_true | Rel_isdirected_false deriving (Eq,Show) data Relend = Relend Relend_Attrs [Attr] deriving (Eq,Show) data Relend_Attrs = Relend_Attrs { relendTarget :: String , relendRole :: (Maybe String) , relendDirection :: (Maybe Relend_direction) , relendStartorder :: (Maybe String) , relendEndorder :: (Maybe String) } deriving (Eq,Show) data Relend_direction = Relend_direction_in | Relend_direction_out | Relend_direction_none deriving (Eq,Show) data Attr = Attr Attr_Attrs [Attr] (OneOf10 Locator Bool AInt AFloat AString Enum Seq Set Bag Tup) deriving (Eq,Show) data Attr_Attrs = Attr_Attrs { attrId :: (Maybe String) , attrName :: String , attrKind :: (Maybe String) } deriving (Eq,Show) data Locator = Locator { locatorXlink'type :: (Defaultable Locator_xlink'type) , locatorXlink'href :: String } deriving (Eq,Show) data Locator_xlink'type = Locator_xlink'type_simple deriving (Eq,Show) newtype Bool = Bool String deriving (Eq,Show) newtype AInt = AInt String deriving (Eq,Show) newtype AFloat = AFloat String deriving (Eq,Show) newtype AString = AString String deriving (Eq,Show) newtype Enum = Enum String deriving (Eq,Show) newtype Seq = Seq [Seq_] deriving (Eq,Show) data Seq_ = Seq_Locator Locator | Seq_Bool Bool | Seq_AInt AInt | Seq_AFloat AFloat | Seq_AString AString | Seq_Enum Enum | Seq_Seq Seq | Seq_Set Set | Seq_Bag Bag | Seq_Tup Tup deriving (Eq,Show) newtype Set = Set [Set_] deriving (Eq,Show) data Set_ = Set_Locator Locator | Set_Bool Bool | Set_AInt AInt | Set_AFloat AFloat | Set_AString AString | Set_Enum Enum | Set_Seq Seq | Set_Set Set | Set_Bag Bag | Set_Tup Tup deriving (Eq,Show) newtype Bag = Bag [Bag_] deriving (Eq,Show) data Bag_ = Bag_Locator Locator | Bag_Bool Bool | Bag_AInt AInt | Bag_AFloat AFloat | Bag_AString AString | Bag_Enum Enum | Bag_Seq Seq | Bag_Set Set | Bag_Bag Bag | Bag_Tup Tup deriving (Eq,Show) newtype Tup = Tup [Tup_] deriving (Eq,Show) data Tup_ = Tup_Locator Locator | Tup_Bool Bool | Tup_AInt AInt | Tup_AFloat AFloat | Tup_AString AString | Tup_Enum Enum | Tup_Seq Seq | Tup_Set Set | Tup_Bag Bag | Tup_Tup Tup deriving (Eq,Show) {-Instance decls-} instance HTypeable Gxl where toHType x = Defined "gxl" [] [] instance XmlContent Gxl where toContents (Gxl as a) = [CElem (Elem "gxl" (toAttrs as) (concatMap toContents a)) ()] parseContents = do { e@(Elem _ as _) <- element ["gxl"] ; interior e $ return (Gxl (fromAttrs as)) `apply` many parseContents } `adjustErr` ("in , "++) instance XmlAttributes Gxl_Attrs where fromAttrs as = Gxl_Attrs { gxlXmlns'xlink = defaultA fromAttrToStr "http://www.w3.org/1999/xlink" "xmlns:xlink" as } toAttrs v = catMaybes [ defaultToAttr toAttrFrStr "xmlns:xlink" (gxlXmlns'xlink v) ] instance HTypeable Type where toHType x = Defined "type" [] [] instance XmlContent Type where toContents as = [CElem (Elem "type" (toAttrs as) []) ()] parseContents = do { (Elem _ as []) <- element ["type"] ; return (fromAttrs as) } `adjustErr` ("in , "++) instance XmlAttributes Type where fromAttrs as = Type { typeXlink'type = defaultA fromAttrToTyp Type_xlink'type_simple "xlink:type" as , typeXlink'href = definiteA fromAttrToStr "type" "xlink:href" as } toAttrs v = catMaybes [ defaultToAttr toAttrFrTyp "xlink:type" (typeXlink'type v) , toAttrFrStr "xlink:href" (typeXlink'href v) ] instance XmlAttrType Type_xlink'type where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "simple" = Just Type_xlink'type_simple translate _ = Nothing toAttrFrTyp n Type_xlink'type_simple = Just (n, str2attr "simple") instance HTypeable Graph where toHType x = Defined "graph" [] [] instance XmlContent Graph where toContents (Graph as a b c) = [CElem (Elem "graph" (toAttrs as) (maybe [] toContents a ++ concatMap toContents b ++ concatMap toContents c)) ()] parseContents = do { e@(Elem _ as _) <- element ["graph"] ; interior e $ return (Graph (fromAttrs as)) `apply` optional parseContents `apply` many parseContents `apply` many parseContents } `adjustErr` ("in , "++) instance XmlAttributes Graph_Attrs where fromAttrs as = Graph_Attrs { graphId = definiteA fromAttrToStr "graph" "id" as , graphRole = possibleA fromAttrToStr "role" as , graphEdgeids = defaultA fromAttrToTyp Graph_edgeids_false "edgeids" as , graphHypergraph = defaultA fromAttrToTyp Graph_hypergraph_false "hypergraph" as , graphEdgemode = defaultA fromAttrToTyp Graph_edgemode_directed "edgemode" as } toAttrs v = catMaybes [ toAttrFrStr "id" (graphId v) , maybeToAttr toAttrFrStr "role" (graphRole v) , defaultToAttr toAttrFrTyp "edgeids" (graphEdgeids v) , defaultToAttr toAttrFrTyp "hypergraph" (graphHypergraph v) , defaultToAttr toAttrFrTyp "edgemode" (graphEdgemode v) ] instance XmlAttrType Graph_edgeids where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "true" = Just Graph_edgeids_true translate "false" = Just Graph_edgeids_false translate _ = Nothing toAttrFrTyp n Graph_edgeids_true = Just (n, str2attr "true") toAttrFrTyp n Graph_edgeids_false = Just (n, str2attr "false") instance XmlAttrType Graph_hypergraph where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "true" = Just Graph_hypergraph_true translate "false" = Just Graph_hypergraph_false translate _ = Nothing toAttrFrTyp n Graph_hypergraph_true = Just (n, str2attr "true") toAttrFrTyp n Graph_hypergraph_false = Just (n, str2attr "false") instance XmlAttrType Graph_edgemode where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "directed" = Just Graph_edgemode_directed translate "undirected" = Just Graph_edgemode_undirected translate "defaultdirected" = Just Graph_edgemode_defaultdirected translate "defaultundirected" = Just Graph_edgemode_defaultundirected translate _ = Nothing toAttrFrTyp n Graph_edgemode_directed = Just (n, str2attr "directed") toAttrFrTyp n Graph_edgemode_undirected = Just (n, str2attr "undirected") toAttrFrTyp n Graph_edgemode_defaultdirected = Just (n, str2attr "defaultdirected") toAttrFrTyp n Graph_edgemode_defaultundirected = Just (n, str2attr "defaultundirected") instance HTypeable Node where toHType x = Defined "node" [] [] instance XmlContent Node where toContents (Node as a b c) = [CElem (Elem "node" (toAttrs as) (maybe [] toContents a ++ concatMap toContents b ++ concatMap toContents c)) ()] parseContents = do { e@(Elem _ as _) <- element ["node"] ; interior e $ return (Node (fromAttrs as)) `apply` optional parseContents `apply` many parseContents `apply` many parseContents } `adjustErr` ("in , "++) instance XmlAttributes Node_Attrs where fromAttrs as = Node_Attrs { nodeId = definiteA fromAttrToStr "node" "id" as } toAttrs v = catMaybes [ toAttrFrStr "id" (nodeId v) ] instance HTypeable Edge where toHType x = Defined "edge" [] [] instance XmlContent Edge where toContents (Edge as a b c) = [CElem (Elem "edge" (toAttrs as) (maybe [] toContents a ++ concatMap toContents b ++ concatMap toContents c)) ()] parseContents = do { e@(Elem _ as _) <- element ["edge"] ; interior e $ return (Edge (fromAttrs as)) `apply` optional parseContents `apply` many parseContents `apply` many parseContents } `adjustErr` ("in , "++) instance XmlAttributes Edge_Attrs where fromAttrs as = Edge_Attrs { edgeId = possibleA fromAttrToStr "id" as , edgeFrom = definiteA fromAttrToStr "edge" "from" as , edgeTo = definiteA fromAttrToStr "edge" "to" as , edgeFromorder = possibleA fromAttrToStr "fromorder" as , edgeToorder = possibleA fromAttrToStr "toorder" as , edgeIsdirected = possibleA fromAttrToTyp "isdirected" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (edgeId v) , toAttrFrStr "from" (edgeFrom v) , toAttrFrStr "to" (edgeTo v) , maybeToAttr toAttrFrStr "fromorder" (edgeFromorder v) , maybeToAttr toAttrFrStr "toorder" (edgeToorder v) , maybeToAttr toAttrFrTyp "isdirected" (edgeIsdirected v) ] instance XmlAttrType Edge_isdirected where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "true" = Just Edge_isdirected_true translate "false" = Just Edge_isdirected_false translate _ = Nothing toAttrFrTyp n Edge_isdirected_true = Just (n, str2attr "true") toAttrFrTyp n Edge_isdirected_false = Just (n, str2attr "false") instance HTypeable Rel where toHType x = Defined "rel" [] [] instance XmlContent Rel where toContents (Rel as a b c d) = [CElem (Elem "rel" (toAttrs as) (maybe [] toContents a ++ concatMap toContents b ++ concatMap toContents c ++ concatMap toContents d)) ()] parseContents = do { e@(Elem _ as _) <- element ["rel"] ; interior e $ return (Rel (fromAttrs as)) `apply` optional parseContents `apply` many parseContents `apply` many parseContents `apply` many parseContents } `adjustErr` ("in , "++) instance XmlAttributes Rel_Attrs where fromAttrs as = Rel_Attrs { relId = possibleA fromAttrToStr "id" as , relIsdirected = possibleA fromAttrToTyp "isdirected" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (relId v) , maybeToAttr toAttrFrTyp "isdirected" (relIsdirected v) ] instance XmlAttrType Rel_isdirected where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "true" = Just Rel_isdirected_true translate "false" = Just Rel_isdirected_false translate _ = Nothing toAttrFrTyp n Rel_isdirected_true = Just (n, str2attr "true") toAttrFrTyp n Rel_isdirected_false = Just (n, str2attr "false") instance HTypeable Relend where toHType x = Defined "relend" [] [] instance XmlContent Relend where toContents (Relend as a) = [CElem (Elem "relend" (toAttrs as) (concatMap toContents a)) ()] parseContents = do { e@(Elem _ as _) <- element ["relend"] ; interior e $ return (Relend (fromAttrs as)) `apply` many parseContents } `adjustErr` ("in , "++) instance XmlAttributes Relend_Attrs where fromAttrs as = Relend_Attrs { relendTarget = definiteA fromAttrToStr "relend" "target" as , relendRole = possibleA fromAttrToStr "role" as , relendDirection = possibleA fromAttrToTyp "direction" as , relendStartorder = possibleA fromAttrToStr "startorder" as , relendEndorder = possibleA fromAttrToStr "endorder" as } toAttrs v = catMaybes [ toAttrFrStr "target" (relendTarget v) , maybeToAttr toAttrFrStr "role" (relendRole v) , maybeToAttr toAttrFrTyp "direction" (relendDirection v) , maybeToAttr toAttrFrStr "startorder" (relendStartorder v) , maybeToAttr toAttrFrStr "endorder" (relendEndorder v) ] instance XmlAttrType Relend_direction where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "in" = Just Relend_direction_in translate "out" = Just Relend_direction_out translate "none" = Just Relend_direction_none translate _ = Nothing toAttrFrTyp n Relend_direction_in = Just (n, str2attr "in") toAttrFrTyp n Relend_direction_out = Just (n, str2attr "out") toAttrFrTyp n Relend_direction_none = Just (n, str2attr "none") instance HTypeable Attr where toHType x = Defined "attr" [] [] instance XmlContent Attr where toContents (Attr as a b) = [CElem (Elem "attr" (toAttrs as) (concatMap toContents a ++ toContents b)) ()] parseContents = do { e@(Elem _ as _) <- element ["attr"] ; interior e $ return (Attr (fromAttrs as)) `apply` many parseContents `apply` parseContents } `adjustErr` ("in , "++) instance XmlAttributes Attr_Attrs where fromAttrs as = Attr_Attrs { attrId = possibleA fromAttrToStr "id" as , attrName = definiteA fromAttrToStr "attr" "name" as , attrKind = possibleA fromAttrToStr "kind" as } toAttrs v = catMaybes [ maybeToAttr toAttrFrStr "id" (attrId v) , toAttrFrStr "name" (attrName v) , maybeToAttr toAttrFrStr "kind" (attrKind v) ] instance HTypeable Locator where toHType x = Defined "locator" [] [] instance XmlContent Locator where toContents as = [CElem (Elem "locator" (toAttrs as) []) ()] parseContents = do { (Elem _ as []) <- element ["locator"] ; return (fromAttrs as) } `adjustErr` ("in , "++) instance XmlAttributes Locator where fromAttrs as = Locator { locatorXlink'type = defaultA fromAttrToTyp Locator_xlink'type_simple "xlink:type" as , locatorXlink'href = definiteA fromAttrToStr "locator" "xlink:href" as } toAttrs v = catMaybes [ defaultToAttr toAttrFrTyp "xlink:type" (locatorXlink'type v) , toAttrFrStr "xlink:href" (locatorXlink'href v) ] instance XmlAttrType Locator_xlink'type where fromAttrToTyp n (n',v) | n==n' = translate (attr2str v) | otherwise = Nothing where translate "simple" = Just Locator_xlink'type_simple translate _ = Nothing toAttrFrTyp n Locator_xlink'type_simple = Just (n, str2attr "simple") instance HTypeable Bool where toHType x = Defined "bool" [] [] instance XmlContent Bool where toContents (Bool a) = [CElem (Elem "bool" [] (toText a)) ()] parseContents = do { e@(Elem _ [] _) <- element ["bool"] ; interior e $ return (Bool) `apply` (text `onFail` return "") } `adjustErr` ("in , "++) instance HTypeable AInt where toHType x = Defined "int" [] [] instance XmlContent AInt where toContents (AInt a) = [CElem (Elem "int" [] (toText a)) ()] parseContents = do { e@(Elem _ [] _) <- element ["int"] ; interior e $ return (AInt) `apply` (text `onFail` return "") } `adjustErr` ("in , "++) instance HTypeable AFloat where toHType x = Defined "float" [] [] instance XmlContent AFloat where toContents (AFloat a) = [CElem (Elem "float" [] (toText a)) ()] parseContents = do { e@(Elem _ [] _) <- element ["float"] ; interior e $ return (AFloat) `apply` (text `onFail` return "") } `adjustErr` ("in , "++) instance HTypeable AString where toHType x = Defined "string" [] [] instance XmlContent AString where toContents (AString a) = [CElem (Elem "string" [] (toText a)) ()] parseContents = do { e@(Elem _ [] _) <- element ["string"] ; interior e $ return (AString) `apply` (text `onFail` return "") } `adjustErr` ("in , "++) instance HTypeable Enum where toHType x = Defined "enum" [] [] instance XmlContent Enum where toContents (Enum a) = [CElem (Elem "enum" [] (toText a)) ()] parseContents = do { e@(Elem _ [] _) <- element ["enum"] ; interior e $ return (Enum) `apply` (text `onFail` return "") } `adjustErr` ("in , "++) instance HTypeable Seq where toHType x = Defined "seq" [] [] instance XmlContent Seq where toContents (Seq a) = [CElem (Elem "seq" [] (concatMap toContents a)) ()] parseContents = do { e@(Elem _ [] _) <- element ["seq"] ; interior e $ return (Seq) `apply` many parseContents } `adjustErr` ("in , "++) instance HTypeable Seq_ where toHType x = Defined "seq" [] [] instance XmlContent Seq_ where toContents (Seq_Locator a) = toContents a toContents (Seq_Bool a) = toContents a toContents (Seq_AInt a) = toContents a toContents (Seq_AFloat a) = toContents a toContents (Seq_AString a) = toContents a toContents (Seq_Enum a) = toContents a toContents (Seq_Seq a) = toContents a toContents (Seq_Set a) = toContents a toContents (Seq_Bag a) = toContents a toContents (Seq_Tup a) = toContents a parseContents = oneOf [ return (Seq_Locator) `apply` parseContents , return (Seq_Bool) `apply` parseContents , return (Seq_AInt) `apply` parseContents , return (Seq_AFloat) `apply` parseContents , return (Seq_AString) `apply` parseContents , return (Seq_Enum) `apply` parseContents , return (Seq_Seq) `apply` parseContents , return (Seq_Set) `apply` parseContents , return (Seq_Bag) `apply` parseContents , return (Seq_Tup) `apply` parseContents ] `adjustErr` ("in , "++) instance HTypeable Set where toHType x = Defined "set" [] [] instance XmlContent Set where toContents (Set a) = [CElem (Elem "set" [] (concatMap toContents a)) ()] parseContents = do { e@(Elem _ [] _) <- element ["set"] ; interior e $ return (Set) `apply` many parseContents } `adjustErr` ("in , "++) instance HTypeable Set_ where toHType x = Defined "set" [] [] instance XmlContent Set_ where toContents (Set_Locator a) = toContents a toContents (Set_Bool a) = toContents a toContents (Set_AInt a) = toContents a toContents (Set_AFloat a) = toContents a toContents (Set_AString a) = toContents a toContents (Set_Enum a) = toContents a toContents (Set_Seq a) = toContents a toContents (Set_Set a) = toContents a toContents (Set_Bag a) = toContents a toContents (Set_Tup a) = toContents a parseContents = oneOf [ return (Set_Locator) `apply` parseContents , return (Set_Bool) `apply` parseContents , return (Set_AInt) `apply` parseContents , return (Set_AFloat) `apply` parseContents , return (Set_AString) `apply` parseContents , return (Set_Enum) `apply` parseContents , return (Set_Seq) `apply` parseContents , return (Set_Set) `apply` parseContents , return (Set_Bag) `apply` parseContents , return (Set_Tup) `apply` parseContents ] `adjustErr` ("in , "++) instance HTypeable Bag where toHType x = Defined "bag" [] [] instance XmlContent Bag where toContents (Bag a) = [CElem (Elem "bag" [] (concatMap toContents a)) ()] parseContents = do { e@(Elem _ [] _) <- element ["bag"] ; interior e $ return (Bag) `apply` many parseContents } `adjustErr` ("in , "++) instance HTypeable Bag_ where toHType x = Defined "bag" [] [] instance XmlContent Bag_ where toContents (Bag_Locator a) = toContents a toContents (Bag_Bool a) = toContents a toContents (Bag_AInt a) = toContents a toContents (Bag_AFloat a) = toContents a toContents (Bag_AString a) = toContents a toContents (Bag_Enum a) = toContents a toContents (Bag_Seq a) = toContents a toContents (Bag_Set a) = toContents a toContents (Bag_Bag a) = toContents a toContents (Bag_Tup a) = toContents a parseContents = oneOf [ return (Bag_Locator) `apply` parseContents , return (Bag_Bool) `apply` parseContents , return (Bag_AInt) `apply` parseContents , return (Bag_AFloat) `apply` parseContents , return (Bag_AString) `apply` parseContents , return (Bag_Enum) `apply` parseContents , return (Bag_Seq) `apply` parseContents , return (Bag_Set) `apply` parseContents , return (Bag_Bag) `apply` parseContents , return (Bag_Tup) `apply` parseContents ] `adjustErr` ("in , "++) instance HTypeable Tup where toHType x = Defined "tup" [] [] instance XmlContent Tup where toContents (Tup a) = [CElem (Elem "tup" [] (concatMap toContents a)) ()] parseContents = do { e@(Elem _ [] _) <- element ["tup"] ; interior e $ return (Tup) `apply` many parseContents } `adjustErr` ("in , "++) instance HTypeable Tup_ where toHType x = Defined "tup" [] [] instance XmlContent Tup_ where toContents (Tup_Locator a) = toContents a toContents (Tup_Bool a) = toContents a toContents (Tup_AInt a) = toContents a toContents (Tup_AFloat a) = toContents a toContents (Tup_AString a) = toContents a toContents (Tup_Enum a) = toContents a toContents (Tup_Seq a) = toContents a toContents (Tup_Set a) = toContents a toContents (Tup_Bag a) = toContents a toContents (Tup_Tup a) = toContents a parseContents = oneOf [ return (Tup_Locator) `apply` parseContents , return (Tup_Bool) `apply` parseContents , return (Tup_AInt) `apply` parseContents , return (Tup_AFloat) `apply` parseContents , return (Tup_AString) `apply` parseContents , return (Tup_Enum) `apply` parseContents , return (Tup_Seq) `apply` parseContents , return (Tup_Set) `apply` parseContents , return (Tup_Bag) `apply` parseContents , return (Tup_Tup) `apply` parseContents ] `adjustErr` ("in , "++) {-Done-}