module Language.WebIDL.PrettyPrint (prettyPrint) where
import Data.Maybe
import Text.PrettyPrint.HughesPJ
import Language.WebIDL.Syntax
prettyPrint :: IDLSpecification -> String
prettyPrint = render . prSpec
prSpec s = vcat (map prDef s)
prDef (IDLDefinition pos jd def) = vcat [prJd jd, prDef' def] <> semi
prJd (JavaDoc "") = empty
prJd (JavaDoc tx) = text tx
prDef' (IDLDefModule mn xattr defs) =
prXattr xattr <+> text "module" <+> text mn <+> lbrace $+$
(nest 2 $ prSpec defs) $+$ rbrace
prDef' (IDLDefInterface ii _ _ Nothing) =
text "interface" <+> text ii
prDef' (IDLDefInterface ii xattr inhr (Just ib)) =
prXattr xattr <+> text "interface" <+> text ii <+> prInhr inhr <+> lbrace $+$
(nest 2 $ prIbody ib) $+$ rbrace
prDef' (IDLDefType td) = prTypeDcl td
prDef' (IDLDefExcept ex) = prExcept ex
prDef' (IDLDefConst cn) = prConst cn
prDef' (IDLDefValue iv Nothing) = text "valuetype" <+> text iv
prDef' (IDLDefValue iv (Just ts)) = text "valuetype" <+> text iv <+> prTypeSpec ts
prDef' IDLDefPP = empty
prInhr [] = empty
prInhr sns = colon <+> hsep (punctuate comma (map prScoped sns))
prScoped (IDLScopedName outer ns) =
let dcolon =space <> colon <> colon
oc = if outer then [dcolon] else []
in hsep $ oc ++ punctuate dcolon (map text ns)
prIbody (IDLInterfaceBody exps) = vcat (map prExport exps)
prXattr [] = empty
prXattr as = brackets $ hsep $ punctuate comma (map prXattr' as)
prXattr' (IDLExtAttr jd ai mbds) = prJd jd $$ (text ai <> prMbds mbds)
prMbds Nothing = empty
prMbds (Just (IDLDetailSN sn)) = space <> equals <+> prScoped sn
prMbds (Just (IDLDetailID di pdcls)) = space <> equals <+> text di <> prParamDcls pdcls
prMbds (Just (IDLDetailPD pdcls)) = prParamDcls pdcls
prExport (IDLExport pos jd exp) = vcat [prJd jd, prExport' exp] <> semi
prExport' (IDLExpType td) = prTypeDcl td
prExport' (IDLExpExcept ex) = prExcept ex
prExport' (IDLExpConst cn) = prConst cn
prExport' (IDLExpAttr at) = prAttr at
prExport' (IDLExpOp op) = prOp op
prExport' IDLExpPP = empty
prOp (IDLOpDcl xattr mbow pts oi pdcls sns) =
prXattr xattr <+> prOpAttr mbow <+> prParamTypeSpec pts <+> text oi <>
prParamDcls pdcls <+> prExcList "raises" sns
prOpAttr Nothing = empty
prOpAttr (Just IDLOneWay) = text "oneway"
prParamDcls [] = parens empty
prParamDcls pdcls = parens (hsep (punctuate comma (map prParam pdcls)))
prParam (IDLParamDcl xattr pattr pts pi) =
prXattr xattr <+> prPattr pattr <+> prParamTypeSpec pts <+> text pi
prPattr IDLParamIn = text "in"
prPattr IDLParamOut = text "out"
prPattr IDLParamInOut = text "inout"
prAttr (IDLAttrDcl xattr ro pts ai getx setx) =
prXattr xattr <+> (if ro then text "readonly" else empty) <+> text "attribute" <+>
prParamTypeSpec pts <+> text ai <+>
prExcList "getraises" getx <+> prExcList "setraises" setx
prParamTypeSpec (IDLParamBaseSpec sb) = prBaseTypeSpec sb
prParamTypeSpec (IDLParamStringSpec st) = prStringType st
prParamTypeSpec (IDLParamScopedSpec sn) = prScoped sn
prParamTypeSpec IDLParamVoid = text "void"
prExcList kw [] = empty
prExcList kw excs = text kw <+> parens (hsep (punctuate comma (map prScoped excs)))
prConst (IDLConstDcl ct ci ex) =
text "const" <+> prConstType ct <+> text ci <+> equals <+> prExpr ex
prConstType (IDLConstTypeFloat fl) = prFloatType fl
prConstType (IDLConstTypeInt it) = prIntType it
prConstType (IDLConstTypeString st) = prStringType st
prConstType IDLConstTypeChar = text "char"
prConstType IDLConstTypeBool = text "boolean"
prConstType IDLConstTypeFixed = text "fixed"
prConstType IDLConstTypeOctet = text "octet"
prConstType (IDLConstTypeScoped sn) = prScoped sn
prBaseTypeSpec (IDLBaseTypeFloat fl) = prFloatType fl
prBaseTypeSpec (IDLBaseTypeInt it) = prIntType it
prBaseTypeSpec IDLBaseTypeChar = text "char"
prBaseTypeSpec IDLBaseTypeBool = text "boolean"
prBaseTypeSpec IDLBaseTypeOctet = text "octet"
prBaseTypeSpec IDLBaseTypeAny = text "any"
prFloatType IDLFloat = text "float"
prFloatType IDLDouble = text "double"
prFloatType IDLLongDouble = text "long double"
prIntType (IDLSigned ii) = prIntType' ii
prIntType (IDLUnsigned ii) = text "unsigned" <+> prIntType' ii
prIntType' IDLShortInt = text "short"
prIntType' IDLLongInt = text "long"
prIntType' IDLLongLongInt = text "long long"
prStringType (IDLStringType Nothing) = text "string"
prStringType (IDLStringType (Just ex)) = text "string <" <> prExpr ex <> text ">"
prTypeDcl (IDLNative s) = text "native" <+> text s
prTypeDcl (IDLConstrFwd s) = text "struct" <+> text s
prTypeDcl (IDLTypeDef its ds) = text "typedef" <+> prTypeSpec its <+> prDecls ds
prTypeDcl (IDLStruct st) = prStruct st
prStruct (IDLStructType si mbs) = prMembers "struct" si mbs
prExcept (IDLExceptDcl ei mbs) = prMembers "exception" ei mbs
prMembers kw ii mbs = text kw <+> text ii <+> lbrace $+$ nest 2 (vcat (map prMember mbs)) $+$ rbrace
prMember (IDLMember its ds) = prTypeSpec its <+> prDecls ds <> semi
prTypeSpec (IDLSimpleSpec sts) = prSimpleTypeSpec sts
prTypeSpec (IDLStructSpec str) = prStruct str
prSimpleTypeSpec (IDLSimpleBase sb) = prBaseTypeSpec sb
prSimpleTypeSpec (IDLSimpleTmpl st) = prTmplTypeSpec st
prSimpleTypeSpec (IDLSimpleScoped sn) = prScoped sn
prTmplTypeSpec (IDLTmplSequence sq) = prSequence sq
prTmplTypeSpec (IDLTmplString st) = prStringType st
prTmplTypeSpec (IDLTmplFixed fx) = prFixedType fx
prSequence (IDLSequenceType ts Nothing) = text "sequence <" <> prSimpleTypeSpec ts <> text ">"
prSequence (IDLSequenceType ts (Just ex)) =
text "sequence <" <> prSimpleTypeSpec ts <> comma <+> prExpr ex <> text ">"
prFixedType (IDLFixedType ex1 ex2) =
text "fixed <" <> prExpr ex1 <> comma <+> prExpr ex2 <> text ">"
prDecl (IDLSimpleDecl s) = text s
prDecl (IDLComplexDecl iad) = prArray iad
prArray (IDLArrayDeclarator ai dims) = text ai <+> prDims dims
prDims [] = empty
prDims (d:ds) = lbrack <> prExpr d <> rbrack <> prDims ds
prDecls ds = hsep (punctuate comma (map prDecl ds))
prExpr (IDLParenExp ex) = parens (prExpr ex)
prExpr (IDLPrimScoped sn) = prScoped sn
prExpr (IDLPrimLit lit) = prLit lit
prExpr (IDLBinExp op l r) = prExpr l <+> prBin op <+> prExpr r
prExpr (IDLUnaryExp op e) = prUn op <> prExpr e
prBin IDLOr = text "|"
prBin IDLXor = text "^"
prBin IDLAnd = text "&"
prBin IDLShiftL = text "<<"
prBin IDLShiftR = text ">>"
prBin IDLAdd = text "+"
prBin IDLSub = text "-"
prBin IDLMult = text "*"
prBin IDLDiv = text "/"
prBin IDLRem = text "%"
prUn IDLPos = empty
prUn IDLNeg = text "-"
prUn IDLNot = text "~"
prLit (IDLIntLit s) = text s
prLit (IDLStringLit s) = text s
prLit (IDLCharLit s) = text s
prLit (IDLFixedLit s) = text s
prLit (IDLFloatLit s) = text s
prLit (IDLBoolLit s) = text s