module Rest.Gen.Base.XML (getXmlSchema, showSchema, showExample) where import Data.List import Text.XML.HXT.Arrow.Pickle import Text.XML.HXT.Arrow.Pickle.Schema getXmlSchema :: XmlPickler a => proxy a -> Schema getXmlSchema = theSchema . getPU getPU :: XmlPickler a => proxy a -> PU a getPU _ = xpickle showSchema :: Schema -> String showSchema sch = case result of [] -> "" [x] -> x xs -> intercalate "\n" $ ["<complexType name='data'>"] ++ indent xs ++ ["</complexType>"] where result = showSchema' "" sch showSchema' :: String -> Schema -> [String] showSchema' ats Any = ["<xs:any" ++ ats ++ "/>"] showSchema' _ (Seq []) = [] showSchema' ats (Seq [x]) = showSchema' ats x showSchema' ats (Seq ss) = ["<xs:sequence" ++ ats ++ ">"] ++ indent (concatMap (showSchema' "") ss) ++ ["</xs:sequence>"] showSchema' _ (Alt []) = [] showSchema' ats (Alt [x]) = showSchema' ats x showSchema' ats (Alt ss) = ["<xs:choice" ++ ats ++ ">"] ++ indent (concatMap (showSchema' "") ss) ++ ["</xs:choice>"] showSchema' ats (Rep l u s) = showSchema' (ats ++ concatMap (' ':) (mn ++ mx)) s where mn = if l >= 0 then ["minOccurs=" ++ show l] else [] mx = if u >= 0 then ["maxOccurs=" ++ show u] else [] showSchema' ats (Element n (CharData dty)) = ["<xs:element name='" ++ n ++ "' type='" ++ dataToString dty ++ "'" ++ ats ++ "/>"] showSchema' ats (Element n (Seq [])) = ["<xs:element name='" ++ n ++ "'" ++ ats ++ "/>"] showSchema' ats (Element n s) = ["<xs:element name='" ++ n ++ "'" ++ ats ++ ">"] ++ indent ( ["<xs:complexType>"] ++ indent (showSchema' "" s) ++ ["</xs:complexType>"]) ++ ["</xs:element>"] showSchema' ats (Attribute n (CharData dty)) = ["<xs:attribute name='" ++ n ++ "' type='" ++ dataToString dty ++ "'" ++ ats ++ "/>"] showSchema' ats (ElemRef n) = ["<xs:element ref='" ++ n ++ "'" ++ ats ++ "/>"] showSchema' _ _ = [] dataToString :: DataTypeDescr -> String dataToString (DTDescr _ n _) = "xs:" ++ n indent :: [String] -> [String] indent = map (" " ++) showExample :: Schema -> String showExample sch = intercalate "\n" $ showExample' sch where showExample' :: Schema -> [String] showExample' Any = ["<anyTag/>"] showExample' (Seq []) = [] showExample' (Seq [x]) = showExample' x showExample' (Seq ss) = concatMap showExample' ss showExample' (Alt []) = [] showExample' (Alt (x : _)) = showExample' x showExample' (Rep _ _ s) = showExample' s showExample' (Element n (CharData _)) = ["<" ++ n ++ ">string</" ++ n ++ ">"] showExample' (Element n (Seq [])) = ["<" ++ n ++ "/>"] showExample' (Element n s) = ["<" ++ n ++ ">"] ++ indent (showExample' s) ++ ["</" ++ n ++ ">"] showExample' _ = []