{-# OPTIONS  #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Language.Python.Common.ParserUtils 
-- Copyright   : (c) 2009 Bernie Pope 
-- License     : BSD-style
-- Maintainer  : bjpop@csse.unimelb.edu.au
-- Stability   : experimental
-- Portability : ghc
--
-- Various utilities to support the Python parser. 
-----------------------------------------------------------------------------

module Language.Python.Common.ParserUtils where

import Data.List (foldl')
import Data.Maybe (isJust)
import Control.Monad.Error.Class (throwError)
import Language.Python.Common.AST as AST
import Language.Python.Common.Token as Token 
import Language.Python.Common.ParserMonad hiding (location)
import Language.Python.Common.SrcLocation 

makeConditionalExpr :: ExprSpan -> Maybe (ExprSpan, ExprSpan) -> ExprSpan
makeConditionalExpr :: ExprSpan -> Maybe (ExprSpan, ExprSpan) -> ExprSpan
makeConditionalExpr e :: ExprSpan
e Nothing = ExprSpan
e
makeConditionalExpr e :: ExprSpan
e opt :: Maybe (ExprSpan, ExprSpan)
opt@(Just (cond :: ExprSpan
cond, false_branch :: ExprSpan
false_branch))
   = ExprSpan -> ExprSpan -> ExprSpan -> SrcSpan -> ExprSpan
forall annot.
Expr annot -> Expr annot -> Expr annot -> annot -> Expr annot
CondExpr ExprSpan
e ExprSpan
cond ExprSpan
false_branch (ExprSpan -> Maybe (ExprSpan, ExprSpan) -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e Maybe (ExprSpan, ExprSpan)
opt)

makeBinOp :: ExprSpan -> [(OpSpan, ExprSpan)] -> ExprSpan
makeBinOp :: ExprSpan -> [(OpSpan, ExprSpan)] -> ExprSpan
makeBinOp e :: ExprSpan
e es :: [(OpSpan, ExprSpan)]
es
   = (ExprSpan -> (OpSpan, ExprSpan) -> ExprSpan)
-> ExprSpan -> [(OpSpan, ExprSpan)] -> ExprSpan
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ExprSpan -> (OpSpan, ExprSpan) -> ExprSpan
mkOp ExprSpan
e [(OpSpan, ExprSpan)]
es
   where
   mkOp :: ExprSpan -> (OpSpan, ExprSpan) -> ExprSpan
mkOp e1 :: ExprSpan
e1 (op :: OpSpan
op, e2 :: ExprSpan
e2) = OpSpan -> ExprSpan -> ExprSpan -> SrcSpan -> ExprSpan
forall annot.
Op annot -> Expr annot -> Expr annot -> annot -> Expr annot
BinaryOp OpSpan
op ExprSpan
e1 ExprSpan
e2 (ExprSpan -> ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e1 ExprSpan
e2)

parseError :: Token -> P a 
parseError :: Token -> P a
parseError = ParseError -> P a
forall (m :: * -> *) a. MonadError m => ErrorType m -> m a
throwError (ParseError -> P a) -> (Token -> ParseError) -> Token -> P a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ParseError
UnexpectedToken 

data Trailer
   = TrailerCall { Trailer -> [ArgumentSpan]
trailer_call_args :: [ArgumentSpan], Trailer -> SrcSpan
trailer_span :: SrcSpan }
   | TrailerSubscript { Trailer -> [Subscript]
trailer_subs :: [Subscript], trailer_span :: SrcSpan }
   | TrailerDot { Trailer -> IdentSpan
trailer_dot_ident :: IdentSpan, Trailer -> SrcSpan
dot_span :: SrcSpan, trailer_span :: SrcSpan }

instance Span Trailer where
  getSpan :: Trailer -> SrcSpan
getSpan = Trailer -> SrcSpan
trailer_span

data Subscript
   = SubscriptExpr { Subscript -> ExprSpan
subscription :: ExprSpan, Subscript -> SrcSpan
subscript_span :: SrcSpan }
   | SubscriptSlice 
     { Subscript -> Maybe ExprSpan
subscript_slice_span1 :: Maybe ExprSpan
     , Subscript -> Maybe ExprSpan
subscript_slice_span2 :: Maybe ExprSpan
     , Subscript -> Maybe (Maybe ExprSpan)
subscript_slice_span3 :: Maybe (Maybe ExprSpan)
     , subscript_span :: SrcSpan
     }
   | SubscriptSliceEllipsis { subscript_span :: SrcSpan }

instance Span Subscript where
   getSpan :: Subscript -> SrcSpan
getSpan = Subscript -> SrcSpan
subscript_span

isProperSlice :: Subscript -> Bool
isProperSlice :: Subscript -> Bool
isProperSlice (SubscriptSlice {}) = Bool
True
isProperSlice (SubscriptSliceEllipsis {}) = Bool
True
isProperSlice other :: Subscript
other = Bool
False

subscriptToSlice :: Subscript -> SliceSpan
subscriptToSlice :: Subscript -> SliceSpan
subscriptToSlice (SubscriptSlice lower :: Maybe ExprSpan
lower upper :: Maybe ExprSpan
upper stride :: Maybe (Maybe ExprSpan)
stride span :: SrcSpan
span)
   = Maybe ExprSpan
-> Maybe ExprSpan -> Maybe (Maybe ExprSpan) -> SrcSpan -> SliceSpan
forall annot.
Maybe (Expr annot)
-> Maybe (Expr annot)
-> Maybe (Maybe (Expr annot))
-> annot
-> Slice annot
SliceProper Maybe ExprSpan
lower Maybe ExprSpan
upper Maybe (Maybe ExprSpan)
stride SrcSpan
span
subscriptToSlice (SubscriptExpr e :: ExprSpan
e span :: SrcSpan
span)
   = ExprSpan -> SrcSpan -> SliceSpan
forall annot. Expr annot -> annot -> Slice annot
SliceExpr ExprSpan
e SrcSpan
span
subscriptToSlice (SubscriptSliceEllipsis span :: SrcSpan
span)
   = SrcSpan -> SliceSpan
forall annot. annot -> Slice annot
SliceEllipsis SrcSpan
span

subscriptToExpr :: Subscript -> ExprSpan
subscriptToExpr :: Subscript -> ExprSpan
subscriptToExpr (SubscriptExpr { subscription :: Subscript -> ExprSpan
subscription = ExprSpan
s }) = ExprSpan
s
subscriptToExpr other :: Subscript
other = [Char] -> ExprSpan
forall a. HasCallStack => [Char] -> a
error "subscriptToExpr applied to non subscript"

subscriptsToExpr :: [Subscript] -> ExprSpan
subscriptsToExpr :: [Subscript] -> ExprSpan
subscriptsToExpr subs :: [Subscript]
subs
   | [Subscript] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Subscript]
subs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
Tuple ((Subscript -> ExprSpan) -> [Subscript] -> [ExprSpan]
forall a b. (a -> b) -> [a] -> [b]
map Subscript -> ExprSpan
subscriptToExpr [Subscript]
subs) ([Subscript] -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan [Subscript]
subs)
   | [Subscript] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Subscript]
