{-# OPTIONS  #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Language.Python.Version2.Parser
-- Copyright   : (c) 2009 Bernie Pope 
-- License     : BSD-style
-- Maintainer  : bjpop@csse.unimelb.edu.au
-- Stability   : experimental
-- Portability : ghc
--
-- A parser for Python version 2.x programs. Parsers are provided for 
-- modules, statements, and expressions. The parsers produce comment tokens
-- in addition to the abstract syntax tree.
--
-- See: 
--
-- * <http://docs.python.org/2.6/reference/index.html> for an overview of the language. 
--
-- * <http://docs.python.org/2.6/reference/grammar.html> for the full grammar.
-- 
-- * <http://docs.python.org/2.6/reference/toplevel_components.html> for a description of 
-- the various Python top-levels, which correspond to the parsers provided here.
-----------------------------------------------------------------------------

module Language.Python.Version2.Parser (
   -- * Parsing modules
   parseModule,
   -- * Parsing statements
   parseStmt,
   -- * Parsing expressions
   parseExpr) where

import Language.Python.Version2.Parser.Parser (parseFileInput, parseSingleInput, parseEval)
import Language.Python.Version2.Parser.Lexer (initStartCodeStack)
import Language.Python.Common.AST (ModuleSpan, StatementSpan, ExprSpan)
import Language.Python.Common.Token (Token)
import Language.Python.Common.SrcLocation (initialSrcLocation)
import Language.Python.Common.ParserMonad (execParserKeepComments, ParseError, initialState)

-- | Parse a whole Python source file. Return comments in addition to the parsed module.
parseModule :: String -- ^ The input stream (python module source code). 
      -> String -- ^ The name of the python source (filename or input device). 
      -> Either ParseError (ModuleSpan, [Token]) -- ^ An error or the abstract syntax tree (AST) of the python module and comment tokens.
parseModule :: String -> String -> Either ParseError (ModuleSpan, [Token])
parseModule input :: String
input srcName :: String
srcName = 
   P ModuleSpan
-> ParseState -> Either ParseError (ModuleSpan, [Token])
forall a. P a -> ParseState -> Either ParseError (a, [Token])
execParserKeepComments P ModuleSpan
parseFileInput ParseState
state 
   where
   initLoc :: SrcLocation
initLoc = String -> SrcLocation
initialSrcLocation String
srcName
   state :: ParseState
state = SrcLocation -> String -> [Int] -> ParseState
initialState SrcLocation
initLoc String
input [Int]
initStartCodeStack

-- | Parse one compound statement, or a sequence of simple statements. Generally used for interactive input, such as from the command line of an interpreter. Return comments in addition to the parsed statements.
parseStmt :: String -- ^ The input stream (python statement source code). 
      -> String -- ^ The name of the python source (filename or input device). 
      -> Either ParseError ([StatementSpan], [Token]) -- ^ An error or maybe the abstract syntax tree (AST) of zero or more python statements, plus comments.
parseStmt :: String -> String -> Either ParseError ([StatementSpan], [Token])
parseStmt input :: String
input srcName :: String
srcName = 
   P [StatementSpan]
-> ParseState -> Either ParseError ([StatementSpan], [Token])
forall a. P a -> ParseState -> Either ParseError (a, [Token])
execParserKeepComments P [StatementSpan]
parseSingleInput ParseState
state 
   where
   initLoc :: SrcLocation
initLoc = String -> SrcLocation
initialSrcLocation String
srcName
   state :: ParseState
state = SrcLocation -> String -> [Int] -> ParseState
initialState SrcLocation
initLoc String
input [Int]
initStartCodeStack

-- | Parse an expression. Generally used as input for the \'eval\' primitive. Return comments in addition to the parsed expression.
parseExpr :: String -- ^ The input stream (python statement source code). 
      -> String -- ^ The name of the python source (filename or input device). 
      -> Either ParseError (ExprSpan, [Token]) -- ^ An error or maybe the abstract syntax tree (AST) of the python expression, plus comment tokens.
parseExpr :: String -> String -> Either ParseError (ExprSpan, [Token])
parseExpr input :: String
input srcName :: String
srcName = 
   P ExprSpan -> ParseState -> Either ParseError (ExprSpan, [Token])
forall a. P a -> ParseState -> Either ParseError (a, [Token])
execParserKeepComments P ExprSpan
parseEval ParseState
state 
   where
   initLoc :: SrcLocation
initLoc = String -> SrcLocation
initialSrcLocation String
srcName
   state :: ParseState
state = SrcLocation -> String -> [Int] -> ParseState
initialState SrcLocation
initLoc String
input [Int]
initStartCodeStack