language-webidl 0.1.4.0 → 0.2.0.0

raw patch · 4 files changed

+53/−82 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• language-webidl.cabal +3/−2
• src/Language/WebIDL/AST.hs +10/−19
• src/Language/WebIDL/PPrint.hs +11/−23
• src/Language/WebIDL/Parser.hs +29/−38

@@ -1,8 +1,9 @@ name:               language-webidl-version:            0.1.4.0+version:            0.2.0.0 synopsis:           Parser and Pretty Printer for WebIDL description:-    Written with parsec and wl-pprint.+    Written with parsec and wl-pprint. Functor AST.+    Reusable node parser.     See <http://www.w3.org/TR/WebIDL/> for reference. license:             MIT license-file:        LICENSE

@@ -13,7 +13,6 @@ data Definition a = DefInterface (Interface a)                   | DefPartial (Partial a)                   | DefDictionary (Dictionary a)-                  | DefException (Exception a)                   | DefEnum (Enum a)                   | DefTypedef (Typedef a)                   | DefCallback (Callback a)@@ -111,34 +110,33 @@ -- | Special qualifier data Special = Getter               | Setter -             | Ccreator               | Deleter -             | Legacycaller+             | LegacyCaller              deriving (Show, Eq)  -- | Argument name keyword data ArgumentNameKeyword = ArgAttribute    | ArgCallback    | ArgConst        | ArgCreator                          | ArgDeleter      | ArgDictionary  | ArgEnum         | ArgException                          | ArgGetter       | ArgImplements  | ArgInherit      | ArgInterface-                         | ArgLegacycaller | ArgPartial     | ArgSetter       | ArgStatic+                         | ArgLegacyCaller | ArgPartial     | ArgSetter       | ArgStatic                          | ArgStringifier  | ArgTypedef     | ArgUnrestricted                          deriving (Show, Eq)  -- | Types-data Type = TySingleType SingleType | TyUnionType UnionType TypeSuffix deriving (Show, Eq)+data Type = TySingleType SingleType | TyUnionType UnionType (Maybe Null) deriving (Show, Eq)  -- | Single type data SingleType = STyNonAny NonAnyType-                | STyAny TypeSuffix+                | STyAny (Maybe Null)                 deriving (Show, Eq)  -- | Types that is not @any@-data NonAnyType = TyPrim PrimitiveType TypeSuffix-                | TyDOMString TypeSuffix-                | TyIdent Ident TypeSuffix+data NonAnyType = TyPrim PrimitiveType (Maybe Null)+                | TyDOMString (Maybe Null)+                | TyIdent Ident (Maybe Null)                 | TySequence Type (Maybe Null)-                | TyObject TypeSuffix-                | TyDate TypeSuffix+                | TyObject (Maybe Null)+                | TyDate (Maybe Null)                 deriving (Show, Eq)  -- | Primitive type@@ -158,12 +156,6 @@ -- | @unsigned@ modifier data Unsigned = Unsigned deriving (Show, Eq) --- | Suffix of type-data TypeSuffix = TypeSuffixArray-                | TypeSuffixNullable-                | TypeSuffixNone-                deriving (Show, Eq)- -- | Float type data FloatType = TyFloat (Maybe Unrestricted)                | TyDouble (Maybe Unrestricted)@@ -173,9 +165,8 @@ type UnionType = [UnionMemberType]  -- | Union member type-data UnionMemberType = UnionTy UnionType TypeSuffix +data UnionMemberType = UnionTy UnionType (Maybe Null)                      | UnionTyNonAny NonAnyType-                     | UnionTyAny TypeSuffix                      deriving (Show, Eq)  -- | Return value's type