subs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = Subscript -> ExprSpan
subscriptToExpr (Subscript -> ExprSpan) -> Subscript -> ExprSpan
forall a b. (a -> b) -> a -> b
$ [Subscript] -> Subscript
forall a. [a] -> a
head [Subscript]
subs
   | Bool
otherwise = [Char] -> ExprSpan
forall a. HasCallStack => [Char] -> a
error "subscriptsToExpr: empty subscript list"

addTrailer :: ExprSpan -> [Trailer] -> ExprSpan
addTrailer :: ExprSpan -> [Trailer] -> ExprSpan
addTrailer
   = (ExprSpan -> Trailer -> ExprSpan)
-> ExprSpan -> [Trailer] -> ExprSpan
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ExprSpan -> Trailer -> ExprSpan
trail
   where
   trail :: ExprSpan -> Trailer -> ExprSpan
   -- XXX fix the span
   trail :: ExprSpan -> Trailer -> ExprSpan
trail e :: ExprSpan
e trail :: Trailer
trail@(TrailerCall { trailer_call_args :: Trailer -> [ArgumentSpan]
trailer_call_args = [ArgumentSpan]
args }) = ExprSpan -> [ArgumentSpan] -> SrcSpan -> ExprSpan
forall annot. Expr annot -> [Argument annot] -> annot -> Expr annot
Call ExprSpan
e [ArgumentSpan]
args (ExprSpan -> Trailer -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e Trailer
trail)
   trail e :: ExprSpan
e trail :: Trailer
trail@(TrailerSubscript { trailer_subs :: Trailer -> [Subscript]
trailer_subs = [Subscript]
subs })
      | (Subscript -> Bool) -> [Subscript] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Subscript -> Bool
isProperSlice [Subscript]
subs
           = ExprSpan -> [SliceSpan] -> SrcSpan -> ExprSpan
forall annot. Expr annot -> [Slice annot] -> annot -> Expr annot
SlicedExpr ExprSpan
e ((Subscript -> SliceSpan) -> [Subscript] -> [SliceSpan]
forall a b. (a -> b) -> [a] -> [b]
map Subscript -> SliceSpan
subscriptToSlice [Subscript]
subs) (ExprSpan -> Trailer -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e Trailer
trail) 
      | Bool
otherwise 
           = ExprSpan -> ExprSpan -> SrcSpan -> ExprSpan
forall annot. Expr annot -> Expr annot -> annot -> Expr annot
Subscript ExprSpan
e ([Subscript] -> ExprSpan
subscriptsToExpr [Subscript]
subs) (ExprSpan -> Trailer -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e Trailer
trail) 
   trail e :: ExprSpan
e trail :: Trailer
trail@(TrailerDot { trailer_dot_ident :: Trailer -> IdentSpan
trailer_dot_ident = IdentSpan
ident, dot_span :: Trailer -> SrcSpan
dot_span = SrcSpan
ds })
      = Dot :: forall annot. Expr annot -> Ident annot -> annot -> Expr annot
