{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, CPP, DeriveDataTypeable, DeriveFunctor #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Language.Python.Version2.Syntax.AST 
-- Copyright   : (c) 2009 Bernie Pope 
-- License     : BSD-style
-- Maintainer  : bjpop@csse.unimelb.edu.au
-- Stability   : experimental
-- Portability : ghc
--
-- Representation of the Python abstract syntax tree (AST). The representation is
-- a superset of versions 2.x and 3.x of Python. In many cases they are 
-- identical. The documentation in this module indicates where they are
-- different.
--
-- All the data types have a (polymorphic) parameter which allows the AST to
-- be annotated by an arbitrary type (for example source locations). Specialised
-- instances of the types are provided for source spans. For example @Module a@ is
-- the type of modules, and @ModuleSpan@ is the type of modules annoted with source
-- span information.
--
-- Note: there are cases where the AST is more liberal than the formal grammar
-- of the language. Therefore some care must be taken when constructing
-- Python programs using the raw AST. 
-----------------------------------------------------------------------------

module Language.Python.Common.AST ( 
   -- * Annotation projection
     Annotated (..)
   -- * Modules
   , Module (..), ModuleSpan
   -- * Identifiers and dotted names
   , Ident (..), IdentSpan
   , DottedName, DottedNameSpan
   -- * Statements, suites, parameters, decorators and assignment operators
   , Statement (..), StatementSpan
   , Suite, SuiteSpan
   , Parameter (..), ParameterSpan
   , ParamTuple (..), ParamTupleSpan
   , Decorator (..), DecoratorSpan
   , AssignOp (..), AssignOpSpan
   -- * Expressions, operators, arguments and slices
   , Expr (..), ExprSpan
   , Op (..), OpSpan
   , Argument (..), ArgumentSpan
   , Slice (..), SliceSpan
   , DictKeyDatumList (..), DictKeyDatumListSpan
   , YieldArg (..), YieldArgSpan
   -- * Imports
   , ImportItem (..), ImportItemSpan
   , FromItem (..), FromItemSpan
   , FromItems (..), FromItemsSpan
   , ImportRelative (..), ImportRelativeSpan
   -- * Exceptions
   , Handler (..), HandlerSpan
   , ExceptClause (..), ExceptClauseSpan
   , RaiseExpr (..), RaiseExprSpan
   -- * Comprehensions
   , Comprehension (..), ComprehensionSpan
   , ComprehensionExpr (..), ComprehensionExprSpan
   , CompFor (..), CompForSpan
   , CompIf (..), CompIfSpan
   , CompIter (..), CompIterSpan
   )
   where

import Language.Python.Common.SrcLocation ( Span (getSpan), SrcSpan (..), spanning ) 
import Data.Data

--------------------------------------------------------------------------------

-- | Convenient access to annotations in annotated types. 
class Annotated t where
   -- | Given an annotated type, project out its annotation value.
   annot :: t annot -> annot

-- | Identifier.
data Ident annot = Ident { forall annot. Ident annot -> String
ident_string :: !String, forall annot. Ident annot -> annot
ident_annot :: annot }
   deriving (Ident annot -> Ident annot -> Bool
(Ident annot -> Ident annot -> Bool)
-> (Ident annot -> Ident annot -> Bool) -> Eq (Ident annot)
forall annot. Eq annot => Ident annot -> Ident annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => Ident annot -> Ident annot -> Bool
== :: Ident annot -> Ident annot -> Bool
$c/= :: forall annot. Eq annot => Ident annot -> Ident annot -> Bool
/= :: Ident annot -> Ident annot -> Bool
Eq,Eq (Ident annot)
Eq (Ident annot) =>
(Ident annot -> Ident annot -> Ordering)
-> (Ident annot -> Ident annot -> Bool)
-> (Ident annot -> Ident annot -> Bool)
-> (Ident annot -> Ident annot -> Bool)
-> (Ident annot -> Ident annot -> Bool)
-> (Ident annot -> Ident annot -> Ident annot)
-> (Ident annot -> Ident annot -> Ident annot)
-> Ord (Ident annot)
Ident annot -> Ident annot -> Bool
Ident annot -> Ident annot -> Ordering
Ident annot -> Ident annot -> Ident annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (Ident annot)
forall annot. Ord annot => Ident annot -> Ident annot -> Bool
forall annot. Ord annot => Ident annot -> Ident annot -> Ordering
forall annot.
Ord annot =>
Ident annot -> Ident annot -> Ident annot
$ccompare :: forall annot. Ord annot => Ident annot -> Ident annot -> Ordering
compare :: Ident annot -> Ident annot -> Ordering
$c< :: forall annot. Ord annot => Ident annot -> Ident annot -> Bool
< :: Ident annot -> Ident annot -> Bool
$c<= :: forall annot. Ord annot => Ident annot -> Ident annot -> Bool
<= :: Ident annot -> Ident annot -> Bool
$c> :: forall annot. Ord annot => Ident annot -> Ident annot -> Bool
> :: Ident annot -> Ident annot -> Bool
$c>= :: forall annot. Ord annot => Ident annot -> Ident annot -> Bool
>= :: Ident annot -> Ident annot -> Bool
$cmax :: forall annot.
Ord annot =>
Ident annot -> Ident annot -> Ident annot
max :: Ident annot -> Ident annot -> Ident annot
$cmin :: forall annot.
Ord annot =>
Ident annot -> Ident annot -> Ident annot
min :: Ident annot -> Ident annot -> Ident annot
Ord,Int -> Ident annot -> ShowS
[Ident annot] -> ShowS
Ident annot -> String
(Int -> Ident annot -> ShowS)
-> (Ident annot -> String)
-> ([Ident annot] -> ShowS)
-> Show (Ident annot)
forall annot. Show annot => Int -> Ident annot -> ShowS
forall annot. Show annot => [Ident annot] -> ShowS
forall annot. Show annot => Ident annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> Ident annot -> ShowS
showsPrec :: Int -> Ident annot -> ShowS
$cshow :: forall annot. Show annot => Ident annot -> String
show :: Ident annot -> String
$cshowList :: forall annot. Show annot => [Ident annot] -> ShowS
showList :: [Ident annot] -> ShowS
Show,Typeable,Typeable (Ident annot)
Typeable (Ident annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Ident annot -> c (Ident annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Ident annot))
-> (Ident annot -> Constr)
-> (Ident annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Ident annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Ident annot)))
-> ((forall b. Data b => b -> b) -> Ident annot -> Ident annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Ident annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Ident annot -> r)
-> (forall u. (forall d. Data d => d -> u) -> Ident annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Ident annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot))
-> Data (Ident annot)
Ident annot -> Constr
Ident annot -> DataType
(forall b. Data b => b -> b) -> Ident annot -> Ident annot
forall annot. Data annot => Typeable (Ident annot)
forall annot. Data annot => Ident annot -> Constr
forall annot. Data annot => Ident annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Ident annot -> Ident annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Ident annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Ident annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ident annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ident annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ident annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident annot -> c (Ident annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Ident annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Ident annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Ident annot -> u
forall u. (forall d. Data d => d -> u) -> Ident annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ident annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ident annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ident annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident annot -> c (Ident annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Ident annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Ident annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident annot -> c (Ident annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident annot -> c (Ident annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ident annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Ident annot)
$ctoConstr :: forall annot. Data annot => Ident annot -> Constr
toConstr :: Ident annot -> Constr
$cdataTypeOf :: forall annot. Data annot => Ident annot -> DataType
dataTypeOf :: Ident annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Ident annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Ident annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Ident annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Ident annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Ident annot -> Ident annot
gmapT :: (forall b. Data b => b -> b) -> Ident annot -> Ident annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ident annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Ident annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ident annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Ident annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Ident annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ident annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Ident annot -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ident annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident annot -> m (Ident annot)
Data,(forall a b. (a -> b) -> Ident a -> Ident b)
-> (forall a b. a -> Ident b -> Ident a) -> Functor Ident
forall a b. a -> Ident b -> Ident a
forall a b. (a -> b) -> Ident a -> Ident b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Ident a -> Ident b
fmap :: forall a b. (a -> b) -> Ident a -> Ident b
$c<$ :: forall a b. a -> Ident b -> Ident a
<$ :: forall a b. a -> Ident b -> Ident a
Functor)

type IdentSpan = Ident SrcSpan

instance Span IdentSpan where
   getSpan :: IdentSpan -> SrcSpan
getSpan = IdentSpan -> SrcSpan
forall annot. Ident annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated Ident where
   annot :: forall annot. Ident annot -> annot
annot = Ident annot -> annot
forall annot. Ident annot -> annot
ident_annot

-- | A module (Python source file). 
--
--    * Version 2.6 <http://docs.python.org/2.6/reference/toplevel_components.html>
-- 
--    * Version 3.1 <http://docs.python.org/3.1/reference/toplevel_components.html> 
-- 
newtype Module annot = Module [Statement annot] -- ^ A module is just a sequence of top-level statements.
   deriving (Module annot -> Module annot -> Bool
(Module annot -> Module annot -> Bool)
-> (Module annot -> Module annot -> Bool) -> Eq (Module annot)
forall annot. Eq annot => Module annot -> Module annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => Module annot -> Module annot -> Bool
== :: Module annot -> Module annot -> Bool
$c/= :: forall annot. Eq annot => Module annot -> Module annot -> Bool
/= :: Module annot -> Module annot -> Bool
Eq,Eq (Module annot)
Eq (Module annot) =>
(Module annot -> Module annot -> Ordering)
-> (Module annot -> Module annot -> Bool)
-> (Module annot -> Module annot -> Bool)
-> (Module annot -> Module annot -> Bool)
-> (Module annot -> Module annot -> Bool)
-> (Module annot -> Module annot -> Module annot)
-> (Module annot -> Module annot -> Module annot)
-> Ord (Module annot)
Module annot -> Module annot -> Bool
Module annot -> Module annot -> Ordering
Module annot -> Module annot -> Module annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (Module annot)
forall annot. Ord annot => Module annot -> Module annot -> Bool
forall annot. Ord annot => Module annot -> Module annot -> Ordering
forall annot.
Ord annot =>
Module annot -> Module annot -> Module annot
$ccompare :: forall annot. Ord annot => Module annot -> Module annot -> Ordering
compare :: Module annot -> Module annot -> Ordering
$c< :: forall annot. Ord annot => Module annot -> Module annot -> Bool
< :: Module annot -> Module annot -> Bool
$c<= :: forall annot. Ord annot => Module annot -> Module annot -> Bool
<= :: Module annot -> Module annot -> Bool
$c> :: forall annot. Ord annot => Module annot -> Module annot -> Bool
> :: Module annot -> Module annot -> Bool
$c>= :: forall annot. Ord annot => Module annot -> Module annot -> Bool
>= :: Module annot -> Module annot -> Bool
$cmax :: forall annot.
Ord annot =>
Module annot -> Module annot -> Module annot
max :: Module annot -> Module annot -> Module annot
$cmin :: forall annot.
Ord annot =>
Module annot -> Module annot -> Module annot
min :: Module annot -> Module annot -> Module annot
Ord,Int -> Module annot -> ShowS
[Module annot] -> ShowS
Module annot -> String
(Int -> Module annot -> ShowS)
-> (Module annot -> String)
-> ([Module annot] -> ShowS)
-> Show (Module annot)
forall annot. Show annot => Int -> Module annot -> ShowS
forall annot. Show annot => [Module annot] -> ShowS
forall annot. Show annot => Module annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> Module annot -> ShowS
showsPrec :: Int -> Module annot -> ShowS
$cshow :: forall annot. Show annot => Module annot -> String
show :: Module annot -> String
$cshowList :: forall annot. Show annot => [Module annot] -> ShowS
showList :: [Module annot] -> ShowS
Show,Typeable,Typeable (Module annot)
Typeable (Module annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Module annot -> c (Module annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Module annot))
-> (Module annot -> Constr)
-> (Module annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Module annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Module annot)))
-> ((forall b. Data b => b -> b) -> Module annot -> Module annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Module annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Module annot -> r)
-> (forall u. (forall d. Data d => d -> u) -> Module annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Module annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Module annot -> m (Module annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Module annot -> m (Module annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Module annot -> m (Module annot))
-> Data (Module annot)
Module annot -> Constr
Module annot -> DataType
(forall b. Data b => b -> b) -> Module annot -> Module annot
forall annot. Data annot => Typeable (Module annot)
forall annot. Data annot => Module annot -> Constr
forall annot. Data annot => Module annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Module annot -> Module annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Module annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Module annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Module annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Module annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> Module annot -> m (Module annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Module annot -> m (Module annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Module annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module annot -> c (Module annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Module annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Module annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Module annot -> u
forall u. (forall d. Data d => d -> u) -> Module annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Module annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Module annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Module annot -> m (Module annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module annot -> m (Module annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Module annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module annot -> c (Module annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Module annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Module annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module annot -> c (Module annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module annot -> c (Module annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Module annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Module annot)
$ctoConstr :: forall annot. Data annot => Module annot -> Constr
toConstr :: Module annot -> Constr
$cdataTypeOf :: forall annot. Data annot => Module annot -> DataType
dataTypeOf :: Module annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Module annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Module annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Module annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Module annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Module annot -> Module annot
gmapT :: (forall b. Data b => b -> b) -> Module annot -> Module annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Module annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Module annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Module annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Module annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Module annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Module annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Module annot -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Module annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> Module annot -> m (Module annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Module annot -> m (Module annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Module annot -> m (Module annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module annot -> m (Module annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Module annot -> m (Module annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module annot -> m (Module annot)
Data,(forall a b. (a -> b) -> Module a -> Module b)
-> (forall a b. a -> Module b -> Module a) -> Functor Module
forall a b. a -> Module b -> Module a
forall a b. (a -> b) -> Module a -> Module b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Module a -> Module b
fmap :: forall a b. (a -> b) -> Module a -> Module b
$c<$ :: forall a b. a -> Module b -> Module a
<$ :: forall a b. a -> Module b -> Module a
Functor)

type ModuleSpan = Module SrcSpan

-- | A block of statements. A suite is a group of statements controlled by a clause, 
-- for example, the body of a loop. 
--
--    * Version 2.6 <http://docs.python.org/2.6/reference/compound_stmts.html>
-- 
--    * Version 3.1 <http://docs.python.org/3.1/reference/compound_stmts.html>
--
type Suite annot = [Statement annot] 

type SuiteSpan = Suite SrcSpan

-- | A compound name constructed with the dot operator.
type DottedName annot = [Ident annot]

type DottedNameSpan = DottedName SrcSpan 

-- | An entity imported using the \'import\' keyword.
-- 
--    * Version 2.6 <http://docs.python.org/2.6/reference/simple_stmts.html#the-import-statement>
--
--    * Version 3.1 <http://docs.python.org/3.1/reference/simple_stmts.html#the-import-statement> 
--
data ImportItem annot = 
   ImportItem 
   { forall annot. ImportItem annot -> DottedName annot
import_item_name :: DottedName annot   -- ^ The name of module to import.
   , forall annot. ImportItem annot -> Maybe (Ident annot)
import_as_name :: Maybe (Ident annot)  -- ^ An optional name to refer to the entity (the \'as\' name). 
   , forall annot. ImportItem annot -> annot
import_item_annot :: annot
   }
   deriving (ImportItem annot -> ImportItem annot -> Bool
(ImportItem annot -> ImportItem annot -> Bool)
-> (ImportItem annot -> ImportItem annot -> Bool)
-> Eq (ImportItem annot)
forall annot.
Eq annot =>
ImportItem annot -> ImportItem annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
ImportItem annot -> ImportItem annot -> Bool
== :: ImportItem annot -> ImportItem annot -> Bool
$c/= :: forall annot.
Eq annot =>
ImportItem annot -> ImportItem annot -> Bool
/= :: ImportItem annot -> ImportItem annot -> Bool
Eq,Eq (ImportItem annot)
Eq (ImportItem annot) =>
(ImportItem annot -> ImportItem annot -> Ordering)
-> (ImportItem annot -> ImportItem annot -> Bool)
-> (ImportItem annot -> ImportItem annot -> Bool)
-> (ImportItem annot -> ImportItem annot -> Bool)
-> (ImportItem annot -> ImportItem annot -> Bool)
-> (ImportItem annot -> ImportItem annot -> ImportItem annot)
-> (ImportItem annot -> ImportItem annot -> ImportItem annot)
-> Ord (ImportItem annot)
ImportItem annot -> ImportItem annot -> Bool
ImportItem annot -> ImportItem annot -> Ordering
ImportItem annot -> ImportItem annot -> ImportItem annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (ImportItem annot)
forall annot.
Ord annot =>
ImportItem annot -> ImportItem annot -> Bool
forall annot.
Ord annot =>
ImportItem annot -> ImportItem annot -> Ordering
forall annot.
Ord annot =>
ImportItem annot -> ImportItem annot -> ImportItem annot
$ccompare :: forall annot.
Ord annot =>
ImportItem annot -> ImportItem annot -> Ordering
compare :: ImportItem annot -> ImportItem annot -> Ordering
$c< :: forall annot.
Ord annot =>
ImportItem annot -> ImportItem annot -> Bool
< :: ImportItem annot -> ImportItem annot -> Bool
$c<= :: forall annot.
Ord annot =>
ImportItem annot -> ImportItem annot -> Bool
<= :: ImportItem annot -> ImportItem annot -> Bool
$c> :: forall annot.
Ord annot =>
ImportItem annot -> ImportItem annot -> Bool
> :: ImportItem annot -> ImportItem annot -> Bool
$c>= :: forall annot.
Ord annot =>
ImportItem annot -> ImportItem annot -> Bool
>= :: ImportItem annot -> ImportItem annot -> Bool
$cmax :: forall annot.
Ord annot =>
ImportItem annot -> ImportItem annot -> ImportItem annot
max :: ImportItem annot -> ImportItem annot -> ImportItem annot
$cmin :: forall annot.
Ord annot =>
ImportItem annot -> ImportItem annot -> ImportItem annot
min :: ImportItem annot -> ImportItem annot -> ImportItem annot
Ord,Int -> ImportItem annot -> ShowS
[ImportItem annot] -> ShowS
ImportItem annot -> String
(Int -> ImportItem annot -> ShowS)
-> (ImportItem annot -> String)
-> ([ImportItem annot] -> ShowS)
-> Show (ImportItem annot)
forall annot. Show annot => Int -> ImportItem annot -> ShowS
forall annot. Show annot => [ImportItem annot] -> ShowS
forall annot. Show annot => ImportItem annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> ImportItem annot -> ShowS
showsPrec :: Int -> ImportItem annot -> ShowS
$cshow :: forall annot. Show annot => ImportItem annot -> String
show :: ImportItem annot -> String
$cshowList :: forall annot. Show annot => [ImportItem annot] -> ShowS
showList :: [ImportItem annot] -> ShowS
Show,Typeable,Typeable (ImportItem annot)
Typeable (ImportItem annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ImportItem annot
 -> c (ImportItem annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ImportItem annot))
-> (ImportItem annot -> Constr)
-> (ImportItem annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ImportItem annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ImportItem annot)))
-> ((forall b. Data b => b -> b)
    -> ImportItem annot -> ImportItem annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ImportItem annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ImportItem annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ImportItem annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ImportItem annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ImportItem annot -> m (ImportItem annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ImportItem annot -> m (ImportItem annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ImportItem annot -> m (ImportItem annot))
-> Data (ImportItem annot)
ImportItem annot -> Constr
ImportItem annot -> DataType
(forall b. Data b => b -> b)
-> ImportItem annot -> ImportItem annot
forall annot. Data annot => Typeable (ImportItem annot)
forall annot. Data annot => ImportItem annot -> Constr
forall annot. Data annot => ImportItem annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> ImportItem annot -> ImportItem annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> ImportItem annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> ImportItem annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportItem annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportItem annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> ImportItem annot -> m (ImportItem annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ImportItem annot -> m (ImportItem annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ImportItem annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImportItem annot -> c (ImportItem annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ImportItem annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ImportItem annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ImportItem annot -> u
forall u. (forall d. Data d => d -> u) -> ImportItem annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportItem annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportItem annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ImportItem annot -> m (ImportItem annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImportItem annot -> m (ImportItem annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ImportItem annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImportItem annot -> c (ImportItem annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ImportItem annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ImportItem annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImportItem annot -> c (ImportItem annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImportItem annot -> c (ImportItem annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ImportItem annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ImportItem annot)
$ctoConstr :: forall annot. Data annot => ImportItem annot -> Constr
toConstr :: ImportItem annot -> Constr
$cdataTypeOf :: forall annot. Data annot => ImportItem annot -> DataType
dataTypeOf :: ImportItem annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ImportItem annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ImportItem annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ImportItem annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ImportItem annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> ImportItem annot -> ImportItem annot
gmapT :: (forall b. Data b => b -> b)
-> ImportItem annot -> ImportItem annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportItem annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportItem annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportItem annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportItem annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> ImportItem annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ImportItem annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> ImportItem annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ImportItem annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> ImportItem annot -> m (ImportItem annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ImportItem annot -> m (ImportItem annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ImportItem annot -> m (ImportItem annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImportItem annot -> m (ImportItem annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ImportItem annot -> m (ImportItem annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImportItem annot -> m (ImportItem annot)
Data,(forall a b. (a -> b) -> ImportItem a -> ImportItem b)
-> (forall a b. a -> ImportItem b -> ImportItem a)
-> Functor ImportItem
forall a b. a -> ImportItem b -> ImportItem a
forall a b. (a -> b) -> ImportItem a -> ImportItem b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ImportItem a -> ImportItem b
fmap :: forall a b. (a -> b) -> ImportItem a -> ImportItem b
$c<$ :: forall a b. a -> ImportItem b -> ImportItem a
<$ :: forall a b. a -> ImportItem b -> ImportItem a
Functor)

type ImportItemSpan = ImportItem SrcSpan

instance Span ImportItemSpan where
   getSpan :: ImportItemSpan -> SrcSpan
getSpan = ImportItemSpan -> SrcSpan
forall annot. ImportItem annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated ImportItem where
   annot :: forall annot. ImportItem annot -> annot
annot = ImportItem annot -> annot
forall annot. ImportItem annot -> annot
import_item_annot 

-- | An entity imported using the \'from ... import\' construct.
--
--    * Version 2.6 <http://docs.python.org/2.6/reference/simple_stmts.html#the-import-statement>
-- 
--    * Version 3.1 <http://docs.python.org/3.1/reference/simple_stmts.html#the-import-statement>
--
data FromItem annot = 
   FromItem 
   { forall annot. FromItem annot -> Ident annot
from_item_name :: Ident annot       -- ^ The name of the entity imported. 
   , forall annot. FromItem annot -> Maybe (Ident annot)
from_as_name :: Maybe (Ident annot) -- ^ An optional name to refer to the entity (the \'as\' name).
   , forall annot. FromItem annot -> annot
from_item_annot :: annot
   }
   deriving (FromItem annot -> FromItem annot -> Bool
(FromItem annot -> FromItem annot -> Bool)
-> (FromItem annot -> FromItem annot -> Bool)
-> Eq (FromItem annot)
forall annot. Eq annot => FromItem annot -> FromItem annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => FromItem annot -> FromItem annot -> Bool
== :: FromItem annot -> FromItem annot -> Bool
$c/= :: forall annot. Eq annot => FromItem annot -> FromItem annot -> Bool
/= :: FromItem annot -> FromItem annot -> Bool
Eq,Eq (FromItem annot)
Eq (FromItem annot) =>
(FromItem annot -> FromItem annot -> Ordering)
-> (FromItem annot -> FromItem annot -> Bool)
-> (FromItem annot -> FromItem annot -> Bool)
-> (FromItem annot -> FromItem annot -> Bool)
-> (FromItem annot -> FromItem annot -> Bool)
-> (FromItem annot -> FromItem annot -> FromItem annot)
-> (FromItem annot -> FromItem annot -> FromItem annot)
-> Ord (FromItem annot)
FromItem annot -> FromItem annot -> Bool
FromItem annot -> FromItem annot -> Ordering
FromItem annot -> FromItem annot -> FromItem annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (FromItem annot)
forall annot. Ord annot => FromItem annot -> FromItem annot -> Bool
forall annot.
Ord annot =>
FromItem annot -> FromItem annot -> Ordering
forall annot.
Ord annot =>
FromItem annot -> FromItem annot -> FromItem annot
$ccompare :: forall annot.
Ord annot =>
FromItem annot -> FromItem annot -> Ordering
compare :: FromItem annot -> FromItem annot -> Ordering
$c< :: forall annot. Ord annot => FromItem annot -> FromItem annot -> Bool
< :: FromItem annot -> FromItem annot -> Bool
$c<= :: forall annot. Ord annot => FromItem annot -> FromItem annot -> Bool
<= :: FromItem annot -> FromItem annot -> Bool
$c> :: forall annot. Ord annot => FromItem annot -> FromItem annot -> Bool
> :: FromItem annot -> FromItem annot -> Bool
$c>= :: forall annot. Ord annot => FromItem annot -> FromItem annot -> Bool
>= :: FromItem annot -> FromItem annot -> Bool
$cmax :: forall annot.
Ord annot =>
FromItem annot -> FromItem annot -> FromItem annot
max :: FromItem annot -> FromItem annot -> FromItem annot
$cmin :: forall annot.
Ord annot =>
FromItem annot -> FromItem annot -> FromItem annot
min :: FromItem annot -> FromItem annot -> FromItem annot
Ord,Int -> FromItem annot -> ShowS
[FromItem annot] -> ShowS
FromItem annot -> String
(Int -> FromItem annot -> ShowS)
-> (FromItem annot -> String)
-> ([FromItem annot] -> ShowS)
-> Show (FromItem annot)
forall annot. Show annot => Int -> FromItem annot -> ShowS
forall annot. Show annot => [FromItem annot] -> ShowS
forall annot. Show annot => FromItem annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> FromItem annot -> ShowS
showsPrec :: Int -> FromItem annot -> ShowS
$cshow :: forall annot. Show annot => FromItem annot -> String
show :: FromItem annot -> String
$cshowList :: forall annot. Show annot => [FromItem annot] -> ShowS
showList :: [FromItem annot] -> ShowS
Show,Typeable,Typeable (FromItem annot)
Typeable (FromItem annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FromItem annot -> c (FromItem annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (FromItem annot))
-> (FromItem annot -> Constr)
-> (FromItem annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (FromItem annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (FromItem annot)))
-> ((forall b. Data b => b -> b)
    -> FromItem annot -> FromItem annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FromItem annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FromItem annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FromItem annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FromItem annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FromItem annot -> m (FromItem annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FromItem annot -> m (FromItem annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FromItem annot -> m (FromItem annot))
-> Data (FromItem annot)
FromItem annot -> Constr
FromItem annot -> DataType
(forall b. Data b => b -> b) -> FromItem annot -> FromItem annot
forall annot. Data annot => Typeable (FromItem annot)
forall annot. Data annot => FromItem annot -> Constr
forall annot. Data annot => FromItem annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> FromItem annot -> FromItem annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> FromItem annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> FromItem annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromItem annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromItem annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> FromItem annot -> m (FromItem annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromItem annot -> m (FromItem annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromItem annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromItem annot -> c (FromItem annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromItem annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromItem annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FromItem annot -> u
forall u. (forall d. Data d => d -> u) -> FromItem annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromItem annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromItem annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FromItem annot -> m (FromItem annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromItem annot -> m (FromItem annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromItem annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromItem annot -> c (FromItem annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromItem annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromItem annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromItem annot -> c (FromItem annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromItem annot -> c (FromItem annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromItem annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromItem annot)
$ctoConstr :: forall annot. Data annot => FromItem annot -> Constr
toConstr :: FromItem annot -> Constr
$cdataTypeOf :: forall annot. Data annot => FromItem annot -> DataType
dataTypeOf :: FromItem annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromItem annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromItem annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromItem annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromItem annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> FromItem annot -> FromItem annot
gmapT :: (forall b. Data b => b -> b) -> FromItem annot -> FromItem annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromItem annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromItem annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromItem annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromItem annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> FromItem annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FromItem annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> FromItem annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FromItem annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> FromItem annot -> m (FromItem annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FromItem annot -> m (FromItem annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromItem annot -> m (FromItem annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromItem annot -> m (FromItem annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromItem annot -> m (FromItem annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromItem annot -> m (FromItem annot)
Data,(forall a b. (a -> b) -> FromItem a -> FromItem b)
-> (forall a b. a -> FromItem b -> FromItem a) -> Functor FromItem
forall a b. a -> FromItem b -> FromItem a
forall a b. (a -> b) -> FromItem a -> FromItem b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> FromItem a -> FromItem b
fmap :: forall a b. (a -> b) -> FromItem a -> FromItem b
$c<$ :: forall a b. a -> FromItem b -> FromItem a
<$ :: forall a b. a -> FromItem b -> FromItem a
Functor)

type FromItemSpan = FromItem SrcSpan

instance Span FromItemSpan where
   getSpan :: FromItemSpan -> SrcSpan
getSpan = FromItemSpan -> SrcSpan
forall annot. FromItem annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated FromItem where
   annot :: forall annot. FromItem annot -> annot
annot = FromItem annot -> annot
forall annot. FromItem annot -> annot
from_item_annot 

-- | Items imported using the \'from ... import\' construct.
data FromItems annot 
   = ImportEverything { forall annot. FromItems annot -> annot
from_items_annot :: annot } -- ^ Import everything exported from the module.
   | FromItems { forall annot. FromItems annot -> [FromItem annot]
from_items_items :: [FromItem annot], from_items_annot :: annot } -- ^ Import a specific list of items from the module.
   deriving (FromItems annot -> FromItems annot -> Bool
(FromItems annot -> FromItems annot -> Bool)
-> (FromItems annot -> FromItems annot -> Bool)
-> Eq (FromItems annot)
forall annot.
Eq annot =>
FromItems annot -> FromItems annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
FromItems annot -> FromItems annot -> Bool
== :: FromItems annot -> FromItems annot -> Bool
$c/= :: forall annot.
Eq annot =>
FromItems annot -> FromItems annot -> Bool
/= :: FromItems annot -> FromItems annot -> Bool
Eq,Eq (FromItems annot)
Eq (FromItems annot) =>
(FromItems annot -> FromItems annot -> Ordering)
-> (FromItems annot -> FromItems annot -> Bool)
-> (FromItems annot -> FromItems annot -> Bool)
-> (FromItems annot -> FromItems annot -> Bool)
-> (FromItems annot -> FromItems annot -> Bool)
-> (FromItems annot -> FromItems annot -> FromItems annot)
-> (FromItems annot -> FromItems annot -> FromItems annot)
-> Ord (FromItems annot)
FromItems annot -> FromItems annot -> Bool
FromItems annot -> FromItems annot -> Ordering
FromItems annot -> FromItems annot -> FromItems annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (FromItems annot)
forall annot.
Ord annot =>
FromItems annot -> FromItems annot -> Bool
forall annot.
Ord annot =>
FromItems annot -> FromItems annot -> Ordering
forall annot.
Ord annot =>
FromItems annot -> FromItems annot -> FromItems annot
$ccompare :: forall annot.
Ord annot =>
FromItems annot -> FromItems annot -> Ordering
compare :: FromItems annot -> FromItems annot -> Ordering
$c< :: forall annot.
Ord annot =>
FromItems annot -> FromItems annot -> Bool
< :: FromItems annot -> FromItems annot -> Bool
$c<= :: forall annot.
Ord annot =>
FromItems annot -> FromItems annot -> Bool
<= :: FromItems annot -> FromItems annot -> Bool
$c> :: forall annot.
Ord annot =>
FromItems annot -> FromItems annot -> Bool
> :: FromItems annot -> FromItems annot -> Bool
$c>= :: forall annot.
Ord annot =>
FromItems annot -> FromItems annot -> Bool
>= :: FromItems annot -> FromItems annot -> Bool
$cmax :: forall annot.
Ord annot =>
FromItems annot -> FromItems annot -> FromItems annot
max :: FromItems annot -> FromItems annot -> FromItems annot
$cmin :: forall annot.
Ord annot =>
FromItems annot -> FromItems annot -> FromItems annot
min :: FromItems annot -> FromItems annot -> FromItems annot
Ord,Int -> FromItems annot -> ShowS
[FromItems annot] -> ShowS
FromItems annot -> String
(Int -> FromItems annot -> ShowS)
-> (FromItems annot -> String)
-> ([FromItems annot] -> ShowS)
-> Show (FromItems annot)
forall annot. Show annot => Int -> FromItems annot -> ShowS
forall annot. Show annot => [FromItems annot] -> ShowS
forall annot. Show annot => FromItems annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> FromItems annot -> ShowS
showsPrec :: Int -> FromItems annot -> ShowS
$cshow :: forall annot. Show annot => FromItems annot -> String
show :: FromItems annot -> String
$cshowList :: forall annot. Show annot => [FromItems annot] -> ShowS
showList :: [FromItems annot] -> ShowS
Show,Typeable,Typeable (FromItems annot)
Typeable (FromItems annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FromItems annot -> c (FromItems annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (FromItems annot))
-> (FromItems annot -> Constr)
-> (FromItems annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (FromItems annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (FromItems annot)))
-> ((forall b. Data b => b -> b)
    -> FromItems annot -> FromItems annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FromItems annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FromItems annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FromItems annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FromItems annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FromItems annot -> m (FromItems annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FromItems annot -> m (FromItems annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FromItems annot -> m (FromItems annot))
-> Data (FromItems annot)
FromItems annot -> Constr
FromItems annot -> DataType
(forall b. Data b => b -> b) -> FromItems annot -> FromItems annot
forall annot. Data annot => Typeable (FromItems annot)
forall annot. Data annot => FromItems annot -> Constr
forall annot. Data annot => FromItems annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> FromItems annot -> FromItems annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> FromItems annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> FromItems annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromItems annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromItems annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> FromItems annot -> m (FromItems annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromItems annot -> m (FromItems annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromItems annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromItems annot -> c (FromItems annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromItems annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromItems annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FromItems annot -> u
forall u. (forall d. Data d => d -> u) -> FromItems annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromItems annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromItems annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FromItems annot -> m (FromItems annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromItems annot -> m (FromItems annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromItems annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromItems annot -> c (FromItems annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromItems annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromItems annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromItems annot -> c (FromItems annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromItems annot -> c (FromItems annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromItems annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromItems annot)
$ctoConstr :: forall annot. Data annot => FromItems annot -> Constr
toConstr :: FromItems annot -> Constr
$cdataTypeOf :: forall annot. Data annot => FromItems annot -> DataType
dataTypeOf :: FromItems annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromItems annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromItems annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromItems annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromItems annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> FromItems annot -> FromItems annot
gmapT :: (forall b. Data b => b -> b) -> FromItems annot -> FromItems annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromItems annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromItems annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromItems annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromItems annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> FromItems annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FromItems annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> FromItems annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FromItems annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> FromItems annot -> m (FromItems annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FromItems annot -> m (FromItems annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromItems annot -> m (FromItems annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromItems annot -> m (FromItems annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromItems annot -> m (FromItems annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromItems annot -> m (FromItems annot)
Data,(forall a b. (a -> b) -> FromItems a -> FromItems b)
-> (forall a b. a -> FromItems b -> FromItems a)
-> Functor FromItems
forall a b. a -> FromItems b -> FromItems a
forall a b. (a -> b) -> FromItems a -> FromItems b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> FromItems a -> FromItems b
fmap :: forall a b. (a -> b) -> FromItems a -> FromItems b
$c<$ :: forall a b. a -> FromItems b -> FromItems a
<$ :: forall a b. a -> FromItems b -> FromItems a
Functor)

type FromItemsSpan = FromItems SrcSpan

instance Span FromItemsSpan where
   getSpan :: FromItemsSpan -> SrcSpan
getSpan = FromItemsSpan -> SrcSpan
forall annot. FromItems annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated FromItems where
   annot :: forall annot. FromItems annot -> annot
annot = FromItems annot -> annot
forall annot. FromItems annot -> annot
from_items_annot 

-- | A reference to the module to import from using the \'from ... import\' construct.
data ImportRelative annot 
   = ImportRelative 
     { forall annot. ImportRelative annot -> Int
import_relative_dots :: Int
     , forall annot. ImportRelative annot -> Maybe (DottedName annot)
import_relative_module :: Maybe (DottedName annot) 
     , forall annot. ImportRelative annot -> annot
import_relative_annot :: annot 
     }
   deriving (ImportRelative annot -> ImportRelative annot -> Bool
(ImportRelative annot -> ImportRelative annot -> Bool)
-> (ImportRelative annot -> ImportRelative annot -> Bool)
-> Eq (ImportRelative annot)
forall annot.
Eq annot =>
ImportRelative annot -> ImportRelative annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
ImportRelative annot -> ImportRelative annot -> Bool
== :: ImportRelative annot -> ImportRelative annot -> Bool
$c/= :: forall annot.
Eq annot =>
ImportRelative annot -> ImportRelative annot -> Bool
/= :: ImportRelative annot -> ImportRelative annot -> Bool
Eq,Eq (ImportRelative annot)
Eq (ImportRelative annot) =>
(ImportRelative annot -> ImportRelative annot -> Ordering)
-> (ImportRelative annot -> ImportRelative annot -> Bool)
-> (ImportRelative annot -> ImportRelative annot -> Bool)
-> (ImportRelative annot -> ImportRelative annot -> Bool)
-> (ImportRelative annot -> ImportRelative annot -> Bool)
-> (ImportRelative annot
    -> ImportRelative annot -> ImportRelative annot)
-> (ImportRelative annot
    -> ImportRelative annot -> ImportRelative annot)
-> Ord (ImportRelative annot)
ImportRelative annot -> ImportRelative annot -> Bool
ImportRelative annot -> ImportRelative annot -> Ordering
ImportRelative annot
-> ImportRelative annot -> ImportRelative annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (ImportRelative annot)
forall annot.
Ord annot =>
ImportRelative annot -> ImportRelative annot -> Bool
forall annot.
Ord annot =>
ImportRelative annot -> ImportRelative annot -> Ordering
forall annot.
Ord annot =>
ImportRelative annot
-> ImportRelative annot -> ImportRelative annot
$ccompare :: forall annot.
Ord annot =>
ImportRelative annot -> ImportRelative annot -> Ordering
compare :: ImportRelative annot -> ImportRelative annot -> Ordering
$c< :: forall annot.
Ord annot =>
ImportRelative annot -> ImportRelative annot -> Bool
< :: ImportRelative annot -> ImportRelative annot -> Bool
$c<= :: forall annot.
Ord annot =>
ImportRelative annot -> ImportRelative annot -> Bool
<= :: ImportRelative annot -> ImportRelative annot -> Bool
$c> :: forall annot.
Ord annot =>
ImportRelative annot -> ImportRelative annot -> Bool
> :: ImportRelative annot -> ImportRelative annot -> Bool
$c>= :: forall annot.
Ord annot =>
ImportRelative annot -> ImportRelative annot -> Bool
>= :: ImportRelative annot -> ImportRelative annot -> Bool
$cmax :: forall annot.
Ord annot =>
ImportRelative annot
-> ImportRelative annot -> ImportRelative annot
max :: ImportRelative annot
-> ImportRelative annot -> ImportRelative annot
$cmin :: forall annot.
Ord annot =>
ImportRelative annot
-> ImportRelative annot -> ImportRelative annot
min :: ImportRelative annot
-> ImportRelative annot -> ImportRelative annot
Ord,Int -> ImportRelative annot -> ShowS
[ImportRelative annot] -> ShowS
ImportRelative annot -> String
(Int -> ImportRelative annot -> ShowS)
-> (ImportRelative annot -> String)
-> ([ImportRelative annot] -> ShowS)
-> Show (ImportRelative annot)
forall annot. Show annot => Int -> ImportRelative annot -> ShowS
forall annot. Show annot => [ImportRelative annot] -> ShowS
forall annot. Show annot => ImportRelative annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> ImportRelative annot -> ShowS
showsPrec :: Int -> ImportRelative annot -> ShowS
$cshow :: forall annot. Show annot => ImportRelative annot -> String
show :: ImportRelative annot -> String
$cshowList :: forall annot. Show annot => [ImportRelative annot] -> ShowS
showList :: [ImportRelative annot] -> ShowS
Show,Typeable,Typeable (ImportRelative annot)
Typeable (ImportRelative annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ImportRelative annot
 -> c (ImportRelative annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ImportRelative annot))
-> (ImportRelative annot -> Constr)
-> (ImportRelative annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ImportRelative annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ImportRelative annot)))
-> ((forall b. Data b => b -> b)
    -> ImportRelative annot -> ImportRelative annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ImportRelative annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ImportRelative annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ImportRelative annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ImportRelative annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ImportRelative annot -> m (ImportRelative annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ImportRelative annot -> m (ImportRelative annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ImportRelative annot -> m (ImportRelative annot))
-> Data (ImportRelative annot)
ImportRelative annot -> Constr
ImportRelative annot -> DataType
(forall b. Data b => b -> b)
-> ImportRelative annot -> ImportRelative annot
forall annot. Data annot => Typeable (ImportRelative annot)
forall annot. Data annot => ImportRelative annot -> Constr
forall annot. Data annot => ImportRelative annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> ImportRelative annot -> ImportRelative annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> ImportRelative annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> ImportRelative annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportRelative annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportRelative annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> ImportRelative annot -> m (ImportRelative annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ImportRelative annot -> m (ImportRelative annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ImportRelative annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ImportRelative annot
-> c (ImportRelative annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ImportRelative annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ImportRelative annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ImportRelative annot -> u
forall u.
(forall d. Data d => d -> u) -> ImportRelative annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportRelative annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportRelative annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ImportRelative annot -> m (ImportRelative annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImportRelative annot -> m (ImportRelative annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ImportRelative annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ImportRelative annot
-> c (ImportRelative annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ImportRelative annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ImportRelative annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ImportRelative annot
-> c (ImportRelative annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ImportRelative annot
-> c (ImportRelative annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ImportRelative annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ImportRelative annot)
$ctoConstr :: forall annot. Data annot => ImportRelative annot -> Constr
toConstr :: ImportRelative annot -> Constr
$cdataTypeOf :: forall annot. Data annot => ImportRelative annot -> DataType
dataTypeOf :: ImportRelative annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ImportRelative annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ImportRelative annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ImportRelative annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ImportRelative annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> ImportRelative annot -> ImportRelative annot
gmapT :: (forall b. Data b => b -> b)
-> ImportRelative annot -> ImportRelative annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportRelative annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportRelative annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportRelative annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportRelative annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> ImportRelative annot -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ImportRelative annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> ImportRelative annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ImportRelative annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> ImportRelative annot -> m (ImportRelative annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ImportRelative annot -> m (ImportRelative annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ImportRelative annot -> m (ImportRelative annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImportRelative annot -> m (ImportRelative annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ImportRelative annot -> m (ImportRelative annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ImportRelative annot -> m (ImportRelative annot)
Data,(forall a b. (a -> b) -> ImportRelative a -> ImportRelative b)
-> (forall a b. a -> ImportRelative b -> ImportRelative a)
-> Functor ImportRelative
forall a b. a -> ImportRelative b -> ImportRelative a
forall a b. (a -> b) -> ImportRelative a -> ImportRelative b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ImportRelative a -> ImportRelative b
fmap :: forall a b. (a -> b) -> ImportRelative a -> ImportRelative b
$c<$ :: forall a b. a -> ImportRelative b -> ImportRelative a
<$ :: forall a b. a -> ImportRelative b -> ImportRelative a
Functor)

type ImportRelativeSpan = ImportRelative SrcSpan

instance Span ImportRelativeSpan where
  getSpan :: ImportRelativeSpan -> SrcSpan
getSpan = ImportRelativeSpan -> SrcSpan
forall annot. ImportRelative annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated ImportRelative where
   annot :: forall annot. ImportRelative annot -> annot
annot = ImportRelative annot -> annot
forall annot. ImportRelative annot -> annot
import_relative_annot 

-- | Statements.
--
--    * Simple statements:
--
--       * Version 2.6 <http://docs.python.org/2.6/reference/simple_stmts.html>
-- 
--       * Version 3.1 <http://docs.python.org/3.1/reference/simple_stmts.html>
--
--    * Compound statements:
--
--       * Version 2.6 <http://docs.python.org/2.6/reference/compound_stmts.html>
--
--       * Version 3.1 <http://docs.python.org/3.1/reference/compound_stmts.html>
--
data Statement annot 
   -- | Import statement.
   = Import 
     { forall annot. Statement annot -> [ImportItem annot]
import_items :: [ImportItem annot] -- ^ Items to import.
     , forall annot. Statement annot -> annot
stmt_annot :: annot 
     } 
   -- | From ... import statement.
   | FromImport 
     { forall annot. Statement annot -> ImportRelative annot
from_module :: ImportRelative annot -- ^ Module to import from.
     , forall annot. Statement annot -> FromItems annot
from_items :: FromItems annot -- ^ Items to import.
     , stmt_annot :: annot
     }
   -- | While loop. 
   | While 
     { forall annot. Statement annot -> Expr annot
while_cond :: Expr annot -- ^ Loop condition.
     , forall annot. Statement annot -> Suite annot
while_body :: Suite annot -- ^ Loop body.
     , forall annot. Statement annot -> Suite annot
while_else :: Suite annot -- ^ Else clause.
     , stmt_annot :: annot
     }
   -- | For loop. 
   | For 
     { forall annot. Statement annot -> [Expr annot]
for_targets :: [Expr annot] -- ^ Loop variables.
     , forall annot. Statement annot -> Expr annot
for_generator :: Expr annot -- ^ Loop generator. 
     , forall annot. Statement annot -> Suite annot
for_body :: Suite annot -- ^ Loop body
     , forall annot. Statement annot -> Suite annot
for_else :: Suite annot -- ^ Else clause.
     , stmt_annot :: annot
     }
   | AsyncFor
     { forall annot. Statement annot -> Statement annot
for_stmt :: Statement annot -- ^ For statement
     , stmt_annot :: annot
     }
   -- | Function definition. 
   | Fun 
     { forall annot. Statement annot -> Ident annot
fun_name :: Ident annot -- ^ Function name.
     , forall annot. Statement annot -> [Parameter annot]
fun_args :: [Parameter annot] -- ^ Function parameter list.
     , forall annot. Statement annot -> Maybe (Expr annot)
fun_result_annotation :: Maybe (Expr annot) -- ^ Optional result annotation.
     , forall annot. Statement annot -> Suite annot
fun_body :: Suite annot -- ^ Function body.
     , stmt_annot :: annot 
     }
   | AsyncFun
     { forall annot. Statement annot -> Statement annot
fun_def :: Statement annot -- ^ Function definition (Fun)
     , stmt_annot :: annot
     }
   -- | Class definition. 
   | Class 
     { forall annot. Statement annot -> Ident annot
class_name :: Ident annot -- ^ Class name.
     , forall annot. Statement annot -> [Argument annot]
class_args :: [Argument annot] -- ^ Class argument list. In version 2.x this is only ArgExprs. 
     , forall annot. Statement annot -> Suite annot
class_body :: Suite annot -- ^ Class body.
     , stmt_annot :: annot
     }
   -- | Conditional statement (if-elif-else). 
   | Conditional 
     { forall annot. Statement annot -> [(Expr annot, Suite annot)]
cond_guards :: [(Expr annot, Suite annot)] -- ^ Sequence of if-elif conditional clauses.
     , forall annot. Statement annot -> Suite annot
cond_else :: Suite annot -- ^ Possibly empty unconditional else clause.
     , stmt_annot :: annot
     }
   -- | Assignment statement. 
   | Assign 
     { forall annot. Statement annot -> [Expr annot]
assign_to :: [Expr annot] -- ^ Entity to assign to. 
     , forall annot. Statement annot -> Expr annot
assign_expr :: Expr annot -- ^ Expression to evaluate.
     , stmt_annot :: annot
     }
   -- | Augmented assignment statement. 
   | AugmentedAssign 
     { forall annot. Statement annot -> Expr annot
aug_assign_to :: Expr annot -- ^ Entity to assign to.
     , forall annot. Statement annot -> AssignOp annot
aug_assign_op :: AssignOp annot -- ^ Assignment operator (for example \'+=\').
     , forall annot. Statement annot -> Expr annot
aug_assign_expr :: Expr annot  -- ^ Expression to evaluate.
     , stmt_annot :: annot
     }
   | AnnotatedAssign
    { forall annot. Statement annot -> Expr annot
ann_assign_annotation :: Expr annot
    , forall annot. Statement annot -> Expr annot
ann_assign_to :: Expr annot
    , forall annot. Statement annot -> Maybe (Expr annot)
ann_assign_expr :: Maybe (Expr annot)
    , stmt_annot :: annot
    }
   -- | Decorated definition of a function or class.
   | Decorated 
     { forall annot. Statement annot -> [Decorator annot]
decorated_decorators :: [Decorator annot] -- ^ Decorators.
     , forall annot. Statement annot -> Statement annot
decorated_def :: Statement annot -- ^ Function or class definition to be decorated.
     , stmt_annot :: annot 
     }
   -- | Return statement (may only occur syntactically nested in a function definition). 
   | Return 
     { forall annot. Statement annot -> Maybe (Expr annot)
return_expr :: Maybe (Expr annot) -- ^ Optional expression to evaluate and return to caller.
     , stmt_annot :: annot 
     }
   -- | Try statement (exception handling). 
   | Try 
     { forall annot. Statement annot -> Suite annot
try_body :: Suite annot -- ^ Try clause.
     , forall annot. Statement annot -> [Handler annot]
try_excepts :: [Handler annot] -- ^ Exception handlers.
     , forall annot. Statement annot -> Suite annot
try_else :: Suite annot -- ^ Possibly empty else clause, executed if and when control flows off the end of the try clause.
     , forall annot. Statement annot -> Suite annot
try_finally :: Suite annot -- ^ Possibly empty finally clause.
     , stmt_annot :: annot
     }
   -- | Raise statement (exception throwing). 
   | Raise 
     { forall annot. Statement annot -> RaiseExpr annot
raise_expr :: RaiseExpr annot 
     , stmt_annot :: annot
     }
   -- | With statement (context management). 
   | With 
     { forall annot. Statement annot -> [(Expr annot, Maybe (Expr annot))]
with_context :: [(Expr annot, Maybe (Expr annot))] -- ^ Context expression(s) (yields a context manager).
     , forall annot. Statement annot -> Suite annot
with_body :: Suite annot -- ^ Suite to be managed.
     , stmt_annot :: annot
     }
   | AsyncWith
      { forall annot. Statement annot -> Statement annot
with_stmt :: Statement annot -- ^ With statement
      , stmt_annot :: annot
      }
   -- | Pass statement (null operation). 
   | Pass { stmt_annot :: annot }
   -- | Break statement (may only occur syntactically nested in a for or while loop, but not nested in a function or class definition within that loop). 
   | Break { stmt_annot :: annot }
   -- | Continue statement (may only occur syntactically nested in a for or while loop, but not nested in a function or class definition or finally clause within that loop). 
   | Continue { stmt_annot :: annot }
   -- | Del statement (delete). 
   | Delete 
     { forall annot. Statement annot -> [Expr annot]
del_exprs :: [Expr annot] -- ^ Items to delete.
     , stmt_annot :: annot 
     }
   -- | Expression statement. 
   | StmtExpr { forall annot. Statement annot -> Expr annot
stmt_expr :: Expr annot, stmt_annot :: annot }
   -- | Global declaration. 
   | Global 
     { forall annot. Statement annot -> [Ident annot]
global_vars :: [Ident annot] -- ^ Variables declared global in the current block.
     , stmt_annot :: annot
     }
   -- | Nonlocal declaration. /Version 3.x only/. 
   | NonLocal 
     { forall annot. Statement annot -> [Ident annot]
nonLocal_vars :: [Ident annot] -- ^ Variables declared nonlocal in the current block (their binding comes from bound the nearest enclosing scope).
     , stmt_annot :: annot
     }
   -- | Assertion. 
   | Assert 
     { forall annot. Statement annot -> [Expr annot]
assert_exprs :: [Expr annot] -- ^ Expressions being asserted.
     , stmt_annot :: annot
     }
   -- | Print statement. /Version 2 only/. 
   | Print 
     { forall annot. Statement annot -> Bool
print_chevron :: Bool -- ^ Optional chevron (>>)
     , forall annot. Statement annot -> [Expr annot]
print_exprs :: [Expr annot] -- ^ Arguments to print
     , forall annot. Statement annot -> Bool
print_trailing_comma :: Bool -- ^ Does it end in a comma?
     , stmt_annot :: annot 
     }
   -- | Exec statement. /Version 2 only/. 
   | Exec
     { forall annot. Statement annot -> Expr annot
exec_expr :: Expr annot -- ^ Expression to exec.
     , forall annot.
Statement annot -> Maybe (Expr annot, Maybe (Expr annot))
exec_globals_locals :: Maybe (Expr annot, Maybe (Expr annot)) -- ^ Global and local environments to evaluate the expression within.
     , stmt_annot :: annot 
     }
   deriving (Statement annot -> Statement annot -> Bool
(Statement annot -> Statement annot -> Bool)
-> (Statement annot -> Statement annot -> Bool)
-> Eq (Statement annot)
forall annot.
Eq annot =>
Statement annot -> Statement annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
Statement annot -> Statement annot -> Bool
== :: Statement annot -> Statement annot -> Bool
$c/= :: forall annot.
Eq annot =>
Statement annot -> Statement annot -> Bool
/= :: Statement annot -> Statement annot -> Bool
Eq,Eq (Statement annot)
Eq (Statement annot) =>
(Statement annot -> Statement annot -> Ordering)
-> (Statement annot -> Statement annot -> Bool)
-> (Statement annot -> Statement annot -> Bool)
-> (Statement annot -> Statement annot -> Bool)
-> (Statement annot -> Statement annot -> Bool)
-> (Statement annot -> Statement annot -> Statement annot)
-> (Statement annot -> Statement annot -> Statement annot)
-> Ord (Statement annot)
Statement annot -> Statement annot -> Bool
Statement annot -> Statement annot -> Ordering
Statement annot -> Statement annot -> Statement annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (Statement annot)
forall annot.
Ord annot =>
Statement annot -> Statement annot -> Bool
forall annot.
Ord annot =>
Statement annot -> Statement annot -> Ordering
forall annot.
Ord annot =>
Statement annot -> Statement annot -> Statement annot
$ccompare :: forall annot.
Ord annot =>
Statement annot -> Statement annot -> Ordering
compare :: Statement annot -> Statement annot -> Ordering
$c< :: forall annot.
Ord annot =>
Statement annot -> Statement annot -> Bool
< :: Statement annot -> Statement annot -> Bool
$c<= :: forall annot.
Ord annot =>
Statement annot -> Statement annot -> Bool
<= :: Statement annot -> Statement annot -> Bool
$c> :: forall annot.
Ord annot =>
Statement annot -> Statement annot -> Bool
> :: Statement annot -> Statement annot -> Bool
$c>= :: forall annot.
Ord annot =>
Statement annot -> Statement annot -> Bool
>= :: Statement annot -> Statement annot -> Bool
$cmax :: forall annot.
Ord annot =>
Statement annot -> Statement annot -> Statement annot
max :: Statement annot -> Statement annot -> Statement annot
$cmin :: forall annot.
Ord annot =>
Statement annot -> Statement annot -> Statement annot
min :: Statement annot -> Statement annot -> Statement annot
Ord,Int -> Statement annot -> ShowS
[Statement annot] -> ShowS
Statement annot -> String
(Int -> Statement annot -> ShowS)
-> (Statement annot -> String)
-> ([Statement annot] -> ShowS)
-> Show (Statement annot)
forall annot. Show annot => Int -> Statement annot -> ShowS
forall annot. Show annot => [Statement annot] -> ShowS
forall annot. Show annot => Statement annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> Statement annot -> ShowS
showsPrec :: Int -> Statement annot -> ShowS
$cshow :: forall annot. Show annot => Statement annot -> String
show :: Statement annot -> String
$cshowList :: forall annot. Show annot => [Statement annot] -> ShowS
showList :: [Statement annot] -> ShowS
Show,Typeable,Typeable (Statement annot)
Typeable (Statement annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Statement annot -> c (Statement annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Statement annot))
-> (Statement annot -> Constr)
-> (Statement annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Statement annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Statement annot)))
-> ((forall b. Data b => b -> b)
    -> Statement annot -> Statement annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Statement annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Statement annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Statement annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Statement annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Statement annot -> m (Statement annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Statement annot -> m (Statement annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Statement annot -> m (Statement annot))
-> Data (Statement annot)
Statement annot -> Constr
Statement annot -> DataType
(forall b. Data b => b -> b) -> Statement annot -> Statement annot
forall annot. Data annot => Typeable (Statement annot)
forall annot. Data annot => Statement annot -> Constr
forall annot. Data annot => Statement annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Statement annot -> Statement annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Statement annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Statement annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Statement annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Statement annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Statement annot -> m (Statement annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Statement annot -> m (Statement annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Statement annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Statement annot -> c (Statement annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Statement annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Statement annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Statement annot -> u
forall u. (forall d. Data d => d -> u) -> Statement annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Statement annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Statement annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Statement annot -> m (Statement annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Statement annot -> m (Statement annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Statement annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Statement annot -> c (Statement annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Statement annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Statement annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Statement annot -> c (Statement annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Statement annot -> c (Statement annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Statement annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Statement annot)
$ctoConstr :: forall annot. Data annot => Statement annot -> Constr
toConstr :: Statement annot -> Constr
$cdataTypeOf :: forall annot. Data annot => Statement annot -> DataType
dataTypeOf :: Statement annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Statement annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Statement annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Statement annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Statement annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Statement annot -> Statement annot
gmapT :: (forall b. Data b => b -> b) -> Statement annot -> Statement annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Statement annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Statement annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Statement annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Statement annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Statement annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Statement annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Statement annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Statement annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Statement annot -> m (Statement annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Statement annot -> m (Statement annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Statement annot -> m (Statement annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Statement annot -> m (Statement annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Statement annot -> m (Statement annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Statement annot -> m (Statement annot)
Data,(forall a b. (a -> b) -> Statement a -> Statement b)
-> (forall a b. a -> Statement b -> Statement a)
-> Functor Statement
forall a b. a -> Statement b -> Statement a
forall a b. (a -> b) -> Statement a -> Statement b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Statement a -> Statement b
fmap :: forall a b. (a -> b) -> Statement a -> Statement b
$c<$ :: forall a b. a -> Statement b -> Statement a
<$ :: forall a b. a -> Statement b -> Statement a
Functor)

type StatementSpan = Statement SrcSpan

instance Span StatementSpan where
   getSpan :: StatementSpan -> SrcSpan
getSpan = StatementSpan -> SrcSpan
forall annot. Statement annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated Statement where
   annot :: forall annot. Statement annot -> annot
annot = Statement annot -> annot
forall annot. Statement annot -> annot
stmt_annot 

-- | The argument for a @raise@ statement.
data RaiseExpr annot
   = RaiseV3 (Maybe (Expr annot, Maybe (Expr annot))) -- ^ Optional expression to evaluate, and optional \'from\' clause. /Version 3 only/.
   | RaiseV2 (Maybe (Expr annot, (Maybe (Expr annot, Maybe (Expr annot))))) -- ^ /Version 2 only/.
   deriving (RaiseExpr annot -> RaiseExpr annot -> Bool
(RaiseExpr annot -> RaiseExpr annot -> Bool)
-> (RaiseExpr annot -> RaiseExpr annot -> Bool)
-> Eq (RaiseExpr annot)
forall annot.
Eq annot =>
RaiseExpr annot -> RaiseExpr annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
RaiseExpr annot -> RaiseExpr annot -> Bool
== :: RaiseExpr annot -> RaiseExpr annot -> Bool
$c/= :: forall annot.
Eq annot =>
RaiseExpr annot -> RaiseExpr annot -> Bool
/= :: RaiseExpr annot -> RaiseExpr annot -> Bool
Eq,Eq (RaiseExpr annot)
Eq (RaiseExpr annot) =>
(RaiseExpr annot -> RaiseExpr annot -> Ordering)
-> (RaiseExpr annot -> RaiseExpr annot -> Bool)
-> (RaiseExpr annot -> RaiseExpr annot -> Bool)
-> (RaiseExpr annot -> RaiseExpr annot -> Bool)
-> (RaiseExpr annot -> RaiseExpr annot -> Bool)
-> (RaiseExpr annot -> RaiseExpr annot -> RaiseExpr annot)
-> (RaiseExpr annot -> RaiseExpr annot -> RaiseExpr annot)
-> Ord (RaiseExpr annot)
RaiseExpr annot -> RaiseExpr annot -> Bool
RaiseExpr annot -> RaiseExpr annot -> Ordering
RaiseExpr annot -> RaiseExpr annot -> RaiseExpr annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (RaiseExpr annot)
forall annot.
Ord annot =>
RaiseExpr annot -> RaiseExpr annot -> Bool
forall annot.
Ord annot =>
RaiseExpr annot -> RaiseExpr annot -> Ordering
forall annot.
Ord annot =>
RaiseExpr annot -> RaiseExpr annot -> RaiseExpr annot
$ccompare :: forall annot.
Ord annot =>
RaiseExpr annot -> RaiseExpr annot -> Ordering
compare :: RaiseExpr annot -> RaiseExpr annot -> Ordering
$c< :: forall annot.
Ord annot =>
RaiseExpr annot -> RaiseExpr annot -> Bool
< :: RaiseExpr annot -> RaiseExpr annot -> Bool
$c<= :: forall annot.
Ord annot =>
RaiseExpr annot -> RaiseExpr annot -> Bool
<= :: RaiseExpr annot -> RaiseExpr annot -> Bool
$c> :: forall annot.
Ord annot =>
RaiseExpr annot -> RaiseExpr annot -> Bool
> :: RaiseExpr annot -> RaiseExpr annot -> Bool
$c>= :: forall annot.
Ord annot =>
RaiseExpr annot -> RaiseExpr annot -> Bool
>= :: RaiseExpr annot -> RaiseExpr annot -> Bool
$cmax :: forall annot.
Ord annot =>
RaiseExpr annot -> RaiseExpr annot -> RaiseExpr annot
max :: RaiseExpr annot -> RaiseExpr annot -> RaiseExpr annot
$cmin :: forall annot.
Ord annot =>
RaiseExpr annot -> RaiseExpr annot -> RaiseExpr annot
min :: RaiseExpr annot -> RaiseExpr annot -> RaiseExpr annot
Ord,Int -> RaiseExpr annot -> ShowS
[RaiseExpr annot] -> ShowS
RaiseExpr annot -> String
(Int -> RaiseExpr annot -> ShowS)
-> (RaiseExpr annot -> String)
-> ([RaiseExpr annot] -> ShowS)
-> Show (RaiseExpr annot)
forall annot. Show annot => Int -> RaiseExpr annot -> ShowS
forall annot. Show annot => [RaiseExpr annot] -> ShowS
forall annot. Show annot => RaiseExpr annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> RaiseExpr annot -> ShowS
showsPrec :: Int -> RaiseExpr annot -> ShowS
$cshow :: forall annot. Show annot => RaiseExpr annot -> String
show :: RaiseExpr annot -> String
$cshowList :: forall annot. Show annot => [RaiseExpr annot] -> ShowS
showList :: [RaiseExpr annot] -> ShowS
Show,Typeable,Typeable (RaiseExpr annot)
Typeable (RaiseExpr annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RaiseExpr annot -> c (RaiseExpr annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (RaiseExpr annot))
-> (RaiseExpr annot -> Constr)
-> (RaiseExpr annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (RaiseExpr annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (RaiseExpr annot)))
-> ((forall b. Data b => b -> b)
    -> RaiseExpr annot -> RaiseExpr annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RaiseExpr annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RaiseExpr annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RaiseExpr annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RaiseExpr annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RaiseExpr annot -> m (RaiseExpr annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RaiseExpr annot -> m (RaiseExpr annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RaiseExpr annot -> m (RaiseExpr annot))
-> Data (RaiseExpr annot)
RaiseExpr annot -> Constr
RaiseExpr annot -> DataType
(forall b. Data b => b -> b) -> RaiseExpr annot -> RaiseExpr annot
forall annot. Data annot => Typeable (RaiseExpr annot)
forall annot. Data annot => RaiseExpr annot -> Constr
forall annot. Data annot => RaiseExpr annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> RaiseExpr annot -> RaiseExpr annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> RaiseExpr annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> RaiseExpr annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RaiseExpr annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RaiseExpr annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> RaiseExpr annot -> m (RaiseExpr annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> RaiseExpr annot -> m (RaiseExpr annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RaiseExpr annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RaiseExpr annot -> c (RaiseExpr annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RaiseExpr annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RaiseExpr annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RaiseExpr annot -> u
forall u. (forall d. Data d => d -> u) -> RaiseExpr annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RaiseExpr annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RaiseExpr annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RaiseExpr annot -> m (RaiseExpr annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RaiseExpr annot -> m (RaiseExpr annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RaiseExpr annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RaiseExpr annot -> c (RaiseExpr annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (RaiseExpr annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RaiseExpr annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RaiseExpr annot -> c (RaiseExpr annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RaiseExpr annot -> c (RaiseExpr annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RaiseExpr annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RaiseExpr annot)
$ctoConstr :: forall annot. Data annot => RaiseExpr annot -> Constr
toConstr :: RaiseExpr annot -> Constr
$cdataTypeOf :: forall annot. Data annot => RaiseExpr annot -> DataType
dataTypeOf :: RaiseExpr annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RaiseExpr annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (RaiseExpr annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RaiseExpr annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RaiseExpr annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> RaiseExpr annot -> RaiseExpr annot
gmapT :: (forall b. Data b => b -> b) -> RaiseExpr annot -> RaiseExpr annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RaiseExpr annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RaiseExpr annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RaiseExpr annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RaiseExpr annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> RaiseExpr annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RaiseExpr annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> RaiseExpr annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RaiseExpr annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> RaiseExpr annot -> m (RaiseExpr annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RaiseExpr annot -> m (RaiseExpr annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> RaiseExpr annot -> m (RaiseExpr annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RaiseExpr annot -> m (RaiseExpr annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> RaiseExpr annot -> m (RaiseExpr annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RaiseExpr annot -> m (RaiseExpr annot)
Data,(forall a b. (a -> b) -> RaiseExpr a -> RaiseExpr b)
-> (forall a b. a -> RaiseExpr b -> RaiseExpr a)
-> Functor RaiseExpr
forall a b. a -> RaiseExpr b -> RaiseExpr a
forall a b. (a -> b) -> RaiseExpr a -> RaiseExpr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RaiseExpr a -> RaiseExpr b
fmap :: forall a b. (a -> b) -> RaiseExpr a -> RaiseExpr b
$c<$ :: forall a b. a -> RaiseExpr b -> RaiseExpr a
<$ :: forall a b. a -> RaiseExpr b -> RaiseExpr a
Functor)

type RaiseExprSpan = RaiseExpr SrcSpan

-- | Decorator.
data Decorator annot = 
   Decorator 
   { forall annot. Decorator annot -> DottedName annot
decorator_name :: DottedName annot -- ^ Decorator name.
   , forall annot. Decorator annot -> [Argument annot]
decorator_args :: [Argument annot] -- ^ Decorator arguments.
   , forall annot. Decorator annot -> annot
decorator_annot :: annot 
   }
   deriving (Decorator annot -> Decorator annot -> Bool
(Decorator annot -> Decorator annot -> Bool)
-> (Decorator annot -> Decorator annot -> Bool)
-> Eq (Decorator annot)
forall annot.
Eq annot =>
Decorator annot -> Decorator annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
Decorator annot -> Decorator annot -> Bool
== :: Decorator annot -> Decorator annot -> Bool
$c/= :: forall annot.
Eq annot =>
Decorator annot -> Decorator annot -> Bool
/= :: Decorator annot -> Decorator annot -> Bool
Eq,Eq (Decorator annot)
Eq (Decorator annot) =>
(Decorator annot -> Decorator annot -> Ordering)
-> (Decorator annot -> Decorator annot -> Bool)
-> (Decorator annot -> Decorator annot -> Bool)
-> (Decorator annot -> Decorator annot -> Bool)
-> (Decorator annot -> Decorator annot -> Bool)
-> (Decorator annot -> Decorator annot -> Decorator annot)
-> (Decorator annot -> Decorator annot -> Decorator annot)
-> Ord (Decorator annot)
Decorator annot -> Decorator annot -> Bool
Decorator annot -> Decorator annot -> Ordering
Decorator annot -> Decorator annot -> Decorator annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (Decorator annot)
forall annot.
Ord annot =>
Decorator annot -> Decorator annot -> Bool
forall annot.
Ord annot =>
Decorator annot -> Decorator annot -> Ordering
forall annot.
Ord annot =>
Decorator annot -> Decorator annot -> Decorator annot
$ccompare :: forall annot.
Ord annot =>
Decorator annot -> Decorator annot -> Ordering
compare :: Decorator annot -> Decorator annot -> Ordering
$c< :: forall annot.
Ord annot =>
Decorator annot -> Decorator annot -> Bool
< :: Decorator annot -> Decorator annot -> Bool
$c<= :: forall annot.
Ord annot =>
Decorator annot -> Decorator annot -> Bool
<= :: Decorator annot -> Decorator annot -> Bool
$c> :: forall annot.
Ord annot =>
Decorator annot -> Decorator annot -> Bool
> :: Decorator annot -> Decorator annot -> Bool
$c>= :: forall annot.
Ord annot =>
Decorator annot -> Decorator annot -> Bool
>= :: Decorator annot -> Decorator annot -> Bool
$cmax :: forall annot.
Ord annot =>
Decorator annot -> Decorator annot -> Decorator annot
max :: Decorator annot -> Decorator annot -> Decorator annot
$cmin :: forall annot.
Ord annot =>
Decorator annot -> Decorator annot -> Decorator annot
min :: Decorator annot -> Decorator annot -> Decorator annot
Ord,Int -> Decorator annot -> ShowS
[Decorator annot] -> ShowS
Decorator annot -> String
(Int -> Decorator annot -> ShowS)
-> (Decorator annot -> String)
-> ([Decorator annot] -> ShowS)
-> Show (Decorator annot)
forall annot. Show annot => Int -> Decorator annot -> ShowS
forall annot. Show annot => [Decorator annot] -> ShowS
forall annot. Show annot => Decorator annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> Decorator annot -> ShowS
showsPrec :: Int -> Decorator annot -> ShowS
$cshow :: forall annot. Show annot => Decorator annot -> String
show :: Decorator annot -> String
$cshowList :: forall annot. Show annot => [Decorator annot] -> ShowS
showList :: [Decorator annot] -> ShowS
Show,Typeable,Typeable (Decorator annot)
Typeable (Decorator annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Decorator annot -> c (Decorator annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Decorator annot))
-> (Decorator annot -> Constr)
-> (Decorator annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Decorator annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Decorator annot)))
-> ((forall b. Data b => b -> b)
    -> Decorator annot -> Decorator annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Decorator annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Decorator annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Decorator annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Decorator annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Decorator annot -> m (Decorator annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Decorator annot -> m (Decorator annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Decorator annot -> m (Decorator annot))
-> Data (Decorator annot)
Decorator annot -> Constr
Decorator annot -> DataType
(forall b. Data b => b -> b) -> Decorator annot -> Decorator annot
forall annot. Data annot => Typeable (Decorator annot)
forall annot. Data annot => Decorator annot -> Constr
forall annot. Data annot => Decorator annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Decorator annot -> Decorator annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Decorator annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Decorator annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Decorator annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Decorator annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Decorator annot -> m (Decorator annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Decorator annot -> m (Decorator annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Decorator annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Decorator annot -> c (Decorator annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Decorator annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Decorator annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Decorator annot -> u
forall u. (forall d. Data d => d -> u) -> Decorator annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Decorator annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Decorator annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Decorator annot -> m (Decorator annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Decorator annot -> m (Decorator annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Decorator annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Decorator annot -> c (Decorator annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Decorator annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Decorator annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Decorator annot -> c (Decorator annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Decorator annot -> c (Decorator annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Decorator annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Decorator annot)
$ctoConstr :: forall annot. Data annot => Decorator annot -> Constr
toConstr :: Decorator annot -> Constr
$cdataTypeOf :: forall annot. Data annot => Decorator annot -> DataType
dataTypeOf :: Decorator annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Decorator annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Decorator annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Decorator annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Decorator annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Decorator annot -> Decorator annot
gmapT :: (forall b. Data b => b -> b) -> Decorator annot -> Decorator annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Decorator annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Decorator annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Decorator annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Decorator annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Decorator annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Decorator annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Decorator annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Decorator annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Decorator annot -> m (Decorator annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Decorator annot -> m (Decorator annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Decorator annot -> m (Decorator annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Decorator annot -> m (Decorator annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Decorator annot -> m (Decorator annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Decorator annot -> m (Decorator annot)
Data,(forall a b. (a -> b) -> Decorator a -> Decorator b)
-> (forall a b. a -> Decorator b -> Decorator a)
-> Functor Decorator
forall a b. a -> Decorator b -> Decorator a
forall a b. (a -> b) -> Decorator a -> Decorator b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Decorator a -> Decorator b
fmap :: forall a b. (a -> b) -> Decorator a -> Decorator b
$c<$ :: forall a b. a -> Decorator b -> Decorator a
<$ :: forall a b. a -> Decorator b -> Decorator a
Functor)

type DecoratorSpan = Decorator SrcSpan

instance Span DecoratorSpan where
   getSpan :: DecoratorSpan -> SrcSpan
getSpan = DecoratorSpan -> SrcSpan
forall annot. Decorator annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated Decorator where
   annot :: forall annot. Decorator annot -> annot
annot = Decorator annot -> annot
forall annot. Decorator annot -> annot
decorator_annot 

-- | Formal parameter of function definitions and lambda expressions.
-- 
-- * Version 2.6: 
--
-- * <http://docs.python.org/2.6/reference/compound_stmts.html#function-definitions>
--
-- * <http://docs.python.org/2.6/reference/expressions.html#calls>
--
-- * Version 3.1: 
--
-- * <http://docs.python.org/3.1/reference/compound_stmts.html#function-definitions>
--
-- * <http://docs.python.org/3.1/reference/expressions.html#calls>
--
data Parameter annot
   -- | Ordinary named parameter.
   = Param 
     { forall annot. Parameter annot -> Ident annot
param_name :: Ident annot -- ^ Parameter name.
     , forall annot. Parameter annot -> Maybe (Expr annot)
param_py_annotation :: Maybe (Expr annot) -- ^ Optional annotation.
     , forall annot. Parameter annot -> Maybe (Expr annot)
param_default :: Maybe (Expr annot) -- ^ Optional default value.
     , forall annot. Parameter annot -> annot
param_annot :: annot
     }
   -- | Excess positional parameter (single asterisk before its name in the concrete syntax). 
   | VarArgsPos 
     { param_name :: Ident annot -- ^ Parameter name.
     , param_py_annotation :: Maybe (Expr annot) -- ^ Optional annotation.
     , param_annot :: annot
     }
   -- | Excess keyword parameter (double asterisk before its name in the concrete syntax).
   | VarArgsKeyword 
     { param_name :: Ident annot -- ^ Parameter name.
     , param_py_annotation :: Maybe (Expr annot) -- ^ Optional annotation.
     , param_annot :: annot
     }
   -- | Marker for the end of positional parameters (not a parameter itself).
   | EndPositional { param_annot :: annot }
   -- | Tuple unpack. /Version 2 only/.
   | UnPackTuple 
     { forall annot. Parameter annot -> ParamTuple annot
param_unpack_tuple :: ParamTuple annot -- ^ The tuple to unpack.
     , param_default :: Maybe (Expr annot) -- ^ Optional default value.
     , param_annot :: annot
     }
   deriving (Parameter annot -> Parameter annot -> Bool
(Parameter annot -> Parameter annot -> Bool)
-> (Parameter annot -> Parameter annot -> Bool)
-> Eq (Parameter annot)
forall annot.
Eq annot =>
Parameter annot -> Parameter annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
Parameter annot -> Parameter annot -> Bool
== :: Parameter annot -> Parameter annot -> Bool
$c/= :: forall annot.
Eq annot =>
Parameter annot -> Parameter annot -> Bool
/= :: Parameter annot -> Parameter annot -> Bool
Eq,Eq (Parameter annot)
Eq (Parameter annot) =>
(Parameter annot -> Parameter annot -> Ordering)
-> (Parameter annot -> Parameter annot -> Bool)
-> (Parameter annot -> Parameter annot -> Bool)
-> (Parameter annot -> Parameter annot -> Bool)
-> (Parameter annot -> Parameter annot -> Bool)
-> (Parameter annot -> Parameter annot -> Parameter annot)
-> (Parameter annot -> Parameter annot -> Parameter annot)
-> Ord (Parameter annot)
Parameter annot -> Parameter annot -> Bool
Parameter annot -> Parameter annot -> Ordering
Parameter annot -> Parameter annot -> Parameter annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (Parameter annot)
forall annot.
Ord annot =>
Parameter annot -> Parameter annot -> Bool
forall annot.
Ord annot =>
Parameter annot -> Parameter annot -> Ordering
forall annot.
Ord annot =>
Parameter annot -> Parameter annot -> Parameter annot
$ccompare :: forall annot.
Ord annot =>
Parameter annot -> Parameter annot -> Ordering
compare :: Parameter annot -> Parameter annot -> Ordering
$c< :: forall annot.
Ord annot =>
Parameter annot -> Parameter annot -> Bool
< :: Parameter annot -> Parameter annot -> Bool
$c<= :: forall annot.
Ord annot =>
Parameter annot -> Parameter annot -> Bool
<= :: Parameter annot -> Parameter annot -> Bool
$c> :: forall annot.
Ord annot =>
Parameter annot -> Parameter annot -> Bool
> :: Parameter annot -> Parameter annot -> Bool
$c>= :: forall annot.
Ord annot =>
Parameter annot -> Parameter annot -> Bool
>= :: Parameter annot -> Parameter annot -> Bool
$cmax :: forall annot.
Ord annot =>
Parameter annot -> Parameter annot -> Parameter annot
max :: Parameter annot -> Parameter annot -> Parameter annot
$cmin :: forall annot.
Ord annot =>
Parameter annot -> Parameter annot -> Parameter annot
min :: Parameter annot -> Parameter annot -> Parameter annot
Ord,Int -> Parameter annot -> ShowS
[Parameter annot] -> ShowS
Parameter annot -> String
(Int -> Parameter annot -> ShowS)
-> (Parameter annot -> String)
-> ([Parameter annot] -> ShowS)
-> Show (Parameter annot)
forall annot. Show annot => Int -> Parameter annot -> ShowS
forall annot. Show annot => [Parameter annot] -> ShowS
forall annot. Show annot => Parameter annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> Parameter annot -> ShowS
showsPrec :: Int -> Parameter annot -> ShowS
$cshow :: forall annot. Show annot => Parameter annot -> String
show :: Parameter annot -> String
$cshowList :: forall annot. Show annot => [Parameter annot] -> ShowS
showList :: [Parameter annot] -> ShowS
Show,Typeable,Typeable (Parameter annot)
Typeable (Parameter annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Parameter annot -> c (Parameter annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Parameter annot))
-> (Parameter annot -> Constr)
-> (Parameter annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Parameter annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Parameter annot)))
-> ((forall b. Data b => b -> b)
    -> Parameter annot -> Parameter annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Parameter annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Parameter annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Parameter annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Parameter annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Parameter annot -> m (Parameter annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Parameter annot -> m (Parameter annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Parameter annot -> m (Parameter annot))
-> Data (Parameter annot)
Parameter annot -> Constr
Parameter annot -> DataType
(forall b. Data b => b -> b) -> Parameter annot -> Parameter annot
forall annot. Data annot => Typeable (Parameter annot)
forall annot. Data annot => Parameter annot -> Constr
forall annot. Data annot => Parameter annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Parameter annot -> Parameter annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Parameter annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Parameter annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Parameter annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Parameter annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Parameter annot -> m (Parameter annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Parameter annot -> m (Parameter annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Parameter annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Parameter annot -> c (Parameter annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Parameter annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Parameter annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Parameter annot -> u
forall u. (forall d. Data d => d -> u) -> Parameter annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Parameter annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Parameter annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Parameter annot -> m (Parameter annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Parameter annot -> m (Parameter annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Parameter annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Parameter annot -> c (Parameter annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Parameter annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Parameter annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Parameter annot -> c (Parameter annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Parameter annot -> c (Parameter annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Parameter annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Parameter annot)
$ctoConstr :: forall annot. Data annot => Parameter annot -> Constr
toConstr :: Parameter annot -> Constr
$cdataTypeOf :: forall annot. Data annot => Parameter annot -> DataType
dataTypeOf :: Parameter annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Parameter annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Parameter annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Parameter annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Parameter annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Parameter annot -> Parameter annot
gmapT :: (forall b. Data b => b -> b) -> Parameter annot -> Parameter annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Parameter annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Parameter annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Parameter annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Parameter annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Parameter annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Parameter annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Parameter annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Parameter annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Parameter annot -> m (Parameter annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Parameter annot -> m (Parameter annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Parameter annot -> m (Parameter annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Parameter annot -> m (Parameter annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Parameter annot -> m (Parameter annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Parameter annot -> m (Parameter annot)
Data,(forall a b. (a -> b) -> Parameter a -> Parameter b)
-> (forall a b. a -> Parameter b -> Parameter a)
-> Functor Parameter
forall a b. a -> Parameter b -> Parameter a
forall a b. (a -> b) -> Parameter a -> Parameter b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Parameter a -> Parameter b
fmap :: forall a b. (a -> b) -> Parameter a -> Parameter b
$c<$ :: forall a b. a -> Parameter b -> Parameter a
<$ :: forall a b. a -> Parameter b -> Parameter a
Functor)

type ParameterSpan = Parameter SrcSpan

instance Span ParameterSpan where
  getSpan :: ParameterSpan -> SrcSpan
getSpan = ParameterSpan -> SrcSpan
forall annot. Parameter annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated Parameter where
   annot :: forall annot. Parameter annot -> annot
annot = Parameter annot -> annot
forall annot. Parameter annot -> annot
param_annot 

-- | Tuple unpack parameter. /Version 2 only/.
data ParamTuple annot
   = ParamTupleName { forall annot. ParamTuple annot -> Ident annot
param_tuple_name :: Ident annot, forall annot. ParamTuple annot -> annot
param_tuple_annot :: annot } -- ^ A variable name.
   | ParamTuple { forall annot. ParamTuple annot -> [ParamTuple annot]
param_tuple :: [ParamTuple annot], param_tuple_annot :: annot } -- ^ A (possibly nested) tuple parameter.
   deriving (ParamTuple annot -> ParamTuple annot -> Bool
(ParamTuple annot -> ParamTuple annot -> Bool)
-> (ParamTuple annot -> ParamTuple annot -> Bool)
-> Eq (ParamTuple annot)
forall annot.
Eq annot =>
ParamTuple annot -> ParamTuple annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
ParamTuple annot -> ParamTuple annot -> Bool
== :: ParamTuple annot -> ParamTuple annot -> Bool
$c/= :: forall annot.
Eq annot =>
ParamTuple annot -> ParamTuple annot -> Bool
/= :: ParamTuple annot -> ParamTuple annot -> Bool
Eq,Eq (ParamTuple annot)
Eq (ParamTuple annot) =>
(ParamTuple annot -> ParamTuple annot -> Ordering)
-> (ParamTuple annot -> ParamTuple annot -> Bool)
-> (ParamTuple annot -> ParamTuple annot -> Bool)
-> (ParamTuple annot -> ParamTuple annot -> Bool)
-> (ParamTuple annot -> ParamTuple annot -> Bool)
-> (ParamTuple annot -> ParamTuple annot -> ParamTuple annot)
-> (ParamTuple annot -> ParamTuple annot -> ParamTuple annot)
-> Ord (ParamTuple annot)
ParamTuple annot -> ParamTuple annot -> Bool
ParamTuple annot -> ParamTuple annot -> Ordering
ParamTuple annot -> ParamTuple annot -> ParamTuple annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (ParamTuple annot)
forall annot.
Ord annot =>
ParamTuple annot -> ParamTuple annot -> Bool
forall annot.
Ord annot =>
ParamTuple annot -> ParamTuple annot -> Ordering
forall annot.
Ord annot =>
ParamTuple annot -> ParamTuple annot -> ParamTuple annot
$ccompare :: forall annot.
Ord annot =>
ParamTuple annot -> ParamTuple annot -> Ordering
compare :: ParamTuple annot -> ParamTuple annot -> Ordering
$c< :: forall annot.
Ord annot =>
ParamTuple annot -> ParamTuple annot -> Bool
< :: ParamTuple annot -> ParamTuple annot -> Bool
$c<= :: forall annot.
Ord annot =>
ParamTuple annot -> ParamTuple annot -> Bool
<= :: ParamTuple annot -> ParamTuple annot -> Bool
$c> :: forall annot.
Ord annot =>
ParamTuple annot -> ParamTuple annot -> Bool
> :: ParamTuple annot -> ParamTuple annot -> Bool
$c>= :: forall annot.
Ord annot =>
ParamTuple annot -> ParamTuple annot -> Bool
>= :: ParamTuple annot -> ParamTuple annot -> Bool
$cmax :: forall annot.
Ord annot =>
ParamTuple annot -> ParamTuple annot -> ParamTuple annot
max :: ParamTuple annot -> ParamTuple annot -> ParamTuple annot
$cmin :: forall annot.
Ord annot =>
ParamTuple annot -> ParamTuple annot -> ParamTuple annot
min :: ParamTuple annot -> ParamTuple annot -> ParamTuple annot
Ord,Int -> ParamTuple annot -> ShowS
[ParamTuple annot] -> ShowS
ParamTuple annot -> String
(Int -> ParamTuple annot -> ShowS)
-> (ParamTuple annot -> String)
-> ([ParamTuple annot] -> ShowS)
-> Show (ParamTuple annot)
forall annot. Show annot => Int -> ParamTuple annot -> ShowS
forall annot. Show annot => [ParamTuple annot] -> ShowS
forall annot. Show annot => ParamTuple annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> ParamTuple annot -> ShowS
showsPrec :: Int -> ParamTuple annot -> ShowS
$cshow :: forall annot. Show annot => ParamTuple annot -> String
show :: ParamTuple annot -> String
$cshowList :: forall annot. Show annot => [ParamTuple annot] -> ShowS
showList :: [ParamTuple annot] -> ShowS
Show,Typeable,Typeable (ParamTuple annot)
Typeable (ParamTuple annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ParamTuple annot
 -> c (ParamTuple annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ParamTuple annot))
-> (ParamTuple annot -> Constr)
-> (ParamTuple annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ParamTuple annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ParamTuple annot)))
-> ((forall b. Data b => b -> b)
    -> ParamTuple annot -> ParamTuple annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ParamTuple annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ParamTuple annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ParamTuple annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ParamTuple annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ParamTuple annot -> m (ParamTuple annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ParamTuple annot -> m (ParamTuple annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ParamTuple annot -> m (ParamTuple annot))
-> Data (ParamTuple annot)
ParamTuple annot -> Constr
ParamTuple annot -> DataType
(forall b. Data b => b -> b)
-> ParamTuple annot -> ParamTuple annot
forall annot. Data annot => Typeable (ParamTuple annot)
forall annot. Data annot => ParamTuple annot -> Constr
forall annot. Data annot => ParamTuple annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> ParamTuple annot -> ParamTuple annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> ParamTuple annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> ParamTuple annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParamTuple annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParamTuple annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> ParamTuple annot -> m (ParamTuple annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ParamTuple annot -> m (ParamTuple annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParamTuple annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParamTuple annot -> c (ParamTuple annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ParamTuple annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParamTuple annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ParamTuple annot -> u
forall u. (forall d. Data d => d -> u) -> ParamTuple annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParamTuple annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParamTuple annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ParamTuple annot -> m (ParamTuple annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParamTuple annot -> m (ParamTuple annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParamTuple annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParamTuple annot -> c (ParamTuple annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ParamTuple annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParamTuple annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParamTuple annot -> c (ParamTuple annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParamTuple annot -> c (ParamTuple annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParamTuple annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParamTuple annot)
$ctoConstr :: forall annot. Data annot => ParamTuple annot -> Constr
toConstr :: ParamTuple annot -> Constr
$cdataTypeOf :: forall annot. Data annot => ParamTuple annot -> DataType
dataTypeOf :: ParamTuple annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ParamTuple annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ParamTuple annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParamTuple annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParamTuple annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> ParamTuple annot -> ParamTuple annot
gmapT :: (forall b. Data b => b -> b)
-> ParamTuple annot -> ParamTuple annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParamTuple annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParamTuple annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParamTuple annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParamTuple annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> ParamTuple annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParamTuple annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> ParamTuple annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ParamTuple annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> ParamTuple annot -> m (ParamTuple annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ParamTuple annot -> m (ParamTuple annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ParamTuple annot -> m (ParamTuple annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParamTuple annot -> m (ParamTuple annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ParamTuple annot -> m (ParamTuple annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParamTuple annot -> m (ParamTuple annot)
Data,(forall a b. (a -> b) -> ParamTuple a -> ParamTuple b)
-> (forall a b. a -> ParamTuple b -> ParamTuple a)
-> Functor ParamTuple
forall a b. a -> ParamTuple b -> ParamTuple a
forall a b. (a -> b) -> ParamTuple a -> ParamTuple b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ParamTuple a -> ParamTuple b
fmap :: forall a b. (a -> b) -> ParamTuple a -> ParamTuple b
$c<$ :: forall a b. a -> ParamTuple b -> ParamTuple a
<$ :: forall a b. a -> ParamTuple b -> ParamTuple a
Functor)

type ParamTupleSpan = ParamTuple SrcSpan

instance Span ParamTupleSpan where
   getSpan :: ParamTupleSpan -> SrcSpan
getSpan = ParamTupleSpan -> SrcSpan
forall annot. ParamTuple annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot

instance Annotated ParamTuple where
   annot :: forall annot. ParamTuple annot -> annot
annot = ParamTuple annot -> annot
forall annot. ParamTuple annot -> annot
param_tuple_annot

-- | Arguments to function calls, class declarations and decorators.
data Argument annot
   -- | Ordinary argument expression.
   = ArgExpr { forall annot. Argument annot -> Expr annot
arg_expr :: Expr annot, forall annot. Argument annot -> annot
arg_annot :: annot }
   -- | Excess positional argument.
   | ArgVarArgsPos { arg_expr :: Expr annot, arg_annot :: annot }
   -- | Excess keyword argument.
   | ArgVarArgsKeyword { arg_expr :: Expr annot, arg_annot :: annot }
   -- | Keyword argument.
   | ArgKeyword 
     { forall annot. Argument annot -> Ident annot
arg_keyword :: Ident annot -- ^ Keyword name.
     , arg_expr :: Expr annot -- ^ Argument expression.
     , arg_annot :: annot
     }
   deriving (Argument annot -> Argument annot -> Bool
(Argument annot -> Argument annot -> Bool)
-> (Argument annot -> Argument annot -> Bool)
-> Eq (Argument annot)
forall annot. Eq annot => Argument annot -> Argument annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => Argument annot -> Argument annot -> Bool
== :: Argument annot -> Argument annot -> Bool
$c/= :: forall annot. Eq annot => Argument annot -> Argument annot -> Bool
/= :: Argument annot -> Argument annot -> Bool
Eq,Eq (Argument annot)
Eq (Argument annot) =>
(Argument annot -> Argument annot -> Ordering)
-> (Argument annot -> Argument annot -> Bool)
-> (Argument annot -> Argument annot -> Bool)
-> (Argument annot -> Argument annot -> Bool)
-> (Argument annot -> Argument annot -> Bool)
-> (Argument annot -> Argument annot -> Argument annot)
-> (Argument annot -> Argument annot -> Argument annot)
-> Ord (Argument annot)
Argument annot -> Argument annot -> Bool
Argument annot -> Argument annot -> Ordering
Argument annot -> Argument annot -> Argument annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (Argument annot)
forall annot. Ord annot => Argument annot -> Argument annot -> Bool
forall annot.
Ord annot =>
Argument annot -> Argument annot -> Ordering
forall annot.
Ord annot =>
Argument annot -> Argument annot -> Argument annot
$ccompare :: forall annot.
Ord annot =>
Argument annot -> Argument annot -> Ordering
compare :: Argument annot -> Argument annot -> Ordering
$c< :: forall annot. Ord annot => Argument annot -> Argument annot -> Bool
< :: Argument annot -> Argument annot -> Bool
$c<= :: forall annot. Ord annot => Argument annot -> Argument annot -> Bool
<= :: Argument annot -> Argument annot -> Bool
$c> :: forall annot. Ord annot => Argument annot -> Argument annot -> Bool
> :: Argument annot -> Argument annot -> Bool
$c>= :: forall annot. Ord annot => Argument annot -> Argument annot -> Bool
>= :: Argument annot -> Argument annot -> Bool
$cmax :: forall annot.
Ord annot =>
Argument annot -> Argument annot -> Argument annot
max :: Argument annot -> Argument annot -> Argument annot
$cmin :: forall annot.
Ord annot =>
Argument annot -> Argument annot -> Argument annot
min :: Argument annot -> Argument annot -> Argument annot
Ord,Int -> Argument annot -> ShowS
[Argument annot] -> ShowS
Argument annot -> String
(Int -> Argument annot -> ShowS)
-> (Argument annot -> String)
-> ([Argument annot] -> ShowS)
-> Show (Argument annot)
forall annot. Show annot => Int -> Argument annot -> ShowS
forall annot. Show annot => [Argument annot] -> ShowS
forall annot. Show annot => Argument annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> Argument annot -> ShowS
showsPrec :: Int -> Argument annot -> ShowS
$cshow :: forall annot. Show annot => Argument annot -> String
show :: Argument annot -> String
$cshowList :: forall annot. Show annot => [Argument annot] -> ShowS
showList :: [Argument annot] -> ShowS
Show,Typeable,Typeable (Argument annot)
Typeable (Argument annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Argument annot -> c (Argument annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Argument annot))
-> (Argument annot -> Constr)
-> (Argument annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Argument annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Argument annot)))
-> ((forall b. Data b => b -> b)
    -> Argument annot -> Argument annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Argument annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Argument annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Argument annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Argument annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Argument annot -> m (Argument annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Argument annot -> m (Argument annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Argument annot -> m (Argument annot))
-> Data (Argument annot)
Argument annot -> Constr
Argument annot -> DataType
(forall b. Data b => b -> b) -> Argument annot -> Argument annot
forall annot. Data annot => Typeable (Argument annot)
forall annot. Data annot => Argument annot -> Constr
forall annot. Data annot => Argument annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Argument annot -> Argument annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Argument annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Argument annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Argument annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Argument annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Argument annot -> m (Argument annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Argument annot -> m (Argument annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Argument annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Argument annot -> c (Argument annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Argument annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Argument annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Argument annot -> u
forall u. (forall d. Data d => d -> u) -> Argument annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Argument annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Argument annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Argument annot -> m (Argument annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Argument annot -> m (Argument annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Argument annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Argument annot -> c (Argument annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Argument annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Argument annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Argument annot -> c (Argument annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Argument annot -> c (Argument annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Argument annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Argument annot)
$ctoConstr :: forall annot. Data annot => Argument annot -> Constr
toConstr :: Argument annot -> Constr
$cdataTypeOf :: forall annot. Data annot => Argument annot -> DataType
dataTypeOf :: Argument annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Argument annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Argument annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Argument annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Argument annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Argument annot -> Argument annot
gmapT :: (forall b. Data b => b -> b) -> Argument annot -> Argument annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Argument annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Argument annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Argument annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Argument annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Argument annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Argument annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Argument annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Argument annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Argument annot -> m (Argument annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Argument annot -> m (Argument annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Argument annot -> m (Argument annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Argument annot -> m (Argument annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Argument annot -> m (Argument annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Argument annot -> m (Argument annot)
Data,(forall a b. (a -> b) -> Argument a -> Argument b)
-> (forall a b. a -> Argument b -> Argument a) -> Functor Argument
forall a b. a -> Argument b -> Argument a
forall a b. (a -> b) -> Argument a -> Argument b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Argument a -> Argument b
fmap :: forall a b. (a -> b) -> Argument a -> Argument b
$c<$ :: forall a b. a -> Argument b -> Argument a
<$ :: forall a b. a -> Argument b -> Argument a
Functor)

type ArgumentSpan = Argument SrcSpan

instance Span ArgumentSpan where
  getSpan :: ArgumentSpan -> SrcSpan
getSpan = ArgumentSpan -> SrcSpan
forall annot. Argument annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated Argument where
   annot :: forall annot. Argument annot -> annot
annot = Argument annot -> annot
forall annot. Argument annot -> annot
arg_annot 

-- | Exception handler. 
data Handler annot
   = Handler 
     { forall annot. Handler annot -> ExceptClause annot
handler_clause :: ExceptClause annot
     , forall annot. Handler annot -> Suite annot
handler_suite :: Suite annot
     , forall annot. Handler annot -> annot
handler_annot :: annot 
     }
   deriving (Handler annot -> Handler annot -> Bool
(Handler annot -> Handler annot -> Bool)
-> (Handler annot -> Handler annot -> Bool) -> Eq (Handler annot)
forall annot. Eq annot => Handler annot -> Handler annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => Handler annot -> Handler annot -> Bool
== :: Handler annot -> Handler annot -> Bool
$c/= :: forall annot. Eq annot => Handler annot -> Handler annot -> Bool
/= :: Handler annot -> Handler annot -> Bool
Eq,Eq (Handler annot)
Eq (Handler annot) =>
(Handler annot -> Handler annot -> Ordering)
-> (Handler annot -> Handler annot -> Bool)
-> (Handler annot -> Handler annot -> Bool)
-> (Handler annot -> Handler annot -> Bool)
-> (Handler annot -> Handler annot -> Bool)
-> (Handler annot -> Handler annot -> Handler annot)
-> (Handler annot -> Handler annot -> Handler annot)
-> Ord (Handler annot)
Handler annot -> Handler annot -> Bool
Handler annot -> Handler annot -> Ordering
Handler annot -> Handler annot -> Handler annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (Handler annot)
forall annot. Ord annot => Handler annot -> Handler annot -> Bool
forall annot.
Ord annot =>
Handler annot -> Handler annot -> Ordering
forall annot.
Ord annot =>
Handler annot -> Handler annot -> Handler annot
$ccompare :: forall annot.
Ord annot =>
Handler annot -> Handler annot -> Ordering
compare :: Handler annot -> Handler annot -> Ordering
$c< :: forall annot. Ord annot => Handler annot -> Handler annot -> Bool
< :: Handler annot -> Handler annot -> Bool
$c<= :: forall annot. Ord annot => Handler annot -> Handler annot -> Bool
<= :: Handler annot -> Handler annot -> Bool
$c> :: forall annot. Ord annot => Handler annot -> Handler annot -> Bool
> :: Handler annot -> Handler annot -> Bool
$c>= :: forall annot. Ord annot => Handler annot -> Handler annot -> Bool
>= :: Handler annot -> Handler annot -> Bool
$cmax :: forall annot.
Ord annot =>
Handler annot -> Handler annot -> Handler annot
max :: Handler annot -> Handler annot -> Handler annot
$cmin :: forall annot.
Ord annot =>
Handler annot -> Handler annot -> Handler annot
min :: Handler annot -> Handler annot -> Handler annot
Ord,Int -> Handler annot -> ShowS
[Handler annot] -> ShowS
Handler annot -> String
(Int -> Handler annot -> ShowS)
-> (Handler annot -> String)
-> ([Handler annot] -> ShowS)
-> Show (Handler annot)
forall annot. Show annot => Int -> Handler annot -> ShowS
forall annot. Show annot => [Handler annot] -> ShowS
forall annot. Show annot => Handler annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> Handler annot -> ShowS
showsPrec :: Int -> Handler annot -> ShowS
$cshow :: forall annot. Show annot => Handler annot -> String
show :: Handler annot -> String
$cshowList :: forall annot. Show annot => [Handler annot] -> ShowS
showList :: [Handler annot] -> ShowS
Show,Typeable,Typeable (Handler annot)
Typeable (Handler annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Handler annot -> c (Handler annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Handler annot))
-> (Handler annot -> Constr)
-> (Handler annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Handler annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Handler annot)))
-> ((forall b. Data b => b -> b) -> Handler annot -> Handler annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Handler annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Handler annot -> r)
-> (forall u. (forall d. Data d => d -> u) -> Handler annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Handler annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Handler annot -> m (Handler annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Handler annot -> m (Handler annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Handler annot -> m (Handler annot))
-> Data (Handler annot)
Handler annot -> Constr
Handler annot -> DataType
(forall b. Data b => b -> b) -> Handler annot -> Handler annot
forall annot. Data annot => Typeable (Handler annot)
forall annot. Data annot => Handler annot -> Constr
forall annot. Data annot => Handler annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Handler annot -> Handler annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Handler annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Handler annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Handler annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Handler annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Handler annot -> m (Handler annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Handler annot -> m (Handler annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Handler annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Handler annot -> c (Handler annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Handler annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Handler annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Handler annot -> u
forall u. (forall d. Data d => d -> u) -> Handler annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Handler annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Handler annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Handler annot -> m (Handler annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Handler annot -> m (Handler annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Handler annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Handler annot -> c (Handler annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Handler annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Handler annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Handler annot -> c (Handler annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Handler annot -> c (Handler annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Handler annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Handler annot)
$ctoConstr :: forall annot. Data annot => Handler annot -> Constr
toConstr :: Handler annot -> Constr
$cdataTypeOf :: forall annot. Data annot => Handler annot -> DataType
dataTypeOf :: Handler annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Handler annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Handler annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Handler annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Handler annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Handler annot -> Handler annot
gmapT :: (forall b. Data b => b -> b) -> Handler annot -> Handler annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Handler annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Handler annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Handler annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Handler annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Handler annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Handler annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Handler annot -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Handler annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Handler annot -> m (Handler annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Handler annot -> m (Handler annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Handler annot -> m (Handler annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Handler annot -> m (Handler annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Handler annot -> m (Handler annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Handler annot -> m (Handler annot)
Data,(forall a b. (a -> b) -> Handler a -> Handler b)
-> (forall a b. a -> Handler b -> Handler a) -> Functor Handler
forall a b. a -> Handler b -> Handler a
forall a b. (a -> b) -> Handler a -> Handler b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Handler a -> Handler b
fmap :: forall a b. (a -> b) -> Handler a -> Handler b
$c<$ :: forall a b. a -> Handler b -> Handler a
<$ :: forall a b. a -> Handler b -> Handler a
Functor)

type HandlerSpan = Handler SrcSpan

instance Span HandlerSpan where
   getSpan :: HandlerSpan -> SrcSpan
getSpan = HandlerSpan -> SrcSpan
forall annot. Handler annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated Handler where
   annot :: forall annot. Handler annot -> annot
annot = Handler annot -> annot
forall annot. Handler annot -> annot
handler_annot 

-- | Exception clause. 
data ExceptClause annot
   = ExceptClause 
     -- NB: difference with version 3 (has NAME as target, but looks like bug in grammar)
     { forall annot.
ExceptClause annot -> Maybe (Expr annot, Maybe (Expr annot))
except_clause :: Maybe (Expr annot, Maybe (Expr annot))
     , forall annot. ExceptClause annot -> annot
except_clause_annot :: annot 
     }
   deriving (ExceptClause annot -> ExceptClause annot -> Bool
(ExceptClause annot -> ExceptClause annot -> Bool)
-> (ExceptClause annot -> ExceptClause annot -> Bool)
-> Eq (ExceptClause annot)
forall annot.
Eq annot =>
ExceptClause annot -> ExceptClause annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
ExceptClause annot -> ExceptClause annot -> Bool
== :: ExceptClause annot -> ExceptClause annot -> Bool
$c/= :: forall annot.
Eq annot =>
ExceptClause annot -> ExceptClause annot -> Bool
/= :: ExceptClause annot -> ExceptClause annot -> Bool
Eq,Eq (ExceptClause annot)
Eq (ExceptClause annot) =>
(ExceptClause annot -> ExceptClause annot -> Ordering)
-> (ExceptClause annot -> ExceptClause annot -> Bool)
-> (ExceptClause annot -> ExceptClause annot -> Bool)
-> (ExceptClause annot -> ExceptClause annot -> Bool)
-> (ExceptClause annot -> ExceptClause annot -> Bool)
-> (ExceptClause annot -> ExceptClause annot -> ExceptClause annot)
-> (ExceptClause annot -> ExceptClause annot -> ExceptClause annot)
-> Ord (ExceptClause annot)
ExceptClause annot -> ExceptClause annot -> Bool
ExceptClause annot -> ExceptClause annot -> Ordering
ExceptClause annot -> ExceptClause annot -> ExceptClause annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (ExceptClause annot)
forall annot.
Ord annot =>
ExceptClause annot -> ExceptClause annot -> Bool
forall annot.
Ord annot =>
ExceptClause annot -> ExceptClause annot -> Ordering
forall annot.
Ord annot =>
ExceptClause annot -> ExceptClause annot -> ExceptClause annot
$ccompare :: forall annot.
Ord annot =>
ExceptClause annot -> ExceptClause annot -> Ordering
compare :: ExceptClause annot -> ExceptClause annot -> Ordering
$c< :: forall annot.
Ord annot =>
ExceptClause annot -> ExceptClause annot -> Bool
< :: ExceptClause annot -> ExceptClause annot -> Bool
$c<= :: forall annot.
Ord annot =>
ExceptClause annot -> ExceptClause annot -> Bool
<= :: ExceptClause annot -> ExceptClause annot -> Bool
$c> :: forall annot.
Ord annot =>
ExceptClause annot -> ExceptClause annot -> Bool
> :: ExceptClause annot -> ExceptClause annot -> Bool
$c>= :: forall annot.
Ord annot =>
ExceptClause annot -> ExceptClause annot -> Bool
>= :: ExceptClause annot -> ExceptClause annot -> Bool
$cmax :: forall annot.
Ord annot =>
ExceptClause annot -> ExceptClause annot -> ExceptClause annot
max :: ExceptClause annot -> ExceptClause annot -> ExceptClause annot
$cmin :: forall annot.
Ord annot =>
ExceptClause annot -> ExceptClause annot -> ExceptClause annot
min :: ExceptClause annot -> ExceptClause annot -> ExceptClause annot
Ord,Int -> ExceptClause annot -> ShowS
[ExceptClause annot] -> ShowS
ExceptClause annot -> String
(Int -> ExceptClause annot -> ShowS)
-> (ExceptClause annot -> String)
-> ([ExceptClause annot] -> ShowS)
-> Show (ExceptClause annot)
forall annot. Show annot => Int -> ExceptClause annot -> ShowS
forall annot. Show annot => [ExceptClause annot] -> ShowS
forall annot. Show annot => ExceptClause annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> ExceptClause annot -> ShowS
showsPrec :: Int -> ExceptClause annot -> ShowS
$cshow :: forall annot. Show annot => ExceptClause annot -> String
show :: ExceptClause annot -> String
$cshowList :: forall annot. Show annot => [ExceptClause annot] -> ShowS
showList :: [ExceptClause annot] -> ShowS
Show,Typeable,Typeable (ExceptClause annot)
Typeable (ExceptClause annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ExceptClause annot
 -> c (ExceptClause annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ExceptClause annot))
-> (ExceptClause annot -> Constr)
-> (ExceptClause annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ExceptClause annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ExceptClause annot)))
-> ((forall b. Data b => b -> b)
    -> ExceptClause annot -> ExceptClause annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ExceptClause annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ExceptClause annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ExceptClause annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ExceptClause annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ExceptClause annot -> m (ExceptClause annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ExceptClause annot -> m (ExceptClause annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ExceptClause annot -> m (ExceptClause annot))
-> Data (ExceptClause annot)
ExceptClause annot -> Constr
ExceptClause annot -> DataType
(forall b. Data b => b -> b)
-> ExceptClause annot -> ExceptClause annot
forall annot. Data annot => Typeable (ExceptClause annot)
forall annot. Data annot => ExceptClause annot -> Constr
forall annot. Data annot => ExceptClause annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> ExceptClause annot -> ExceptClause annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> ExceptClause annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> ExceptClause annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptClause annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptClause annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> ExceptClause annot -> m (ExceptClause annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ExceptClause annot -> m (ExceptClause annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExceptClause annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExceptClause annot
-> c (ExceptClause annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ExceptClause annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExceptClause annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ExceptClause annot -> u
forall u. (forall d. Data d => d -> u) -> ExceptClause annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptClause annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptClause annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExceptClause annot -> m (ExceptClause annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExceptClause annot -> m (ExceptClause annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExceptClause annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExceptClause annot
-> c (ExceptClause annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ExceptClause annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExceptClause annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExceptClause annot
-> c (ExceptClause annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExceptClause annot
-> c (ExceptClause annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExceptClause annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ExceptClause annot)
$ctoConstr :: forall annot. Data annot => ExceptClause annot -> Constr
toConstr :: ExceptClause annot -> Constr
$cdataTypeOf :: forall annot. Data annot => ExceptClause annot -> DataType
dataTypeOf :: ExceptClause annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ExceptClause annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ExceptClause annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExceptClause annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ExceptClause annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> ExceptClause annot -> ExceptClause annot
gmapT :: (forall b. Data b => b -> b)
-> ExceptClause annot -> ExceptClause annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptClause annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptClause annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptClause annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExceptClause annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> ExceptClause annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ExceptClause annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> ExceptClause annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ExceptClause annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> ExceptClause annot -> m (ExceptClause annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExceptClause annot -> m (ExceptClause annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ExceptClause annot -> m (ExceptClause annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExceptClause annot -> m (ExceptClause annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ExceptClause annot -> m (ExceptClause annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExceptClause annot -> m (ExceptClause annot)
Data,(forall a b. (a -> b) -> ExceptClause a -> ExceptClause b)
-> (forall a b. a -> ExceptClause b -> ExceptClause a)
-> Functor ExceptClause
forall a b. a -> ExceptClause b -> ExceptClause a
forall a b. (a -> b) -> ExceptClause a -> ExceptClause b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ExceptClause a -> ExceptClause b
fmap :: forall a b. (a -> b) -> ExceptClause a -> ExceptClause b
$c<$ :: forall a b. a -> ExceptClause b -> ExceptClause a
<$ :: forall a b. a -> ExceptClause b -> ExceptClause a
Functor)

type ExceptClauseSpan = ExceptClause SrcSpan

instance Span ExceptClauseSpan where
   getSpan :: ExceptClauseSpan -> SrcSpan
getSpan = ExceptClauseSpan -> SrcSpan
forall annot. ExceptClause annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated ExceptClause where
   annot :: forall annot. ExceptClause annot -> annot
annot = ExceptClause annot -> annot
forall annot. ExceptClause annot -> annot
except_clause_annot 

-- | Comprehension. In version 3.x this can be used for lists, sets, dictionaries and generators. 
-- data Comprehension e annot
data Comprehension annot
   = Comprehension 
     { forall annot. Comprehension annot -> ComprehensionExpr annot
comprehension_expr :: ComprehensionExpr annot
     , forall annot. Comprehension annot -> CompFor annot
comprehension_for :: CompFor annot
     , forall annot. Comprehension annot -> annot
comprehension_annot :: annot 
     }
   deriving (Comprehension annot -> Comprehension annot -> Bool
(Comprehension annot -> Comprehension annot -> Bool)
-> (Comprehension annot -> Comprehension annot -> Bool)
-> Eq (Comprehension annot)
forall annot.
Eq annot =>
Comprehension annot -> Comprehension annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
Comprehension annot -> Comprehension annot -> Bool
== :: Comprehension annot -> Comprehension annot -> Bool
$c/= :: forall annot.
Eq annot =>
Comprehension annot -> Comprehension annot -> Bool
/= :: Comprehension annot -> Comprehension annot -> Bool
Eq,Eq (Comprehension annot)
Eq (Comprehension annot) =>
(Comprehension annot -> Comprehension annot -> Ordering)
-> (Comprehension annot -> Comprehension annot -> Bool)
-> (Comprehension annot -> Comprehension annot -> Bool)
-> (Comprehension annot -> Comprehension annot -> Bool)
-> (Comprehension annot -> Comprehension annot -> Bool)
-> (Comprehension annot
    -> Comprehension annot -> Comprehension annot)
-> (Comprehension annot
    -> Comprehension annot -> Comprehension annot)
-> Ord (Comprehension annot)
Comprehension annot -> Comprehension annot -> Bool
Comprehension annot -> Comprehension annot -> Ordering
Comprehension annot -> Comprehension annot -> Comprehension annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (Comprehension annot)
forall annot.
Ord annot =>
Comprehension annot -> Comprehension annot -> Bool
forall annot.
Ord annot =>
Comprehension annot -> Comprehension annot -> Ordering
forall annot.
Ord annot =>
Comprehension annot -> Comprehension annot -> Comprehension annot
$ccompare :: forall annot.
Ord annot =>
Comprehension annot -> Comprehension annot -> Ordering
compare :: Comprehension annot -> Comprehension annot -> Ordering
$c< :: forall annot.
Ord annot =>
Comprehension annot -> Comprehension annot -> Bool
< :: Comprehension annot -> Comprehension annot -> Bool
$c<= :: forall annot.
Ord annot =>
Comprehension annot -> Comprehension annot -> Bool
<= :: Comprehension annot -> Comprehension annot -> Bool
$c> :: forall annot.
Ord annot =>
Comprehension annot -> Comprehension annot -> Bool
> :: Comprehension annot -> Comprehension annot -> Bool
$c>= :: forall annot.
Ord annot =>
Comprehension annot -> Comprehension annot -> Bool
>= :: Comprehension annot -> Comprehension annot -> Bool
$cmax :: forall annot.
Ord annot =>
Comprehension annot -> Comprehension annot -> Comprehension annot
max :: Comprehension annot -> Comprehension annot -> Comprehension annot
$cmin :: forall annot.
Ord annot =>
Comprehension annot -> Comprehension annot -> Comprehension annot
min :: Comprehension annot -> Comprehension annot -> Comprehension annot
Ord,Int -> Comprehension annot -> ShowS
[Comprehension annot] -> ShowS
Comprehension annot -> String
(Int -> Comprehension annot -> ShowS)
-> (Comprehension annot -> String)
-> ([Comprehension annot] -> ShowS)
-> Show (Comprehension annot)
forall annot. Show annot => Int -> Comprehension annot -> ShowS
forall annot. Show annot => [Comprehension annot] -> ShowS
forall annot. Show annot => Comprehension annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> Comprehension annot -> ShowS
showsPrec :: Int -> Comprehension annot -> ShowS
$cshow :: forall annot. Show annot => Comprehension annot -> String
show :: Comprehension annot -> String
$cshowList :: forall annot. Show annot => [Comprehension annot] -> ShowS
showList :: [Comprehension annot] -> ShowS
Show,Typeable,Typeable (Comprehension annot)
Typeable (Comprehension annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> Comprehension annot
 -> c (Comprehension annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Comprehension annot))
-> (Comprehension annot -> Constr)
-> (Comprehension annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Comprehension annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Comprehension annot)))
-> ((forall b. Data b => b -> b)
    -> Comprehension annot -> Comprehension annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Comprehension annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Comprehension annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Comprehension annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Comprehension annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Comprehension annot -> m (Comprehension annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Comprehension annot -> m (Comprehension annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Comprehension annot -> m (Comprehension annot))
-> Data (Comprehension annot)
Comprehension annot -> Constr
Comprehension annot -> DataType
(forall b. Data b => b -> b)
-> Comprehension annot -> Comprehension annot
forall annot. Data annot => Typeable (Comprehension annot)
forall annot. Data annot => Comprehension annot -> Constr
forall annot. Data annot => Comprehension annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> Comprehension annot -> Comprehension annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Comprehension annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Comprehension annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comprehension annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comprehension annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Comprehension annot -> m (Comprehension annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Comprehension annot -> m (Comprehension annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Comprehension annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Comprehension annot
-> c (Comprehension annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Comprehension annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Comprehension annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Comprehension annot -> u
forall u.
(forall d. Data d => d -> u) -> Comprehension annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comprehension annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comprehension annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Comprehension annot -> m (Comprehension annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Comprehension annot -> m (Comprehension annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Comprehension annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Comprehension annot
-> c (Comprehension annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Comprehension annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Comprehension annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Comprehension annot
-> c (Comprehension annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Comprehension annot
-> c (Comprehension annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Comprehension annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Comprehension annot)
$ctoConstr :: forall annot. Data annot => Comprehension annot -> Constr
toConstr :: Comprehension annot -> Constr
$cdataTypeOf :: forall annot. Data annot => Comprehension annot -> DataType
dataTypeOf :: Comprehension annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Comprehension annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Comprehension annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Comprehension annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Comprehension annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> Comprehension annot -> Comprehension annot
gmapT :: (forall b. Data b => b -> b)
-> Comprehension annot -> Comprehension annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comprehension annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comprehension annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comprehension annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comprehension annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Comprehension annot -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> Comprehension annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Comprehension annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Comprehension annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> Comprehension annot -> m (Comprehension annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Comprehension annot -> m (Comprehension annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Comprehension annot -> m (Comprehension annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Comprehension annot -> m (Comprehension annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Comprehension annot -> m (Comprehension annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Comprehension annot -> m (Comprehension annot)
Data,(forall a b. (a -> b) -> Comprehension a -> Comprehension b)
-> (forall a b. a -> Comprehension b -> Comprehension a)
-> Functor Comprehension
forall a b. a -> Comprehension b -> Comprehension a
forall a b. (a -> b) -> Comprehension a -> Comprehension b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Comprehension a -> Comprehension b
fmap :: forall a b. (a -> b) -> Comprehension a -> Comprehension b
$c<$ :: forall a b. a -> Comprehension b -> Comprehension a
<$ :: forall a b. a -> Comprehension b -> Comprehension a
Functor)

type ComprehensionSpan = Comprehension SrcSpan

instance Span ComprehensionSpan where
   getSpan :: ComprehensionSpan -> SrcSpan
getSpan = ComprehensionSpan -> SrcSpan
forall annot. Comprehension annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated Comprehension where
   annot :: forall annot. Comprehension annot -> annot
annot = Comprehension annot -> annot
forall annot. Comprehension annot -> annot
comprehension_annot 

data ComprehensionExpr annot
   = ComprehensionExpr (Expr annot)
   | ComprehensionDict (DictKeyDatumList annot)
   deriving (ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
(ComprehensionExpr annot -> ComprehensionExpr annot -> Bool)
-> (ComprehensionExpr annot -> ComprehensionExpr annot -> Bool)
-> Eq (ComprehensionExpr annot)
forall annot.
Eq annot =>
ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
== :: ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
$c/= :: forall annot.
Eq annot =>
ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
/= :: ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
Eq,Eq (ComprehensionExpr annot)
Eq (ComprehensionExpr annot) =>
(ComprehensionExpr annot -> ComprehensionExpr annot -> Ordering)
-> (ComprehensionExpr annot -> ComprehensionExpr annot -> Bool)
-> (ComprehensionExpr annot -> ComprehensionExpr annot -> Bool)
-> (ComprehensionExpr annot -> ComprehensionExpr annot -> Bool)
-> (ComprehensionExpr annot -> ComprehensionExpr annot -> Bool)
-> (ComprehensionExpr annot
    -> ComprehensionExpr annot -> ComprehensionExpr annot)
-> (ComprehensionExpr annot
    -> ComprehensionExpr annot -> ComprehensionExpr annot)
-> Ord (ComprehensionExpr annot)
ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
ComprehensionExpr annot -> ComprehensionExpr annot -> Ordering
ComprehensionExpr annot
-> ComprehensionExpr annot -> ComprehensionExpr annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (ComprehensionExpr annot)
forall annot.
Ord annot =>
ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
forall annot.
Ord annot =>
ComprehensionExpr annot -> ComprehensionExpr annot -> Ordering
forall annot.
Ord annot =>
ComprehensionExpr annot
-> ComprehensionExpr annot -> ComprehensionExpr annot
$ccompare :: forall annot.
Ord annot =>
ComprehensionExpr annot -> ComprehensionExpr annot -> Ordering
compare :: ComprehensionExpr annot -> ComprehensionExpr annot -> Ordering
$c< :: forall annot.
Ord annot =>
ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
< :: ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
$c<= :: forall annot.
Ord annot =>
ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
<= :: ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
$c> :: forall annot.
Ord annot =>
ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
> :: ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
$c>= :: forall annot.
Ord annot =>
ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
>= :: ComprehensionExpr annot -> ComprehensionExpr annot -> Bool
$cmax :: forall annot.
Ord annot =>
ComprehensionExpr annot
-> ComprehensionExpr annot -> ComprehensionExpr annot
max :: ComprehensionExpr annot
-> ComprehensionExpr annot -> ComprehensionExpr annot
$cmin :: forall annot.
Ord annot =>
ComprehensionExpr annot
-> ComprehensionExpr annot -> ComprehensionExpr annot
min :: ComprehensionExpr annot
-> ComprehensionExpr annot -> ComprehensionExpr annot
Ord,Int -> ComprehensionExpr annot -> ShowS
[ComprehensionExpr annot] -> ShowS
ComprehensionExpr annot -> String
(Int -> ComprehensionExpr annot -> ShowS)
-> (ComprehensionExpr annot -> String)
-> ([ComprehensionExpr annot] -> ShowS)
-> Show (ComprehensionExpr annot)
forall annot. Show annot => Int -> ComprehensionExpr annot -> ShowS
forall annot. Show annot => [ComprehensionExpr annot] -> ShowS
forall annot. Show annot => ComprehensionExpr annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> ComprehensionExpr annot -> ShowS
showsPrec :: Int -> ComprehensionExpr annot -> ShowS
$cshow :: forall annot. Show annot => ComprehensionExpr annot -> String
show :: ComprehensionExpr annot -> String
$cshowList :: forall annot. Show annot => [ComprehensionExpr annot] -> ShowS
showList :: [ComprehensionExpr annot] -> ShowS
Show,Typeable,Typeable (ComprehensionExpr annot)
Typeable (ComprehensionExpr annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ComprehensionExpr annot
 -> c (ComprehensionExpr annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ComprehensionExpr annot))
-> (ComprehensionExpr annot -> Constr)
-> (ComprehensionExpr annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c (ComprehensionExpr annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ComprehensionExpr annot)))
-> ((forall b. Data b => b -> b)
    -> ComprehensionExpr annot -> ComprehensionExpr annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ComprehensionExpr annot
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ComprehensionExpr annot
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ComprehensionExpr annot -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> ComprehensionExpr annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ComprehensionExpr annot -> m (ComprehensionExpr annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ComprehensionExpr annot -> m (ComprehensionExpr annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ComprehensionExpr annot -> m (ComprehensionExpr annot))
-> Data (ComprehensionExpr annot)
ComprehensionExpr annot -> Constr
ComprehensionExpr annot -> DataType
(forall b. Data b => b -> b)
-> ComprehensionExpr annot -> ComprehensionExpr annot
forall annot. Data annot => Typeable (ComprehensionExpr annot)
forall annot. Data annot => ComprehensionExpr annot -> Constr
forall annot. Data annot => ComprehensionExpr annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> ComprehensionExpr annot -> ComprehensionExpr annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> ComprehensionExpr annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> ComprehensionExpr annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComprehensionExpr annot
-> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComprehensionExpr annot
-> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> ComprehensionExpr annot -> m (ComprehensionExpr annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ComprehensionExpr annot -> m (ComprehensionExpr annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ComprehensionExpr annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ComprehensionExpr annot
-> c (ComprehensionExpr annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (ComprehensionExpr annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ComprehensionExpr annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ComprehensionExpr annot -> u
forall u.
(forall d. Data d => d -> u) -> ComprehensionExpr annot -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComprehensionExpr annot
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComprehensionExpr annot
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ComprehensionExpr annot -> m (ComprehensionExpr annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ComprehensionExpr annot -> m (ComprehensionExpr annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ComprehensionExpr annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ComprehensionExpr annot
-> c (ComprehensionExpr annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (ComprehensionExpr annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ComprehensionExpr annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ComprehensionExpr annot
-> c (ComprehensionExpr annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ComprehensionExpr annot
-> c (ComprehensionExpr annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ComprehensionExpr annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ComprehensionExpr annot)
$ctoConstr :: forall annot. Data annot => ComprehensionExpr annot -> Constr
toConstr :: ComprehensionExpr annot -> Constr
$cdataTypeOf :: forall annot. Data annot => ComprehensionExpr annot -> DataType
dataTypeOf :: ComprehensionExpr annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d))
-> Maybe (c (ComprehensionExpr annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c (ComprehensionExpr annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ComprehensionExpr annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ComprehensionExpr annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> ComprehensionExpr annot -> ComprehensionExpr annot
gmapT :: (forall b. Data b => b -> b)
-> ComprehensionExpr annot -> ComprehensionExpr annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComprehensionExpr annot
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComprehensionExpr annot
-> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComprehensionExpr annot
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ComprehensionExpr annot
-> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> ComprehensionExpr annot -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ComprehensionExpr annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> ComprehensionExpr annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ComprehensionExpr annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> ComprehensionExpr annot -> m (ComprehensionExpr annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ComprehensionExpr annot -> m (ComprehensionExpr annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ComprehensionExpr annot -> m (ComprehensionExpr annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ComprehensionExpr annot -> m (ComprehensionExpr annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ComprehensionExpr annot -> m (ComprehensionExpr annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ComprehensionExpr annot -> m (ComprehensionExpr annot)
Data,(forall a b.
 (a -> b) -> ComprehensionExpr a -> ComprehensionExpr b)
-> (forall a b. a -> ComprehensionExpr b -> ComprehensionExpr a)
-> Functor ComprehensionExpr
forall a b. a -> ComprehensionExpr b -> ComprehensionExpr a
forall a b. (a -> b) -> ComprehensionExpr a -> ComprehensionExpr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ComprehensionExpr a -> ComprehensionExpr b
fmap :: forall a b. (a -> b) -> ComprehensionExpr a -> ComprehensionExpr b
$c<$ :: forall a b. a -> ComprehensionExpr b -> ComprehensionExpr a
<$ :: forall a b. a -> ComprehensionExpr b -> ComprehensionExpr a
Functor)

type ComprehensionExprSpan = ComprehensionExpr SrcSpan

instance Span ComprehensionExprSpan where
   getSpan :: ComprehensionExprSpan -> SrcSpan
getSpan (ComprehensionExpr Expr SrcSpan
e) = Expr SrcSpan -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan Expr SrcSpan
e
   getSpan (ComprehensionDict DictKeyDatumList SrcSpan
d) = DictKeyDatumList SrcSpan -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan DictKeyDatumList SrcSpan
d

-- | Comprehension \'for\' component. 
data CompFor annot = 
   CompFor 
   { forall annot. CompFor annot -> Bool
comp_for_async :: Bool
   , forall annot. CompFor annot -> [Expr annot]
comp_for_exprs :: [Expr annot]
   , forall annot. CompFor annot -> Expr annot
comp_in_expr :: Expr annot
   , forall annot. CompFor annot -> Maybe (CompIter annot)
comp_for_iter :: Maybe (CompIter annot) 
   , forall annot. CompFor annot -> annot
comp_for_annot :: annot
   }
   deriving (CompFor annot -> CompFor annot -> Bool
(CompFor annot -> CompFor annot -> Bool)
-> (CompFor annot -> CompFor annot -> Bool) -> Eq (CompFor annot)
forall annot. Eq annot => CompFor annot -> CompFor annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => CompFor annot -> CompFor annot -> Bool
== :: CompFor annot -> CompFor annot -> Bool
$c/= :: forall annot. Eq annot => CompFor annot -> CompFor annot -> Bool
/= :: CompFor annot -> CompFor annot -> Bool
Eq,Eq (CompFor annot)
Eq (CompFor annot) =>
(CompFor annot -> CompFor annot -> Ordering)
-> (CompFor annot -> CompFor annot -> Bool)
-> (CompFor annot -> CompFor annot -> Bool)
-> (CompFor annot -> CompFor annot -> Bool)
-> (CompFor annot -> CompFor annot -> Bool)
-> (CompFor annot -> CompFor annot -> CompFor annot)
-> (CompFor annot -> CompFor annot -> CompFor annot)
-> Ord (CompFor annot)
CompFor annot -> CompFor annot -> Bool
CompFor annot -> CompFor annot -> Ordering
CompFor annot -> CompFor annot -> CompFor annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (CompFor annot)
forall annot. Ord annot => CompFor annot -> CompFor annot -> Bool
forall annot.
Ord annot =>
CompFor annot -> CompFor annot -> Ordering
forall annot.
Ord annot =>
CompFor annot -> CompFor annot -> CompFor annot
$ccompare :: forall annot.
Ord annot =>
CompFor annot -> CompFor annot -> Ordering
compare :: CompFor annot -> CompFor annot -> Ordering
$c< :: forall annot. Ord annot => CompFor annot -> CompFor annot -> Bool
< :: CompFor annot -> CompFor annot -> Bool
$c<= :: forall annot. Ord annot => CompFor annot -> CompFor annot -> Bool
<= :: CompFor annot -> CompFor annot -> Bool
$c> :: forall annot. Ord annot => CompFor annot -> CompFor annot -> Bool
> :: CompFor annot -> CompFor annot -> Bool
$c>= :: forall annot. Ord annot => CompFor annot -> CompFor annot -> Bool
>= :: CompFor annot -> CompFor annot -> Bool
$cmax :: forall annot.
Ord annot =>
CompFor annot -> CompFor annot -> CompFor annot
max :: CompFor annot -> CompFor annot -> CompFor annot
$cmin :: forall annot.
Ord annot =>
CompFor annot -> CompFor annot -> CompFor annot
min :: CompFor annot -> CompFor annot -> CompFor annot
Ord,Int -> CompFor annot -> ShowS
[CompFor annot] -> ShowS
CompFor annot -> String
(Int -> CompFor annot -> ShowS)
-> (CompFor annot -> String)
-> ([CompFor annot] -> ShowS)
-> Show (CompFor annot)
forall annot. Show annot => Int -> CompFor annot -> ShowS
forall annot. Show annot => [CompFor annot] -> ShowS
forall annot. Show annot => CompFor annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> CompFor annot -> ShowS
showsPrec :: Int -> CompFor annot -> ShowS
$cshow :: forall annot. Show annot => CompFor annot -> String
show :: CompFor annot -> String
$cshowList :: forall annot. Show annot => [CompFor annot] -> ShowS
showList :: [CompFor annot] -> ShowS
Show,Typeable,Typeable (CompFor annot)
Typeable (CompFor annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CompFor annot -> c (CompFor annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (CompFor annot))
-> (CompFor annot -> Constr)
-> (CompFor annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (CompFor annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (CompFor annot)))
-> ((forall b. Data b => b -> b) -> CompFor annot -> CompFor annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CompFor annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CompFor annot -> r)
-> (forall u. (forall d. Data d => d -> u) -> CompFor annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CompFor annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CompFor annot -> m (CompFor annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompFor annot -> m (CompFor annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompFor annot -> m (CompFor annot))
-> Data (CompFor annot)
CompFor annot -> Constr
CompFor annot -> DataType
(forall b. Data b => b -> b) -> CompFor annot -> CompFor annot
forall annot. Data annot => Typeable (CompFor annot)
forall annot. Data annot => CompFor annot -> Constr
forall annot. Data annot => CompFor annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> CompFor annot -> CompFor annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> CompFor annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> CompFor annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompFor annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompFor annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> CompFor annot -> m (CompFor annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> CompFor annot -> m (CompFor annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompFor annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompFor annot -> c (CompFor annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CompFor annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompFor annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CompFor annot -> u
forall u. (forall d. Data d => d -> u) -> CompFor annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompFor annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompFor annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompFor annot -> m (CompFor annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompFor annot -> m (CompFor annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompFor annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompFor annot -> c (CompFor annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CompFor annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompFor annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompFor annot -> c (CompFor annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompFor annot -> c (CompFor annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompFor annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompFor annot)
$ctoConstr :: forall annot. Data annot => CompFor annot -> Constr
toConstr :: CompFor annot -> Constr
$cdataTypeOf :: forall annot. Data annot => CompFor annot -> DataType
dataTypeOf :: CompFor annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CompFor annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CompFor annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompFor annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompFor annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> CompFor annot -> CompFor annot
gmapT :: (forall b. Data b => b -> b) -> CompFor annot -> CompFor annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompFor annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompFor annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompFor annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompFor annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> CompFor annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CompFor annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> CompFor annot -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CompFor annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> CompFor annot -> m (CompFor annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompFor annot -> m (CompFor annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> CompFor annot -> m (CompFor annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompFor annot -> m (CompFor annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> CompFor annot -> m (CompFor annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompFor annot -> m (CompFor annot)
Data,(forall a b. (a -> b) -> CompFor a -> CompFor b)
-> (forall a b. a -> CompFor b -> CompFor a) -> Functor CompFor
forall a b. a -> CompFor b -> CompFor a
forall a b. (a -> b) -> CompFor a -> CompFor b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CompFor a -> CompFor b
fmap :: forall a b. (a -> b) -> CompFor a -> CompFor b
$c<$ :: forall a b. a -> CompFor b -> CompFor a
<$ :: forall a b. a -> CompFor b -> CompFor a
Functor)

type CompForSpan = CompFor SrcSpan

instance Span CompForSpan where
   getSpan :: CompForSpan -> SrcSpan
getSpan = CompForSpan -> SrcSpan
forall annot. CompFor annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated CompFor where
   annot :: forall annot. CompFor annot -> annot
annot = CompFor annot -> annot
forall annot. CompFor annot -> annot
comp_for_annot 

-- | Comprehension guard. 
data CompIf annot = 
   CompIf 
   { forall annot. CompIf annot -> Expr annot
comp_if :: Expr annot
   , forall annot. CompIf annot -> Maybe (CompIter annot)
comp_if_iter :: Maybe (CompIter annot)
   , forall annot. CompIf annot -> annot
comp_if_annot :: annot 
   }
   deriving (CompIf annot -> CompIf annot -> Bool
(CompIf annot -> CompIf annot -> Bool)
-> (CompIf annot -> CompIf annot -> Bool) -> Eq (CompIf annot)
forall annot. Eq annot => CompIf annot -> CompIf annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => CompIf annot -> CompIf annot -> Bool
== :: CompIf annot -> CompIf annot -> Bool
$c/= :: forall annot. Eq annot => CompIf annot -> CompIf annot -> Bool
/= :: CompIf annot -> CompIf annot -> Bool
Eq,Eq (CompIf annot)
Eq (CompIf annot) =>
(CompIf annot -> CompIf annot -> Ordering)
-> (CompIf annot -> CompIf annot -> Bool)
-> (CompIf annot -> CompIf annot -> Bool)
-> (CompIf annot -> CompIf annot -> Bool)
-> (CompIf annot -> CompIf annot -> Bool)
-> (CompIf annot -> CompIf annot -> CompIf annot)
-> (CompIf annot -> CompIf annot -> CompIf annot)
-> Ord (CompIf annot)
CompIf annot -> CompIf annot -> Bool
CompIf annot -> CompIf annot -> Ordering
CompIf annot -> CompIf annot -> CompIf annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (CompIf annot)
forall annot. Ord annot => CompIf annot -> CompIf annot -> Bool
forall annot. Ord annot => CompIf annot -> CompIf annot -> Ordering
forall annot.
Ord annot =>
CompIf annot -> CompIf annot -> CompIf annot
$ccompare :: forall annot. Ord annot => CompIf annot -> CompIf annot -> Ordering
compare :: CompIf annot -> CompIf annot -> Ordering
$c< :: forall annot. Ord annot => CompIf annot -> CompIf annot -> Bool
< :: CompIf annot -> CompIf annot -> Bool
$c<= :: forall annot. Ord annot => CompIf annot -> CompIf annot -> Bool
<= :: CompIf annot -> CompIf annot -> Bool
$c> :: forall annot. Ord annot => CompIf annot -> CompIf annot -> Bool
> :: CompIf annot -> CompIf annot -> Bool
$c>= :: forall annot. Ord annot => CompIf annot -> CompIf annot -> Bool
>= :: CompIf annot -> CompIf annot -> Bool
$cmax :: forall annot.
Ord annot =>
CompIf annot -> CompIf annot -> CompIf annot
max :: CompIf annot -> CompIf annot -> CompIf annot
$cmin :: forall annot.
Ord annot =>
CompIf annot -> CompIf annot -> CompIf annot
min :: CompIf annot -> CompIf annot -> CompIf annot
Ord,Int -> CompIf annot -> ShowS
[CompIf annot] -> ShowS
CompIf annot -> String
(Int -> CompIf annot -> ShowS)
-> (CompIf annot -> String)
-> ([CompIf annot] -> ShowS)
-> Show (CompIf annot)
forall annot. Show annot => Int -> CompIf annot -> ShowS
forall annot. Show annot => [CompIf annot] -> ShowS
forall annot. Show annot => CompIf annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> CompIf annot -> ShowS
showsPrec :: Int -> CompIf annot -> ShowS
$cshow :: forall annot. Show annot => CompIf annot -> String
show :: CompIf annot -> String
$cshowList :: forall annot. Show annot => [CompIf annot] -> ShowS
showList :: [CompIf annot] -> ShowS
Show,Typeable,Typeable (CompIf annot)
Typeable (CompIf annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CompIf annot -> c (CompIf annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (CompIf annot))
-> (CompIf annot -> Constr)
-> (CompIf annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (CompIf annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (CompIf annot)))
-> ((forall b. Data b => b -> b) -> CompIf annot -> CompIf annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CompIf annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CompIf annot -> r)
-> (forall u. (forall d. Data d => d -> u) -> CompIf annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CompIf annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot))
-> Data (CompIf annot)
CompIf annot -> Constr
CompIf annot -> DataType
(forall b. Data b => b -> b) -> CompIf annot -> CompIf annot
forall annot. Data annot => Typeable (CompIf annot)
forall annot. Data annot => CompIf annot -> Constr
forall annot. Data annot => CompIf annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> CompIf annot -> CompIf annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> CompIf annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> CompIf annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompIf annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompIf annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompIf annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompIf annot -> c (CompIf annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CompIf annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompIf annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CompIf annot -> u
forall u. (forall d. Data d => d -> u) -> CompIf annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompIf annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompIf annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompIf annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompIf annot -> c (CompIf annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CompIf annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompIf annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompIf annot -> c (CompIf annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompIf annot -> c (CompIf annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompIf annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompIf annot)
$ctoConstr :: forall annot. Data annot => CompIf annot -> Constr
toConstr :: CompIf annot -> Constr
$cdataTypeOf :: forall annot. Data annot => CompIf annot -> DataType
dataTypeOf :: CompIf annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CompIf annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CompIf annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompIf annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompIf annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> CompIf annot -> CompIf annot
gmapT :: (forall b. Data b => b -> b) -> CompIf annot -> CompIf annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompIf annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompIf annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompIf annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompIf annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> CompIf annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CompIf annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> CompIf annot -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CompIf annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CompIf annot -> m (CompIf annot)
Data,(forall a b. (a -> b) -> CompIf a -> CompIf b)
-> (forall a b. a -> CompIf b -> CompIf a) -> Functor CompIf
forall a b. a -> CompIf b -> CompIf a
forall a b. (a -> b) -> CompIf a -> CompIf b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CompIf a -> CompIf b
fmap :: forall a b. (a -> b) -> CompIf a -> CompIf b
$c<$ :: forall a b. a -> CompIf b -> CompIf a
<$ :: forall a b. a -> CompIf b -> CompIf a
Functor)

type CompIfSpan = CompIf SrcSpan

instance Span CompIfSpan where
   getSpan :: CompIfSpan -> SrcSpan
getSpan = CompIfSpan -> SrcSpan
forall annot. CompIf annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated CompIf where
   annot :: forall annot. CompIf annot -> annot
annot = CompIf annot -> annot
forall annot. CompIf annot -> annot
comp_if_annot 

-- | Comprehension iterator (either a \'for\' or an \'if\'). 
data CompIter annot 
   = IterFor { forall annot. CompIter annot -> CompFor annot
comp_iter_for :: CompFor annot, forall annot. CompIter annot -> annot
comp_iter_annot :: annot }
   | IterIf { forall annot. CompIter annot -> CompIf annot
comp_iter_if :: CompIf annot, comp_iter_annot :: annot }
   deriving (CompIter annot -> CompIter annot -> Bool
(CompIter annot -> CompIter annot -> Bool)
-> (CompIter annot -> CompIter annot -> Bool)
-> Eq (CompIter annot)
forall annot. Eq annot => CompIter annot -> CompIter annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => CompIter annot -> CompIter annot -> Bool
== :: CompIter annot -> CompIter annot -> Bool
$c/= :: forall annot. Eq annot => CompIter annot -> CompIter annot -> Bool
/= :: CompIter annot -> CompIter annot -> Bool
Eq,Eq (CompIter annot)
Eq (CompIter annot) =>
(CompIter annot -> CompIter annot -> Ordering)
-> (CompIter annot -> CompIter annot -> Bool)
-> (CompIter annot -> CompIter annot -> Bool)
-> (CompIter annot -> CompIter annot -> Bool)
-> (CompIter annot -> CompIter annot -> Bool)
-> (CompIter annot -> CompIter annot -> CompIter annot)
-> (CompIter annot -> CompIter annot -> CompIter annot)
-> Ord (CompIter annot)
CompIter annot -> CompIter annot -> Bool
CompIter annot -> CompIter annot -> Ordering
CompIter annot -> CompIter annot -> CompIter annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (CompIter annot)
forall annot. Ord annot => CompIter annot -> CompIter annot -> Bool
forall annot.
Ord annot =>
CompIter annot -> CompIter annot -> Ordering
forall annot.
Ord annot =>
CompIter annot -> CompIter annot -> CompIter annot
$ccompare :: forall annot.
Ord annot =>
CompIter annot -> CompIter annot -> Ordering
compare :: CompIter annot -> CompIter annot -> Ordering
$c< :: forall annot. Ord annot => CompIter annot -> CompIter annot -> Bool
< :: CompIter annot -> CompIter annot -> Bool
$c<= :: forall annot. Ord annot => CompIter annot -> CompIter annot -> Bool
<= :: CompIter annot -> CompIter annot -> Bool
$c> :: forall annot. Ord annot => CompIter annot -> CompIter annot -> Bool
> :: CompIter annot -> CompIter annot -> Bool
$c>= :: forall annot. Ord annot => CompIter annot -> CompIter annot -> Bool
>= :: CompIter annot -> CompIter annot -> Bool
$cmax :: forall annot.
Ord annot =>
CompIter annot -> CompIter annot -> CompIter annot
max :: CompIter annot -> CompIter annot -> CompIter annot
$cmin :: forall annot.
Ord annot =>
CompIter annot -> CompIter annot -> CompIter annot
min :: CompIter annot -> CompIter annot -> CompIter annot
Ord,Int -> CompIter annot -> ShowS
[CompIter annot] -> ShowS
CompIter annot -> String
(Int -> CompIter annot -> ShowS)
-> (CompIter annot -> String)
-> ([CompIter annot] -> ShowS)
-> Show (CompIter annot)
forall annot. Show annot => Int -> CompIter annot -> ShowS
forall annot. Show annot => [CompIter annot] -> ShowS
forall annot. Show annot => CompIter annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> CompIter annot -> ShowS
showsPrec :: Int -> CompIter annot -> ShowS
$cshow :: forall annot. Show annot => CompIter annot -> String
show :: CompIter annot -> String
$cshowList :: forall annot. Show annot => [CompIter annot] -> ShowS
showList :: [CompIter annot] -> ShowS
Show,Typeable,Typeable (CompIter annot)
Typeable (CompIter annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CompIter annot -> c (CompIter annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (CompIter annot))
-> (CompIter annot -> Constr)
-> (CompIter annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (CompIter annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (CompIter annot)))
-> ((forall b. Data b => b -> b)
    -> CompIter annot -> CompIter annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CompIter annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CompIter annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CompIter annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CompIter annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CompIter annot -> m (CompIter annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompIter annot -> m (CompIter annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompIter annot -> m (CompIter annot))
-> Data (CompIter annot)
CompIter annot -> Constr
CompIter annot -> DataType
(forall b. Data b => b -> b) -> CompIter annot -> CompIter annot
forall annot. Data annot => Typeable (CompIter annot)
forall annot. Data annot => CompIter annot -> Constr
forall annot. Data annot => CompIter annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> CompIter annot -> CompIter annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> CompIter annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> CompIter annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompIter annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompIter annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> CompIter annot -> m (CompIter annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> CompIter annot -> m (CompIter annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompIter annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompIter annot -> c (CompIter annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CompIter annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompIter annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CompIter annot -> u
forall u. (forall d. Data d => d -> u) -> CompIter annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompIter annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompIter annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompIter annot -> m (CompIter annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompIter annot -> m (CompIter annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompIter annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompIter annot -> c (CompIter annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CompIter annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompIter annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompIter annot -> c (CompIter annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompIter annot -> c (CompIter annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompIter annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompIter annot)
$ctoConstr :: forall annot. Data annot => CompIter annot -> Constr
toConstr :: CompIter annot -> Constr
$cdataTypeOf :: forall annot. Data annot => CompIter annot -> DataType
dataTypeOf :: CompIter annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CompIter annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CompIter annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompIter annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompIter annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> CompIter annot -> CompIter annot
gmapT :: (forall b. Data b => b -> b) -> CompIter annot -> CompIter annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompIter annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompIter annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompIter annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompIter annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> CompIter annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CompIter annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> CompIter annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CompIter annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> CompIter annot -> m (CompIter annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompIter annot -> m (CompIter annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> CompIter annot -> m (CompIter annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompIter annot -> m (CompIter annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> CompIter annot -> m (CompIter annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompIter annot -> m (CompIter annot)
Data,(forall a b. (a -> b) -> CompIter a -> CompIter b)
-> (forall a b. a -> CompIter b -> CompIter a) -> Functor CompIter
forall a b. a -> CompIter b -> CompIter a
forall a b. (a -> b) -> CompIter a -> CompIter b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CompIter a -> CompIter b
fmap :: forall a b. (a -> b) -> CompIter a -> CompIter b
$c<$ :: forall a b. a -> CompIter b -> CompIter a
<$ :: forall a b. a -> CompIter b -> CompIter a
Functor)

type CompIterSpan = CompIter SrcSpan

instance Span CompIterSpan where
   getSpan :: CompIterSpan -> SrcSpan
getSpan = CompIterSpan -> SrcSpan
forall annot. CompIter annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated CompIter where
   annot :: forall annot. CompIter annot -> annot
annot = CompIter annot -> annot
forall annot. CompIter annot -> annot
comp_iter_annot 

-- | Expressions.
-- 
-- * Version 2.6 <http://docs.python.org/2.6/reference/expressions.html>.
-- 
-- * Version 3.1 <http://docs.python.org/3.1/reference/expressions.html>.
-- 
data Expr annot
   -- | Variable.
   = Var { forall annot. Expr annot -> Ident annot
var_ident :: Ident annot, forall annot. Expr annot -> annot
expr_annot :: annot }
   -- | Literal integer.
   | Int { forall annot. Expr annot -> Integer
int_value :: Integer, forall annot. Expr annot -> String
expr_literal :: String, expr_annot :: annot }
   -- | Long literal integer. /Version 2 only/.
   | LongInt { int_value :: Integer, expr_literal :: String, expr_annot :: annot }
   -- | Literal floating point number.
   | Float { forall annot. Expr annot -> Double
float_value :: Double, expr_literal :: String, expr_annot :: annot }
   -- | Literal imaginary number.
   | Imaginary { forall annot. Expr annot -> Double
imaginary_value :: Double, expr_literal :: String, expr_annot :: annot } 
   -- | Literal boolean.
   | Bool { forall annot. Expr annot -> Bool
bool_value :: Bool, expr_annot :: annot }
   -- | Literal \'None\' value.
   | None { expr_annot :: annot } 
   -- | Ellipsis \'...\'.
   | Ellipsis { expr_annot :: annot }
   -- | Literal byte string.
   | ByteStrings { forall annot. Expr annot -> [String]
byte_string_strings :: [String], expr_annot :: annot }
   -- | Literal strings (to be concatentated together).
   | Strings { forall annot. Expr annot -> [String]
strings_strings :: [String], expr_annot :: annot }
   -- | Unicode literal strings (to be concatentated together). Version 2 only.
   | UnicodeStrings { forall annot. Expr annot -> [String]
unicodestrings_strings :: [String], expr_annot :: annot }
   -- | Function call. 
   | Call 
     { forall annot. Expr annot -> Expr annot
call_fun :: Expr annot -- ^ Expression yielding a callable object (such as a function).
     , forall annot. Expr annot -> [Argument annot]
call_args :: [Argument annot] -- ^ Call arguments.
     , expr_annot :: annot
     }
   -- | Subscription, for example \'x [y]\'. 
   | Subscript { forall annot. Expr annot -> Expr annot
subscriptee :: Expr annot, forall annot. Expr annot -> Expr annot
subscript_expr :: Expr annot, expr_annot :: annot }
   -- | Slicing, for example \'w [x:y:z]\'. 
   | SlicedExpr { forall annot. Expr annot -> Expr annot
slicee :: Expr annot, forall annot. Expr annot -> [Slice annot]
slices :: [Slice annot], expr_annot :: annot } 
   -- | Conditional expresison. 
   | CondExpr 
     { forall annot. Expr annot -> Expr annot
ce_true_branch :: Expr annot -- ^ Expression to evaluate if condition is True.
     , forall annot. Expr annot -> Expr annot
ce_condition :: Expr annot -- ^ Boolean condition.
     , forall annot. Expr annot -> Expr annot
ce_false_branch :: Expr annot -- ^ Expression to evaluate if condition is False.
     , expr_annot :: annot
     }
   -- | Binary operator application.
   | BinaryOp { forall annot. Expr annot -> Op annot
operator :: Op annot, forall annot. Expr annot -> Expr annot
left_op_arg :: Expr annot, forall annot. Expr annot -> Expr annot
right_op_arg :: Expr annot, expr_annot :: annot }
   -- | Unary operator application.
   | UnaryOp { operator :: Op annot, forall annot. Expr annot -> Expr annot
op_arg :: Expr annot, expr_annot :: annot }
   -- Dot operator (attribute selection)
   | Dot { forall annot. Expr annot -> Expr annot
dot_expr :: Expr annot, forall annot. Expr annot -> Ident annot
dot_attribute :: Ident annot, expr_annot :: annot }
   -- | Anonymous function definition (lambda). 
   | Lambda { forall annot. Expr annot -> [Parameter annot]
lambda_args :: [Parameter annot], forall annot. Expr annot -> Expr annot
lambda_body :: Expr annot, expr_annot :: annot }
   -- | Tuple. Can be empty. 
   | Tuple { forall annot. Expr annot -> [Expr annot]
tuple_exprs :: [Expr annot], expr_annot :: annot }
   -- | Generator yield. 
   | Yield 
     -- { yield_expr :: Maybe (Expr annot) -- ^ Optional expression to yield.
     { forall annot. Expr annot -> Maybe (YieldArg annot)
yield_arg :: Maybe (YieldArg annot) -- ^ Optional Yield argument.
     , expr_annot :: annot
     }
   -- | Generator. 
   | Generator { forall annot. Expr annot -> Comprehension annot
gen_comprehension :: Comprehension annot, expr_annot :: annot }
   -- | Await
   | Await { forall annot. Expr annot -> Expr annot
await_expr :: Expr annot, expr_annot :: annot }
   -- | List comprehension. 
   | ListComp { forall annot. Expr annot -> Comprehension annot
list_comprehension :: Comprehension annot, expr_annot :: annot }
   -- | List. 
   | List { forall annot. Expr annot -> [Expr annot]
list_exprs :: [Expr annot], expr_annot :: annot }
   -- | Dictionary. 
   | Dictionary { forall annot. Expr annot -> [DictKeyDatumList annot]
dict_mappings :: [DictKeyDatumList annot], expr_annot :: annot }
   -- | Dictionary comprehension. /Version 3 only/. 
   | DictComp { forall annot. Expr annot -> Comprehension annot
dict_comprehension :: Comprehension annot, expr_annot :: annot }
   -- | Set. 
   | Set { forall annot. Expr annot -> [Expr annot]
set_exprs :: [Expr annot], expr_annot :: annot } 
   -- | Set comprehension. /Version 3 only/. 
   | SetComp { forall annot. Expr annot -> Comprehension annot
set_comprehension :: Comprehension annot, expr_annot :: annot }
   -- | Starred expression. /Version 3 only/.
   | Starred { forall annot. Expr annot -> Expr annot
starred_expr :: Expr annot, expr_annot :: annot }
   -- | Parenthesised expression.
   | Paren { forall annot. Expr annot -> Expr annot
paren_expr :: Expr annot, expr_annot :: annot }
   -- | String conversion (backquoted expression). Version 2 only. 
   | StringConversion { forall annot. Expr annot -> Expr annot
backquoted_expr :: Expr annot, forall annot. Expr annot -> annot
expr_anot :: annot }
   deriving (Expr annot -> Expr annot -> Bool
(Expr annot -> Expr annot -> Bool)
-> (Expr annot -> Expr annot -> Bool) -> Eq (Expr annot)
forall annot. Eq annot => Expr annot -> Expr annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => Expr annot -> Expr annot -> Bool
== :: Expr annot -> Expr annot -> Bool
$c/= :: forall annot. Eq annot => Expr annot -> Expr annot -> Bool
/= :: Expr annot -> Expr annot -> Bool
Eq,Eq (Expr annot)
Eq (Expr annot) =>
(Expr annot -> Expr annot -> Ordering)
-> (Expr annot -> Expr annot -> Bool)
-> (Expr annot -> Expr annot -> Bool)
-> (Expr annot -> Expr annot -> Bool)
-> (Expr annot -> Expr annot -> Bool)
-> (Expr annot -> Expr annot -> Expr annot)
-> (Expr annot -> Expr annot -> Expr annot)
-> Ord (Expr annot)
Expr annot -> Expr annot -> Bool
Expr annot -> Expr annot -> Ordering
Expr annot -> Expr annot -> Expr annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (Expr annot)
forall annot. Ord annot => Expr annot -> Expr annot -> Bool
forall annot. Ord annot => Expr annot -> Expr annot -> Ordering
forall annot. Ord annot => Expr annot -> Expr annot -> Expr annot
$ccompare :: forall annot. Ord annot => Expr annot -> Expr annot -> Ordering
compare :: Expr annot -> Expr annot -> Ordering
$c< :: forall annot. Ord annot => Expr annot -> Expr annot -> Bool
< :: Expr annot -> Expr annot -> Bool
$c<= :: forall annot. Ord annot => Expr annot -> Expr annot -> Bool
<= :: Expr annot -> Expr annot -> Bool
$c> :: forall annot. Ord annot => Expr annot -> Expr annot -> Bool
> :: Expr annot -> Expr annot -> Bool
$c>= :: forall annot. Ord annot => Expr annot -> Expr annot -> Bool
>= :: Expr annot -> Expr annot -> Bool
$cmax :: forall annot. Ord annot => Expr annot -> Expr annot -> Expr annot
max :: Expr annot -> Expr annot -> Expr annot
$cmin :: forall annot. Ord annot => Expr annot -> Expr annot -> Expr annot
min :: Expr annot -> Expr annot -> Expr annot
Ord,Int -> Expr annot -> ShowS
[Expr annot] -> ShowS
Expr annot -> String
(Int -> Expr annot -> ShowS)
-> (Expr annot -> String)
-> ([Expr annot] -> ShowS)
-> Show (Expr annot)
forall annot. Show annot => Int -> Expr annot -> ShowS
forall annot. Show annot => [Expr annot] -> ShowS
forall annot. Show annot => Expr annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> Expr annot -> ShowS
showsPrec :: Int -> Expr annot -> ShowS
$cshow :: forall annot. Show annot => Expr annot -> String
show :: Expr annot -> String
$cshowList :: forall annot. Show annot => [Expr annot] -> ShowS
showList :: [Expr annot] -> ShowS
Show,Typeable,Typeable (Expr annot)
Typeable (Expr annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Expr annot -> c (Expr annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Expr annot))
-> (Expr annot -> Constr)
-> (Expr annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Expr annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Expr annot)))
-> ((forall b. Data b => b -> b) -> Expr annot -> Expr annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Expr annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Expr annot -> r)
-> (forall u. (forall d. Data d => d -> u) -> Expr annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Expr annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot))
-> Data (Expr annot)
Expr annot -> Constr
Expr annot -> DataType
(forall b. Data b => b -> b) -> Expr annot -> Expr annot
forall annot. Data annot => Typeable (Expr annot)
forall annot. Data annot => Expr annot -> Constr
forall annot. Data annot => Expr annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Expr annot -> Expr annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Expr annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Expr annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expr annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expr annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr annot -> c (Expr annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Expr annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Expr annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Expr annot -> u
forall u. (forall d. Data d => d -> u) -> Expr annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expr annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expr annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr annot -> c (Expr annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Expr annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Expr annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr annot -> c (Expr annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr annot -> c (Expr annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr annot)
$ctoConstr :: forall annot. Data annot => Expr annot -> Constr
toConstr :: Expr annot -> Constr
$cdataTypeOf :: forall annot. Data annot => Expr annot -> DataType
dataTypeOf :: Expr annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Expr annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Expr annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Expr annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Expr annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Expr annot -> Expr annot
gmapT :: (forall b. Data b => b -> b) -> Expr annot -> Expr annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expr annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expr annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expr annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expr annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Expr annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Expr annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Expr annot -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Expr annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr annot -> m (Expr annot)
Data,(forall a b. (a -> b) -> Expr a -> Expr b)
-> (forall a b. a -> Expr b -> Expr a) -> Functor Expr
forall a b. a -> Expr b -> Expr a
forall a b. (a -> b) -> Expr a -> Expr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Expr a -> Expr b
fmap :: forall a b. (a -> b) -> Expr a -> Expr b
$c<$ :: forall a b. a -> Expr b -> Expr a
<$ :: forall a b. a -> Expr b -> Expr a
Functor)

type ExprSpan = Expr SrcSpan

instance Span ExprSpan where
   getSpan :: Expr SrcSpan -> SrcSpan
getSpan = Expr SrcSpan -> SrcSpan
forall annot. Expr annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

data YieldArg annot
   = YieldFrom (Expr annot) annot -- ^ Yield from a generator (Version 3 only)
   | YieldExpr (Expr annot) -- ^ Yield value of an expression
   deriving (YieldArg annot -> YieldArg annot -> Bool
(YieldArg annot -> YieldArg annot -> Bool)
-> (YieldArg annot -> YieldArg annot -> Bool)
-> Eq (YieldArg annot)
forall annot. Eq annot => YieldArg annot -> YieldArg annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => YieldArg annot -> YieldArg annot -> Bool
== :: YieldArg annot -> YieldArg annot -> Bool
$c/= :: forall annot. Eq annot => YieldArg annot -> YieldArg annot -> Bool
/= :: YieldArg annot -> YieldArg annot -> Bool
Eq,Eq (YieldArg annot)
Eq (YieldArg annot) =>
(YieldArg annot -> YieldArg annot -> Ordering)
-> (YieldArg annot -> YieldArg annot -> Bool)
-> (YieldArg annot -> YieldArg annot -> Bool)
-> (YieldArg annot -> YieldArg annot -> Bool)
-> (YieldArg annot -> YieldArg annot -> Bool)
-> (YieldArg annot -> YieldArg annot -> YieldArg annot)
-> (YieldArg annot -> YieldArg annot -> YieldArg annot)
-> Ord (YieldArg annot)
YieldArg annot -> YieldArg annot -> Bool
YieldArg annot -> YieldArg annot -> Ordering
YieldArg annot -> YieldArg annot -> YieldArg annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (YieldArg annot)
forall annot. Ord annot => YieldArg annot -> YieldArg annot -> Bool
forall annot.
Ord annot =>
YieldArg annot -> YieldArg annot -> Ordering
forall annot.
Ord annot =>
YieldArg annot -> YieldArg annot -> YieldArg annot
$ccompare :: forall annot.
Ord annot =>
YieldArg annot -> YieldArg annot -> Ordering
compare :: YieldArg annot -> YieldArg annot -> Ordering
$c< :: forall annot. Ord annot => YieldArg annot -> YieldArg annot -> Bool
< :: YieldArg annot -> YieldArg annot -> Bool
$c<= :: forall annot. Ord annot => YieldArg annot -> YieldArg annot -> Bool
<= :: YieldArg annot -> YieldArg annot -> Bool
$c> :: forall annot. Ord annot => YieldArg annot -> YieldArg annot -> Bool
> :: YieldArg annot -> YieldArg annot -> Bool
$c>= :: forall annot. Ord annot => YieldArg annot -> YieldArg annot -> Bool
>= :: YieldArg annot -> YieldArg annot -> Bool
$cmax :: forall annot.
Ord annot =>
YieldArg annot -> YieldArg annot -> YieldArg annot
max :: YieldArg annot -> YieldArg annot -> YieldArg annot
$cmin :: forall annot.
Ord annot =>
YieldArg annot -> YieldArg annot -> YieldArg annot
min :: YieldArg annot -> YieldArg annot -> YieldArg annot
Ord,Int -> YieldArg annot -> ShowS
[YieldArg annot] -> ShowS
YieldArg annot -> String
(Int -> YieldArg annot -> ShowS)
-> (YieldArg annot -> String)
-> ([YieldArg annot] -> ShowS)
-> Show (YieldArg annot)
forall annot. Show annot => Int -> YieldArg annot -> ShowS
forall annot. Show annot => [YieldArg annot] -> ShowS
forall annot. Show annot => YieldArg annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> YieldArg annot -> ShowS
showsPrec :: Int -> YieldArg annot -> ShowS
$cshow :: forall annot. Show annot => YieldArg annot -> String
show :: YieldArg annot -> String
$cshowList :: forall annot. Show annot => [YieldArg annot] -> ShowS
showList :: [YieldArg annot] -> ShowS
Show,Typeable,Typeable (YieldArg annot)
Typeable (YieldArg annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> YieldArg annot -> c (YieldArg annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (YieldArg annot))
-> (YieldArg annot -> Constr)
-> (YieldArg annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (YieldArg annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (YieldArg annot)))
-> ((forall b. Data b => b -> b)
    -> YieldArg annot -> YieldArg annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> YieldArg annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> YieldArg annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> YieldArg annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> YieldArg annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> YieldArg annot -> m (YieldArg annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> YieldArg annot -> m (YieldArg annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> YieldArg annot -> m (YieldArg annot))
-> Data (YieldArg annot)
YieldArg annot -> Constr
YieldArg annot -> DataType
(forall b. Data b => b -> b) -> YieldArg annot -> YieldArg annot
forall annot. Data annot => Typeable (YieldArg annot)
forall annot. Data annot => YieldArg annot -> Constr
forall annot. Data annot => YieldArg annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> YieldArg annot -> YieldArg annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> YieldArg annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> YieldArg annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> YieldArg annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> YieldArg annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> YieldArg annot -> m (YieldArg annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> YieldArg annot -> m (YieldArg annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (YieldArg annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> YieldArg annot -> c (YieldArg annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (YieldArg annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (YieldArg annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> YieldArg annot -> u
forall u. (forall d. Data d => d -> u) -> YieldArg annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> YieldArg annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> YieldArg annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> YieldArg annot -> m (YieldArg annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> YieldArg annot -> m (YieldArg annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (YieldArg annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> YieldArg annot -> c (YieldArg annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (YieldArg annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (YieldArg annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> YieldArg annot -> c (YieldArg annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> YieldArg annot -> c (YieldArg annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (YieldArg annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (YieldArg annot)
$ctoConstr :: forall annot. Data annot => YieldArg annot -> Constr
toConstr :: YieldArg annot -> Constr
$cdataTypeOf :: forall annot. Data annot => YieldArg annot -> DataType
dataTypeOf :: YieldArg annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (YieldArg annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (YieldArg annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (YieldArg annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (YieldArg annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> YieldArg annot -> YieldArg annot
gmapT :: (forall b. Data b => b -> b) -> YieldArg annot -> YieldArg annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> YieldArg annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> YieldArg annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> YieldArg annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> YieldArg annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> YieldArg annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> YieldArg annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> YieldArg annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> YieldArg annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> YieldArg annot -> m (YieldArg annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> YieldArg annot -> m (YieldArg annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> YieldArg annot -> m (YieldArg annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> YieldArg annot -> m (YieldArg annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> YieldArg annot -> m (YieldArg annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> YieldArg annot -> m (YieldArg annot)
Data,(forall a b. (a -> b) -> YieldArg a -> YieldArg b)
-> (forall a b. a -> YieldArg b -> YieldArg a) -> Functor YieldArg
forall a b. a -> YieldArg b -> YieldArg a
forall a b. (a -> b) -> YieldArg a -> YieldArg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> YieldArg a -> YieldArg b
fmap :: forall a b. (a -> b) -> YieldArg a -> YieldArg b
$c<$ :: forall a b. a -> YieldArg b -> YieldArg a
<$ :: forall a b. a -> YieldArg b -> YieldArg a
Functor)

type YieldArgSpan = YieldArg SrcSpan

instance Span YieldArgSpan where
   getSpan :: YieldArgSpan -> SrcSpan
getSpan (YieldFrom Expr SrcSpan
_e SrcSpan
span) = SrcSpan
span
   getSpan (YieldExpr Expr SrcSpan
e) = Expr SrcSpan -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan Expr SrcSpan
e

instance Annotated Expr where
   annot :: forall annot. Expr annot -> annot
annot = Expr annot -> annot
forall annot. Expr annot -> annot
expr_annot 

data DictKeyDatumList annot =
   DictMappingPair (Expr annot) (Expr annot)
   | DictUnpacking (Expr annot)
   deriving (DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
(DictKeyDatumList annot -> DictKeyDatumList annot -> Bool)
-> (DictKeyDatumList annot -> DictKeyDatumList annot -> Bool)
-> Eq (DictKeyDatumList annot)
forall annot.
Eq annot =>
DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot.
Eq annot =>
DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
== :: DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
$c/= :: forall annot.
Eq annot =>
DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
/= :: DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
Eq,Eq (DictKeyDatumList annot)
Eq (DictKeyDatumList annot) =>
(DictKeyDatumList annot -> DictKeyDatumList annot -> Ordering)
-> (DictKeyDatumList annot -> DictKeyDatumList annot -> Bool)
-> (DictKeyDatumList annot -> DictKeyDatumList annot -> Bool)
-> (DictKeyDatumList annot -> DictKeyDatumList annot -> Bool)
-> (DictKeyDatumList annot -> DictKeyDatumList annot -> Bool)
-> (DictKeyDatumList annot
    -> DictKeyDatumList annot -> DictKeyDatumList annot)
-> (DictKeyDatumList annot
    -> DictKeyDatumList annot -> DictKeyDatumList annot)
-> Ord (DictKeyDatumList annot)
DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
DictKeyDatumList annot -> DictKeyDatumList annot -> Ordering
DictKeyDatumList annot
-> DictKeyDatumList annot -> DictKeyDatumList annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (DictKeyDatumList annot)
forall annot.
Ord annot =>
DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
forall annot.
Ord annot =>
DictKeyDatumList annot -> DictKeyDatumList annot -> Ordering
forall annot.
Ord annot =>
DictKeyDatumList annot
-> DictKeyDatumList annot -> DictKeyDatumList annot
$ccompare :: forall annot.
Ord annot =>
DictKeyDatumList annot -> DictKeyDatumList annot -> Ordering
compare :: DictKeyDatumList annot -> DictKeyDatumList annot -> Ordering
$c< :: forall annot.
Ord annot =>
DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
< :: DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
$c<= :: forall annot.
Ord annot =>
DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
<= :: DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
$c> :: forall annot.
Ord annot =>
DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
> :: DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
$c>= :: forall annot.
Ord annot =>
DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
>= :: DictKeyDatumList annot -> DictKeyDatumList annot -> Bool
$cmax :: forall annot.
Ord annot =>
DictKeyDatumList annot
-> DictKeyDatumList annot -> DictKeyDatumList annot
max :: DictKeyDatumList annot
-> DictKeyDatumList annot -> DictKeyDatumList annot
$cmin :: forall annot.
Ord annot =>
DictKeyDatumList annot
-> DictKeyDatumList annot -> DictKeyDatumList annot
min :: DictKeyDatumList annot
-> DictKeyDatumList annot -> DictKeyDatumList annot
Ord,Int -> DictKeyDatumList annot -> ShowS
[DictKeyDatumList annot] -> ShowS
DictKeyDatumList annot -> String
(Int -> DictKeyDatumList annot -> ShowS)
-> (DictKeyDatumList annot -> String)
-> ([DictKeyDatumList annot] -> ShowS)
-> Show (DictKeyDatumList annot)
forall annot. Show annot => Int -> DictKeyDatumList annot -> ShowS
forall annot. Show annot => [DictKeyDatumList annot] -> ShowS
forall annot. Show annot => DictKeyDatumList annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> DictKeyDatumList annot -> ShowS
showsPrec :: Int -> DictKeyDatumList annot -> ShowS
$cshow :: forall annot. Show annot => DictKeyDatumList annot -> String
show :: DictKeyDatumList annot -> String
$cshowList :: forall annot. Show annot => [DictKeyDatumList annot] -> ShowS
showList :: [DictKeyDatumList annot] -> ShowS
Show,Typeable,Typeable (DictKeyDatumList annot)
Typeable (DictKeyDatumList annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> DictKeyDatumList annot
 -> c (DictKeyDatumList annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (DictKeyDatumList annot))
-> (DictKeyDatumList annot -> Constr)
-> (DictKeyDatumList annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c (DictKeyDatumList annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (DictKeyDatumList annot)))
-> ((forall b. Data b => b -> b)
    -> DictKeyDatumList annot -> DictKeyDatumList annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DictKeyDatumList annot
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DictKeyDatumList annot
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DictKeyDatumList annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DictKeyDatumList annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DictKeyDatumList annot -> m (DictKeyDatumList annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DictKeyDatumList annot -> m (DictKeyDatumList annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DictKeyDatumList annot -> m (DictKeyDatumList annot))
-> Data (DictKeyDatumList annot)
DictKeyDatumList annot -> Constr
DictKeyDatumList annot -> DataType
(forall b. Data b => b -> b)
-> DictKeyDatumList annot -> DictKeyDatumList annot
forall annot. Data annot => Typeable (DictKeyDatumList annot)
forall annot. Data annot => DictKeyDatumList annot -> Constr
forall annot. Data annot => DictKeyDatumList annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> DictKeyDatumList annot -> DictKeyDatumList annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> DictKeyDatumList annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> DictKeyDatumList annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DictKeyDatumList annot
-> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DictKeyDatumList annot
-> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> DictKeyDatumList annot -> m (DictKeyDatumList annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> DictKeyDatumList annot -> m (DictKeyDatumList annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (DictKeyDatumList annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DictKeyDatumList annot
-> c (DictKeyDatumList annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (DictKeyDatumList annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (DictKeyDatumList annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DictKeyDatumList annot -> u
forall u.
(forall d. Data d => d -> u) -> DictKeyDatumList annot -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DictKeyDatumList annot
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DictKeyDatumList annot
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DictKeyDatumList annot -> m (DictKeyDatumList annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DictKeyDatumList annot -> m (DictKeyDatumList annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (DictKeyDatumList annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DictKeyDatumList annot
-> c (DictKeyDatumList annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (DictKeyDatumList annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (DictKeyDatumList annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DictKeyDatumList annot
-> c (DictKeyDatumList annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DictKeyDatumList annot
-> c (DictKeyDatumList annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (DictKeyDatumList annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (DictKeyDatumList annot)
$ctoConstr :: forall annot. Data annot => DictKeyDatumList annot -> Constr
toConstr :: DictKeyDatumList annot -> Constr
$cdataTypeOf :: forall annot. Data annot => DictKeyDatumList annot -> DataType
dataTypeOf :: DictKeyDatumList annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (DictKeyDatumList annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (DictKeyDatumList annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (DictKeyDatumList annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (DictKeyDatumList annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b)
-> DictKeyDatumList annot -> DictKeyDatumList annot
gmapT :: (forall b. Data b => b -> b)
-> DictKeyDatumList annot -> DictKeyDatumList annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DictKeyDatumList annot
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DictKeyDatumList annot
-> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DictKeyDatumList annot
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DictKeyDatumList annot
-> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> DictKeyDatumList annot -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> DictKeyDatumList annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> DictKeyDatumList annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DictKeyDatumList annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> DictKeyDatumList annot -> m (DictKeyDatumList annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DictKeyDatumList annot -> m (DictKeyDatumList annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> DictKeyDatumList annot -> m (DictKeyDatumList annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DictKeyDatumList annot -> m (DictKeyDatumList annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> DictKeyDatumList annot -> m (DictKeyDatumList annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DictKeyDatumList annot -> m (DictKeyDatumList annot)
Data,(forall a b. (a -> b) -> DictKeyDatumList a -> DictKeyDatumList b)
-> (forall a b. a -> DictKeyDatumList b -> DictKeyDatumList a)
-> Functor DictKeyDatumList
forall a b. a -> DictKeyDatumList b -> DictKeyDatumList a
forall a b. (a -> b) -> DictKeyDatumList a -> DictKeyDatumList b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> DictKeyDatumList a -> DictKeyDatumList b
fmap :: forall a b. (a -> b) -> DictKeyDatumList a -> DictKeyDatumList b
$c<$ :: forall a b. a -> DictKeyDatumList b -> DictKeyDatumList a
<$ :: forall a b. a -> DictKeyDatumList b -> DictKeyDatumList a
Functor)

type DictKeyDatumListSpan = DictKeyDatumList SrcSpan

instance Span DictKeyDatumListSpan where
   getSpan :: DictKeyDatumList SrcSpan -> SrcSpan
getSpan (DictMappingPair Expr SrcSpan
e1 Expr SrcSpan
e2) = Expr SrcSpan -> Expr SrcSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Expr SrcSpan
e1 Expr SrcSpan
e2
   getSpan (DictUnpacking Expr SrcSpan
e) = Expr SrcSpan -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan Expr SrcSpan
e

-- | Slice compenent.
data Slice annot
   = SliceProper 
     { forall annot. Slice annot -> Maybe (Expr annot)
slice_lower :: Maybe (Expr annot)
     , forall annot. Slice annot -> Maybe (Expr annot)
slice_upper :: Maybe (Expr annot)
     , forall annot. Slice annot -> Maybe (Maybe (Expr annot))
slice_stride :: Maybe (Maybe (Expr annot)) 
     , forall annot. Slice annot -> annot
slice_annot :: annot
     } 
   | SliceExpr 
     { forall annot. Slice annot -> Expr annot
slice_expr :: Expr annot
     , slice_annot :: annot 
     }
   | SliceEllipsis { slice_annot :: annot }
   deriving (Slice annot -> Slice annot -> Bool
(Slice annot -> Slice annot -> Bool)
-> (Slice annot -> Slice annot -> Bool) -> Eq (Slice annot)
forall annot. Eq annot => Slice annot -> Slice annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => Slice annot -> Slice annot -> Bool
== :: Slice annot -> Slice annot -> Bool
$c/= :: forall annot. Eq annot => Slice annot -> Slice annot -> Bool
/= :: Slice annot -> Slice annot -> Bool
Eq,Eq (Slice annot)
Eq (Slice annot) =>
(Slice annot -> Slice annot -> Ordering)
-> (Slice annot -> Slice annot -> Bool)
-> (Slice annot -> Slice annot -> Bool)
-> (Slice annot -> Slice annot -> Bool)
-> (Slice annot -> Slice annot -> Bool)
-> (Slice annot -> Slice annot -> Slice annot)
-> (Slice annot -> Slice annot -> Slice annot)
-> Ord (Slice annot)
Slice annot -> Slice annot -> Bool
Slice annot -> Slice annot -> Ordering
Slice annot -> Slice annot -> Slice annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (Slice annot)
forall annot. Ord annot => Slice annot -> Slice annot -> Bool
forall annot. Ord annot => Slice annot -> Slice annot -> Ordering
forall annot.
Ord annot =>
Slice annot -> Slice annot -> Slice annot
$ccompare :: forall annot. Ord annot => Slice annot -> Slice annot -> Ordering
compare :: Slice annot -> Slice annot -> Ordering
$c< :: forall annot. Ord annot => Slice annot -> Slice annot -> Bool
< :: Slice annot -> Slice annot -> Bool
$c<= :: forall annot. Ord annot => Slice annot -> Slice annot -> Bool
<= :: Slice annot -> Slice annot -> Bool
$c> :: forall annot. Ord annot => Slice annot -> Slice annot -> Bool
> :: Slice annot -> Slice annot -> Bool
$c>= :: forall annot. Ord annot => Slice annot -> Slice annot -> Bool
>= :: Slice annot -> Slice annot -> Bool
$cmax :: forall annot.
Ord annot =>
Slice annot -> Slice annot -> Slice annot
max :: Slice annot -> Slice annot -> Slice annot
$cmin :: forall annot.
Ord annot =>
Slice annot -> Slice annot -> Slice annot
min :: Slice annot -> Slice annot -> Slice annot
Ord,Int -> Slice annot -> ShowS
[Slice annot] -> ShowS
Slice annot -> String
(Int -> Slice annot -> ShowS)
-> (Slice annot -> String)
-> ([Slice annot] -> ShowS)
-> Show (Slice annot)
forall annot. Show annot => Int -> Slice annot -> ShowS
forall annot. Show annot => [Slice annot] -> ShowS
forall annot. Show annot => Slice annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> Slice annot -> ShowS
showsPrec :: Int -> Slice annot -> ShowS
$cshow :: forall annot. Show annot => Slice annot -> String
show :: Slice annot -> String
$cshowList :: forall annot. Show annot => [Slice annot] -> ShowS
showList :: [Slice annot] -> ShowS
Show,Typeable,Typeable (Slice annot)
Typeable (Slice annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Slice annot -> c (Slice annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Slice annot))
-> (Slice annot -> Constr)
-> (Slice annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Slice annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Slice annot)))
-> ((forall b. Data b => b -> b) -> Slice annot -> Slice annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Slice annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Slice annot -> r)
-> (forall u. (forall d. Data d => d -> u) -> Slice annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Slice annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot))
-> Data (Slice annot)
Slice annot -> Constr
Slice annot -> DataType
(forall b. Data b => b -> b) -> Slice annot -> Slice annot
forall annot. Data annot => Typeable (Slice annot)
forall annot. Data annot => Slice annot -> Constr
forall annot. Data annot => Slice annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Slice annot -> Slice annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Slice annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Slice annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Slice annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Slice annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Slice annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Slice annot -> c (Slice annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Slice annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Slice annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Slice annot -> u
forall u. (forall d. Data d => d -> u) -> Slice annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Slice annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Slice annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Slice annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Slice annot -> c (Slice annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Slice annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Slice annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Slice annot -> c (Slice annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Slice annot -> c (Slice annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Slice annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Slice annot)
$ctoConstr :: forall annot. Data annot => Slice annot -> Constr
toConstr :: Slice annot -> Constr
$cdataTypeOf :: forall annot. Data annot => Slice annot -> DataType
dataTypeOf :: Slice annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Slice annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Slice annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Slice annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Slice annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Slice annot -> Slice annot
gmapT :: (forall b. Data b => b -> b) -> Slice annot -> Slice annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Slice annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Slice annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Slice annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Slice annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Slice annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Slice annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Slice annot -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Slice annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Slice annot -> m (Slice annot)
Data,(forall a b. (a -> b) -> Slice a -> Slice b)
-> (forall a b. a -> Slice b -> Slice a) -> Functor Slice
forall a b. a -> Slice b -> Slice a
forall a b. (a -> b) -> Slice a -> Slice b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Slice a -> Slice b
fmap :: forall a b. (a -> b) -> Slice a -> Slice b
$c<$ :: forall a b. a -> Slice b -> Slice a
<$ :: forall a b. a -> Slice b -> Slice a
Functor)

type SliceSpan = Slice SrcSpan

instance Span SliceSpan where
   getSpan :: SliceSpan -> SrcSpan
getSpan = SliceSpan -> SrcSpan
forall annot. Slice annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated Slice where
   annot :: forall annot. Slice annot -> annot
annot = Slice annot -> annot
forall annot. Slice annot -> annot
slice_annot 

-- | Operators.
data Op annot
   = And { forall annot. Op annot -> annot
op_annot :: annot } -- ^ \'and\'
   | Or { op_annot :: annot } -- ^ \'or\'
   | Not { op_annot :: annot } -- ^ \'not\'
   | Exponent { op_annot :: annot } -- ^ \'**\'
   | LessThan { op_annot :: annot } -- ^ \'<\'
   | GreaterThan { op_annot :: annot } -- ^ \'>\'
   | Equality { op_annot :: annot } -- ^ \'==\'
   | GreaterThanEquals { op_annot :: annot } -- ^ \'>=\'
   | LessThanEquals { op_annot :: annot } -- ^ \'<=\'
   | NotEquals  { op_annot :: annot } -- ^ \'!=\'
   | NotEqualsV2  { op_annot :: annot } -- ^ \'<>\'. Version 2 only.
   | In { op_annot :: annot } -- ^ \'in\'
   | Is { op_annot :: annot } -- ^ \'is\'
   | IsNot { op_annot :: annot } -- ^ \'is not\'
   | NotIn { op_annot :: annot } -- ^ \'not in\'
   | BinaryOr { op_annot :: annot } -- ^ \'|\'
   | Xor { op_annot :: annot } -- ^ \'^\'
   | BinaryAnd { op_annot :: annot } -- ^ \'&\'
   | ShiftLeft { op_annot :: annot } -- ^ \'<<\'
   | ShiftRight { op_annot :: annot } -- ^ \'>>\'
   | Multiply { op_annot :: annot } -- ^ \'*\'
   | Plus { op_annot :: annot } -- ^ \'+\'
   | Minus { op_annot :: annot } -- ^ \'-\'
   | Divide { op_annot :: annot } -- ^ \'\/\'
   | FloorDivide { op_annot :: annot } -- ^ \'\/\/\'
   | MatrixMult { op_annot :: annot } -- ^ \'@\'
   | Invert { op_annot :: annot } -- ^ \'~\' (bitwise inversion of its integer argument)
   | Modulo { op_annot :: annot } -- ^ \'%\'
   deriving (Op annot -> Op annot -> Bool
(Op annot -> Op annot -> Bool)
-> (Op annot -> Op annot -> Bool) -> Eq (Op annot)
forall annot. Eq annot => Op annot -> Op annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => Op annot -> Op annot -> Bool
== :: Op annot -> Op annot -> Bool
$c/= :: forall annot. Eq annot => Op annot -> Op annot -> Bool
/= :: Op annot -> Op annot -> Bool
Eq,Eq (Op annot)
Eq (Op annot) =>
(Op annot -> Op annot -> Ordering)
-> (Op annot -> Op annot -> Bool)
-> (Op annot -> Op annot -> Bool)
-> (Op annot -> Op annot -> Bool)
-> (Op annot -> Op annot -> Bool)
-> (Op annot -> Op annot -> Op annot)
-> (Op annot -> Op annot -> Op annot)
-> Ord (Op annot)
Op annot -> Op annot -> Bool
Op annot -> Op annot -> Ordering
Op annot -> Op annot -> Op annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (Op annot)
forall annot. Ord annot => Op annot -> Op annot -> Bool
forall annot. Ord annot => Op annot -> Op annot -> Ordering
forall annot. Ord annot => Op annot -> Op annot -> Op annot
$ccompare :: forall annot. Ord annot => Op annot -> Op annot -> Ordering
compare :: Op annot -> Op annot -> Ordering
$c< :: forall annot. Ord annot => Op annot -> Op annot -> Bool
< :: Op annot -> Op annot -> Bool
$c<= :: forall annot. Ord annot => Op annot -> Op annot -> Bool
<= :: Op annot -> Op annot -> Bool
$c> :: forall annot. Ord annot => Op annot -> Op annot -> Bool
> :: Op annot -> Op annot -> Bool
$c>= :: forall annot. Ord annot => Op annot -> Op annot -> Bool
>= :: Op annot -> Op annot -> Bool
$cmax :: forall annot. Ord annot => Op annot -> Op annot -> Op annot
max :: Op annot -> Op annot -> Op annot
$cmin :: forall annot. Ord annot => Op annot -> Op annot -> Op annot
min :: Op annot -> Op annot -> Op annot
Ord,Int -> Op annot -> ShowS
[Op annot] -> ShowS
Op annot -> String
(Int -> Op annot -> ShowS)
-> (Op annot -> String) -> ([Op annot] -> ShowS) -> Show (Op annot)
forall annot. Show annot => Int -> Op annot -> ShowS
forall annot. Show annot => [Op annot] -> ShowS
forall annot. Show annot => Op annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> Op annot -> ShowS
showsPrec :: Int -> Op annot -> ShowS
$cshow :: forall annot. Show annot => Op annot -> String
show :: Op annot -> String
$cshowList :: forall annot. Show annot => [Op annot] -> ShowS
showList :: [Op annot] -> ShowS
Show,Typeable,Typeable (Op annot)
Typeable (Op annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Op annot -> c (Op annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Op annot))
-> (Op annot -> Constr)
-> (Op annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Op annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Op annot)))
-> ((forall b. Data b => b -> b) -> Op annot -> Op annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Op annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Op annot -> r)
-> (forall u. (forall d. Data d => d -> u) -> Op annot -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Op annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Op annot -> m (Op annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Op annot -> m (Op annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Op annot -> m (Op annot))
-> Data (Op annot)
Op annot -> Constr
Op annot -> DataType
(forall b. Data b => b -> b) -> Op annot -> Op annot
forall annot. Data annot => Typeable (Op annot)
forall annot. Data annot => Op annot -> Constr
forall annot. Data annot => Op annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Op annot -> Op annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Op annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Op annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Op annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Op annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> Op annot -> m (Op annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Op annot -> m (Op annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Op annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op annot -> c (Op annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Op annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Op annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Op annot -> u
forall u. (forall d. Data d => d -> u) -> Op annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Op annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Op annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Op annot -> m (Op annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op annot -> m (Op annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Op annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op annot -> c (Op annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Op annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Op annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op annot -> c (Op annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Op annot -> c (Op annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Op annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Op annot)
$ctoConstr :: forall annot. Data annot => Op annot -> Constr
toConstr :: Op annot -> Constr
$cdataTypeOf :: forall annot. Data annot => Op annot -> DataType
dataTypeOf :: Op annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Op annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Op annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Op annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Op annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> Op annot -> Op annot
gmapT :: (forall b. Data b => b -> b) -> Op annot -> Op annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Op annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Op annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Op annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Op annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> Op annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Op annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> Op annot -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Op annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d) -> Op annot -> m (Op annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Op annot -> m (Op annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Op annot -> m (Op annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op annot -> m (Op annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Op annot -> m (Op annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Op annot -> m (Op annot)
Data,(forall a b. (a -> b) -> Op a -> Op b)
-> (forall a b. a -> Op b -> Op a) -> Functor Op
forall a b. a -> Op b -> Op a
forall a b. (a -> b) -> Op a -> Op b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Op a -> Op b
fmap :: forall a b. (a -> b) -> Op a -> Op b
$c<$ :: forall a b. a -> Op b -> Op a
<$ :: forall a b. a -> Op b -> Op a
Functor)

type OpSpan = Op SrcSpan

instance Span OpSpan where
  getSpan :: OpSpan -> SrcSpan
getSpan = OpSpan -> SrcSpan
forall annot. Op annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated Op where
   annot :: forall annot. Op annot -> annot
annot = Op annot -> annot
forall annot. Op annot -> annot
op_annot 

-- | Augmented assignment operators.
data AssignOp annot
   = PlusAssign { forall annot. AssignOp annot -> annot
assignOp_annot :: annot } -- ^ \'+=\'
   | MinusAssign { assignOp_annot :: annot } -- ^ \'-=\'
   | MultAssign { assignOp_annot :: annot } -- ^ \'*=\'
   | DivAssign { assignOp_annot :: annot } -- ^ \'\/=\'
   | ModAssign { assignOp_annot :: annot } -- ^ \'%=\'
   | PowAssign { assignOp_annot :: annot } -- ^ \'*=\'
   | BinAndAssign { assignOp_annot :: annot } -- ^ \'&=\'
   | BinOrAssign { assignOp_annot :: annot } -- ^ \'|=\'
   | BinXorAssign { assignOp_annot :: annot } -- ^ \'^=\' 
   | LeftShiftAssign { assignOp_annot :: annot } -- ^ \'<<=\'
   | RightShiftAssign { assignOp_annot :: annot } -- ^ \'>>=\'
   | FloorDivAssign { assignOp_annot :: annot } -- ^ \'\/\/=\'
   | MatrixMultAssign { assignOp_annot :: annot } -- ^ \'@=\'
   deriving (AssignOp annot -> AssignOp annot -> Bool
(AssignOp annot -> AssignOp annot -> Bool)
-> (AssignOp annot -> AssignOp annot -> Bool)
-> Eq (AssignOp annot)
forall annot. Eq annot => AssignOp annot -> AssignOp annot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall annot. Eq annot => AssignOp annot -> AssignOp annot -> Bool
== :: AssignOp annot -> AssignOp annot -> Bool
$c/= :: forall annot. Eq annot => AssignOp annot -> AssignOp annot -> Bool
/= :: AssignOp annot -> AssignOp annot -> Bool
Eq,Eq (AssignOp annot)
Eq (AssignOp annot) =>
(AssignOp annot -> AssignOp annot -> Ordering)
-> (AssignOp annot -> AssignOp annot -> Bool)
-> (AssignOp annot -> AssignOp annot -> Bool)
-> (AssignOp annot -> AssignOp annot -> Bool)
-> (AssignOp annot -> AssignOp annot -> Bool)
-> (AssignOp annot -> AssignOp annot -> AssignOp annot)
-> (AssignOp annot -> AssignOp annot -> AssignOp annot)
-> Ord (AssignOp annot)
AssignOp annot -> AssignOp annot -> Bool
AssignOp annot -> AssignOp annot -> Ordering
AssignOp annot -> AssignOp annot -> AssignOp annot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall annot. Ord annot => Eq (AssignOp annot)
forall annot. Ord annot => AssignOp annot -> AssignOp annot -> Bool
forall annot.
Ord annot =>
AssignOp annot -> AssignOp annot -> Ordering
forall annot.
Ord annot =>
AssignOp annot -> AssignOp annot -> AssignOp annot
$ccompare :: forall annot.
Ord annot =>
AssignOp annot -> AssignOp annot -> Ordering
compare :: AssignOp annot -> AssignOp annot -> Ordering
$c< :: forall annot. Ord annot => AssignOp annot -> AssignOp annot -> Bool
< :: AssignOp annot -> AssignOp annot -> Bool
$c<= :: forall annot. Ord annot => AssignOp annot -> AssignOp annot -> Bool
<= :: AssignOp annot -> AssignOp annot -> Bool
$c> :: forall annot. Ord annot => AssignOp annot -> AssignOp annot -> Bool
> :: AssignOp annot -> AssignOp annot -> Bool
$c>= :: forall annot. Ord annot => AssignOp annot -> AssignOp annot -> Bool
>= :: AssignOp annot -> AssignOp annot -> Bool
$cmax :: forall annot.
Ord annot =>
AssignOp annot -> AssignOp annot -> AssignOp annot
max :: AssignOp annot -> AssignOp annot -> AssignOp annot
$cmin :: forall annot.
Ord annot =>
AssignOp annot -> AssignOp annot -> AssignOp annot
min :: AssignOp annot -> AssignOp annot -> AssignOp annot
Ord,Int -> AssignOp annot -> ShowS
[AssignOp annot] -> ShowS
AssignOp annot -> String
(Int -> AssignOp annot -> ShowS)
-> (AssignOp annot -> String)
-> ([AssignOp annot] -> ShowS)
-> Show (AssignOp annot)
forall annot. Show annot => Int -> AssignOp annot -> ShowS
forall annot. Show annot => [AssignOp annot] -> ShowS
forall annot. Show annot => AssignOp annot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall annot. Show annot => Int -> AssignOp annot -> ShowS
showsPrec :: Int -> AssignOp annot -> ShowS
$cshow :: forall annot. Show annot => AssignOp annot -> String
show :: AssignOp annot -> String
$cshowList :: forall annot. Show annot => [AssignOp annot] -> ShowS
showList :: [AssignOp annot] -> ShowS
Show,Typeable,Typeable (AssignOp annot)
Typeable (AssignOp annot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AssignOp annot -> c (AssignOp annot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (AssignOp annot))
-> (AssignOp annot -> Constr)
-> (AssignOp annot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (AssignOp annot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (AssignOp annot)))
-> ((forall b. Data b => b -> b)
    -> AssignOp annot -> AssignOp annot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AssignOp annot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AssignOp annot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AssignOp annot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AssignOp annot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AssignOp annot -> m (AssignOp annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssignOp annot -> m (AssignOp annot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AssignOp annot -> m (AssignOp annot))
-> Data (AssignOp annot)
AssignOp annot -> Constr
AssignOp annot -> DataType
(forall b. Data b => b -> b) -> AssignOp annot -> AssignOp annot
forall annot. Data annot => Typeable (AssignOp annot)
forall annot. Data annot => AssignOp annot -> Constr
forall annot. Data annot => AssignOp annot -> DataType
forall annot.
Data annot =>
(forall b. Data b => b -> b) -> AssignOp annot -> AssignOp annot
forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> AssignOp annot -> u
forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> AssignOp annot -> [u]
forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp annot -> r
forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp annot -> r
forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> AssignOp annot -> m (AssignOp annot)
forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> AssignOp annot -> m (AssignOp annot)
forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AssignOp annot)
forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssignOp annot -> c (AssignOp annot)
forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (AssignOp annot))
forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AssignOp annot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AssignOp annot -> u
forall u. (forall d. Data d => d -> u) -> AssignOp annot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp annot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp annot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssignOp annot -> m (AssignOp annot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssignOp annot -> m (AssignOp annot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AssignOp annot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssignOp annot -> c (AssignOp annot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (AssignOp annot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AssignOp annot))
$cgfoldl :: forall annot (c :: * -> *).
Data annot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssignOp annot -> c (AssignOp annot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AssignOp annot -> c (AssignOp annot)
$cgunfold :: forall annot (c :: * -> *).
Data annot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AssignOp annot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AssignOp annot)
$ctoConstr :: forall annot. Data annot => AssignOp annot -> Constr
toConstr :: AssignOp annot -> Constr
$cdataTypeOf :: forall annot. Data annot => AssignOp annot -> DataType
dataTypeOf :: AssignOp annot -> DataType
$cdataCast1 :: forall annot (t :: * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (AssignOp annot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (AssignOp annot))
$cdataCast2 :: forall annot (t :: * -> * -> *) (c :: * -> *).
(Data annot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AssignOp annot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AssignOp annot))
$cgmapT :: forall annot.
Data annot =>
(forall b. Data b => b -> b) -> AssignOp annot -> AssignOp annot
gmapT :: (forall b. Data b => b -> b) -> AssignOp annot -> AssignOp annot
$cgmapQl :: forall annot r r'.
Data annot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp annot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp annot -> r
$cgmapQr :: forall annot r r'.
Data annot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp annot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AssignOp annot -> r
$cgmapQ :: forall annot u.
Data annot =>
(forall d. Data d => d -> u) -> AssignOp annot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> AssignOp annot -> [u]
$cgmapQi :: forall annot u.
Data annot =>
Int -> (forall d. Data d => d -> u) -> AssignOp annot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AssignOp annot -> u
$cgmapM :: forall annot (m :: * -> *).
(Data annot, Monad m) =>
(forall d. Data d => d -> m d)
-> AssignOp annot -> m (AssignOp annot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AssignOp annot -> m (AssignOp annot)
$cgmapMp :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> AssignOp annot -> m (AssignOp annot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssignOp annot -> m (AssignOp annot)
$cgmapMo :: forall annot (m :: * -> *).
(Data annot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> AssignOp annot -> m (AssignOp annot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AssignOp annot -> m (AssignOp annot)
Data,(forall a b. (a -> b) -> AssignOp a -> AssignOp b)
-> (forall a b. a -> AssignOp b -> AssignOp a) -> Functor AssignOp
forall a b. a -> AssignOp b -> AssignOp a
forall a b. (a -> b) -> AssignOp a -> AssignOp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AssignOp a -> AssignOp b
fmap :: forall a b. (a -> b) -> AssignOp a -> AssignOp b
$c<$ :: forall a b. a -> AssignOp b -> AssignOp a
<$ :: forall a b. a -> AssignOp b -> AssignOp a
Functor)

type AssignOpSpan = AssignOp SrcSpan

instance Span AssignOpSpan where
   getSpan :: AssignOpSpan -> SrcSpan
getSpan = AssignOpSpan -> SrcSpan
forall annot. AssignOp annot -> annot
forall (t :: * -> *) annot. Annotated t => t annot -> annot
annot 

instance Annotated AssignOp where
   annot :: forall annot. AssignOp annot -> annot
annot = AssignOp annot -> annot
forall annot. AssignOp annot -> annot
assignOp_annot