content: 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 _ u s)        = showSchema' (unwords $ ats : mn ++ mx) s
          where mn = ["minOccurs=" ++ show u | u >= 0]
                mx = ["maxOccurs=" ++ show u | u >= 0]
  
    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' _                = []
  