Dot { dot_expr :: ExprSpan
dot_expr = ExprSpan
e, dot_attribute :: IdentSpan
dot_attribute = IdentSpan
ident, expr_annot :: SrcSpan
expr_annot = ExprSpan -> Trailer -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e Trailer
trail }

makeTupleOrExpr :: [ExprSpan] -> Maybe Token -> ExprSpan
makeTupleOrExpr :: [ExprSpan] -> Maybe Token -> ExprSpan
makeTupleOrExpr [e :: ExprSpan
e] Nothing = ExprSpan
e
makeTupleOrExpr es :: [ExprSpan]
es@(_:_) (Just t :: Token
t) = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
Tuple [ExprSpan]
es ([ExprSpan] -> Token -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning [ExprSpan]
es Token
t) 
makeTupleOrExpr es :: [ExprSpan]
es@(_:_) Nothing  = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
Tuple [ExprSpan]
es ([ExprSpan] -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan [ExprSpan]
es)

makeAssignmentOrExpr :: ExprSpan -> Either [ExprSpan] (AssignOpSpan, ExprSpan) -> StatementSpan
makeAssignmentOrExpr :: ExprSpan
-> Either [ExprSpan] (AssignOpSpan, ExprSpan) -> StatementSpan
makeAssignmentOrExpr e :: ExprSpan
e (Left es :: [ExprSpan]
es) 
   = ExprSpan -> [ExprSpan] -> StatementSpan
makeNormalAssignment ExprSpan
e [ExprSpan]
es
makeAssignmentOrExpr e :: ExprSpan
e (Right ope2 :: (AssignOpSpan, ExprSpan)
ope2)
   = ExprSpan -> (AssignOpSpan, ExprSpan) -> StatementSpan
makeAugAssignment ExprSpan
e (AssignOpSpan, ExprSpan)
ope2

makeAugAssignment :: ExprSpan -> (AssignOpSpan, ExprSpan) -> StatementSpan
makeAugAssignment :: ExprSpan -> (AssignOpSpan, ExprSpan) -> StatementSpan
makeAugAssignment e1 :: ExprSpan
e1 (op :: AssignOpSpan
op, e2 :: ExprSpan
e2)
  = ExprSpan -> AssignOpSpan -> ExprSpan -> SrcSpan -> StatementSpan
forall annot.
Expr annot
-> AssignOp annot -> Expr annot -> annot -> Statement annot
AST.AugmentedAssign ExprSpan
e1 AssignOpSpan
op ExprSpan
e2 (ExprSpan -> ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e1 ExprSpan
e2)

makeNormalAssignment :: ExprSpan -> [ExprSpan] -> StatementSpan
makeNormalAssignment :: ExprSpan -> [ExprSpan] -> StatementSpan
makeNormalAssignment e :: ExprSpan
e [] = ExprSpan -> SrcSpan -> StatementSpan
forall annot. Expr annot -> annot -> Statement annot
StmtExpr ExprSpan
e (ExprSpan -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan ExprSpan
e)
makeNormalAssignment e :: ExprSpan
e es :: [ExprSpan]
es
  = [ExprSpan] -> ExprSpan -> SrcSpan -> StatementSpan
