module Syntax 
( module Syntax
) 
where

import Text.Parsec.Language
import Text.Parsec.Token
import Text.Parsec.Combinator
import Text.Parsec

import qualified JavaClass as JavaClass
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

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

javaPathParser = m_identifier `sepBy1` (string ".")

semicolon = (m_lexeme . char $ ';') <?> "semicolon"

m_reserved' s = m_reserved s <?> s

typeIdentifier = m_identifier

packageParser = do
        _ <- m_reserved' "package"
        name <- m_lexeme javaPathParser <?> "package path"
        _ <- semicolon
        return (List.intercalate "." name)

importParser = do
        _ <- m_reserved' "import"
        name <- m_lexeme javaPathParser <?> "import class path"
        _ <- semicolon
        return (List.intercalate "." name)

fileLevelClassAccess = do
        maybeAccess <- optionMaybe $ m_reserved' "public" *> return JavaClassAccess.Public
        return (Maybe.fromMaybe JavaClassAccess.PackagePrivate maybeAccess)

fileLevelClassModifier = optionMaybe $ choice [ m_reserved' "final" *> return JavaClassModifier.Final
                                        , m_reserved' "sealed" *> return JavaClassModifier.Sealed
                                        , m_reserved' "non-sealed" *> return JavaClassModifier.NonSealed 
                                        ]

interfaceType = classType

typeArgument = choice [ 
          wildCardType  >>= return . ClassTypeParameter.WildCardTypeArgument 
        , referenceType >>= return . ClassTypeParameter.ReferenceTypeArgument
        ]

wildCardType = do
        _ <- m_symbol "?"
        bound <- optionMaybe wildCardBound
        return (ClassTypeParameter.WildCard bound)

wildCardBound = choice [ wildCardSuperBound , wildCardExtendsBound ]

wildCardSuperBound = do
        _ <- m_reserved "super"
        referenceType >>= return . ClassTypeParameter.SuperWildCardBound

wildCardExtendsBound = do
        _ <- m_reserved "extends"
        referenceType >>= return . ClassTypeParameter.ExtendsWildCardBound

-- TODO: Fix infinite recursion with typeArgument
referenceType = choice [
          typeIdentifier >>= return . ClassTypeParameter.VariableReferenceType
        , classType      >>= return . ClassTypeParameter.ClassReferenceType
        , arrayType      >>= return . ClassTypeParameter.ArrayReferenceType
        ]

arrayType = do 
        partialConstructor <- choice [ primitiveType >>= return . ClassTypeParameter.PrimitiveArrayType
                , classType >>= return . ClassTypeParameter.ClassArrayType
                , typeIdentifier >>= return . ClassTypeParameter.VariableArrayType
                ]
        arrayDepth <- m_lexeme $ (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)
        let typeArguments = Maybe.fromMaybe [] maybeTypeArguments
        return (ClassTypeParameter.NonRecursiveTypeBound qualifiedType typeArguments)

unqualifiedClassType = do
        unqualifiedType <- typeIdentifier
        maybeTypeArguments <- optionMaybe $ m_angles (m_commaSep1 typeArgument)
        let typeArguments = Maybe.fromMaybe [] maybeTypeArguments
        return (ClassTypeParameter.NonRecursiveTypeBound unqualifiedType typeArguments)

-- TODO: Review this, i cancelled the left-recursive rule
recursiveClassType = do
        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
        , unqualifiedClassType
        , recursiveClassType
        ]

classTypeParameterClassOrInterfaceBound = do
        classType_ <- classType
        interfaces <- m_commaSep interfaceType
        return (ClassTypeParameter.ClassTypeBound classType_ interfaces)

classTypeParameterBound = do
        _ <- m_reserved' "extends"
        bound <- choice [ 
                  try classTypeParameterClassOrInterfaceBound
                , typeIdentifier >>= return . ClassTypeParameter.SimpleTypeBound
                ]
        return bound

classTypeParameter = do
        name <- typeIdentifier
        typeBound <- optionMaybe classTypeParameterBound
        -- TODO: Interfaces
        return (ClassTypeParameter.ClassTypeParameter name typeBound [])

classTypeParameters = optionMaybe $ m_angles $ ((classTypeParameter <?> "class type parameter") `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
        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)

fileLevelParser = do
        package <- packageParser
        imports <- many importParser
        classes <- many (choice [fileLevelClass])
        return (JavaFile.JavaFile package imports classes)