you can now parse <K extends Comparable<K>>

javahc.cabal

@@ -22,8 +22,12 @@ library
       ClassTypeParameter
       JavaClass
       JavaClassAccess
+      JavaClassField
+      JavaClassFieldVisibility
       JavaClassModifier
+      JavaExpression
       JavaFile
+      JavaVariableInitializer
       Lib
       PrimitiveTypes
       Syntax

src/JavaClass.hs

@@ -14,5 +14,7 @@ data JavaClass = JavaClass { name       :: String
         , isAbstract                    :: Bool
         , typeParameters                :: [ClassTypeParameter]
         , extends                       :: Maybe ClassType
+        , implements                    :: [ClassType]
+        , permits                       :: [String]
         }
         deriving Show

src/PrimitiveTypes.hs

@@ -1,6 +1,5 @@
 module PrimitiveTypes (
-        module PrimitiveTypes
+        PrimitiveType(..)
-        , PrimitiveType 
         ) where
 
 data PrimitiveType = PrimitiveBoolean | PrimitiveByte | PrimitiveShort | PrimitiveInt | PrimitiveLong | PrimitiveChar | PrimitiveFloat | PrimitiveDouble

src/Syntax.hs

@@ -13,11 +13,14 @@ import qualified JavaClassAccess as JavaClassAccess
 import qualified JavaClassModifier as JavaClassModifier
 import qualified JavaFile as JavaFile
 import qualified ClassTypeParameter as ClassTypeParameter
+import qualified JavaClassFieldVisibility as JavaClassFieldVisibility
+import qualified JavaClassField as JavaClassField
 import PrimitiveTypes
 
 import Data.Functor.Identity
 import qualified Data.List as List
 import qualified Data.Maybe as Maybe
+import qualified Data.Set as Set
 
 import Numeric.Natural
 
@@ -62,7 +65,9 @@ TokenParser{ parens = m_paren
         , lexeme     = m_lexeme
         , symbol     = m_symbol
         , commaSep1  = m_commaSep1
+        , commaSep   = m_commaSep
         , angles     = m_angles
+        , braces     = m_braces
         , reservedOp = m_reservedOp } = makeTokenParser javaLanguageDef
 
 javaPathParser = m_identifier `sepBy1` (string ".")
@@ -128,7 +133,7 @@ arrayType = do
                 , classType >>= return . ClassTypeParameter.ClassArrayType
                 , typeIdentifier >>= return . ClassTypeParameter.VariableArrayType
                 ]
