<commit_before>-----------------------------------------------------------------------------
--
-- Module      :  PureScript.Parser.Values
-- Copyright   :  (c) <NAME> 2013
-- License     :  MIT
--
-- Maintainer  :  <NAME> <<EMAIL>>
-- Stability   :  experimental
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

module PureScript.Parser.Values (
    parseValue,
    parseBinder
) where

import PureScript.Values
import PureScript.Names
import PureScript.Declarations
import PureScript.Parser.State
import Data.Function (on)
import Data.List
import Data.Functor.Identity
import qualified Data.Map as M
import qualified PureScript.Parser.Common as C
import Control.Applicative
import qualified Text.Parsec as P
import Text.Parsec.Expr
import Control.Monad
import Control.Arrow (Arrow(..))
import PureScript.Parser.Types
import PureScript.Types

booleanLiteral :: P.Parsec String ParseState Bool
booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)

parseNumericLiteral :: P.Parsec String ParseState Value
parseNumericLiteral = NumericLiteral <$> C.integerOrFloat

parseStringLiteral :: P.Parsec String ParseState Value
parseStringLiteral = StringLiteral <$> C.stringLiteral

parseBooleanLiteral :: P.Parsec String ParseState Value
parseBooleanLiteral = BooleanLiteral <$> booleanLiteral

parseArrayLiteral :: P.Parsec String ParseState Value
parseArrayLiteral = ArrayLiteral <$> (C.squares $ parseValue `P.sepBy` (C.indented *> C.comma))

parseObjectLiteral :: P.Parsec String ParseState Value
parseObjectLiteral = ObjectLiteral <$> (C.braces $ parseIdentifierAndValue `P.sepBy` (C.indented *> C.comma))

parseIdentifierAndValue :: P.Parsec String ParseState (String, Value)
parseIdentifierAndValue = (,) <$> (C.indented *> C.identifier <* C.indented <* C.colon)
                              <*> (C.indented *> parseValue)

parseAbs :: P.Parsec String ParseState Value
parseAbs = do
  C.lexeme $ P.char '\\'
  args <- (C.indented *> C.parseIdent) `P.sepBy` (C.indented *> C.comma)
  C.lexeme $ C.indented *> P.string "->"
  value <- parseValue
  return $ Abs args value

parseApp :: P.Parsec String ParseState Value
parseApp = App <$> parseValue
               <*> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))

parseVar :: P.Parsec String ParseState Value
parseVar = Var <$> C.parseIdent

parseConstructor :: P.Parsec String ParseState Value
parseConstructor = Constructor <$> C.properName

parseCase :: P.Parsec String ParseState Value
parseCase = Case <$> (P.between (C.reserved "case") (C.indented *> C.reserved "of") parseValue)
                 <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative)))

parseCaseAlternative :: P.Parsec String ParseState (Binder, Value)
parseCaseAlternative = (,) <$> (parseGuardedBinder <* C.lexeme (P.string "->"))
                           <*> parseValue
                           P.<?> "case alternative"

parseIfThenElse :: P.Parsec String ParseState Value
parseIfThenElse = IfThenElse <$> (C.reserved "if" *> C.indented *> parseValue)
                             <*> (C.indented *> C.reserved "then" *> C.indented *> parseValue)
                             <*> (C.indented *> C.reserved "else" *> C.indented *> parseValue)

parseBlock :: P.Parsec String ParseState Value
parseBlock = Block <$> (C.reserved "do" *> parseManyStatements)

parseManyStatements :: P.Parsec String ParseState [Statement]
parseManyStatements = C.indented *> (C.mark $ P.many $ C.same *> C.mark parseStatement) P.<?> "block"

parseValueAtom :: P.Parsec String ParseState Value
parseValueAtom = C.indented *> P.choice (map P.try
            [ parseNumericLiteral
            , parseStringLiteral
            , parseBooleanLiteral
            , parseArrayLiteral
            , parseObjectLiteral
            , parseAbs
            , parseVar
            , parseConstructor
            , parseBlock
            , parseCase
            , parseIfThenElse
            , C.parens parseValue ])

