language-webidl 0.1.0.0 → 0.1.1.0

raw patch · 7 files changed

+657/−645 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• language-webidl.cabal +4/−2
• src/AST.hs +0/−159
• src/Language/WebIDL/AST.hs +159/−0
• src/Language/WebIDL/PPrint.hs +207/−0
• src/Language/WebIDL/Parser.hs +287/−0
• src/PPrint.hs +0/−200
• src/Parser.hs +0/−284

@@ -1,5 +1,5 @@ name:                language-webidl-version:             0.1.0.0+version:             0.1.1.0 synopsis:           Parser and Pretty Printer for WebIDL description:     It is intended to replace this package:@@ -18,7 +18,9 @@   location: https://github.com/izgzhen/language-webidl-hs  library-  exposed-modules:     AST, Parser, PPrint+  exposed-modules:     Language.WebIDL.AST+                       Language.WebIDL.Parser+                       Language.WebIDL.PPrint   build-depends:       base >=4.8 && <4.9, parsec, wl-pprint   hs-source-dirs:      src   default-language:    Haskell2010

@@ -1,159 +0,0 @@-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)

@@ -0,0 +1,159 @@+module Language.WebIDL.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, Eq)++-- Interface+data Interface a = Interface a Ident (Maybe Ident) [InterfaceMember a] deriving (Show, Eq)++-- Partial+data Partial a = PartialInterface a Ident [InterfaceMember a]+               | PartialDictionary a Ident [DictionaryMember a]+               deriving (Show, Eq)++-- Dictionary+data Dictionary a = Dictionary a Ident (Maybe Ident) [DictionaryMember a] deriving (Show, Eq)++-- Exception+data Exception a = Exception a Ident (Maybe Ident) [ExceptionMember a] deriving (Show, Eq)++-- Enum+data Enum a = Enum a Ident [EnumValue] deriving (Show, Eq)++-- Typedef+data Typedef a = Typedef a Type Ident deriving (Show, Eq)++-- Implements+data ImplementsStatement a = ImplementsStatement a Ident Ident deriving (Show, Eq)++-- Fields+data InterfaceMember a = IMemConst (Const a)+                       | IMemAttribute (Attribute a)+                       | IMemOperation (Operation a)+                       deriving (Show, Eq)++data DictionaryMember a = DictionaryMember a Type Ident (Maybe Default) deriving (Show, Eq)++data ExceptionMember a = ExConst a (Const a)+                       | ExField a Type Ident+                       deriving (Show, Eq)++data Attribute a = Attribute a (Maybe Inherit) (Maybe ReadOnly) Type Ident deriving (Show, Eq)++data Operation a = Operation a (Maybe Qualifier) ReturnType (Maybe Ident) [Argument] deriving (Show, Eq)++data Argument = ArgOptional Type ArgumentName Default+              | ArgNonOpt Type (Maybe Ellipsis) ArgumentName+              deriving (Show, Eq)++newtype EnumValue = EnumValue String deriving (Show, Eq)++data ArgumentName = ArgKey ArgumentNameKeyword+                  | ArgIdent Ident+                  deriving (Show, Eq)++-- Values+data Const a = Const a ConstType Ident ConstValue deriving (Show, Eq)++data Default = DefaultValue ConstValue+             | DefaultString String+             deriving (Show, Eq)++data ConstValue = ConstBooleanLiteral Bool+                | ConstFloatLiteral Double+                | ConstInteger Integer+                | ConstNull+                deriving (Show, Eq)+++-- Qualifers+data Qualifier = QuaStatic+               | QSpecials [Special]+               deriving (Show, Eq)++data Special = Getter +             | Setter +             | Ccreator +             | Deleter +             | Legacycaller+             deriving (Show, Eq)++data ArgumentNameKeyword = ArgAttribute    | ArgCallback    | ArgConst        | ArgCreator+                         | ArgDeleter      | ArgDictionary  | ArgEnum         | ArgException+                         | ArgGetter       | ArgImplements  | ArgInherit      | ArgInterface+                         | ArgLegacycaller | ArgPartial     | ArgSetter       | ArgStatic+                         | ArgStringifier  | ArgTypedef     | ArgUnrestricted+                         deriving (Show, Eq)++-- Types+data Type = TySingleType SingleType | TyUnionType UnionType TypeSuffix deriving (Show, Eq)++data SingleType = STyNonAny NonAnyType+                | STyAny TypeSuffix+                deriving (Show, Eq)++data NonAnyType = TyPrim PrimitiveType TypeSuffix+                | TyDOMString TypeSuffix+                | TyIdent Ident TypeSuffix+                | TySequence Type (Maybe Null)+                | TyObject TypeSuffix+                | TyDate TypeSuffix+                deriving (Show, Eq)+++data PrimitiveType = PrimIntegerType IntegerType+                   | PrimFloatType FloatType+                   | Boolean+                   | Byte+                   | Octet+                   deriving (Show, Eq)++data IntegerType = IntegerType (Maybe Unsigned) IntegerWidth deriving (Show, Eq)++data IntegerWidth = Short | Long Int deriving (Show, Eq)++data TypeSuffix = TypeSuffixArray+                | TypeSuffixNullable+                | TypeSuffixNone+                deriving (Show, Eq)++data FloatType = TyFloat (Maybe Unrestricted)+               | TyDouble (Maybe Unrestricted)+               deriving (Show, Eq)++type UnionType = [UnionMemberType]++data UnionMemberType = UnionTy UnionType TypeSuffix +                     | UnionTyNonAny NonAnyType+                     | UnionTyAny TypeSuffix+                     deriving (Show, Eq)++data ReturnType = RetType Type+                | RetVoid+                deriving (Show, Eq)+++data ConstType = ConstPrim PrimitiveType (Maybe Null)+               | ConstIdent Ident (Maybe Null)+               deriving (Show, Eq)++-- Markers++data Ellipsis = Ellipsis deriving (Show, Eq)+data ReadOnly = ReadOnly deriving (Show, Eq)+data Inherit = Inherit deriving (Show, Eq)+data Unrestricted = Unrestricted deriving (Show, Eq)+data Null = Null deriving (Show, Eq)+data Unsigned = Unsigned deriving (Show, Eq)++-- Ident+newtype Ident = Ident String deriving (Show, Eq)