-        arrayDepth <- (many1 $ string "[]") >>= return . List.length
+        arrayDepth <- m_lexeme $ (many1 $ string "[]") >>= return . List.length
         return (partialConstructor (fromInteger . toInteger $ arrayDepth))
 
 primitiveType = choice [ 
@@ -154,12 +159,13 @@ unqualifiedClassType = do
         let typeArguments = Maybe.fromMaybe [] maybeTypeArguments
         return (ClassTypeParameter.NonRecursiveTypeBound unqualifiedType typeArguments)
 
+-- TODO: Review this, i cancelled the left-recursive rule
 recursiveClassType = do
-        classType_ <- classType
-        _ <- char '.'
         unqualifiedType <- typeIdentifier
         maybeTypeArguments <- optionMaybe $ m_angles (m_commaSep1 typeArgument)
         let typeArguments = Maybe.fromMaybe [] maybeTypeArguments
+        _ <- char '.'
+        classType_ <- classType
         return (ClassTypeParameter.RecursiveTypeBound classType_ unqualifiedType typeArguments)
 
 classType = choice [ qualifiedClassType
@@ -169,13 +175,14 @@ classType = choice [ qualifiedClassType
 
 classTypeParameterClassOrInterfaceBound = do
         classType_ <- classType
-        interfaces <- m_commaSep1 interfaceType
+        interfaces <- m_commaSep interfaceType
         return (ClassTypeParameter.ClassTypeBound classType_ interfaces)
 
 classTypeParameterBound = do
         _ <- m_reserved' "extends"
-        bound <- choice [ typeIdentifier >>= return . ClassTypeParameter.SimpleTypeBound
+        bound <- choice [ 
-                , classTypeParameterClassOrInterfaceBound
+                  try classTypeParameterClassOrInterfaceBound
+                , typeIdentifier >>= return . ClassTypeParameter.SimpleTypeBound
                 ]
         return bound
 
@@ -185,17 +192,86 @@ classTypeParameter = do
         -- TODO: Interfaces
         return (ClassTypeParameter.ClassTypeParameter name typeBound [])
 
-classTypeParameters = optionMaybe $ m_angles $ (classTypeParameter `sepBy1` (m_symbol ","))
+classTypeParameters = optionMaybe $ m_angles $ ((classTypeParameter <?> "class type parameter") `sepBy1` (m_symbol ","))
 
-fileLevelClass= do
+classPermits = do
-        accessModifier <- fileLevelClassAccess
+        _ <- m_reserved "permits"
-        _ <- m_reserved' "class"
+        m_commaSep typeName
-        className <- m_identifier <?> "class name"
+
-        let isStatic = False
+typeName = choice [
-        maybeModifier <- fileLevelClassModifier
+          qualifiedTypeIdentifier
+        , typeIdentifier
+        ]
+
+qualifiedTypeIdentifier = do
+        packagePath <- many (try $ m_identifier <* char '.')
+        typeName_ <- typeIdentifier
+        return . List.intercalate "." $ packagePath ++ [typeName_]
+
+--classBody = many $ choice [
+--          classMemberDeclaration
+--        , classInstanceInitializer
+--        , classStaticInitializer
+--        , classConstructorDeclaration
+--        ]
+--  
+--classMemberDeclaration = choice [
+ --         classFieldDeclaration
+ --       , classMethodDeclaration
+ --       , classClassDeclaration
+ --       , classInterfaceDeclaration
+ --       ]
+ --
+
+-- TODO: Support multiple declarations
+classFieldDeclaration = do
+        visibility <- optionMaybe classFieldVisibility >>= return . Maybe.fromMaybe JavaClassFieldVisibility.Package
+        modifiers  <- many $ classFieldModifier
+        fieldType  <- classFieldType
+        let modifierSet = Set.fromList modifiers
+        -- TODO: throw errors for duplicates
+        -- TODO: Support declarator lists
+        fieldName  <- m_identifier
+ --       maybeInitializer <- optionMaybe $ m_reservedOp "=" *> variableInitializer
+        return $ JavaClassField.JavaClassField fieldName visibility modifierSet fieldType
+
+--variableInitializer = choice 
+--        [ 
+
+classFieldType = choice
+        [ arrayType      >>= return . JavaClassField.ArrayFieldType
+        , primitiveType  >>= return . JavaClassField.PrimitiveFieldType
+        , classType      >>= return . JavaClassField.ClassFieldType
+        , typeIdentifier >>= return . JavaClassField.VariableFieldType
+        ]
+
+classFieldModifier = choice [
+          m_reserved "final"     *> return JavaClassField.Final
+        , m_reserved "static"    *> return JavaClassField.Static
+        , m_reserved "volatile"  *> return JavaClassField.Volatile
+        , m_reserved "transient" *> return JavaClassField.Transient
+        ]
+
+classFieldVisibility = choice [
+          m_reserved "public"    *> return JavaClassFieldVisibility.Public
+        , m_reserved "private"   *> return JavaClassFieldVisibility.Private
+        , m_reserved "protected" *> return JavaClassFieldVisibility.Protected
+        ]
+
+fileLevelClass = do
+        accessModifier      <- fileLevelClassAccess
+        _                   <- m_reserved' "class"
+        className           <- m_identifier <?> "class name"
+        maybeModifier       <- fileLevelClassModifier
         maybeTypeParameters <- classTypeParameters
+        maybeExtends        <- optionMaybe (m_reserved "extends" *> classType)
+        maybeImplements     <- optionMaybe (m_reserved "implements" *> m_commaSep interfaceType)
+        permits             <- optionMaybe classPermits >>= return . Maybe.fromMaybe []
+        --body                <- m_braces classBody
+        let isStatic       = False
         let typeParameters = Maybe.fromMaybe [] maybeTypeParameters
-        return (JavaClass.JavaClass className accessModifier maybeModifier isStatic typeParameters)
+        let implements     = Maybe.fromMaybe [] maybeImplements
+        return (JavaClass.JavaClass className accessModifier maybeModifier isStatic typeParameters maybeExtends implements permits)
 
 fileLevelParser = do
         package <- packageParser