parsePropertyUpdate :: P.Parsec String ParseState (String, Value)
parsePropertyUpdate = do
  name <- C.lexeme C.identifier
  C.lexeme $ C.indented *> P.char '='
  value <- C.indented *> parseValue
  return (name, value)

parseValue :: P.Parsec String ParseState Value
parseValue = do
  customOps <- fixities <$> P.getState
  (buildExpressionParser (operators customOps)
   . C.buildPostfixParser postfixTable2
   $ indexersAndAccessors) P.<?> "expression"
  where
  indexersAndAccessors = C.buildPostfixParser postfixTable1 $ parseValueAtom
  postfixTable1 = [ Accessor <$> (C.indented *> C.dot *> C.indented *> C.identifier)
                  , Indexer <$> (C.indented *> C.squares parseValue)
                  , flip ObjectUpdate <$> (C.indented *> C.braces ((C.indented *> parsePropertyUpdate) `P.sepBy1` (C.indented *> C.comma))) ]
  postfixTable2 = [ C.indented *> indexersAndAccessors >>= \t2 -> return (\t1 -> App t1 [t2])
                  , flip App <$> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))
                  , flip TypedValue <$> (P.try $ C.lexeme (C.indented *> P.string "::") *> parsePolyType) ]
  operators user =
              [ [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not)
                , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "~") >> return (Unary BitwiseNot)
                , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "-") >> return (Unary Negate)
                , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "+") >> return id ]
              ] ++ customOperatorTable user ++
              [ [ Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident -> return $ \t1 t2 -> App (App (Var ident) [t1]) [t2])) AssocRight ]
              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<=") >> return (Binary LessThanOrEqualTo)) AssocRight
                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">=") >> return (Binary GreaterThanOrEqualTo)) AssocRight ]
              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<") >> return (Binary LessThan)) AssocRight
                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">") >> return (Binary GreaterThan)) AssocRight ]
              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "*") >> return (Binary Multiply)) AssocRight
                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "/") >> return (Binary Divide)) AssocRight<commit_msg>Default fixity declaration is infixl<commit_after>-----------------------------------------------------------------------------
--
-- Module      :  PureScript.Parser.Values
-- Copyright   :  (c) <NAME> 2013
-- License     :  MIT
--
-- Maintainer  :  <NAME> <<EMAIL>>
-- Stability   :  experimental
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

module PureScript.Parser.Values (
    parseValue,
    parseBinder
) where

import PureScript.Values
import PureScript.Names
import PureScript.Declarations
import PureScript.Parser.State
import Data.Function (on)
import Data.List
import Data.Functor.Identity
import qualified Data.Map as M
import qualified PureScript.Parser.Common as C
import Control.Applicative
import qualified Text.Parsec as P
import Text.Parsec.Expr
import Control.Monad
import Control.Arrow (Arrow(..))
import PureScript.Parser.Types
import PureScript.Types

booleanLiteral :: P.Parsec String ParseState Bool
booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)

parseNumericLiteral :: P.Parsec String ParseState Value
parseNumericLiteral = NumericLiteral <$> C.integerOrFloat

parseStringLiteral :: P.Parsec String ParseState Value
parseStringLiteral = StringLiteral <$> C.stringLiteral

parseBooleanLiteral :: P.Parsec String ParseState Value
parseBooleanLiteral = BooleanLiteral <$> booleanLiteral

parseArrayLiteral :: P.Parsec String ParseState Value
parseArrayLiteral = ArrayLiteral <$> (C.squares $ parseValue `P.sepBy` (C.indented *> C.comma))

parseObjectLiteral :: P.Parsec String ParseState Value
parseObjectLiteral = ObjectLiteral <$> (C.braces $ parseIdentifierAndValue `P.sepBy` (C.indented *> C.comma))

parseIdentifierAndValue :: P.Parsec String ParseState (String, Value)
parseIdentifierAndValue = (,) <$> (C.indented *> C.identifier <* C.indented <* C.colon)
                              <*> (C.indented *> parseValue)

parseAbs :: P.Parsec String ParseState Value
parseAbs = do
  C.lexeme $ P.char '\\'
  args <- (C.indented *> C.parseIdent) `P.sepBy` (C.indented *> C.comma)
  C.lexeme $ C.indented *> P.string "->"
  value <- parseValue
  return $ Abs args value

