module Language.CSharp.Parser.Expression where

import Text.Parsec                    hiding (Empty, sourceName)
import Language.CSharp.Lexer
import Language.CSharp.Syntax
import Language.CSharp.Parser.Utility
import {-# SOURCE #-} Language.CSharp.Parser.Statement
import Language.CSharp.Parser.Type

pMaybeExpression :: P (Maybe Expression)
pMaybeExpression = optionMaybe pExpression

pExpression :: P Expression
pExpression = pExpressionP1

--Assignment operators: assignment.
pExpressionP1 :: P Expression
pExpressionP1 = pExpressionP2 `chainr1` pAssignment
    where
        pAssignment = do
            operator <- pAssignmentOperator
            return (\ target value -> Assign target operator value)

pAssignmentOperator :: P AssignmentOperator
pAssignmentOperator = choice 
    [ OpAssign                  <$ pToken TOpAssign
    , OpAssignPlus              <$ pToken TOpAssignPlus
    , OpAssignMinus             <$ pToken TOpAssignMinus
    , OpAssignMultiply          <$ pToken TOpAssignMultiply
    , OpAssignDivide            <$ pToken TOpAssignDivide
    , OpAssignModulo            <$ pToken TOpAssignModulo
    , OpAssignBitwiseAnd        <$ pToken TOpAssignBitwiseAnd       
    , OpAssignBitwiseOr         <$ pToken TOpAssignBitwiseOr        
    , OpAssignBitwiseXor        <$ pToken TOpAssignBitwiseXor       
    , OpAssignBitwiseLeftShift  <$ pToken TOpAssignBitwiseLeftShift 
    , OpAssignBitwiseRightShift <$ pToken TOpAssignBitwiseRightShift
    ]

-- Anonymous function expressions: lambda expression.
pExpressionP2 :: P Expression
pExpressionP2 = try pLambdaExpression <|> try pDelegateExpression <|> pExpressionP3

pLambdaExpression :: P Expression
pLambdaExpression = do
    sig <- pAnonymousFunctionSignature
    pLambda
    body <- pAnonymousFunctionBody
    return $ Lambda sig body

pDelegateExpression :: P Expression
pDelegateExpression = do
    pToken TKWdelegate
    sig  <- optionMaybe pExplicitFunctionSignature
    body <- betweenCurly pStatements
    return $ Delegate sig body

pAnonymousFunctionSignature :: P AnonymousFunctionSignature
pAnonymousFunctionSignature = choice
    [ try pExplicitFunctionSignature
    , betweenParens $ ImplicitAnonymousFunctionSignature <$> sepBy pIdentifier pComma
    , ImplicitAnonymousFunctionSignature . (:[]) <$> pIdentifier ]

pExplicitFunctionSignature :: P AnonymousFunctionSignature
pExplicitFunctionSignature = betweenParens $ 
    ExplicitAnonymousFunctionSignature <$> sepBy pAnonymousFunctionParameter pComma

pAnonymousFunctionParameter :: P AnonymousFunctionParameter
pAnonymousFunctionParameter = do
    modifier <- optionMaybe (RefParam <$ pToken TKWref <|> OutParam <$ pToken TKWout)
    ty       <- pType
    name     <- pIdentifier
    return $ ExplicitAnonymousFunctionParameter modifier ty name

pAnonymousFunctionBody :: P AnonymousFunctionBody
pAnonymousFunctionBody = choice
    [ AnonymousFunctionExpressionBody <$> pExpressionP1
    , AnonymousFunctionStatementBody  <$> betweenCurly pStatements ]

-- Conditional operator: conditional.
pExpressionP3 :: P Expression
pExpressionP3 = try pConditional <|> pExpressionP4

pConditional :: P Expression
pConditional = do
    guard <- pExpressionP4
    pToken TQuestion
    exp1 <- pExpressionP4
    pColon
    exp2 <- pExpressionP3
    return $ Conditional guard exp1 exp2

-- Query expressions: query.
pExpressionP4 :: P Expression
pExpressionP4 = pExpressionP5

-- The null coalescing operator: Null coalescing.
pExpressionP5 :: P Expression
pExpressionP5 = pExpressionP6 `chainr1` pNullCoalescing
    where
        pNullCoalescing = BinaryOperator BinaryNullCoalescing <$ pToken TOpNullCoalescing

-- Conditional logical operators: boolean or.
pExpressionP6 :: P Expression
pExpressionP6 = pExpressionP7 `chainl1` pBooleanOr
    where
        pBooleanOr = BinaryOperator BinaryOr <$ pToken TOpOr

-- Conditional logical operators: boolean and.
pExpressionP7 :: P Expression
pExpressionP7 = pExpressionP8 `chainl1` pBooleanAnd
    where
        pBooleanAnd = BinaryOperator BinaryAnd <$ pToken TOpAnd

-- Logical operators: bitwise or.
pExpressionP8 :: P Expression
pExpressionP8 = pExpressionP9 `chainl1` pBitwiseOr
    where
        pBitwiseOr = BinaryOperator BinaryBitwiseOr <$ pToken TOpBitwiseOr

-- Logical operators: bitwise xor.
pExpressionP9 :: P Expression
pExpressionP9 = pExpressionP10 `chainl1` pBitwiseXor
    where
        pBitwiseXor = BinaryOperator BinaryBitwiseXor <$ pToken TOpBitwiseXor

-- Logical operators: bitwise and.
pExpressionP10 :: P Expression
pExpressionP10 = pExpressionP11 `chainl1` pBitwiseAnd
    where
        pBitwiseAnd = BinaryOperator BinaryBitwiseAnd <$ pToken TOpBitwiseAnd

-- Relational and type-testing operators: equality.
pExpressionP11 :: P Expression
pExpressionP11 = pExpressionP12 `chainl1` pOperators
    where
        pOperators = choice 
            [ BinaryOperator BinaryEquals    <$ pToken TOpEqual
            , BinaryOperator BinaryNotEquals <$ pToken TOpNotEqual ]

-- Relational and type-testing operators: relational and type testing.
pExpressionP12 :: P Expression
pExpressionP12 = pExpressionP13 `chainl1` pOperators
    where
        pOperators = choice 
            [ BinaryOperator BinaryLessThan         <$ pToken TOpLessThan
            , BinaryOperator BinaryGreaterThan      <$ pToken TOpGreaterThan
            , BinaryOperator BinaryLessThanEqual    <$ pToken TOpLessThanEqual
            , BinaryOperator BinaryGreaterThanEqual <$ pToken TOpGreaterThanEqual
            , BinaryOperator BinaryIs               <$ pToken TKWis
            , BinaryOperator BinaryAs               <$ pToken TKWas ]

-- Shift operators: shift.
pExpressionP13 :: P Expression
pExpressionP13 = pExpressionP14 `chainl1` pOperators
    where
        pOperators = choice
            [ BinaryOperator BinaryShiftLeft  <$ pToken TOpLeftShift
            , BinaryOperator BinaryShiftRight <$ pToken TOpRightShift ]

-- Arithmetic operators: additive.
pExpressionP14 :: P Expression
pExpressionP14 = pExpressionP15 `chainl1` pOperators
    where
        pOperators = choice 
            [ BinaryOperator BinaryPlus  <$ pToken TOpPlus
            , BinaryOperator BinaryMinus <$ pToken TOpMinus ]

-- Arithmetic operators: multiplicative.
pExpressionP15 :: P Expression
pExpressionP15 = pExpressionP16 `chainl1`  pOperators
    where        
        pOperators = choice
            [ BinaryOperator BinaryMultiply <$ pToken TOpMultiply
            , BinaryOperator BinaryDivide   <$ pToken TOpDivide
            , BinaryOperator BinaryModulo   <$ pToken TOpModulo ]

-- Unary operators: unary.
pExpressionP16 :: P Expression
pExpressionP16 = choice
    [ UnaryAwait <$ pToken TOpAwait <*> pExpressionP16
    , pExpressionP17 `chainlUnary1` pOperators
    ]
    where
        pOperators = choice 
            [ UnaryPlus         <$  pToken TOpPlus      
            , UnaryMinus        <$  pToken TOpMinus     
            , UnaryNot          <$  pToken TOpNot       
            , UnaryBitwiseNot   <$  pToken TOpBitwiseNot
            , UnaryPreIncrement <$  pToken TOpPlusPlus  
            , UnaryPreDecrement <$  pToken TOpMinusMinus
            , try (UnaryCast    <$> betweenParens pType) ]

-- Primary expressions: primary, literals and parenthesized.
pExpressionP17 :: P Expression
pExpressionP17 = pTerm `chainPostfix` pPostfixOperator
    
pPostfixOperator :: P (Expression -> Expression)
pPostfixOperator = choice 
    [ UnaryPostIncrement <$  pToken TOpPlusPlus
    , UnaryPostDecrement <$  pToken TOpMinusMinus
    , flip ElementAccess <$> betweenSquare (sepBy1 pExpression pComma)
    , try pPrimaryMemberAccess
    , flip Invocation    <$> pArguments ]
    where
        pPrimaryMemberAccess = do 
            pPeriod
            name          <- pIdentifier
            typeArguments <- option [] pTypeArguments
            return (\ e -> MemberAccess (PrimaryMemberAccess e name typeArguments))

pTerm :: P Expression
pTerm = choice
    [      This         <$  pToken TKWthis
    ,      Base         <$  pToken TKWbase
    ,      Typeof       <$  pToken TKWtypeof            <*> betweenParens pTypeOfExpression
    ,      Sizeof       <$  pToken TKWsizeof            <*> betweenParens pType
    ,      Checked      <$  pToken TKWchecked           <*> betweenParens pExpression
    ,      Unchecked    <$  pToken TKWunchecked         <*> betweenParens pExpression
    ,      Nameof       <$  pIdentifierKeyword "nameof" <*> betweenParens pNameofEntity
    , try (Default      <$  pToken TKWdefault           <*> betweenParens pType)
    ,      MemberAccess <$> try pMemberAccess
    ,      SimpleName   <$> pIdentifier                 <*> option [] pTypeArguments
    ,      pNewExpression
    ,      pParenthesizedExpression
    ,      pLiteralExpression ]

pNameofEntity :: P NameofEntity
pNameofEntity = choice
    [ NameofThis           <$  pToken TKWthis <* pPeriod <*> pIdentifier
    , NameofBase           <$  pToken TKWbase <* pPeriod <*> pIdentifier
    , NameofPredefinedType <$> pSimpleType    <* pPeriod <*> pIdentifier
    , NameofIdentifier     <$> pIdentifier ]

pTypeOfExpression :: P TypeOfExpression
pTypeOfExpression = TypeofType <$> pTypeWithVoid <?> "a type"

pMemberAccess :: P MemberAccess
pMemberAccess = choice 
    [ PredefinedMemberAccess <$> pSimpleType 
                             <*  pPeriod 
                             <*> pIdentifier 
                             <*> option [] pTypeArguments

    , QualifiedMemberAccess  <$> pIdentifier 
                             <*  pToken TDoubleColon 
                             <*> pIdentifier 
                             <*  pPeriod 
                             <*> pIdentifier ] 

pNewExpression :: P Expression
pNewExpression = pToken TKWnew *> choice
    [ try $ ObjectCreationExpression      <$> pType 
                                          <*> pArguments
                                          <*> optionMaybe pObjectCreationInitializer

    , try $ ObjectCreationTypeInitializer <$> pType <*> pObjectCreationInitializer

    , try $ ArrayCreationExpression       <$> pNonArrayType 
                                          <*> betweenSquare (sepBy1 pExpression pComma) 
                                          <*> many pRankSpecifier 
                                          <*> optionMaybe pArrayCreationInitializer
 
    , try $ ArrayCreationTypeInitializer <$> pType <*> pArrayCreationInitializer

    , ArrayCreationRankInitializer <$> pRankSpecifier <*> pArrayCreationInitializer ]

pObjectCreationInitializer :: P ObjectCreationInitializer
pObjectCreationInitializer = choice 
    [ try $ ObjectInitializer     <$> betweenCurly (sepBy pMemberInitializer pComma)
    , try $ CollectionInitializer <$> pArrayCreationInitializer ]

pMemberInitializer :: P MemberInitializer
pMemberInitializer = 
    MemberInitializer <$> pInitializerTarget <* pEqualSign <*> pInitializerValue

pArrayCreationInitializer :: P ArrayCreationInitializer
pArrayCreationInitializer = betweenCurly $ choice
    [ ArrayCreationInitializerExpression   <$> sepBy1 pExpression pComma
    , ArrayCreationInitializerInitializers <$> sepBy1 pArrayCreationInitializer pComma ]

pInitializerTarget :: P InitializerTarget
pInitializerTarget = choice 
    [ InitializerTargetIdentifier <$> pIdentifier
    , InitializerTargetList       <$> betweenSquare (sepBy pArgument pComma) ]

pInitializerValue :: P InitializerValue
pInitializerValue = choice
    [ InitializerValueExpression  <$> pExpression
    , InitializerValueInitializer <$> pObjectCreationInitializer ]

pLiteralExpression :: P Expression
pLiteralExpression = choice
    [ Literal         <$> pBooleanLiteral
    , Literal         <$> pIntLiteral
    , Literal         <$> pRealLiteral
    , Literal         <$> pCharLiteral
    , Literal         <$> pStringLiteral
    , Literal NullLit <$  pToken TKWnull ]

pBooleanLiteral :: P Literal
pBooleanLiteral = 
    (BooleanLit True  <$ pToken TKWtrue   <|>
     BooleanLit False <$ pToken TKWfalse) <?> "a boolean literal"

pIntLiteral :: P Literal
pIntLiteral = do
    sourceName <- getSourceName
    token show (posFromToken sourceName) matchToken <?> "an integral literal"
    where
        matchToken (Positioned _ (TIntLiteral x))   = Just (IntLit x)
        matchToken (Positioned _ (TUIntLiteral x))  = Just (UIntLit x)
        matchToken (Positioned _ (TLongLiteral x))  = Just (LongLit x)
        matchToken (Positioned _ (TULongLiteral x)) = Just (ULongLit x)
        matchToken _                                = Nothing

pRealLiteral :: P Literal
pRealLiteral = do
    sourceName <- getSourceName
    token show (posFromToken sourceName) matchToken <?> "a floating point literal"
    where
        matchToken (Positioned _ (TFloatLiteral x))   = Just (FloatLit x)
        matchToken (Positioned _ (TDoubleLiteral x))  = Just (DoubleLit x)
        matchToken (Positioned _ (TDecimalLiteral x)) = Just (DecimalLit x)
        matchToken _                                  = Nothing

pCharLiteral :: P Literal
pCharLiteral = do
    sourceName <- getSourceName
    token show (posFromToken sourceName) matchToken <?> "a char literal"
    where
        matchToken (Positioned _ (TCharLiteral x)) = Just (CharLit x)
        matchToken _                               = Nothing

pStringLiteral :: P Literal
pStringLiteral = do
    sourceName <- getSourceName
    token show (posFromToken sourceName) matchToken <?> "a string literal"
    where
        matchToken (Positioned _ tok)
            = case tok of
                TStringLiteral x             -> Just (StringLit x)
              --  TInterpolatedStringLiteral x -> Just (InterpolatedStringLit x)
                TVerbatimStringLiteral x     -> Just (VerbatimStringLit x)
                _                            -> Nothing

pParenthesizedExpression :: P Expression
pParenthesizedExpression = Parenthesized <$> betweenParens pExpression

pArguments :: P [Argument]
pArguments = betweenParens (sepBy pArgument pComma)

pArgument :: P Argument
pArgument = do
    name <- optionMaybe (try (pIdentifier <* pColon))
    choice [argument name, refArgument name, outArgument name]
    where
        argument    name' = Argument    name' <$> pExpression
        refArgument name' = RefArgument name' <$ pToken TKWref <*> pExpression
        outArgument name' = OutArgument name' <$ pToken TKWout <*> pExpression