@@ -19,7 +19,6 @@     pretty (DefInterface x) = pretty x     pretty (DefPartial x) = pretty x     pretty (DefDictionary x) = pretty x-    pretty (DefException x) = pretty x     pretty (DefEnum x) = pretty x     pretty (DefTypedef x) = pretty x     pretty (DefImplementsStatement x) = pretty x@@ -31,7 +30,7 @@  instance Pretty (Callback a) where     pretty (Callback _ f retty args) = text "callback" <+> pretty f <+>-                                       equals <+> pretty retty <+> prettyParenList args+                                       equals <+> pretty retty <+> prettyParenList args <> semi  prettyExtAttrs :: [ExtendedAttribute a] -> Doc -> Doc prettyExtAttrs [] _ = empty@@ -49,10 +48,6 @@  prettyInherit x = prettyMaybe x (\e -> colon <+> pretty e) -instance Pretty (Exception a) where-    pretty (Exception _ x mInherit members) =-        text "exception" <+> pretty x <+> prettyInherit mInherit <+> scope members <> semi- instance Pretty (Partial a) where     pretty (PartialInterface _ x members) =         text "interface" <+> pretty x <+> scope members <> semi@@ -80,21 +75,21 @@  instance Pretty Type where     pretty (TySingleType s) = pretty s-    pretty (TyUnionType ut suffix) = prettyUnionType ut <> pretty suffix+    pretty (TyUnionType ut mNull) = prettyUnionType ut <> prettyMaybe mNull pretty  prettyUnionType ut = parens (hcat (punctuate (space <> text "or" <> space) (map pretty ut)))  instance Pretty SingleType where     pretty (STyNonAny t) = pretty t-    pretty (STyAny suffix) = text "any" <> pretty suffix+    pretty (STyAny mNull) = text "any" <> prettyMaybe mNull pretty  instance Pretty NonAnyType where-    pretty (TyPrim t suffix) = pretty t <> pretty suffix-    pretty (TyDOMString suffix) = text "DOMString" <> pretty suffix-    pretty (TyIdent ident suffix) = pretty ident <> pretty suffix+    pretty (TyPrim t mNull) = pretty t <> prettyMaybe mNull pretty+    pretty (TyDOMString mNull) = text "DOMString" <> prettyMaybe mNull pretty+    pretty (TyIdent ident mNull) = pretty ident <> prettyMaybe mNull pretty     pretty (TySequence t mNull) = text "sequence" <> angles (pretty t) <> prettyMaybe mNull pretty-    pretty (TyObject suffix) = text "object" <> pretty suffix-    pretty (TyDate suffix) = text "Date" <> pretty suffix+    pretty (TyObject mNull) = text "object" <> prettyMaybe mNull pretty+    pretty (TyDate mNull) = text "Date" <> prettyMaybe mNull pretty   instance Pretty (DictionaryMember a) where@@ -114,11 +109,6 @@ instance Pretty Null where     pretty Null = text "?" -instance Pretty TypeSuffix where-    pretty TypeSuffixArray = text "[]"-    pretty TypeSuffixNullable = text "?"-    pretty TypeSuffixNone = empty- instance Pretty PrimitiveType where     pretty (PrimIntegerType t) = pretty t     pretty (PrimFloatType t)   = pretty t@@ -144,9 +134,8 @@     pretty Unsigned = text "unsigned"  instance Pretty UnionMemberType where-    pretty (UnionTy ut suffix) = pretty ut <> pretty suffix+    pretty (UnionTy ut mNull) = pretty ut <> prettyMaybe mNull pretty     pretty (UnionTyNonAny t) = pretty t-    pretty (UnionTyAny suffix) = text "any" <> pretty suffix  instance Pretty EnumValue where     pretty (EnumValue s) = text s@@ -189,7 +178,7 @@     pretty ArgImplements = text "implements"     pretty ArgInherit = text "inherit"     pretty ArgInterface   = text "interface"-    pretty ArgLegacycaller = text "legacycaller"+    pretty ArgLegacyCaller = text "legacycaller"     pretty ArgPartial = text "partial"     pretty ArgSetter = text "setter"     pretty ArgStatic  = text "static"@@ -209,9 +198,8 @@ instance Pretty Special where     pretty Getter = text "getter"     pretty Setter = text "setter"-    pretty Ccreator = text "ccreator"     pretty Deleter = text "deleter"-    pretty Legacycaller = text "legacycaller"+    pretty LegacyCaller = text "legacycaller"   instance Pretty (Attribute a) where