parseApp :: P.Parsec String ParseState Value
parseApp = App <$> parseValue
               <*> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))

parseVar :: P.Parsec String ParseState Value
parseVar = Var <$> C.parseIdent

parseConstructor :: P.Parsec String ParseState Value
parseConstructor = Constructor <$> C.properName

parseCase :: P.Parsec String ParseState Value
parseCase = Case <$> (P.between (C.reserved "case") (C.indented *> C.reserved "of") parseValue)
                 <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative)))

parseCaseAlternative :: P.Parsec String ParseState (Binder, Value)
parseCaseAlternative = (,) <$> (parseGuardedBinder <* C.lexeme (P.string "->"))
                           <*> parseValue
                           P.<?> "case alternative"

parseIfThenElse :: P.Parsec String ParseState Value
parseIfThenElse = IfThenElse <$> (C.reserved "if" *> C.indented *> parseValue)
                             <*> (C.indented *> C.reserved "then" *> C.indented *> parseValue)
                             <*> (C.indented *> C.reserved "else" *> C.indented *> parseValue)

parseBlock :: P.Parsec String ParseState Value
parseBlock = Block <$> (C.reserved "do" *> parseManyStatements)

parseManyStatements :: P.Parsec String ParseState [Statement]
parseManyStatements = C.indented *> (C.mark $ P.many $ C.same *> C.mark parseStatement) P.<?> "block"

parseValueAtom :: P.Parsec String ParseState Value
parseValueAtom = C.indented *> P.choice (map P.try
            [ parseNumericLiteral
            , parseStringLiteral
            , parseBooleanLiteral
            , parseArrayLiteral
            , parseObjectLiteral
            , parseAbs
            , parseVar
            , parseConstructor
            , parseBlock
            , parseCase
            , parseIfThenElse
            , C.parens parseValue ])

parsePropertyUpdate :: P.Parsec String ParseState (String, Value)
parsePropertyUpdate = do
  name <- C.lexeme C.identifier
  C.lexeme $ C.indented *> P.char '='
  value <- C.indented *> parseValue
  return (name, value)

parseValue :: P.Parsec String ParseState Value
parseValue = do
  customOps <- fixities <$> P.getState
  (buildExpressionParser (operators customOps)
   . C.buildPostfixParser postfixTable2
   $ indexersAndAccessors) P.<?> "expression"
  where
  indexersAndAccessors = C.buildPostfixParser postfixTable1 $ parseValueAtom
  postfixTable1 = [ Accessor <$> (C.indented *> C.dot *> C.indented *> C.identifier)
                  , Indexer <$> (C.indented *> C.squares parseValue)
                  , flip ObjectUpdate <$> (C.indented *> C.braces ((C.indented *> parsePropertyUpdate) `P.sepBy1` (C.indented *> C.comma))) ]
  postfixTable2 = [ C.indented *> indexersAndAccessors >>= \t2 -> return (\t1 -> App t1 [t2])
                  , flip App <$> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))
                  , flip TypedValue <$> (P.try $ C.lexeme (C.indented *> P.string "::") *> parsePolyType) ]
  operators user =
              [ [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not)
                , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "~") >> return (Unary BitwiseNot)
                , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "-") >> return (Unary Negate)
                , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "+") >> return id ]
              ] ++ customOperatorTable user ++
              [ [ Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident -> return $ \t1 t2 -> App (App (Var ident) [t1]) [t2])) AssocLeft ]
              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<=") >> return (Binary LessThanOrEqualTo)) AssocRight
                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">=") >> return (Binary GreaterThanOrEqualTo)) AssocRight ]
              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<") >> return (Binary LessThan)) AssocRight
                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">") >> return (Binary GreaterThan)) AssocRight ]
              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "*") >> return (Binary Multiply)) AssocRight
                , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "/") >> return (Binary Divide)) AssocRight
{'fraction_non_alphanumeric': 0.1564305259957434, 'fraction_numerical': 0.002584372149589541, 'mean_word_length': 2.692674712321078, 'pattern_counts': {'":': 2, '<': 91, '<?xml version=': 0, '>': 241, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2246317', 'n_tokens_mistral': 4192, 'n_tokens_neox': 4077, 'n_words': 979}