javahc.cabal

@@ -22,15 +22,9 @@ library
       ClassTypeParameter
       JavaClass
       JavaClassAccess
-      JavaClassField
-      JavaClassFieldVisibility
       JavaClassModifier
-      JavaExpression
       JavaFile
-      JavaLanguage
-      JavaVariableInitializer
       Lib
-      LiteralExpression
       PrimitiveTypes
       Syntax
   other-modules:

src/Annotation.hs

@@ -1,8 +0,0 @@
-module Annotation (Annotation(..) )
-where
-
-import JavaExpression (JavaExpression)
-
-import Data.Map (Map)
-
-data Annotation = Normal String (Map String JavaExpression)

src/ClassLiteral.hs

@@ -1,31 +0,0 @@
-module ClassLiteral (ClassLiteral(..), parseClassLiteral ) where
-
-import qualified Data.List as List
-import Numeric.Natural (Natural)
-
-import PrimitiveTypes (PrimitiveType, primitiveType)
-import JavaLanguage (m_reserved, m_lexeme, m_identifier)
-
-import Text.Parsec (choice, string', many, sepBy, char, manyTill, lookAhead)
-import Text.Parsec.String (Parser)
-
-data ClassLiteral = Void 
-        | Primitive PrimitiveType Natural -- type, array dimension
-        | Type String Natural -- type, array dimension
-        deriving Show
-
-parseClassLiteral :: Parser ClassLiteral
-parseClassLiteral = choice 
-        [ m_reserved "void" *>  return Void
-        , primitiveType     >>= parseArrayDims . Primitive
-        , typeName          >>= parseArrayDims . Type
-        ] <* string' ".class"
-
-typeName :: Parser String
-typeName = do
-        start <- m_identifier
-        paths <- manyTill (char '.' *> m_identifier) (choice [ lookAhead $ string' ".class" , lookAhead $ string' "[]" ])
-        return . List.intercalate "." $ (start:paths)
-
-parseArrayDims :: (Natural -> ClassLiteral) -> Parser ClassLiteral
-parseArrayDims f = m_lexeme $ many (string' "[]") >>= return . f . fromInteger . toInteger . List.length

src/JavaClass.hs

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

src/JavaClassField.hs

@@ -1,28 +0,0 @@
-module JavaClassField (module JavaClassField) where
-
-import JavaClassFieldVisibility (JavaClassFieldVisibility)
-import PrimitiveTypes (PrimitiveType)
-import ClassTypeParameter (ClassType, ArrayType)
-import JavaVariableInitializer (JavaVariableInitializer)
-
-import Data.Set (Set)
-
-data JavaClassField = JavaClassField { name :: String
-        , visiblity   :: JavaClassFieldVisibility
-        , modifiers   :: Set JavaClassFieldModifier
-        , type_       :: JavaClassFieldType
-        , initializer :: Maybe JavaVariableInitializer
-        }
-        deriving Show
-
-data JavaClassFieldModifier = Static 
-        | Final 
-        | Transient 
-        | Volatile
-        deriving (Show, Ord, Eq)
-
-data JavaClassFieldType = PrimitiveFieldType PrimitiveType 
-        | ClassFieldType ClassType 
-        | VariableFieldType String 
-        | ArrayFieldType ArrayType
-        deriving Show

src/JavaClassFieldVisibility.hs

@@ -1,4 +0,0 @@
-module JavaClassFieldVisibility (JavaClassFieldVisibility(..) ) where
-
-data JavaClassFieldVisibility = Public | Protected | Private | Package
-        deriving Show

src/JavaLanguage.hs

@@ -1,65 +0,0 @@
-module JavaLanguage 
-( javaLanguageDef
-, m_paren
-, m_identifier
-, m_reserved
-, m_lexeme
-, m_symbol
-, m_commaSep1
-, m_commaSep
-, m_angles
-, m_braces
-, m_reservedOp
-) where
-
-import Text.Parsec
-import Text.Parsec.Language
-import Text.Parsec.Token
-
-import Data.Functor.Identity
-
-javaLanguageDef :: GenLanguageDef String u Identity
-javaLanguageDef = emptyDef{ commentStart = "/*"
-              , commentEnd = "*/"
-              , commentLine = "//"
-              , nestedComments = False
-              , identStart = letter <|> char '_'
-              , identLetter = alphaNum <|> char '_'
-              , opStart = oneOf ".+-*/;"
-              , opLetter = oneOf ".+-*/;"
-              , reservedOpNames = [";"]
-              , reservedNames = [ "true"
-                , "false"
-                , "package"
-                , "class"
-                , "interface"
-                , "void"
-                , "boolean"
-                , "char"
-                , "short"
-                , "int"
-                , "float"
-                , "long"
-                , "double"
-                , "instanceof"
-                , "public"
-                , "private"
-                , "protected"
-                , "static"
-                , "final"
-                , "volatile"
-                , "transient"
-                ]
-              , caseSensitive = True
-              }
-
-TokenParser{ parens = m_paren
-        , identifier = m_identifier 
-        , reserved   = m_reserved
-        , lexeme     = m_lexeme
-        , symbol     = m_symbol
-        , commaSep1  = m_commaSep1
-        , commaSep   = m_commaSep
-        , angles     = m_angles
-        , braces     = m_braces
-        , reservedOp = m_reservedOp } = makeTokenParser javaLanguageDef

src/JavaVariableInitializer.hs

@@ -1,7 +0,0 @@
-module JavaVariableInitializer (JavaVariableInitializer(..) ) where
-
-import JavaExpression (JavaExpression)
-
-data JavaVariableInitializer = ArrayVariableInitializer [JavaVariableInitializer] 
-        | ExpressionVariableInitializer JavaExpression
-        deriving Show

src/LiteralExpression.hs

@@ -1,140 +0,0 @@
-module LiteralExpression (LiteralExpression(..))
-where
-
-import Data.Ratio ((%))
-import Data.Int (Int16)
-import qualified Data.Char as Char
-
-import JavaLanguage (m_lexeme, m_reserved)
-
-import Text.Parsec (many1, digit, oneOf, option, char, choice, many, try, satisfy, manyTill, string', endOfLine, space)
-import Text.Parsec.String (Parser)
-
-data LiteralExpression = NullLiteral
-        | IntegerLiteral   Integer  IntegerLiteralType
-        | FloatingLiteral  Rational DecimalLiteralType
-        | BooleanLiteral   Bool
-        | CharacterLiteral Char
-        | StringLiteral    String
-        | TextLiteral      String
-        deriving Show
-
-data IntegerLiteralType = IntLiteral    | LongLiteral
-        deriving Show
-data DecimalLiteralType = DoubleLiteral | FloatLiteral
-        deriving Show
-
-signedInteger :: Parser Integer
-signedInteger = do
-        signFactor <- option 1 (char '-' *> return (-1))
-        digits     <- many1 digit
-        return (signFactor * read digits)
-
-parseNullLiteral :: Parser LiteralExpression
-parseNullLiteral = m_reserved "null" *> return NullLiteral
-
--- TODO: Hex, Oct, Bin
-parseDecimalIntegerLiteral :: Parser LiteralExpression
-parseDecimalIntegerLiteral = m_lexeme $ do
-        negative    <- option False (char '-' *> return True)
-        digitString <- many1 digit
-        literalType <- option IntLiteral (oneOf "Ll" *> return LongLiteral)
-        let positiveNumber = read digitString :: Integer
-        let number = (if (negative) then negate else id) positiveNumber
-        return (IntegerLiteral number literalType)
-
--- TODO: Hex
-parseDecimalFloatingLiteral :: Parser LiteralExpression
-parseDecimalFloatingLiteral = do
-        prefix      <- option "0" $ many1 digit
-        _           <- option '.' (char '.')
-        suffix      <- many digit
-        exponent    <- option 0 (char 'e' *> signedInteger)
-        literalType <- option FloatLiteral $ choice [ 
-                  oneOf "fF" *> return FloatLiteral
-                , oneOf "dD" *> return DoubleLiteral
-                ]
-        let suffixLength = length suffix
-        let prefixPower  = 10 ^ suffixLength :: Integer
-        let iprefix = read prefix :: Integer
-        let isuffix = if (suffixLength == 0) then 0 else read suffix :: Integer
-        let exponentPower = (if exponent > 0 then 10 ^ exponent else 1) % (if exponent < 0 then 10^(-exponent) else 1)
-        let rational = ((iprefix * prefixPower + isuffix) % prefixPower) * exponentPower
-        return (FloatingLiteral rational literalType)
-
-
-parseBooleanLiteral :: Parser LiteralExpression
-parseBooleanLiteral = choice 
-        [ m_reserved "true"  *> return (BooleanLiteral True)
-        , m_reserved "false" *> return (BooleanLiteral False)
-        ]
-
-parseCharLiteral :: Parser LiteralExpression
-parseCharLiteral = (char '\'' *> choice [
-          parseEscapedChar
-        , satisfy (not . flip elem "'\\")
-        ] <* char '\'') >>= return . CharacterLiteral
-
--- TODO: Support double line terminator
-parseEscapedChar :: Parser Char
-parseEscapedChar = char '\\' *> choice [
-          char 'b' *> return '\b'
-        , char 's' *> return ' '
-        , char 't' *> return '\t'
-        , char 'n' *> return '\n'
-        , char 'f' *> return '\f'
-        , char 'r' *> return '\r'
-        , char '"' *> return '"'
-        , char '\'' *> return '\''
-        , char '\\' *> return '\\'
-        , parseOctalEscapedChar
-        ]
-
-parseOctalEscapedChar :: Parser Char
-parseOctalEscapedChar = choice [
-          try $ tripleOctalEscapedChar
-        , try $ doubleOctalEscapedChar
-        ,       singleOctalEscapedChar
-        ]
-
-singleOctalEscapedChar :: Parser Char
-singleOctalEscapedChar = do
-        char1 <- oneOf "01234567"
-        let num1 = read [char1] :: Int
-        return . Char.chr $ num1
-
-doubleOctalEscapedChar :: Parser Char
-doubleOctalEscapedChar = do
-        char1 <- oneOf "01234567"
-        char2 <- oneOf "01234567"
-        let num1 = read [char1] :: Int
-        let num2 = read [char2] :: Int
-        let num = num2 + num1 * 8
-        return . Char.chr $ num
-
-tripleOctalEscapedChar :: Parser Char
-tripleOctalEscapedChar = do
-        char1 <- oneOf "0123"
-        char2 <- oneOf "01234567"
-        char3 <- oneOf "01234567"
-        let num1 = read [char1] :: Int
-        let num2 = read [char2] :: Int
-        let num3 = read [char3] :: Int
-        let num = num3 + num2 * 8 + num1 * 64
-        return . Char.chr $ num
-
-parseStringLiteral :: Parser LiteralExpression
-parseStringLiteral = do
-        _ <- char '"'
-        content <- manyTill (choice
-                [ parseEscapedChar
-                , satisfy (not . flip elem "\r\n\"\\")
-                ]) (char '"')
-        return (StringLiteral content)
-
-parseTextLiteral :: Parser LiteralExpression
-parseTextLiteral = do
-        _ <- string' "\"\"\""
-        _ <- space `manyTill` endOfLine
-        content <- (choice [ parseEscapedChar , satisfy (not . flip elem "\\") ] ) `manyTill` (string' "\"\"\"")
-        return . TextLiteral $ content

src/PrimaryExpression.hs

@@ -1,26 +0,0 @@
-module PrimaryExpression (PrimaryExpression(..) ) where
-
-import qualified Data.List as List
-
-import ClassLiteral (ClassLiteral)
-import JavaLanguage (m_identifier)
-import LiteralExpression (LiteralExpression)
-
-import Text.Parsec (manyTill, char, string')
-import Text.Parsec.String (Parser)
-
-data PrimaryExpression = Literal LiteralExpression
-        | ClassLiteral ClassLiteral
-        | This
-        | TypedThis String
-        | InstanceCreation
-        deriving Show
-
-parseThis :: Parser PrimaryExpression
-parseThis = string' "this" *> return This
-
-parseTypedThis :: Parser PrimaryExpression
-parseTypedThis = do
-        start <- m_identifier
-        paths <- manyTill (char '.' *> m_identifier) (string' ".this")
-        return . TypedThis . List.intercalate "." $ (start:paths)

src/PrimitiveTypes.hs

@@ -1,25 +1,7 @@
-module PrimitiveTypes 
-        ( PrimitiveType(..)
-        , primitiveType
+module PrimitiveTypes (
+        module PrimitiveTypes
+        , PrimitiveType 
         ) where
 
-import JavaLanguage (m_reserved)
-
-import Text.Parsec (choice)
-import Text.Parsec.String (Parser)
-
 data PrimitiveType = PrimitiveBoolean | PrimitiveByte | PrimitiveShort | PrimitiveInt | PrimitiveLong | PrimitiveChar | PrimitiveFloat | PrimitiveDouble
         deriving Show
-
-primitiveType :: Parser PrimitiveType
-primitiveType = choice [ 
-          m_reserved "boolean" *> return PrimitiveTypes.PrimitiveBoolean
-        , m_reserved "byte"    *> return PrimitiveTypes.PrimitiveByte
-        , m_reserved "char"    *> return PrimitiveTypes.PrimitiveChar
-        , m_reserved "short"   *> return PrimitiveTypes.PrimitiveShort
-        , m_reserved "int"     *> return PrimitiveTypes.PrimitiveInt
-        , m_reserved "float"   *> return PrimitiveTypes.PrimitiveFloat
-        , m_reserved "long"    *> return PrimitiveTypes.PrimitiveLong
-        , m_reserved "double"  *> return PrimitiveTypes.PrimitiveDouble
-        ]
-

src/Syntax.hs

@@ -13,17 +13,58 @@ 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 JavaLanguage
 
+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
 
+javaLanguageDef :: GenLanguageDef String u Identity
+javaLanguageDef = emptyDef{ commentStart = "/*"
+              , commentEnd = "*/"
+              , commentLine = "//"
+              , nestedComments = False
+              , identStart = letter <|> char '_'
+              , identLetter = alphaNum <|> char '_'
+              , opStart = oneOf ".+-*/;"
+              , opLetter = oneOf ".+-*/;"
+              , reservedOpNames = [";"]
+              , reservedNames = [ "true"
+                , "false"
+                , "package"
+                , "class"
+                , "interface"
+                , "void"
+                , "boolean"
+                , "char"
+                , "short"
+                , "int"
+                , "float"
+                , "long"
+                , "double"
+                , "instanceof"
+                , "public"
+                , "private"
+                , "protected"
+                , "static"
+                , "final"
+                , "volatile"
+                , "transient"
+                ]
+              , caseSensitive = True
+              }
+
+TokenParser{ parens = m_paren
+        , identifier = m_identifier 
+        , reserved   = m_reserved
+        , lexeme     = m_lexeme
+        , symbol     = m_symbol
+        , commaSep1  = m_commaSep1
+        , angles     = m_angles
+        , reservedOp = m_reservedOp } = makeTokenParser javaLanguageDef
+
 javaPathParser = m_identifier `sepBy1` (string ".")
 
 semicolon = (m_lexeme . char $ ';') <?> "semicolon"
@@ -87,9 +128,20 @@ arrayType = do
                 , classType >>= return . ClassTypeParameter.ClassArrayType
                 , typeIdentifier >>= return . ClassTypeParameter.VariableArrayType
                 ]
-        arrayDepth <- m_lexeme $ (many1 $ string "[]") >>= return . List.length
+        arrayDepth <- (many1 $ string "[]") >>= return . List.length
         return (partialConstructor (fromInteger . toInteger $ arrayDepth))
 
+primitiveType = choice [ 
+          m_reserved "boolean" *> return PrimitiveTypes.PrimitiveBoolean
+        , m_reserved "byte"    *> return PrimitiveTypes.PrimitiveByte
+        , m_reserved "char"    *> return PrimitiveTypes.PrimitiveChar
+        , m_reserved "short"   *> return PrimitiveTypes.PrimitiveShort
+        , m_reserved "int"     *> return PrimitiveTypes.PrimitiveInt
+        , m_reserved "float"   *> return PrimitiveTypes.PrimitiveFloat
+        , m_reserved "long"    *> return PrimitiveTypes.PrimitiveLong
+        , m_reserved "double"  *> return PrimitiveTypes.PrimitiveDouble
+        ]
+
 qualifiedClassType = do
         qualifiedType <- typeIdentifier `sepBy1` (string' ".") >>= return . List.intercalate "."
         maybeTypeArguments <- optionMaybe $ m_angles (m_commaSep1 typeArgument)
@@ -102,13 +154,12 @@ 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
@@ -118,14 +169,13 @@ classType = choice [ qualifiedClassType
 
 classTypeParameterClassOrInterfaceBound = do
         classType_ <- classType
-        interfaces <- m_commaSep interfaceType
+        interfaces <- m_commaSep1 interfaceType
         return (ClassTypeParameter.ClassTypeBound classType_ interfaces)
 
 classTypeParameterBound = do
         _ <- m_reserved' "extends"
-        bound <- choice [ 
-                  try classTypeParameterClassOrInterfaceBound
-                , typeIdentifier >>= return . ClassTypeParameter.SimpleTypeBound
+        bound <- choice [ typeIdentifier >>= return . ClassTypeParameter.SimpleTypeBound
+                , classTypeParameterClassOrInterfaceBound
                 ]
         return bound
 
@@ -135,86 +185,17 @@ classTypeParameter = do
         -- TODO: Interfaces
         return (ClassTypeParameter.ClassTypeParameter name typeBound [])
 
-classTypeParameters = optionMaybe $ m_angles $ ((classTypeParameter <?> "class type parameter") `sepBy1` (m_symbol ","))
+classTypeParameters = optionMaybe $ m_angles $ (classTypeParameter `sepBy1` (m_symbol ","))
 
-classPermits = do
-        _ <- m_reserved "permits"
-        m_commaSep typeName
-
-typeName = choice [
-          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
+fileLevelClass= do
+        accessModifier <- fileLevelClassAccess
+        _ <- m_reserved' "class"
+        className <- m_identifier <?> "class name"
+        let isStatic = False
+        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
-        let implements     = Maybe.fromMaybe [] maybeImplements
-        return (JavaClass.JavaClass className accessModifier maybeModifier isStatic typeParameters maybeExtends implements permits)
+        return (JavaClass.JavaClass className accessModifier maybeModifier isStatic typeParameters)
 
 fileLevelParser = do
         package <- packageParser