@@ -4,12 +4,13 @@ -}  module Language.WebIDL.Parser (-  Tag(..), MyParser, ParserState, parseIDL, tryParse, pDef, pExtAttrs, pExtAttr, pPartial, pDictionary,-  pInterface, pException, pInheritance, pEnum, pEnumValues, pTypedef, pImplementsStatement,-  pDictionaryMember, pExceptionMember, pMaybeIdent, pInterfaceMember, pConst, pConstType,+  Tag(..), MyParser, ParserState, Comment(..), parseIDL, tryParse, pDef, pExtAttrs, pExtAttr, pPartial, pDictionary,+  pInterface, pInheritance, pEnum, pEnumValues, pTypedef, pImplementsStatement,+  pDictionaryMember, pMaybeIdent, pInterfaceMember, pConst, pConstType,   pAttribute, pOperation, pArg, pArgumentName, pArgumentNameKeyword, pDefault, pQualifier,   pSpecial, pReturnType, pConstValue, pBool, pNull, pPrimTy, pIntegerType, pUnsigned, pFloatType,-  pType, pSingleType, pNonAnyType, pTypeSuffix, pUnionType, pUnionMemberType ) where+  pType, pSingleType, pNonAnyType, pUnionType, pUnionMemberType,+  pIdent, spaces, pParenComma, pString, pStringEnds, string, parens) where  import Language.WebIDL.AST import Prelude hiding (Enum)@@ -18,13 +19,15 @@ import Text.Parsec (modifyState, SourcePos, getPosition, getState, putState, sourceLine) import qualified Text.Parsec.Token as Tok +data Comment = LineComment String | BlockComment String deriving Show+ data ParserState = ParserState {-  _comments :: [String]+  _comments' :: [Comment] }  -- | Tag of source data Tag = Tag {-  _comment :: [String],+  _comments  :: [Comment],   _sourcePos :: SourcePos } @@ -32,9 +35,7 @@   (==) _ _ = True  instance Show Tag where-    show (Tag comments pos) =-      let line = if length comments > 0 then take 5 (head comments) ++ "..., " else ""-      in  "(" ++ line ++ show (sourceLine pos) ++ ")"+    show (Tag comment pos) = show comment ++ "(" ++ show (sourceLine pos) ++ ")"  initState :: ParserState initState = ParserState []@@ -53,7 +54,6 @@    <|> DefCallback <$> pCallback    <|> DefPartial <$> pPartial    <|> DefDictionary <$> pDictionary-   <|> DefException <$> pException    <|> DefEnum <$> pEnum    <|> DefTypedef <$> pTypedef    <|> DefImplementsStatement <$> pImplementsStatement@@ -62,7 +62,7 @@ pCallback = Callback <$> (string "callback" *> pSpaces *> getTag)                      <*> pIdent                      <*> (pEq *> pReturnType <* pSpaces)-                     <*> pParenComma pArg+                     <*> pParenComma pArg <* semi  pExtAttrs :: MyParser [ExtendedAttribute Tag] pExtAttrs = try (brackets (pSpaces *> sepBy (pExtAttr <* pSpaces) (char ',' <* pSpaces)))@@ -91,10 +91,6 @@ pInterface = Interface <$> getTag <*> pExtAttrs <*> (string "interface" *> pSpaces *> pIdent)                        <*> pInheritance <*> braces (pSpaces *> many (pInterfaceMember <* pSpaces)) <* semi -pException :: MyParser (Exception Tag)-pException = Exception <$> getTag <*> (string "exception" *> pSpaces *> pIdent)-                          <*> pInheritance <*> braces (many pExceptionMember)- pInheritance :: MyParser (Maybe Ident) pInheritance = optionMaybe (spaces *> char ':'  *> spaces *> pIdent) @@ -123,10 +119,6 @@ pDictionaryMember = DictionaryMember <$> getTag <*> pType <* pSpaces                                      <*> pIdent <*> pDefault <* semi -pExceptionMember :: MyParser (ExceptionMember Tag)-pExceptionMember =  ExConst <$> getTag <*> pConst-                <|> ExField <$> getTag <*> pType <*> pIdent <* semi- pMaybeIdent :: MyParser (Maybe Ident) pMaybeIdent = optionMaybe pIdent @@ -179,7 +171,7 @@                     <|> string "implements" *> return ArgImplements                     <|> string "inherit" *> return ArgInherit                     <|> string "interface" *> return ArgInterface  -                    <|> string "legacycaller" *> return ArgLegacycaller+                    <|> string "legacycaller" *> return ArgLegacyCaller                     <|> string "partial" *> return ArgPartial                     <|> string "setter" *> return ArgSetter                     <|> string "static" *> return ArgStatic @@ -203,9 +195,8 @@ pSpecial :: MyParser Special pSpecial = string "getter" *> return Getter        <|> string "setter" *> return Setter-       <|> string "ccreator" *> return Ccreator        <|> string "deleter" *> return Deleter-       <|> string "legacycaller" *> return Legacycaller+       <|> string "legacycaller" *> return LegacyCaller  pReturnType :: MyParser ReturnType pReturnType = string "void" *> return RetVoid@@ -248,33 +239,27 @@  pType :: MyParser Type pType =  TySingleType <$> pSingleType-     <|> TyUnionType <$> pUnionType <*> pTypeSuffix+     <|> TyUnionType <$> pUnionType <*> pNull  pSingleType :: MyParser SingleType-pSingleType =  STyAny <$> (string "any" *> pTypeSuffix)+pSingleType =  STyAny <$> (string "any" *> pNull)            <|> STyNonAny <$> pNonAnyType  pNonAnyType :: MyParser NonAnyType-pNonAnyType =  try (TyPrim <$> pPrimTy <*> pTypeSuffix)+pNonAnyType =  try (TyPrim <$> pPrimTy <*> pNull)            <|> TySequence <$> (string "sequence" *> pSpaces *> angles pType) <*> pNull-           <|> TyObject <$> (string "object" *> pTypeSuffix)-           <|> try (TyDOMString <$> (string "DOMString" *> pTypeSuffix))-           <|> try (TyDate <$> (string "Date" *> pTypeSuffix))-           <|> TyIdent <$> pIdent <*> pTypeSuffix--pTypeSuffix :: MyParser TypeSuffix-pTypeSuffix =  try (string "[]" *> return TypeSuffixArray)-           <|> try (char '?' *> return TypeSuffixNullable)-           <|> return TypeSuffixNone+           <|> TyObject <$> (string "object" *> pNull)+           <|> try (TyDOMString <$> (string "DOMString" *> pNull))+           <|> try (TyDate <$> (string "Date" *> pNull))+           <|> TyIdent <$> pIdent <*> pNull  -- FIXME: Not working correctly currently pUnionType :: MyParser UnionType pUnionType = parens (sepBy1 pUnionMemberType (spaces *> string "or" <* spaces))  pUnionMemberType :: MyParser UnionMemberType-pUnionMemberType =  UnionTy <$> pUnionType <*> pTypeSuffix+pUnionMemberType =  UnionTy <$> pUnionType <*> pNull                 <|> UnionTyNonAny <$> pNonAnyType-                <|> UnionTyAny <$> (string "any []" *> pTypeSuffix)  lexer = Tok.makeTokenParser emptyDef @@ -297,12 +282,12 @@ pLineComment = do   _ <- string "//"   comment <- manyTill anyChar (try newline)-  modifyState (\ps -> ParserState { _comments = _comments ps ++ [comment]})+  modifyState (\ps -> ParserState { _comments' = _comments' ps ++ [LineComment comment]})  pBlockComment = do   _ <- string "/*"   comment <- manyTill anyChar (try (string "*/"))-  modifyState (\ps -> ParserState { _comments = _comments ps ++ lines comment})+  modifyState (\ps -> ParserState { _comments' = _comments' ps ++ [BlockComment comment]})  getTag :: MyParser Tag getTag = do@@ -313,3 +298,9 @@  pParenComma :: MyParser a -> MyParser [a] pParenComma p = parens (pSpaces *> sepBy (p <* pSpaces) (char ',' <* pSpaces))++pString :: MyParser String+pString = many anyChar++pStringEnds :: String -> MyParser String+pStringEnds s = manyTill anyChar (try (string s))