forall annot.
[Expr annot] -> Expr annot -> annot -> Statement annot
AST.Assign (ExprSpan
e ExprSpan -> [ExprSpan] -> [ExprSpan]
forall a. a -> [a] -> [a]
: [ExprSpan]
front) ([ExprSpan] -> ExprSpan
forall a. [a] -> a
head [ExprSpan]
back) (ExprSpan -> [ExprSpan] -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e [ExprSpan]
es)
  where
  (front :: [ExprSpan]
front, back :: [ExprSpan]
back) = Int -> [ExprSpan] -> ([ExprSpan], [ExprSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) [ExprSpan]
es
  len :: Int
len = [ExprSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExprSpan]
es

makeAnnAssignment :: ExprSpan -> (ExprSpan, Maybe ExprSpan) -> StatementSpan
makeAnnAssignment :: ExprSpan -> (ExprSpan, Maybe ExprSpan) -> StatementSpan
makeAnnAssignment ato :: ExprSpan
ato (annotation :: ExprSpan
annotation, ae :: Maybe ExprSpan
ae) = ExprSpan -> ExprSpan -> Maybe ExprSpan -> SrcSpan -> StatementSpan
forall annot.
Expr annot
-> Expr annot -> Maybe (Expr annot) -> annot -> Statement annot
AST.AnnotatedAssign ExprSpan
annotation ExprSpan
ato Maybe ExprSpan
ae (Maybe ExprSpan -> ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Maybe ExprSpan
ae ExprSpan
ato)

makeTry :: Token -> SuiteSpan -> ([HandlerSpan], [StatementSpan], [StatementSpan]) -> StatementSpan
makeTry :: Token
-> SuiteSpan
-> ([HandlerSpan], SuiteSpan, SuiteSpan)
-> StatementSpan
makeTry t1 :: Token
t1 body :: SuiteSpan
body (handlers :: [HandlerSpan]
handlers, elses :: SuiteSpan
elses, finally :: SuiteSpan
finally)
   = SuiteSpan
-> [HandlerSpan]
-> SuiteSpan
-> SuiteSpan
-> SrcSpan
-> StatementSpan
forall annot.
Suite annot
-> [Handler annot]
-> Suite annot
-> Suite annot
-> annot
-> Statement annot
AST.Try SuiteSpan
body [HandlerSpan]
handlers SuiteSpan
elses SuiteSpan
finally 
     (SrcSpan -> SuiteSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (SrcSpan -> SuiteSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (SrcSpan -> [HandlerSpan] -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (Token -> SuiteSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 SuiteSpan
body) [HandlerSpan]
handlers) SuiteSpan
elses) SuiteSpan
finally)

makeParam :: (IdentSpan, Maybe ExprSpan) -> Maybe ExprSpan -> ParameterSpan
makeParam :: (IdentSpan, Maybe ExprSpan) -> Maybe ExprSpan -> ParameterSpan
makeParam (name :: IdentSpan
name, annot :: Maybe ExprSpan
annot) defaultVal :: Maybe ExprSpan
defaultVal
   = IdentSpan
-> Maybe ExprSpan -> Maybe ExprSpan -> SrcSpan -> ParameterSpan
forall annot.
Ident annot
-> Maybe (Expr annot)
-> Maybe (Expr annot)
-> annot
-> Parameter annot
Param IdentSpan
name Maybe ExprSpan
annot Maybe ExprSpan
defaultVal SrcSpan
paramSpan
   where
   paramSpan :: SrcSpan
paramSpan = SrcSpan -> Maybe ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (IdentSpan -> Maybe ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning IdentSpan
name Maybe ExprSpan
annot) Maybe ExprSpan
defaultVal

makeStarParam :: Token -> Maybe (IdentSpan, Maybe ExprSpan) -> ParameterSpan
makeStarParam :: Token -> Maybe (IdentSpan, Maybe ExprSpan) -> ParameterSpan
makeStarParam t1 :: Token
t1 Nothing = SrcSpan -> ParameterSpan
forall annot. annot -> Parameter annot
EndPositional (Token -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan Token
t1) 
makeStarParam t1 :: Token
t1 (Just (name :: IdentSpan
name, annot :: Maybe ExprSpan
annot))
   = IdentSpan -> Maybe ExprSpan -> SrcSpan -> ParameterSpan
forall annot.
Ident annot -> Maybe (Expr annot) -> annot -> Parameter annot
VarArgsPos IdentSpan
name Maybe ExprSpan
annot (Token -> Maybe ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 Maybe ExprSpan
annot) 

makeStarStarParam :: Token -> (IdentSpan, Maybe ExprSpan) -> ParameterSpan
makeStarStarParam :: Token -> (IdentSpan, Maybe ExprSpan) -> ParameterSpan
makeStarStarParam t1 :: Token
t1 (name :: IdentSpan
name, annot :: Maybe ExprSpan
annot)
   = IdentSpan -> Maybe ExprSpan -> SrcSpan -> ParameterSpan
forall annot.
Ident annot -> Maybe (Expr annot) -> annot -> Parameter annot
VarArgsKeyword IdentSpan
name Maybe ExprSpan
annot (SrcSpan -> Maybe ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (Token -> IdentSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 IdentSpan
name) Maybe ExprSpan
annot) 

-- version 2 only 
makeTupleParam :: ParamTupleSpan -> Maybe ExprSpan -> ParameterSpan
-- just a name
makeTupleParam :: ParamTupleSpan -> Maybe ExprSpan -> ParameterSpan
makeTupleParam p :: ParamTupleSpan
p@(ParamTupleName {}) optDefault :: Maybe ExprSpan
optDefault = 
   IdentSpan
-> Maybe ExprSpan -> Maybe ExprSpan -> SrcSpan -> ParameterSpan
forall annot.
Ident annot
-> Maybe (Expr annot)
-> Maybe (Expr annot)
-> annot
-> Parameter annot
Param (ParamTupleSpan -> IdentSpan
forall annot. ParamTuple annot -> Ident annot
param_tuple_name ParamTupleSpan
p) Maybe ExprSpan
forall a. Maybe a
Nothing Maybe ExprSpan
optDefault (ParamTupleSpan -> Maybe ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ParamTupleSpan
p Maybe ExprSpan
optDefault)
-- a parenthesised tuple. NOTE: we do not distinguish between (foo) and (foo,)
makeTupleParam p :: ParamTupleSpan
p@(ParamTuple { param_tuple_annot :: forall annot. ParamTuple annot -> annot
param_tuple_annot = SrcSpan
span }) optDefault :: Maybe ExprSpan
optDefault =
   ParamTupleSpan -> Maybe ExprSpan -> SrcSpan -> ParameterSpan
forall annot.
ParamTuple annot -> Maybe (Expr annot) -> annot -> Parameter annot
UnPackTuple ParamTupleSpan
p Maybe ExprSpan
optDefault SrcSpan
span 

makeComprehension :: ExprSpan -> CompForSpan -> ComprehensionSpan
makeComprehension :: ExprSpan -> CompForSpan -> ComprehensionSpan
makeComprehension e :: ExprSpan
e for :: CompForSpan
for = ComprehensionExpr SrcSpan
-> CompForSpan -> SrcSpan -> ComprehensionSpan
forall annot.
ComprehensionExpr annot
-> CompFor annot -> annot -> Comprehension annot
Comprehension (ExprSpan -> ComprehensionExpr SrcSpan
forall annot. Expr annot -> ComprehensionExpr annot
ComprehensionExpr ExprSpan
e) CompForSpan
for (ExprSpan -> CompForSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e CompForSpan
for)

makeListForm :: SrcSpan -> Either ExprSpan ComprehensionSpan -> ExprSpan
makeListForm :: SrcSpan -> Either ExprSpan ComprehensionSpan -> ExprSpan
makeListForm span :: SrcSpan
span (Left tuple :: ExprSpan
tuple@(Tuple {})) = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
List (ExprSpan -> [ExprSpan]
forall annot. Expr annot -> [Expr annot]
tuple_exprs ExprSpan
tuple) SrcSpan
span
makeListForm span :: SrcSpan
span (Left other :: ExprSpan
other) = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
List [ExprSpan
other] SrcSpan
span 
makeListForm span :: SrcSpan
span (Right comprehension :: ComprehensionSpan
comprehension) = ComprehensionSpan -> SrcSpan -> ExprSpan
forall annot. Comprehension annot -> annot -> Expr annot
ListComp ComprehensionSpan
comprehension SrcSpan
span

makeSet :: ExprSpan -> Either CompForSpan [ExprSpan] -> SrcSpan -> ExprSpan
makeSet :: ExprSpan -> Either CompForSpan [ExprSpan] -> SrcSpan -> ExprSpan
makeSet e :: ExprSpan
e (Left compFor :: CompForSpan
compFor) = ComprehensionSpan -> SrcSpan -> ExprSpan
forall annot. Comprehension annot -> annot -> Expr annot
SetComp (ComprehensionExpr SrcSpan
-> CompForSpan -> SrcSpan -> ComprehensionSpan
forall annot.
ComprehensionExpr annot
-> CompFor annot -> annot -> Comprehension annot
Comprehension (ExprSpan -> ComprehensionExpr SrcSpan
forall annot. Expr annot -> ComprehensionExpr annot
ComprehensionExpr ExprSpan
e) CompForSpan
compFor (ExprSpan -> CompForSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e CompForSpan
compFor))
makeSet e :: ExprSpan
e (Right es :: [ExprSpan]
es) = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
Set (ExprSpan
eExprSpan -> [ExprSpan] -> [ExprSpan]
forall a. a -> [a] -> [a]
:[ExprSpan]
es)

-- The Either (ExprSpan, ExprSpan) ExprSpan refers to a (key, value) pair or a dictionary unpacking expression.
makeDictionary :: Either (ExprSpan, ExprSpan) ExprSpan -> Either CompForSpan [Either (ExprSpan, ExprSpan) ExprSpan] -> SrcSpan -> ExprSpan
makeDictionary :: Either (ExprSpan, ExprSpan) ExprSpan
-> Either CompForSpan [Either (ExprSpan, ExprSpan) ExprSpan]
-> SrcSpan
-> ExprSpan
makeDictionary (Left mapping :: (ExprSpan, ExprSpan)
mapping@(key :: ExprSpan
key, val :: ExprSpan
val)) (Left compFor :: CompForSpan
compFor) =
   ComprehensionSpan -> SrcSpan -> ExprSpan
forall annot. Comprehension annot -> annot -> Expr annot
DictComp (ComprehensionExpr SrcSpan
-> CompForSpan -> SrcSpan -> ComprehensionSpan
forall annot.
ComprehensionExpr annot
-> CompFor annot -> annot -> Comprehension annot
Comprehension (DictKeyDatumList SrcSpan -> ComprehensionExpr SrcSpan
forall annot. DictKeyDatumList annot -> ComprehensionExpr annot
ComprehensionDict (ExprSpan -> ExprSpan -> DictKeyDatumList SrcSpan
forall annot. Expr annot -> Expr annot -> DictKeyDatumList annot
DictMappingPair ExprSpan
key ExprSpan
val)) CompForSpan
compFor ((ExprSpan, ExprSpan) -> CompForSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (ExprSpan, ExprSpan)
mapping CompForSpan
compFor))
-- This is allowed by the grammar, but will produce a runtime syntax error:
-- dict unpacking cannot be used in dict comprehension
makeDictionary (Right unpacking :: ExprSpan
unpacking) (Left compFor :: CompForSpan
compFor) =
   ComprehensionSpan -> SrcSpan -> ExprSpan
forall annot. Comprehension annot -> annot -> Expr annot
DictComp (ComprehensionExpr SrcSpan
-> CompForSpan -> SrcSpan -> ComprehensionSpan
forall annot.
ComprehensionExpr annot
-> CompFor annot -> annot -> Comprehension annot
Comprehension (DictKeyDatumList SrcSpan -> ComprehensionExpr SrcSpan
forall annot. DictKeyDatumList annot -> ComprehensionExpr annot
ComprehensionDict (ExprSpan -> DictKeyDatumList SrcSpan
forall annot. Expr annot -> DictKeyDatumList annot
DictUnpacking ExprSpan
unpacking)) CompForSpan
compFor (ExprSpan -> CompForSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
unpacking CompForSpan
compFor))
makeDictionary item :: Either (ExprSpan, ExprSpan) ExprSpan
item (Right es :: [Either (ExprSpan, ExprSpan) ExprSpan]
es) = [DictKeyDatumList SrcSpan] -> SrcSpan -> ExprSpan
forall annot. [DictKeyDatumList annot] -> annot -> Expr annot
Dictionary ([DictKeyDatumList SrcSpan] -> SrcSpan -> ExprSpan)
-> [DictKeyDatumList SrcSpan] -> SrcSpan -> ExprSpan
forall a b. (a -> b) -> a -> b
$ Either (ExprSpan, ExprSpan) ExprSpan -> DictKeyDatumList SrcSpan
toKeyDatumList (Either (ExprSpan, ExprSpan) ExprSpan -> DictKeyDatumList SrcSpan)
-> [Either (ExprSpan, ExprSpan) ExprSpan]
-> [DictKeyDatumList SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (ExprSpan, ExprSpan) ExprSpan
item Either (ExprSpan, ExprSpan) ExprSpan
-> [Either (ExprSpan, ExprSpan) ExprSpan]
-> [Either (ExprSpan, ExprSpan) ExprSpan]
forall a. a -> [a] -> [a]
: [Either (ExprSpan, ExprSpan) ExprSpan]
es


toKeyDatumList :: Either (ExprSpan, ExprSpan) ExprSpan -> DictKeyDatumList SrcSpan
toKeyDatumList :: Either (ExprSpan, ExprSpan) ExprSpan -> DictKeyDatumList SrcSpan
toKeyDatumList (Left (key :: ExprSpan
key, value :: ExprSpan
value)) = ExprSpan -> ExprSpan -> DictKeyDatumList SrcSpan
forall annot. Expr annot -> Expr annot -> DictKeyDatumList annot
DictMappingPair ExprSpan
key ExprSpan
value
toKeyDatumList (Right unpacking :: ExprSpan
unpacking) = ExprSpan -> DictKeyDatumList SrcSpan
forall annot. Expr annot -> DictKeyDatumList annot
DictUnpacking ExprSpan
unpacking


fromEither :: Either a a -> a
fromEither :: Either a a -> a
fromEither (Left x :: a
x) = a
x
fromEither (Right x :: a
x) = a
x

makeDecorator :: Token -> DottedNameSpan -> [ArgumentSpan] -> DecoratorSpan
makeDecorator :: Token -> DottedNameSpan -> [ArgumentSpan] -> DecoratorSpan
makeDecorator t1 :: Token
t1 name :: DottedNameSpan
name [] = DottedNameSpan -> [ArgumentSpan] -> SrcSpan -> DecoratorSpan
forall annot.
DottedName annot -> [Argument annot] -> annot -> Decorator annot
Decorator DottedNameSpan
name [] (Token -> DottedNameSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 DottedNameSpan
name)
makeDecorator t1 :: Token
t1 name :: DottedNameSpan
name args :: [ArgumentSpan]
args = DottedNameSpan -> [ArgumentSpan] -> SrcSpan -> DecoratorSpan
forall annot.
DottedName annot -> [Argument annot] -> annot -> Decorator annot
Decorator DottedNameSpan
name [ArgumentSpan]
args (Token -> [ArgumentSpan] -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 [ArgumentSpan]
args)

-- parser guarantees that the first list is non-empty
makeDecorated :: [DecoratorSpan] -> StatementSpan -> StatementSpan
makeDecorated :: [DecoratorSpan] -> StatementSpan -> StatementSpan
makeDecorated ds :: [DecoratorSpan]
ds@(d :: DecoratorSpan
d:_) def :: StatementSpan
def = [DecoratorSpan] -> StatementSpan -> SrcSpan -> StatementSpan
forall annot.
[Decorator annot] -> Statement annot -> annot -> Statement annot
Decorated [DecoratorSpan]
ds StatementSpan
def (DecoratorSpan -> StatementSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning DecoratorSpan
d StatementSpan
def)

-- suite can't be empty so it is safe to take span over it
makeFun :: Token -> IdentSpan -> [ParameterSpan] -> Maybe ExprSpan -> SuiteSpan -> StatementSpan
makeFun :: Token
-> IdentSpan
-> [ParameterSpan]
-> Maybe ExprSpan
-> SuiteSpan
-> StatementSpan
makeFun t1 :: Token
t1 name :: IdentSpan
name params :: [ParameterSpan]
params annot :: Maybe ExprSpan
annot body :: SuiteSpan
body = 
   IdentSpan
-> [ParameterSpan]
-> Maybe ExprSpan
-> SuiteSpan
-> SrcSpan
-> StatementSpan
forall annot.
Ident annot
-> [Parameter annot]
-> Maybe (Expr annot)
-> Suite annot
-> annot
-> Statement annot
Fun IdentSpan
name [ParameterSpan]
params Maybe ExprSpan
annot SuiteSpan
body (SrcSpan -> StatementSpan) -> SrcSpan -> StatementSpan
forall a b. (a -> b) -> a -> b
$ Token -> SuiteSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 SuiteSpan
body 

makeReturn :: Token -> Maybe ExprSpan -> StatementSpan
makeReturn :: Token -> Maybe ExprSpan -> StatementSpan
makeReturn t1 :: Token
t1 Nothing = Maybe ExprSpan -> SrcSpan -> StatementSpan
forall annot. Maybe (Expr annot) -> annot -> Statement annot
AST.Return Maybe ExprSpan
forall a. Maybe a
Nothing (Token -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan Token
t1)
makeReturn t1 :: Token
t1 expr :: Maybe ExprSpan
expr@(Just e :: ExprSpan
e) = Maybe ExprSpan -> SrcSpan -> StatementSpan
forall annot. Maybe (Expr annot) -> annot -> Statement annot
AST.Return Maybe ExprSpan
expr (Token -> ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 ExprSpan
e)

makeParenOrGenerator :: Either ExprSpan ComprehensionSpan -> SrcSpan -> ExprSpan
makeParenOrGenerator :: Either ExprSpan ComprehensionSpan -> SrcSpan -> ExprSpan
makeParenOrGenerator (Left e :: ExprSpan
e) span :: SrcSpan
span = ExprSpan -> SrcSpan -> ExprSpan
forall annot. Expr annot -> annot -> Expr annot
Paren ExprSpan
e SrcSpan
span
makeParenOrGenerator (Right comp :: ComprehensionSpan
comp) span :: SrcSpan
span = ComprehensionSpan -> SrcSpan -> ExprSpan
forall annot. Comprehension annot -> annot -> Expr annot
Generator ComprehensionSpan
comp SrcSpan
span

makePrint :: Bool -> Maybe ([ExprSpan], Maybe Token) -> SrcSpan -> StatementSpan
makePrint :: Bool -> Maybe ([ExprSpan], Maybe Token) -> SrcSpan -> StatementSpan
makePrint chevron :: Bool
chevron Nothing span :: SrcSpan
span = Bool -> [ExprSpan] -> Bool -> SrcSpan -> StatementSpan
forall annot.
Bool -> [Expr annot] -> Bool -> annot -> Statement annot
AST.Print Bool
chevron [] Bool
False SrcSpan
span
makePrint chevron :: Bool
chevron (Just (args :: [ExprSpan]
args, last_comma :: Maybe Token
last_comma)) span :: SrcSpan
span =
   Bool -> [ExprSpan] -> Bool -> SrcSpan -> StatementSpan
forall annot.
Bool -> [Expr annot] -> Bool -> annot -> Statement annot
AST.Print Bool
chevron [ExprSpan]
args (Maybe Token -> Bool
forall a. Maybe a -> Bool
isJust Maybe Token
last_comma) SrcSpan
span
   
makeRelative :: [Either Token DottedNameSpan] -> ImportRelativeSpan
makeRelative :: [Either Token DottedNameSpan] -> ImportRelativeSpan
makeRelative items :: [Either Token DottedNameSpan]
items =
   Int -> Maybe DottedNameSpan -> SrcSpan -> ImportRelativeSpan
forall annot.
Int -> Maybe (DottedName annot) -> annot -> ImportRelative annot
ImportRelative Int
ndots Maybe DottedNameSpan
maybeName ([Either Token DottedNameSpan] -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan [Either Token DottedNameSpan]
items) 
   where
   (ndots :: Int
ndots, maybeName :: Maybe DottedNameSpan
maybeName) = Int -> [Either Token DottedNameSpan] -> (Int, Maybe DottedNameSpan)
countDots 0 [Either Token DottedNameSpan]
items
   -- parser ensures that the dotted name will be at the end 
   -- of the list if it is there at all
   countDots :: Int -> [Either Token DottedNameSpan] -> (Int, Maybe DottedNameSpan)
   countDots :: Int -> [Either Token DottedNameSpan] -> (Int, Maybe DottedNameSpan)
countDots count :: Int
count [] = (Int
count, Maybe DottedNameSpan
forall a. Maybe a
Nothing)
   countDots count :: Int
count (Right name :: DottedNameSpan
name:_) = (Int
count, DottedNameSpan -> Maybe DottedNameSpan
forall a. a -> Maybe a
Just DottedNameSpan
name)
   countDots count :: Int
count (Left token :: Token
token:rest :: [Either Token DottedNameSpan]
rest) = Int -> [Either Token DottedNameSpan] -> (Int, Maybe DottedNameSpan)
countDots (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Token -> Int
forall p. Num p => Token -> p
dots Token
token) [Either Token DottedNameSpan]
rest 
   dots :: Token -> p
dots (DotToken {}) = 1
   dots (EllipsisToken {}) = 3

{-
   See: http://docs.python.org/3.0/reference/expressions.html#calls

   arglist: (argument ',')* (argument [',']
                         |'*' test (',' argument)* [',' '**' test]
                         |'**' test)

   (state 1) Positional arguments come first.
   (state 2) Then keyword arguments.
   (state 3) Then the single star form.
   (state 4) Then more keyword arguments (but no positional arguments).
   (state 5) Then the double star form.

XXX fixme: we need to include SrcLocations for the errors.
-}

checkArguments :: [ArgumentSpan] -> P [ArgumentSpan]
checkArguments :: [ArgumentSpan] -> P [ArgumentSpan]
checkArguments args :: [ArgumentSpan]
args = do
   Int -> [ArgumentSpan] -> P ()
check 1 [ArgumentSpan]
args
   [ArgumentSpan] -> P [ArgumentSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [ArgumentSpan]
args
   where
   check :: Int -> [ArgumentSpan] -> P ()
   check :: Int -> [ArgumentSpan] -> P ()
check state :: Int
state [] = () -> P ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   check 5 (arg :: ArgumentSpan
arg:_) = ArgumentSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ArgumentSpan
arg "an **argument must not be followed by any other arguments"
   check state :: Int
state (arg :: ArgumentSpan
arg:rest :: [ArgumentSpan]
rest) = do
      case ArgumentSpan
arg of
         ArgExpr {}
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> Int -> [ArgumentSpan] -> P ()
check Int
state [ArgumentSpan]
rest
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 -> ArgumentSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ArgumentSpan
arg "a positional argument must not follow a keyword argument"
            | Bool
otherwise -> ArgumentSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ArgumentSpan
arg "a positional argument must not follow a *argument"
         ArgKeyword {}
            | Int
state Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [1,2] -> Int -> [ArgumentSpan] -> P ()
check 2 [ArgumentSpan]
rest
            | Int
state Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [3,4] -> Int -> [ArgumentSpan] -> P ()
check 4 [ArgumentSpan]
rest
         ArgVarArgsPos {}
            | Int
state Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [1,2] -> Int -> [ArgumentSpan] -> P ()
check 3 [ArgumentSpan]
rest
            | Int
state Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [3,4] -> ArgumentSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ArgumentSpan
arg "there must not be two *arguments in an argument list"
         ArgVarArgsKeyword {} -> Int -> [ArgumentSpan] -> P ()
check 5 [ArgumentSpan]
rest

{-
   See: http://docs.python.org/3.1/reference/compound_stmts.html#grammar-token-parameter_list

   parameter_list ::=  (defparameter ",")*
                    (  "*" [parameter] ("," defparameter)*
                    [, "**" parameter]
                    | "**" parameter
                    | defparameter [","] )

   (state 1) Parameters/unpack tuples first.
   (state 2) Then the single star (on its own or with parameter)
   (state 3) Then more parameters. 
   (state 4) Then the double star form.

   XXX fixme, add support for version 2 unpack tuple.
-}

checkParameters :: [ParameterSpan] -> P [ParameterSpan]
checkParameters :: [ParameterSpan] -> P [ParameterSpan]
checkParameters params :: [ParameterSpan]
params = do
   Int -> [ParameterSpan] -> P ()
check 1 [ParameterSpan]
params 
   [ParameterSpan] -> P [ParameterSpan]
forall (m :: * -> *) a. Monad m => a -> m a
return [ParameterSpan]
params
   where
   check :: Int -> [ParameterSpan] -> P ()
   check :: Int -> [ParameterSpan] -> P ()
check state :: Int
state [] = () -> P ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   check 4 (param :: ParameterSpan
param:_) = ParameterSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ParameterSpan
param "a **parameter must not be followed by any other parameters"
   check state :: Int
state (param :: ParameterSpan
param:rest :: [ParameterSpan]
rest) = do
      case ParameterSpan
param of
         -- Param and UnPackTuple are treated the same.
         UnPackTuple {}
            | Int
state Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [1,3] -> Int -> [ParameterSpan] -> P ()
check Int
state [ParameterSpan]
rest
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 -> Int -> [ParameterSpan] -> P ()
check 3 [ParameterSpan]
rest 
         Param {}
            | Int
state Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [1,3] -> Int -> [ParameterSpan] -> P ()
check Int
state [ParameterSpan]
rest
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 -> Int -> [ParameterSpan] -> P ()
check 3 [ParameterSpan]
rest 
         EndPositional {}
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> Int -> [ParameterSpan] -> P ()
check 2 [ParameterSpan]
rest
            | Bool
otherwise -> ParameterSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ParameterSpan
param "there must not be two *parameters in a parameter list"
         VarArgsPos {}
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> Int -> [ParameterSpan] -> P ()
check 2 [ParameterSpan]
rest
            | Bool
otherwise -> ParameterSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ParameterSpan
param "there must not be two *parameters in a parameter list"
         VarArgsKeyword {} -> Int -> [ParameterSpan] -> P ()
check 4 [ParameterSpan]
rest

{-
spanError :: Span a => a -> String -> P ()
spanError x str = throwError $ StrError $ unwords [prettyText $ getSpan x, str]
-}