@@ -0,0 +1,207 @@+module Language.WebIDL.PPrint where++import Language.WebIDL.AST+import Prelude hiding (Enum)+import Text.PrettyPrint.Leijen++printDef :: Definition a -> String+printDef = show . pretty++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 <+> scope 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 <+> scope members <> semi++instance Pretty (Partial a) where+    pretty (PartialInterface _ x members) =+        text "interface" <+> pretty x <+> scope members <> semi+    pretty (PartialDictionary _ x members) =+        text "dictionary" <+> pretty x <+> braces (vsep $ map pretty members) <> semi++instance Pretty (Enum a) where+    pretty (Enum _ x enums) = text "enum" <+> pretty x <+> scope enums <> semi++instance Pretty (Dictionary a) where+    pretty (Dictionary _ x mInherit members) =+        text "dictionary" <+> pretty x <+> prettyInherit mInherit+                          <+> scope members <> semi++scope members = braces (line <> vsep (map (indent 4 . pretty) members) <> line)++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) = text "sequence" <> angles (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 "?"++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)  = prettyMaybe mUnres (\e -> pretty e <> space) <> text "float"+    pretty (TyDouble mUnres) = prettyMaybe mUnres (\e -> pretty e <> space) <> text "double"++instance Pretty Unrestricted where+    pretty Unrestricted = text "unrestricted"++instance Pretty IntegerType where+    pretty (IntegerType mUns width) = prettyMaybe mUns pretty <> pretty width++instance Pretty IntegerWidth where+    pretty Short = text "short"+    pretty (Long i) = hsep $ 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)+                  <> parens (hcat (punctuate (comma <> space) (map pretty args))) <> semi+++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) = hsep $ map pretty 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+                               <> text "attribute" <+> pretty t <+> pretty i <> semi++instance Pretty ReadOnly where+    pretty ReadOnly = text "readonly" <> space++instance Pretty Inherit where+    pretty Inherit = text "inherit" <> space++instance Pretty (Const a) where+    pretty (Const _ t i v) = text "const" <+> 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

@@ -0,0 +1,287 @@+module Language.WebIDL.Parser where++import Language.WebIDL.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 Eq Tagging where+  (==) _ _ = True++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+

@@ -1,200 +0,0 @@-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

@@ -1,284 +0,0 @@-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-