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' _                = []