SHARE
TWEET

gxl_dtd

edv Nov 15th, 2011 69 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. module GXL where
  2.  
  3. import Text.XML.HaXml.XmlContent
  4. import Text.XML.HaXml.OneOfN
  5. import qualified Text.XML.HaXml.Types as T
  6.  
  7.  
  8. {-Type decls-}
  9.  
  10. data Gxl = Gxl Gxl_Attrs [Graph]
  11.          deriving (Eq,Show)
  12. data Gxl_Attrs = Gxl_Attrs
  13.     { gxlXmlns'xlink :: (Defaultable String)
  14.     } deriving (Eq,Show)
  15. data Type = Type
  16.     { typeXlink'type :: (Defaultable Type_xlink'type)
  17.     , typeXlink'href :: String
  18.     } deriving (Eq,Show)
  19. data Type_xlink'type = Type_xlink'type_simple
  20.                      deriving (Eq,Show)
  21. data Graph = Graph Graph_Attrs (Maybe Type) [Attr]
  22.                    [(OneOf3 Node Edge Rel)]
  23.            deriving (Eq,Show)
  24. data Graph_Attrs = Graph_Attrs
  25.     { graphId :: String
  26.     , graphRole :: (Maybe String)
  27.     , graphEdgeids :: (Defaultable Graph_edgeids)
  28.     , graphHypergraph :: (Defaultable Graph_hypergraph)
  29.     , graphEdgemode :: (Defaultable Graph_edgemode)
  30.     } deriving (Eq,Show)
  31. data Graph_edgeids = Graph_edgeids_true  |  Graph_edgeids_false
  32.                    deriving (Eq,Show)
  33. data Graph_hypergraph = Graph_hypergraph_true  |
  34.                         Graph_hypergraph_false
  35.                       deriving (Eq,Show)
  36. data Graph_edgemode = Graph_edgemode_directed  |
  37.                       Graph_edgemode_undirected  |  Graph_edgemode_defaultdirected  |
  38.                       Graph_edgemode_defaultundirected
  39.                     deriving (Eq,Show)
  40. data Node = Node Node_Attrs (Maybe Type) [Attr] [Graph]
  41.           deriving (Eq,Show)
  42. data Node_Attrs = Node_Attrs
  43.     { nodeId :: String
  44.     } deriving (Eq,Show)
  45. data Edge = Edge Edge_Attrs (Maybe Type) [Attr] [Graph]
  46.           deriving (Eq,Show)
  47. data Edge_Attrs = Edge_Attrs
  48.     { edgeId :: (Maybe String)
  49.     , edgeFrom :: String
  50.     , edgeTo :: String
  51.     , edgeFromorder :: (Maybe String)
  52.     , edgeToorder :: (Maybe String)
  53.     , edgeIsdirected :: (Maybe Edge_isdirected)
  54.     } deriving (Eq,Show)
  55. data Edge_isdirected = Edge_isdirected_true  |
  56.                        Edge_isdirected_false
  57.                      deriving (Eq,Show)
  58. data Rel = Rel Rel_Attrs (Maybe Type) [Attr] [Graph] [Relend]
  59.          deriving (Eq,Show)
  60. data Rel_Attrs = Rel_Attrs
  61.     { relId :: (Maybe String)
  62.     , relIsdirected :: (Maybe Rel_isdirected)
  63.     } deriving (Eq,Show)
  64. data Rel_isdirected = Rel_isdirected_true  |  Rel_isdirected_false
  65.                     deriving (Eq,Show)
  66. data Relend = Relend Relend_Attrs [Attr]
  67.             deriving (Eq,Show)
  68. data Relend_Attrs = Relend_Attrs
  69.     { relendTarget :: String
  70.     , relendRole :: (Maybe String)
  71.     , relendDirection :: (Maybe Relend_direction)
  72.     , relendStartorder :: (Maybe String)
  73.     , relendEndorder :: (Maybe String)
  74.     } deriving (Eq,Show)
  75. data Relend_direction = Relend_direction_in  |
  76.                         Relend_direction_out  |  Relend_direction_none
  77.                       deriving (Eq,Show)
  78. data Attr = Attr Attr_Attrs [Attr]
  79.                  (OneOf10 Locator ABool AInt AFloat AString AEnum Seq Set Bag Tup)
  80.           deriving (Eq,Show)
  81. data Attr_Attrs = Attr_Attrs
  82.     { attrId :: (Maybe String)
  83.     , attrName :: String
  84.     , attrKind :: (Maybe String)
  85.     } deriving (Eq,Show)
  86. data Locator = Locator
  87.     { locatorXlink'type :: (Defaultable Locator_xlink'type)
  88.     , locatorXlink'href :: String
  89.     } deriving (Eq,Show)
  90. data Locator_xlink'type = Locator_xlink'type_simple
  91.                         deriving (Eq,Show)
  92. newtype ABool = ABool String            deriving (Eq,Show)
  93. newtype AInt = AInt String              deriving (Eq,Show)
  94. newtype AFloat = AFloat String          deriving (Eq,Show)
  95. newtype AString = AString String                deriving (Eq,Show)
  96. newtype AEnum = AEnum String            deriving (Eq,Show)
  97. newtype Seq = Seq [Seq_]                deriving (Eq,Show)
  98. data Seq_ = Seq_Locator Locator
  99.           | Seq_ABool ABool
  100.           | Seq_AInt AInt
  101.           | Seq_AFloat AFloat
  102.           | Seq_AString AString
  103.           | Seq_AEnum AEnum
  104.           | Seq_Seq Seq
  105.           | Seq_Set Set
  106.           | Seq_Bag Bag
  107.           | Seq_Tup Tup
  108.           deriving (Eq,Show)
  109. newtype Set = Set [Set_]                deriving (Eq,Show)
  110. data Set_ = Set_Locator Locator
  111.           | Set_ABool ABool
  112.           | Set_AInt AInt
  113.           | Set_AFloat AFloat
  114.           | Set_AString AString
  115.           | Set_AEnum AEnum
  116.           | Set_Seq Seq
  117.           | Set_Set Set
  118.           | Set_Bag Bag
  119.           | Set_Tup Tup
  120.           deriving (Eq,Show)
  121. newtype Bag = Bag [Bag_]                deriving (Eq,Show)
  122. data Bag_ = Bag_Locator Locator
  123.           | Bag_ABool ABool
  124.           | Bag_AInt AInt
  125.           | Bag_AFloat AFloat
  126.           | Bag_AString AString
  127.           | Bag_AEnum AEnum
  128.           | Bag_Seq Seq
  129.           | Bag_Set Set
  130.           | Bag_Bag Bag
  131.           | Bag_Tup Tup
  132.           deriving (Eq,Show)
  133. newtype Tup = Tup [Tup_]                deriving (Eq,Show)
  134. data Tup_ = Tup_Locator Locator
  135.           | Tup_ABool ABool
  136.           | Tup_AInt AInt
  137.           | Tup_AFloat AFloat
  138.           | Tup_AString AString
  139.           | Tup_AEnum AEnum
  140.           | Tup_Seq Seq
  141.           | Tup_Set Set
  142.           | Tup_Bag Bag
  143.           | Tup_Tup Tup
  144.           deriving (Eq,Show)
  145.  
  146.  
  147. {-Instance decls-}
  148.  
  149. instance HTypeable Gxl where
  150.     toHType x = Defined "gxl" [] []
  151. instance XmlContent Gxl where
  152.     toContents (Gxl as a) =
  153.         [CElem (Elem (T.N "gxl") (toAttrs as) (concatMap toContents a)) ()]
  154.     parseContents = do
  155.         { e@(Elem _ as _) <- element ["gxl"]
  156.         ; interior e $ return (Gxl (fromAttrs as))
  157.                        `apply` many parseContents
  158.         } `adjustErr` ("in <gxl>, "++)
  159. instance XmlAttributes Gxl_Attrs where
  160.     fromAttrs as =
  161.         Gxl_Attrs
  162.           { gxlXmlns'xlink = defaultA fromAttrToStr "http://www.w3.org/1999/xlink" "xmlns:xlink" as
  163.           }
  164.     toAttrs v = catMaybes
  165.         [ defaultToAttr toAttrFrStr "xmlns:xlink" (gxlXmlns'xlink v)
  166.         ]
  167.  
  168. instance HTypeable Type where
  169.     toHType x = Defined "type" [] []
  170. instance XmlContent Type where
  171.     toContents as =
  172.         [CElem (Elem (T.N "type") (toAttrs as) []) ()]
  173.     parseContents = do
  174.         { (Elem _ as []) <- element ["type"]
  175.         ; return (fromAttrs as)
  176.         } `adjustErr` ("in <type>, "++)
  177. instance XmlAttributes Type where
  178.     fromAttrs as =
  179.         Type
  180.           { typeXlink'type = defaultA fromAttrToTyp Type_xlink'type_simple "xlink:type" as
  181.           , typeXlink'href = definiteA fromAttrToStr "type" "xlink:href" as
  182.           }
  183.     toAttrs v = catMaybes
  184.         [ defaultToAttr toAttrFrTyp "xlink:type" (typeXlink'type v)
  185.         , toAttrFrStr "xlink:href" (typeXlink'href v)
  186.         ]
  187.  
  188. instance XmlAttrType Type_xlink'type where
  189.     fromAttrToTyp n (n',v)
  190.         | n==(show n')     = translate (attr2str v)
  191.         | otherwise = Nothing
  192.       where translate "simple" = Just Type_xlink'type_simple
  193.             translate _ = Nothing
  194.     toAttrFrTyp n Type_xlink'type_simple = Just (T.N n, str2attr "simple")
  195.  
  196. instance HTypeable Graph where
  197.     toHType x = Defined "graph" [] []
  198. instance XmlContent Graph where
  199.     toContents (Graph as a b c) =
  200.         [CElem (Elem (T.N "graph") (toAttrs as) (maybe [] toContents a ++
  201.                                            concatMap toContents b ++ concatMap toContents c)) ()]
  202.     parseContents = do
  203.         { e@(Elem _ as _) <- element ["graph"]
  204.         ; interior e $ return (Graph (fromAttrs as))
  205.                        `apply` optional parseContents `apply` many parseContents
  206.                        `apply` many parseContents
  207.         } `adjustErr` ("in <graph>, "++)
  208. instance XmlAttributes Graph_Attrs where
  209.     fromAttrs as =
  210.         Graph_Attrs
  211.           { graphId = definiteA fromAttrToStr "graph" "id" as
  212.           , graphRole = possibleA fromAttrToStr "role" as
  213.           , graphEdgeids = defaultA fromAttrToTyp Graph_edgeids_false "edgeids" as
  214.           , graphHypergraph = defaultA fromAttrToTyp Graph_hypergraph_false "hypergraph" as
  215.           , graphEdgemode = defaultA fromAttrToTyp Graph_edgemode_directed "edgemode" as
  216.           }
  217.     toAttrs v = catMaybes
  218.         [ toAttrFrStr "id" (graphId v)
  219.         , maybeToAttr toAttrFrStr "role" (graphRole v)
  220.         , defaultToAttr toAttrFrTyp "edgeids" (graphEdgeids v)
  221.         , defaultToAttr toAttrFrTyp "hypergraph" (graphHypergraph v)
  222.         , defaultToAttr toAttrFrTyp "edgemode" (graphEdgemode v)
  223.         ]
  224.  
  225. instance XmlAttrType Graph_edgeids where
  226.     fromAttrToTyp n (n',v)
  227.         | n==(show n')     = translate (attr2str v)
  228.         | otherwise = Nothing
  229.       where translate "true" = Just Graph_edgeids_true
  230.             translate "false" = Just Graph_edgeids_false
  231.             translate _ = Nothing
  232.     toAttrFrTyp n Graph_edgeids_true = Just (T.N n, str2attr "true")
  233.     toAttrFrTyp n Graph_edgeids_false = Just (T.N n, str2attr "false")
  234.  
  235. instance XmlAttrType Graph_hypergraph where
  236.     fromAttrToTyp n (n',v)
  237.         | n==(show n')     = translate (attr2str v)
  238.         | otherwise = Nothing
  239.       where translate "true" = Just Graph_hypergraph_true
  240.             translate "false" = Just Graph_hypergraph_false
  241.             translate _ = Nothing
  242.     toAttrFrTyp n Graph_hypergraph_true = Just (T.N n, str2attr "true")
  243.     toAttrFrTyp n Graph_hypergraph_false = Just (T.N n, str2attr "false")
  244.  
  245. instance XmlAttrType Graph_edgemode where
  246.     fromAttrToTyp n (n',v)
  247.         | n==(show n')     = translate (attr2str v)
  248.         | otherwise = Nothing
  249.       where translate "directed" = Just Graph_edgemode_directed
  250.             translate "undirected" = Just Graph_edgemode_undirected
  251.             translate "defaultdirected" = Just Graph_edgemode_defaultdirected
  252.             translate "defaultundirected" = Just Graph_edgemode_defaultundirected
  253.             translate _ = Nothing
  254.     toAttrFrTyp n Graph_edgemode_directed = Just (T.N n, str2attr "directed")
  255.     toAttrFrTyp n Graph_edgemode_undirected = Just (T.N n, str2attr "undirected")
  256.     toAttrFrTyp n Graph_edgemode_defaultdirected = Just (T.N n, str2attr "defaultdirected")
  257.     toAttrFrTyp n Graph_edgemode_defaultundirected = Just (T.N n, str2attr "defaultundirected")
  258.  
  259. instance HTypeable Node where
  260.     toHType x = Defined "node" [] []
  261. instance XmlContent Node where
  262.     toContents (Node as a b c) =
  263.         [CElem (Elem (T.N "node") (toAttrs as) (maybe [] toContents a ++
  264.                                           concatMap toContents b ++ concatMap toContents c)) ()]
  265.     parseContents = do
  266.         { e@(Elem _ as _) <- element ["node"]
  267.         ; interior e $ return (Node (fromAttrs as))
  268.                        `apply` optional parseContents `apply` many parseContents
  269.                        `apply` many parseContents
  270.         } `adjustErr` ("in <node>, "++)
  271. instance XmlAttributes Node_Attrs where
  272.     fromAttrs as =
  273.         Node_Attrs
  274.           { nodeId = definiteA fromAttrToStr "node" "id" as
  275.           }
  276.     toAttrs v = catMaybes
  277.         [ toAttrFrStr "id" (nodeId v)
  278.         ]
  279.  
  280. instance HTypeable Edge where
  281.     toHType x = Defined "edge" [] []
  282. instance XmlContent Edge where
  283.     toContents (Edge as a b c) =
  284.         [CElem (Elem (T.N "edge") (toAttrs as) (maybe [] toContents a ++
  285.                                           concatMap toContents b ++ concatMap toContents c)) ()]
  286.     parseContents = do
  287.         { e@(Elem _ as _) <- element ["edge"]
  288.         ; interior e $ return (Edge (fromAttrs as))
  289.                        `apply` optional parseContents `apply` many parseContents
  290.                        `apply` many parseContents
  291.         } `adjustErr` ("in <edge>, "++)
  292. instance XmlAttributes Edge_Attrs where
  293.     fromAttrs as =
  294.         Edge_Attrs
  295.           { edgeId = possibleA fromAttrToStr "id" as
  296.           , edgeFrom = definiteA fromAttrToStr "edge" "from" as
  297.           , edgeTo = definiteA fromAttrToStr "edge" "to" as
  298.           , edgeFromorder = possibleA fromAttrToStr "fromorder" as
  299.           , edgeToorder = possibleA fromAttrToStr "toorder" as
  300.           , edgeIsdirected = possibleA fromAttrToTyp "isdirected" as
  301.           }
  302.     toAttrs v = catMaybes
  303.         [ maybeToAttr toAttrFrStr "id" (edgeId v)
  304.         , toAttrFrStr "from" (edgeFrom v)
  305.         , toAttrFrStr "to" (edgeTo v)
  306.         , maybeToAttr toAttrFrStr "fromorder" (edgeFromorder v)
  307.         , maybeToAttr toAttrFrStr "toorder" (edgeToorder v)
  308.         , maybeToAttr toAttrFrTyp "isdirected" (edgeIsdirected v)
  309.         ]
  310.  
  311. instance XmlAttrType Edge_isdirected where
  312.     fromAttrToTyp n (n',v)
  313.         | n==(show n')     = translate (attr2str v)
  314.         | otherwise = Nothing
  315.       where translate "true" = Just Edge_isdirected_true
  316.             translate "false" = Just Edge_isdirected_false
  317.             translate _ = Nothing
  318.     toAttrFrTyp n Edge_isdirected_true = Just (T.N n, str2attr "true")
  319.     toAttrFrTyp n Edge_isdirected_false = Just (T.N n, str2attr "false")
  320.  
  321. instance HTypeable Rel where
  322.     toHType x = Defined "rel" [] []
  323. instance XmlContent Rel where
  324.     toContents (Rel as a b c d) =
  325.         [CElem (Elem (T.N "rel") (toAttrs as) (maybe [] toContents a ++
  326.                                          concatMap toContents b ++ concatMap toContents c ++
  327.                                          concatMap toContents d)) ()]
  328.     parseContents = do
  329.         { e@(Elem _ as _) <- element ["rel"]
  330.         ; interior e $ return (Rel (fromAttrs as))
  331.                        `apply` optional parseContents `apply` many parseContents
  332.                        `apply` many parseContents `apply` many parseContents
  333.         } `adjustErr` ("in <rel>, "++)
  334. instance XmlAttributes Rel_Attrs where
  335.     fromAttrs as =
  336.         Rel_Attrs
  337.           { relId = possibleA fromAttrToStr "id" as
  338.           , relIsdirected = possibleA fromAttrToTyp "isdirected" as
  339.           }
  340.     toAttrs v = catMaybes
  341.         [ maybeToAttr toAttrFrStr "id" (relId v)
  342.         , maybeToAttr toAttrFrTyp "isdirected" (relIsdirected v)
  343.         ]
  344.  
  345. instance XmlAttrType Rel_isdirected where
  346.     fromAttrToTyp n (n',v)
  347.         | n==(show n')     = translate (attr2str v)
  348.         | otherwise = Nothing
  349.       where translate "true" = Just Rel_isdirected_true
  350.             translate "false" = Just Rel_isdirected_false
  351.             translate _ = Nothing
  352.     toAttrFrTyp n Rel_isdirected_true = Just (T.N n, str2attr "true")
  353.     toAttrFrTyp n Rel_isdirected_false = Just (T.N n, str2attr "false")
  354.  
  355. instance HTypeable Relend where
  356.     toHType x = Defined "relend" [] []
  357. instance XmlContent Relend where
  358.     toContents (Relend as a) =
  359.         [CElem (Elem (T.N "relend") (toAttrs as) (concatMap toContents a)) ()]
  360.     parseContents = do
  361.         { e@(Elem _ as _) <- element ["relend"]
  362.         ; interior e $ return (Relend (fromAttrs as))
  363.                        `apply` many parseContents
  364.         } `adjustErr` ("in <relend>, "++)
  365. instance XmlAttributes Relend_Attrs where
  366.     fromAttrs as =
  367.         Relend_Attrs
  368.           { relendTarget = definiteA fromAttrToStr "relend" "target" as
  369.           , relendRole = possibleA fromAttrToStr "role" as
  370.           , relendDirection = possibleA fromAttrToTyp "direction" as
  371.           , relendStartorder = possibleA fromAttrToStr "startorder" as
  372.           , relendEndorder = possibleA fromAttrToStr "endorder" as
  373.           }
  374.     toAttrs v = catMaybes
  375.         [ toAttrFrStr "target" (relendTarget v)
  376.         , maybeToAttr toAttrFrStr "role" (relendRole v)
  377.         , maybeToAttr toAttrFrTyp "direction" (relendDirection v)
  378.         , maybeToAttr toAttrFrStr "startorder" (relendStartorder v)
  379.         , maybeToAttr toAttrFrStr "endorder" (relendEndorder v)
  380.         ]
  381.  
  382. instance XmlAttrType Relend_direction where
  383.     fromAttrToTyp n (n',v)
  384.         | n==(show n')     = translate (attr2str v)
  385.         | otherwise = Nothing
  386.       where translate "in" = Just Relend_direction_in
  387.             translate "out" = Just Relend_direction_out
  388.             translate "none" = Just Relend_direction_none
  389.             translate _ = Nothing
  390.     toAttrFrTyp n Relend_direction_in = Just (T.N n, str2attr "in")
  391.     toAttrFrTyp n Relend_direction_out = Just (T.N n, str2attr "out")
  392.     toAttrFrTyp n Relend_direction_none = Just (T.N n, str2attr "none")
  393.  
  394. instance HTypeable Attr where
  395.     toHType x = Defined "attr" [] []
  396. instance XmlContent Attr where
  397.     toContents (Attr as a b) =
  398.         [CElem (Elem (T.N "attr") (toAttrs as) (concatMap toContents a ++
  399.                                           toContents b)) ()]
  400.     parseContents = do
  401.         { e@(Elem _ as _) <- element ["attr"]
  402.         ; interior e $ return (Attr (fromAttrs as))
  403.                        `apply` many parseContents `apply` parseContents
  404.         } `adjustErr` ("in <attr>, "++)
  405. instance XmlAttributes Attr_Attrs where
  406.     fromAttrs as =
  407.         Attr_Attrs
  408.           { attrId = possibleA fromAttrToStr "id" as
  409.           , attrName = definiteA fromAttrToStr "attr" "name" as
  410.           , attrKind = possibleA fromAttrToStr "kind" as
  411.           }
  412.     toAttrs v = catMaybes
  413.         [ maybeToAttr toAttrFrStr "id" (attrId v)
  414.         , toAttrFrStr "name" (attrName v)
  415.         , maybeToAttr toAttrFrStr "kind" (attrKind v)
  416.         ]
  417.  
  418. instance HTypeable Locator where
  419.     toHType x = Defined "locator" [] []
  420. instance XmlContent Locator where
  421.     toContents as =
  422.         [CElem (Elem (T.N "locator") (toAttrs as) []) ()]
  423.     parseContents = do
  424.         { (Elem _ as []) <- element ["locator"]
  425.         ; return (fromAttrs as)
  426.         } `adjustErr` ("in <locator>, "++)
  427. instance XmlAttributes Locator where
  428.     fromAttrs as =
  429.         Locator
  430.           { locatorXlink'type = defaultA fromAttrToTyp Locator_xlink'type_simple "xlink:type" as
  431.           , locatorXlink'href = definiteA fromAttrToStr "locator" "xlink:href" as
  432.           }
  433.     toAttrs v = catMaybes
  434.         [ defaultToAttr toAttrFrTyp "xlink:type" (locatorXlink'type v)
  435.         , toAttrFrStr "xlink:href" (locatorXlink'href v)
  436.         ]
  437.  
  438. instance XmlAttrType Locator_xlink'type where
  439.     fromAttrToTyp n (n',v)
  440.         | n==(show n')     = translate (attr2str v)
  441.         | otherwise = Nothing
  442.       where translate "simple" = Just Locator_xlink'type_simple
  443.             translate _ = Nothing
  444.     toAttrFrTyp n Locator_xlink'type_simple = Just (T.N n, str2attr "simple")
  445.  
  446. instance HTypeable ABool where
  447.     toHType x = Defined "bool" [] []
  448. instance XmlContent ABool where
  449.     toContents (ABool a) =
  450.         [CElem (Elem (T.N "bool") [] (toText a)) ()]
  451.     parseContents = do
  452.         { e@(Elem _ [] _) <- element ["bool"]
  453.         ; interior e $ return (ABool) `apply` (text `onFail` return "")
  454.         } `adjustErr` ("in <bool>, "++)
  455.  
  456. instance HTypeable AInt where
  457.     toHType x = Defined "int" [] []
  458. instance XmlContent AInt where
  459.     toContents (AInt a) =
  460.         [CElem (Elem (T.N "int") [] (toText a)) ()]
  461.     parseContents = do
  462.         { e@(Elem _ [] _) <- element ["int"]
  463.         ; interior e $ return (AInt) `apply` (text `onFail` return "")
  464.         } `adjustErr` ("in <int>, "++)
  465.  
  466. instance HTypeable AFloat where
  467.     toHType x = Defined "float" [] []
  468. instance XmlContent AFloat where
  469.     toContents (AFloat a) =
  470.         [CElem (Elem (T.N "float") [] (toText a)) ()]
  471.     parseContents = do
  472.         { e@(Elem _ [] _) <- element ["float"]
  473.         ; interior e $ return (AFloat) `apply` (text `onFail` return "")
  474.         } `adjustErr` ("in <float>, "++)
  475.  
  476. instance HTypeable AString where
  477.     toHType x = Defined "string" [] []
  478. instance XmlContent AString where
  479.     toContents (AString a) =
  480.         [CElem (Elem (T.N "string") [] (toText a)) ()]
  481.     parseContents = do
  482.         { e@(Elem _ [] _) <- element ["string"]
  483.         ; interior e $ return (AString) `apply` (text `onFail` return "")
  484.         } `adjustErr` ("in <string>, "++)
  485.  
  486. instance HTypeable AEnum where
  487.     toHType x = Defined "enum" [] []
  488. instance XmlContent AEnum where
  489.     toContents (AEnum a) =
  490.         [CElem (Elem (T.N "enum") [] (toText a)) ()]
  491.     parseContents = do
  492.         { e@(Elem _ [] _) <- element ["enum"]
  493.         ; interior e $ return (AEnum) `apply` (text `onFail` return "")
  494.         } `adjustErr` ("in <enum>, "++)
  495.  
  496. instance HTypeable Seq where
  497.     toHType x = Defined "seq" [] []
  498. instance XmlContent Seq where
  499.     toContents (Seq a) =
  500.         [CElem (Elem (T.N "seq") [] (concatMap toContents a)) ()]
  501.     parseContents = do
  502.         { e@(Elem _ [] _) <- element ["seq"]
  503.         ; interior e $ return (Seq) `apply` many parseContents
  504.         } `adjustErr` ("in <seq>, "++)
  505.  
  506. instance HTypeable Seq_ where
  507.     toHType x = Defined "seq" [] []
  508. instance XmlContent Seq_ where
  509.     toContents (Seq_Locator a) = toContents a
  510.     toContents (Seq_ABool a) = toContents a
  511.     toContents (Seq_AInt a) = toContents a
  512.     toContents (Seq_AFloat a) = toContents a
  513.     toContents (Seq_AString a) = toContents a
  514.     toContents (Seq_AEnum a) = toContents a
  515.     toContents (Seq_Seq a) = toContents a
  516.     toContents (Seq_Set a) = toContents a
  517.     toContents (Seq_Bag a) = toContents a
  518.     toContents (Seq_Tup a) = toContents a
  519.     parseContents = oneOf
  520.         [ return (Seq_Locator) `apply` parseContents
  521.         , return (Seq_ABool) `apply` parseContents
  522.         , return (Seq_AInt) `apply` parseContents
  523.         , return (Seq_AFloat) `apply` parseContents
  524.         , return (Seq_AString) `apply` parseContents
  525.         , return (Seq_AEnum) `apply` parseContents
  526.         , return (Seq_Seq) `apply` parseContents
  527.         , return (Seq_Set) `apply` parseContents
  528.         , return (Seq_Bag) `apply` parseContents
  529.         , return (Seq_Tup) `apply` parseContents
  530.         ] `adjustErr` ("in <seq>, "++)
  531.  
  532. instance HTypeable Set where
  533.     toHType x = Defined "set" [] []
  534. instance XmlContent Set where
  535.     toContents (Set a) =
  536.         [CElem (Elem (T.N "set") [] (concatMap toContents a)) ()]
  537.     parseContents = do
  538.         { e@(Elem _ [] _) <- element ["set"]
  539.         ; interior e $ return (Set) `apply` many parseContents
  540.         } `adjustErr` ("in <set>, "++)
  541.  
  542. instance HTypeable Set_ where
  543.     toHType x = Defined "set" [] []
  544. instance XmlContent Set_ where
  545.     toContents (Set_Locator a) = toContents a
  546.     toContents (Set_ABool a) = toContents a
  547.     toContents (Set_AInt a) = toContents a
  548.     toContents (Set_AFloat a) = toContents a
  549.     toContents (Set_AString a) = toContents a
  550.     toContents (Set_AEnum a) = toContents a
  551.     toContents (Set_Seq a) = toContents a
  552.     toContents (Set_Set a) = toContents a
  553.     toContents (Set_Bag a) = toContents a
  554.     toContents (Set_Tup a) = toContents a
  555.     parseContents = oneOf
  556.         [ return (Set_Locator) `apply` parseContents
  557.         , return (Set_ABool) `apply` parseContents
  558.         , return (Set_AInt) `apply` parseContents
  559.         , return (Set_AFloat) `apply` parseContents
  560.         , return (Set_AString) `apply` parseContents
  561.         , return (Set_AEnum) `apply` parseContents
  562.         , return (Set_Seq) `apply` parseContents
  563.         , return (Set_Set) `apply` parseContents
  564.         , return (Set_Bag) `apply` parseContents
  565.         , return (Set_Tup) `apply` parseContents
  566.         ] `adjustErr` ("in <set>, "++)
  567.  
  568. instance HTypeable Bag where
  569.     toHType x = Defined "bag" [] []
  570. instance XmlContent Bag where
  571.     toContents (Bag a) =
  572.         [CElem (Elem (T.N "bag") [] (concatMap toContents a)) ()]
  573.     parseContents = do
  574.         { e@(Elem _ [] _) <- element ["bag"]
  575.         ; interior e $ return (Bag) `apply` many parseContents
  576.         } `adjustErr` ("in <bag>, "++)
  577.  
  578. instance HTypeable Bag_ where
  579.     toHType x = Defined "bag" [] []
  580. instance XmlContent Bag_ where
  581.     toContents (Bag_Locator a) = toContents a
  582.     toContents (Bag_ABool a) = toContents a
  583.     toContents (Bag_AInt a) = toContents a
  584.     toContents (Bag_AFloat a) = toContents a
  585.     toContents (Bag_AString a) = toContents a
  586.     toContents (Bag_AEnum a) = toContents a
  587.     toContents (Bag_Seq a) = toContents a
  588.     toContents (Bag_Set a) = toContents a
  589.     toContents (Bag_Bag a) = toContents a
  590.     toContents (Bag_Tup a) = toContents a
  591.     parseContents = oneOf
  592.         [ return (Bag_Locator) `apply` parseContents
  593.         , return (Bag_ABool) `apply` parseContents
  594.         , return (Bag_AInt) `apply` parseContents
  595.         , return (Bag_AFloat) `apply` parseContents
  596.         , return (Bag_AString) `apply` parseContents
  597.         , return (Bag_AEnum) `apply` parseContents
  598.         , return (Bag_Seq) `apply` parseContents
  599.         , return (Bag_Set) `apply` parseContents
  600.         , return (Bag_Bag) `apply` parseContents
  601.         , return (Bag_Tup) `apply` parseContents
  602.         ] `adjustErr` ("in <bag>, "++)
  603.  
  604. instance HTypeable Tup where
  605.     toHType x = Defined "tup" [] []
  606. instance XmlContent Tup where
  607.     toContents (Tup a) =
  608.         [CElem (Elem (T.N "tup") [] (concatMap toContents a)) ()]
  609.     parseContents = do
  610.         { e@(Elem _ [] _) <- element ["tup"]
  611.         ; interior e $ return (Tup) `apply` many parseContents
  612.         } `adjustErr` ("in <tup>, "++)
  613.  
  614. instance HTypeable Tup_ where
  615.     toHType x = Defined "tup" [] []
  616. instance XmlContent Tup_ where
  617.     toContents (Tup_Locator a) = toContents a
  618.     toContents (Tup_ABool a) = toContents a
  619.     toContents (Tup_AInt a) = toContents a
  620.     toContents (Tup_AFloat a) = toContents a
  621.     toContents (Tup_AString a) = toContents a
  622.     toContents (Tup_AEnum a) = toContents a
  623.     toContents (Tup_Seq a) = toContents a
  624.     toContents (Tup_Set a) = toContents a
  625.     toContents (Tup_Bag a) = toContents a
  626.     toContents (Tup_Tup a) = toContents a
  627.     parseContents = oneOf
  628.         [ return (Tup_Locator) `apply` parseContents
  629.         , return (Tup_ABool) `apply` parseContents
  630.         , return (Tup_AInt) `apply` parseContents
  631.         , return (Tup_AFloat) `apply` parseContents
  632.         , return (Tup_AString) `apply` parseContents
  633.         , return (Tup_AEnum) `apply` parseContents
  634.         , return (Tup_Seq) `apply` parseContents
  635.         , return (Tup_Set) `apply` parseContents
  636.         , return (Tup_Bag) `apply` parseContents
  637.         , return (Tup_Tup) `apply` parseContents
  638.         ] `adjustErr` ("in <tup>, "++)
  639.  
  640.  
  641.  
  642. {-Done-}
  643.  
  644.  
RAW Paste Data
Top