language-webidl (empty) → 0.1.0.0
raw patch · 6 files changed
+689/−0 lines, 6 filesdep +basedep +parsecdep +wl-pprintsetup-changed
Dependencies added: base, parsec, wl-pprint
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- language-webidl.cabal +24/−0
- src/AST.hs +159/−0
- src/PPrint.hs +200/−0
- src/Parser.hs +284/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Zhen Zhang++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ language-webidl.cabal view
@@ -0,0 +1,24 @@+name: language-webidl+version: 0.1.0.0+synopsis: Parser and Pretty Printer for WebIDL+description:+ It is intended to replace this package:+ <https://hackage.haskell.org/package/webidl>+ This package is written with parsec and wl-pprint.+license: MIT+license-file: LICENSE+author: Zhen Zhang <izgzhen@gmail.com>+maintainer: Zhen Zhang <izgzhen@gmail.com>+copyright: 2016, Zhen Zhang+category: Language+build-type: Simple+cabal-version: >=1.10+source-repository head+ type: git+ location: https://github.com/izgzhen/language-webidl-hs++library+ exposed-modules: AST, Parser, PPrint+ build-depends: base >=4.8 && <4.9, parsec, wl-pprint+ hs-source-dirs: src+ default-language: Haskell2010
+ src/AST.hs view
@@ -0,0 +1,159 @@+module AST where++import Prelude hiding (Enum)++-- Definition+data Definition a = DefInterface (Interface a)+ | DefPartial (Partial a)+ | DefDictionary (Dictionary a)+ | DefException (Exception a)+ | DefEnum (Enum a)+ | DefTypedef (Typedef a)+ | DefImplementsStatement (ImplementsStatement a)+ deriving (Show)++-- Interface+data Interface a = Interface a Ident (Maybe Ident) [InterfaceMember a] deriving (Show)++-- Partial+data Partial a = PartialInterface a Ident [InterfaceMember a]+ | PartialDictionary a Ident [DictionaryMember a]+ deriving (Show)++-- Dictionary+data Dictionary a = Dictionary a Ident (Maybe Ident) [DictionaryMember a] deriving (Show)++-- Exception+data Exception a = Exception a Ident (Maybe Ident) [ExceptionMember a] deriving (Show)++-- Enum+data Enum a = Enum a Ident [EnumValue] deriving (Show)++-- Typedef+data Typedef a = Typedef a Type Ident deriving (Show)++-- Implements+data ImplementsStatement a = ImplementsStatement a Ident Ident deriving (Show)++-- Fields+data InterfaceMember a = IMemConst (Const a)+ | IMemAttribute (Attribute a)+ | IMemOperation (Operation a)+ deriving (Show)++data DictionaryMember a = DictionaryMember a Type Ident (Maybe Default) deriving (Show)++data ExceptionMember a = ExConst a (Const a)+ | ExField a Type Ident+ deriving (Show)++data Attribute a = Attribute a (Maybe Inherit) (Maybe ReadOnly) Type Ident deriving (Show)++data Operation a = Operation a (Maybe Qualifier) ReturnType (Maybe Ident) [Argument] deriving (Show)++data Argument = ArgOptional Type ArgumentName Default+ | ArgNonOpt Type (Maybe Ellipsis) ArgumentName+ deriving (Show)++newtype EnumValue = EnumValue String deriving (Show)++data ArgumentName = ArgKey ArgumentNameKeyword+ | ArgIdent Ident+ deriving (Show)++-- Values+data Const a = Const a ConstType Ident ConstValue deriving (Show)++data Default = DefaultValue ConstValue+ | DefaultString String+ deriving (Show)++data ConstValue = ConstBooleanLiteral Bool+ | ConstFloatLiteral Double+ | ConstInteger Integer+ | ConstNull+ deriving (Show)+++-- Qualifers+data Qualifier = QuaStatic+ | QSpecials [Special]+ deriving (Show)++data Special = Getter + | Setter + | Ccreator + | Deleter + | Legacycaller+ deriving (Show)++data ArgumentNameKeyword = ArgAttribute | ArgCallback | ArgConst | ArgCreator+ | ArgDeleter | ArgDictionary | ArgEnum | ArgException+ | ArgGetter | ArgImplements | ArgInherit | ArgInterface+ | ArgLegacycaller | ArgPartial | ArgSetter | ArgStatic+ | ArgStringifier | ArgTypedef | ArgUnrestricted+ deriving (Show)++-- Types+data Type = TySingleType SingleType | TyUnionType UnionType TypeSuffix deriving (Show)++data SingleType = STyNonAny NonAnyType+ | STyAny TypeSuffix+ deriving (Show)++data NonAnyType = TyPrim PrimitiveType TypeSuffix+ | TyDOMString TypeSuffix+ | TyIdent Ident TypeSuffix+ | TySequence Type (Maybe Null)+ | TyObject TypeSuffix+ | TyDate TypeSuffix+ deriving (Show)+++data PrimitiveType = PrimIntegerType IntegerType+ | PrimFloatType FloatType+ | Boolean+ | Byte+ | Octet+ deriving (Show)++data IntegerType = IntegerType (Maybe Unsigned) IntegerWidth deriving (Show)++data IntegerWidth = Short | Long Int deriving (Show)++data TypeSuffix = TypeSuffixArray+ | TypeSuffixNullable+ | TypeSuffixNone+ deriving (Show)++data FloatType = TyFloat (Maybe Unrestricted)+ | TyDouble (Maybe Unrestricted)+ deriving (Show)++type UnionType = [UnionMemberType]++data UnionMemberType = UnionTy UnionType TypeSuffix + | UnionTyNonAny NonAnyType+ | UnionTyAny TypeSuffix+ deriving (Show)++data ReturnType = RetType Type+ | RetVoid+ deriving (Show)+++data ConstType = ConstPrim PrimitiveType (Maybe Null)+ | ConstIdent Ident (Maybe Null)+ deriving (Show)++-- Markers++data Ellipsis = Ellipsis deriving (Show)+data ReadOnly = ReadOnly deriving (Show)+data Inherit = Inherit deriving (Show)+data Unrestricted = Unrestricted deriving (Show)+data Null = Null deriving (Show)+data Unsigned = Unsigned deriving (Show)++-- Ident+newtype Ident = Ident String deriving (Show)
+ src/PPrint.hs view
@@ -0,0 +1,200 @@+module PPrint where++import AST+import Prelude hiding (Enum)+import Text.PrettyPrint.Leijen++instance Pretty (Definition a) where+ 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++instance Pretty (Interface a) where+ pretty (Interface _ x mInherit members) =+ text "interface" <+> pretty x <+> prettyInherit mInherit <+> braces (prettyList members) <> semi++prettyMaybe Nothing _ = empty+prettyMaybe (Just x) f = f x++prettyInherit x = prettyMaybe x (\e -> colon <+> pretty e)++instance Pretty (Exception a) where+ pretty (Exception _ x mInherit members) =+ text "exception" <+> pretty x <+> prettyInherit mInherit <+> braces (prettyList members) <> semi++instance Pretty (Partial a) where+ pretty (PartialInterface _ x members) =+ text "interface" <+> pretty x <+> braces (prettyList members) <> semi+ pretty (PartialDictionary _ x members) =+ text "dictionary" <+> pretty x <+> braces (prettyList members) <> semi++instance Pretty (Enum a) where+ pretty (Enum _ x enums) = text "enum" <+> pretty x <+> braces (prettyList enums) <> semi++instance Pretty (Dictionary a) where+ pretty (Dictionary _ x mInherit members) =+ text "dictionary" <+> pretty x <+> prettyInherit mInherit <+> braces (prettyList members) <> semi++instance Pretty (Typedef a) where+ pretty (Typedef _ ty ident) = text "typedef" <+> pretty ty <+> pretty ident <> semi++instance Pretty (ImplementsStatement a) where+ pretty (ImplementsStatement _ i1 i2) = pretty i1 <+> text "implements" <+> pretty i2 <> semi++instance Pretty Ident where+ pretty (Ident x) = text x++instance Pretty Type where+ pretty (TySingleType s) = pretty s+ pretty (TyUnionType ut suffix) = pretty ut <> pretty suffix++instance Pretty SingleType where+ pretty (STyNonAny t) = pretty t+ pretty (STyAny suffix) = text "any" <> pretty suffix++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 (TySequence t mNull) = pretty t <> prettyMaybe mNull pretty+ pretty (TyObject suffix) = text "object" <> pretty suffix+ pretty (TyDate suffix) = text "Date" <> pretty suffix+++instance Pretty (DictionaryMember a) where+ pretty (DictionaryMember _ t ident mDefault) =+ pretty t <+> pretty ident <> prettyMaybe mDefault prettyDefault <> semi++instance Pretty Default where+ pretty (DefaultValue cval) = pretty cval+ pretty (DefaultString s) = text (show s)++instance Pretty ConstValue where+ pretty (ConstBooleanLiteral b) = if b then text "true" else text "false"+ pretty (ConstFloatLiteral d) = pretty d+ pretty (ConstInteger i) = pretty i+ pretty ConstNull = text "null"++instance Pretty Null where+ pretty Null = text "null"++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+ pretty Boolean = text "boolean"+ pretty Byte = text "byte"+ pretty Octet = text "octet"++instance Pretty FloatType where+ pretty (TyFloat mUnres) = text "float" <> prettyMaybe mUnres (\e -> space <> pretty e)+ pretty (TyDouble mUnres) = text "double" <> prettyMaybe mUnres (\e -> space <> pretty e)++instance Pretty Unrestricted where+ pretty Unrestricted = text "unrestricted"++instance Pretty IntegerType where+ pretty (IntegerType mUns width) = prettyMaybe mUns (\e -> pretty e <> space) <> pretty width++instance Pretty IntegerWidth where+ pretty Short = text "short"+ pretty (Long i) = foldr (<+>) empty $ take i (repeat (text "long"))++instance Pretty Unsigned where+ pretty Unsigned = text "unsigned"++instance Pretty UnionMemberType where+ pretty (UnionTy ut suffix) = pretty ut <> pretty suffix+ pretty (UnionTyNonAny t) = pretty t+ pretty (UnionTyAny suffix) = text "any" <> pretty suffix++instance Pretty EnumValue where+ pretty (EnumValue s) = text s++instance Pretty (InterfaceMember a) where+ pretty (IMemConst c) = pretty c+ pretty (IMemAttribute attr) = pretty attr+ pretty (IMemOperation op) = pretty op++instance Pretty (Operation a) where+ pretty (Operation _ mQ retty mIdent args) =+ pretty mQ <> pretty retty <+> prettyMaybe mIdent (\e -> pretty e <> space)+ <+> encloseSep lparen rparen (comma <> space) (map pretty args)+++instance Pretty Argument where+ pretty (ArgOptional t name def) = text "optional" <+> pretty t <+> pretty name <> prettyDefault def+ pretty (ArgNonOpt t mElli name) = pretty t <> prettyMaybe mElli (\_ -> text "...") <+> pretty name++prettyDefault def = space <> equals <+> pretty def++instance Pretty ArgumentName where+ pretty (ArgKey key) = pretty key+ pretty (ArgIdent i) = pretty i++instance Pretty ArgumentNameKeyword where+ pretty ArgAttribute = text "attribute"+ pretty ArgCallback = text "callback"+ pretty ArgConst = text "const"+ pretty ArgCreator = text "creator"+ pretty ArgDeleter = text "deleter"+ pretty ArgDictionary = text "dictionary"+ pretty ArgEnum = text "enum"+ pretty ArgException = text "exception"+ pretty ArgGetter = text "getter"+ pretty ArgImplements = text "implements"+ pretty ArgInherit = text "inherit"+ pretty ArgInterface = text "interface"+ pretty ArgLegacycaller = text "legacycaller"+ pretty ArgPartial = text "partial"+ pretty ArgSetter = text "setter"+ pretty ArgStatic = text "static"+ pretty ArgStringifier = text "stringifier"+ pretty ArgTypedef = text "typedef"+ pretty ArgUnrestricted = text "unrestricted"+++instance Pretty ReturnType where+ pretty (RetType t) = pretty t+ pretty RetVoid = text "void"++instance Pretty Qualifier where+ pretty QuaStatic = text "static"+ pretty (QSpecials specials) = prettyList specials++instance Pretty Special where+ pretty Getter = text "getter"+ pretty Setter = text "setter"+ pretty Ccreator = text "ccreator"+ pretty Deleter = text "deleter"+ pretty Legacycaller = text "legacycaller"+++instance Pretty (Attribute a) where+ pretty (Attribute _ mInherit mReadOnly t i) =+ prettyInherit mInherit <+> prettyMaybe mReadOnly pretty <+> pretty t <+> pretty i++instance Pretty ReadOnly where+ pretty ReadOnly = text "readonly"++instance Pretty Inherit where+ pretty Inherit = text "inherit"++instance Pretty (Const a) where+ pretty (Const _ t i v) = pretty t <+> pretty i <+> equals <+> pretty v <> semi++instance Pretty ConstType where+ pretty (ConstPrim ty mNull) = pretty ty <> prettyMaybe mNull pretty+ pretty (ConstIdent i mNull) = pretty i <> prettyMaybe mNull pretty++instance Pretty (ExceptionMember a) where+ pretty (ExConst _ c) = pretty c+ pretty (ExField _ t i) = pretty t <+> pretty i <> semi
+ src/Parser.hs view
@@ -0,0 +1,284 @@+module Parser where++import AST+import Prelude hiding (Enum)+import Text.ParserCombinators.Parsec+import Text.Parsec.Language (emptyDef)+import Text.Parsec (modifyState, SourcePos, getPosition, getState, putState, sourceLine)+import Control.Monad (void)+import qualified Text.Parsec.Token as Tok++data ParserState = ParserState {+ _comments :: [String]+}++data Tagging = Tagging {+ _comment :: [String],+ _sourcePos :: SourcePos+}++instance Show Tagging where+ show (Tagging comments pos) =+ let line = if length comments > 0 then take 5 (head comments) ++ "..., " else ""+ in "(" ++ line ++ show (sourceLine pos) ++ ")"++initState :: ParserState+initState = ParserState []++type MyParser = CharParser ParserState++testParse :: MyParser a -> String -> Either ParseError a+testParse p = runParser p initState "webidl"++parseIDL :: String -> Either ParseError [Definition Tagging]+parseIDL = testParse (pSpaces *> many1 (pDef <* pSpaces))++pDef :: MyParser (Definition Tagging)+pDef = DefInterface <$> (pExtAttrs *> pInterface)+ <|> DefPartial <$> pPartial+ <|> DefDictionary <$> pDictionary+ <|> DefException <$> pException+ <|> DefEnum <$> pEnum+ <|> DefTypedef <$> pTypedef+ <|> DefImplementsStatement <$> pImplementsStatement++-- FIXME: currently we ignore extended attributes+pExtAttrs :: MyParser ()+pExtAttrs = pSpaces *> void (char '[' *> (manyTill anyChar (try (char ']')))) <* pSpaces+ <|> pSpaces++pPartial :: MyParser (Partial Tagging)+pPartial = string "partial" *> pSpaces *> p+ where+ p = PartialInterface <$> getTag <*> (string "interface" *> pSpaces *> pIdent)+ <*> braces (many pInterfaceMember) <* semi+ <|> PartialDictionary <$> getTag <*> (string "dictionary" *> pSpaces *> pIdent)+ <*> braces (many pDictionaryMember) <* semi++pDictionary :: MyParser (Dictionary Tagging)+pDictionary = Dictionary <$> getTag <*> (string "dictionary" *> pSpaces *> pIdent)+ <*> pInheritance <*> braces (many pDictionaryMember) <* semi++pInterface :: MyParser (Interface Tagging)+pInterface = Interface <$> getTag <*> (string "interface" *> pSpaces *> pIdent)+ <*> pInheritance <*> braces (pSpaces *> many (pInterfaceMember <* pSpaces)) <* semi++pException :: MyParser (Exception Tagging)+pException = Exception <$> getTag <*> (string "exception" *> pSpaces *> pIdent)+ <*> pInheritance <*> braces (many pExceptionMember)++pInheritance :: MyParser (Maybe Ident)+pInheritance = optionMaybe (spaces *> char ':' *> spaces *> pIdent)++pEnum :: MyParser (Enum Tagging)+pEnum = Enum <$> getTag <*> (string "enum" *> pSpaces *> pIdent) <*> braces pEnumValues <* semi++pEnumValues :: MyParser [EnumValue]+pEnumValues = sepBy1 (EnumValue <$> stringLit) (char ',')+++pTypedef :: MyParser (Typedef Tagging)+pTypedef = do+ tag <- getTag+ string "typedef"+ pSpaces+ ty <- try pType+ pSpaces+ ident <- pIdent+ semi+ return (Typedef tag ty ident)++pImplementsStatement :: MyParser (ImplementsStatement Tagging)+pImplementsStatement = ImplementsStatement <$> getTag <*> pIdent <* pSpaces+ <*> (string "implements" *> pSpaces *> pIdent <* semi)++pDictionaryMember :: MyParser (DictionaryMember Tagging)+pDictionaryMember = DictionaryMember <$> getTag <*> pType <* pSpaces+ <*> pIdent <*> optionMaybe (spaces *> pEq *> spaces *> pDefault) <* semi++pExceptionMember :: MyParser (ExceptionMember Tagging)+pExceptionMember = ExConst <$> getTag <*> pConst+ <|> ExField <$> getTag <*> pType <*> pIdent <* semi++pMaybeIdent :: MyParser (Maybe Ident)+pMaybeIdent = optionMaybe pIdent++pInterfaceMember :: MyParser (InterfaceMember Tagging)+pInterfaceMember = try (IMemConst <$> pConst)+ <|> try (IMemAttribute <$> pAttribute)+ <|> IMemOperation <$> (pExtAttrs *> pOperation)++pConst :: MyParser (Const Tagging)+pConst = Const <$> getTag <*> (string "const" *> pSpaces *> pConstType <* pSpaces)+ <*> (pIdent <* pEq) <*> (pSpaces *> pConstValue <* semi)++pConstType :: MyParser ConstType+pConstType = ConstPrim <$> pPrimTy <*> pNull+ <|> ConstIdent <$> pIdent <*> pNull++pAttribute :: MyParser (Attribute Tagging)+pAttribute = Attribute <$> getTag <*> pModifier Inherit "inherit"+ <*> pModifier ReadOnly "readonly"+ <*> (string "attribute" *> pSpaces *> pType) <*> (pSpaces *> pIdent <* semi)++pModifier :: a -> String -> MyParser (Maybe a)+pModifier m s = optionMaybe (string s *> pSpaces *> return m)++pOperation :: MyParser (Operation Tagging)+pOperation = Operation <$> getTag <*> pQualifier <* spaces+ <*> pReturnType <* pSpaces+ <*> pMaybeIdent <* pSpaces+ <*> parens (pSpaces *> sepBy (pArg <* pSpaces) (char ',' <* pSpaces)) <* semi++pArg :: MyParser Argument+pArg = ArgOptional <$> (string "optional" *> pType <* pSpaces) <*> pArgumentName <*> pDefault+ <|> ArgNonOpt <$> (pType <* pSpaces) <*> (pModifier Ellipsis "...") <*> (pSpaces *> pArgumentName)++pArgumentName :: MyParser ArgumentName+pArgumentName = try (ArgKey <$> pArgumentNameKeyword)+ <|> ArgIdent <$> pIdent++pArgumentNameKeyword :: MyParser ArgumentNameKeyword+pArgumentNameKeyword = string "attribute" *> return ArgAttribute+ <|> string "callback" *> return ArgCallback+ <|> string "const" *> return ArgConst+ <|> string "creator" *> return ArgCreator+ <|> string "deleter" *> return ArgDeleter+ <|> string "dictionary" *> return ArgDictionary+ <|> string "enum" *> return ArgEnum+ <|> string "exception" *> return ArgException + <|> string "getter" *> return ArgGetter+ <|> string "implements" *> return ArgImplements+ <|> string "inherit" *> return ArgInherit+ <|> string "interface" *> return ArgInterface + <|> string "legacycaller" *> return ArgLegacycaller+ <|> string "partial" *> return ArgPartial+ <|> string "setter" *> return ArgSetter+ <|> string "static" *> return ArgStatic + <|> string "stringifier" *> return ArgStringifier+ <|> string "typedef" *> return ArgTypedef+ <|> string "unrestricted" *> return ArgUnrestricted++pDefault :: MyParser Default+pDefault = DefaultValue <$> pConstValue+ <|> DefaultString <$> stringLit+++pQualifier :: MyParser (Maybe Qualifier)+pQualifier = try (string "static" *> return (Just QuaStatic))+ <|> try (Just . QSpecials <$> many pSpecial)+ <|> return Nothing++pSpecial :: MyParser Special+pSpecial = string "getter" *> return Getter+ <|> string "setter" *> return Setter+ <|> string "ccreator" *> return Ccreator+ <|> string "deleter" *> return Deleter+ <|> string "legacycaller" *> return Legacycaller++pReturnType :: MyParser ReturnType+pReturnType = string "void" *> return RetVoid+ <|> RetType <$> pType++pConstValue :: MyParser ConstValue+pConstValue = ConstBooleanLiteral <$> pBool+ <|> try (ConstFloatLiteral <$> pFloat)+ <|> ConstInteger <$> pInt+ <|> string "null" *> return ConstNull++pBool :: MyParser Bool+pBool = string "true" *> return True+ <|> string "false" *> return False+++pNull :: MyParser (Maybe Null)+pNull = optionMaybe (char '?' *> return Null)++pPrimTy :: MyParser PrimitiveType+pPrimTy = try (string "boolean" *> return Boolean)+ <|> try (string "byte" *> return Byte)+ <|> try (string "octet" *> return Octet)+ <|> try (PrimIntegerType <$> pIntegerType)+ <|> PrimFloatType <$> pFloatType++pIntegerType :: MyParser IntegerType+pIntegerType = IntegerType <$> pUnsigned <* pSpaces <*> pIntegerWidth++pUnsigned :: MyParser (Maybe Unsigned)+pUnsigned = optionMaybe (string "unsigned" *> return Unsigned)++pIntegerWidth = string "short" *> return Short+ <|> Long . length <$> many1 (string "long" <* pSpaces)++pFloatType :: MyParser FloatType+pFloatType = try (TyFloat <$> pModifier Unrestricted "unrestricted" <* spaces <* string "float")+ <|> TyDouble <$> pModifier Unrestricted "unrestricted" <* spaces <* string "double"++pType :: MyParser Type+pType = TySingleType <$> pSingleType+ <|> TyUnionType <$> pUnionType <*> pTypeSuffix++pSingleType :: MyParser SingleType+pSingleType = STyAny <$> (string "any" *> pTypeSuffix)+ <|> STyNonAny <$> pNonAnyType++pNonAnyType :: MyParser NonAnyType+pNonAnyType = try (TyPrim <$> pPrimTy <*> pTypeSuffix)+ <|> TySequence <$> (string "sequence" *> pSpaces *> angles pType) <*> pNull+ <|> TyObject <$> (string "object" *> pTypeSuffix)+ <|> try (TyDOMString <$> (string "DOMString" *> pTypeSuffix))+ <|> TyDate <$> (string "Date" *> pTypeSuffix)+ <|> TyIdent <$> pIdent <*> pTypeSuffix++pTypeSuffix :: MyParser TypeSuffix+pTypeSuffix = try (string "[]" *> return TypeSuffixArray)+ <|> try (char '?' *> return TypeSuffixNullable)+ <|> return TypeSuffixNone++-- FIXME: Not working correctly currently+pUnionType :: MyParser UnionType+pUnionType = parens (sepBy1 pUnionMemberType (string "or"))++pUnionMemberType :: MyParser UnionMemberType+pUnionMemberType = UnionTy <$> pUnionType <*> pTypeSuffix+ <|> UnionTyNonAny <$> pNonAnyType+ <|> UnionTyAny <$> (string "any []" *> pTypeSuffix)++lexer = Tok.makeTokenParser emptyDef++parens = Tok.parens lexer+braces = Tok.braces lexer+angles = Tok.angles lexer+reserved = Tok.reserved lexer+reservedOp = Tok.reservedOp lexer+whiteSpace = Tok.whiteSpace lexer+pIdent = Ident <$> Tok.identifier lexer+pInt = Tok.integer lexer+pFloat = Tok.float lexer+semi = Tok.semi lexer+stringLit = Tok.stringLiteral lexer+pEq = char '='++pSpaces = try (skipMany (spaces *> pComment <* spaces) <* spaces)+ <|> spaces++pComment = try pLineComment <|> pBlockComment++pLineComment = do+ string "//"+ comment <- manyTill anyChar (try newline)+ modifyState (\ps -> ParserState { _comments = _comments ps ++ [comment]})++pBlockComment = do+ string "/*"+ comment <- manyTill anyChar (try (string "*/"))+ modifyState (\ps -> ParserState { _comments = _comments ps ++ lines comment})+++getTag :: MyParser Tagging+getTag = do+ pos <- getPosition+ ParserState comments <- getState+ putState $ ParserState []+ return $ Tagging comments pos+