Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Ast
Description
The abstract ayntax tree ( ast ) aims to be a data structure able to:
- represent multiple ( native ) ast kinds
- from various programming languages
Its main purpose is to serve as the:
As part of the dhscanner framework:
- targets mostly languages used for cloud native applications ☁️
- Python, Ruby 💎, Php, Javascript, Typescript, Java ☕️, C# and Golang.
Typical flow:
a file is parsed with the corresponding native parser of the language it's written in
- see Python's native parser, for example
- native parsers hosted on independent micro services
- the native ast is dumped (as JSON, or plain text)
- dumped content is sent to a Happy + Alex Haskell parser
- the Haskell parser organizes the natively parsed content into an ast
Geared towards static code analysis, the ast design abstracts away details that are normally ignored anyway
- for example, it does not distinguish between
try
andcatch
blocks - it models both of them as plain sequential code blocks.
- for example, it does not distinguish between
- Every file has exactly one ast (
Root
) that represents it Non Haskell parogrammers note:
- The ast is immutable ( like everything else in Haskell ... )
Synopsis
- data Root = Root {}
- data Exp
- data Stmt
- = StmtExp Exp
- | StmtIf StmtIfContent
- | StmtTry StmtTryContent
- | StmtFunc StmtFuncContent
- | StmtBlock StmtBlockContent
- | StmtBreak StmtBreakContent
- | StmtClass StmtClassContent
- | StmtWhile StmtWhileContent
- | StmtImport StmtImportContent
- | StmtMethod StmtMethodContent
- | StmtAssign StmtAssignContent
- | StmtReturn StmtReturnContent
- | StmtVardec StmtVardecContent
- | StmtContinue StmtContinueContent
- data Param = Param {
- paramName :: ParamName
- paramNominalType :: NominalTy
- paramNominalTypeV2 :: Maybe Var
- paramSerialIdx :: Word
- data DataMember = DataMember {}
- data DataMembers = DataMembers {
- actualDataMembers :: Map MembrName DataMember
- data StmtMethodContent = StmtMethodContent {}
- data Methods = Methods {}
- data StmtClassContent = StmtClassContent {}
- data StmtFuncContent = StmtFuncContent {}
- data StmtVardecContent = StmtVardecContent {}
- data ExpIntContent = ExpIntContent {}
- data ExpStrContent = ExpStrContent {}
- data ExpBoolContent = ExpBoolContent {}
- data ExpNullContent = ExpNullContent {}
- data Operator
- data ExpLambdaContent = ExpLambdaContent {
- expLambdaParams :: [Param]
- expLambdaBody :: [Stmt]
- expLambdaLocation :: Location
- data ExpBinopContent = ExpBinopContent {}
- data ExpVarContent = ExpVarContent {
- actualExpVar :: Var
- data StmtAssignContent = StmtAssignContent {
- stmtAssignLhs :: Var
- stmtAssignRhs :: Exp
- data StmtTryContent = StmtTryContent {
- stmtTryPart :: [Stmt]
- stmtCatchPart :: [Stmt]
- stmtTryLocation :: Location
- data StmtBreakContent = StmtBreakContent {}
- data StmtBlockContent = StmtBlockContent {}
- data StmtImportContent = StmtImportContent {
- stmtImportSource :: String
- stmtImportFromSource :: Maybe String
- stmtImportAlias :: Maybe String
- stmtImportLocation :: Location
- data StmtContinueContent = StmtContinueContent {}
- data StmtIfContent = StmtIfContent {
- stmtIfCond :: Exp
- stmtIfBody :: [Stmt]
- stmtElseBody :: [Stmt]
- stmtIfLocation :: Location
- data StmtWhileContent = StmtWhileContent {}
- data StmtReturnContent = StmtReturnContent {
- stmtReturnValue :: Maybe Exp
- stmtReturnLocation :: Location
- data ExpCallContent = ExpCallContent {}
- data VarFieldContent = VarFieldContent {}
- data VarSimpleContent = VarSimpleContent {}
- data VarSubscriptContent = VarSubscriptContent {}
- data Var
- locationVar :: Var -> Location
Documentation
- every file has exactly one root 🌱
- classes, functions and methods are organized as statements ( not declarations )
- this enables a simpler view for modules, namespaces, nested classes etc.
Instances
FromJSON Root Source # | |
ToJSON Root Source # | |
Generic Root Source # | |
Show Root Source # | |
Eq Root Source # | |
Ord Root Source # | |
type Rep Root Source # | |
Defined in Ast type Rep Root = D1 ('MetaData "Root" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "Root" 'PrefixI 'True) (S1 ('MetaSel ('Just "filename") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FilePath) :*: S1 ('MetaSel ('Just "stmts") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Stmt]))) |
Constructors
ExpInt ExpIntContent | |
ExpStr ExpStrContent | |
ExpVar ExpVarContent | |
ExpBool ExpBoolContent | |
ExpNull ExpNullContent | |
ExpCall ExpCallContent | |
ExpBinop ExpBinopContent | |
ExpLambda ExpLambdaContent |
Instances
FromJSON Exp Source # | |
ToJSON Exp Source # | |
Generic Exp Source # | |
Show Exp Source # | |
Eq Exp Source # | |
Ord Exp Source # | |
type Rep Exp Source # | |
Defined in Ast type Rep Exp = D1 ('MetaData "Exp" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (((C1 ('MetaCons "ExpInt" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ExpIntContent)) :+: C1 ('MetaCons "ExpStr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ExpStrContent))) :+: (C1 ('MetaCons "ExpVar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ExpVarContent)) :+: C1 ('MetaCons "ExpBool" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ExpBoolContent)))) :+: ((C1 ('MetaCons "ExpNull" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ExpNullContent)) :+: C1 ('MetaCons "ExpCall" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ExpCallContent))) :+: (C1 ('MetaCons "ExpBinop" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ExpBinopContent)) :+: C1 ('MetaCons "ExpLambda" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ExpLambdaContent))))) |
Constructors
Instances
FromJSON Stmt Source # | |
ToJSON Stmt Source # | |
Generic Stmt Source # | |
Show Stmt Source # | |
Eq Stmt Source # | |
Ord Stmt Source # | |
type Rep Stmt Source # | |
Defined in Ast type Rep Stmt = D1 ('MetaData "Stmt" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (((C1 ('MetaCons "StmtExp" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Exp)) :+: (C1 ('MetaCons "StmtIf" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtIfContent)) :+: C1 ('MetaCons "StmtTry" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtTryContent)))) :+: ((C1 ('MetaCons "StmtFunc" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtFuncContent)) :+: C1 ('MetaCons "StmtBlock" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtBlockContent))) :+: (C1 ('MetaCons "StmtBreak" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtBreakContent)) :+: C1 ('MetaCons "StmtClass" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtClassContent))))) :+: ((C1 ('MetaCons "StmtWhile" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtWhileContent)) :+: (C1 ('MetaCons "StmtImport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtImportContent)) :+: C1 ('MetaCons "StmtMethod" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtMethodContent)))) :+: ((C1 ('MetaCons "StmtAssign" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtAssignContent)) :+: C1 ('MetaCons "StmtReturn" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtReturnContent))) :+: (C1 ('MetaCons "StmtVardec" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtVardecContent)) :+: C1 ('MetaCons "StmtContinue" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtContinueContent)))))) |
paramNominalTypeV2
aims to replace paramNominalType
Since: 1.0.6
Constructors
Param | |
Fields
|
Instances
FromJSON Param Source # | |
ToJSON Param Source # | |
Generic Param Source # | |
Show Param Source # | |
Eq Param Source # | |
Ord Param Source # | |
type Rep Param Source # | |
Defined in Ast type Rep Param = D1 ('MetaData "Param" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "Param" 'PrefixI 'True) ((S1 ('MetaSel ('Just "paramName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ParamName) :*: S1 ('MetaSel ('Just "paramNominalType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NominalTy)) :*: (S1 ('MetaSel ('Just "paramNominalTypeV2") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Var)) :*: S1 ('MetaSel ('Just "paramSerialIdx") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word)))) |
data DataMember Source #
Constructors
DataMember | |
Fields
|
Instances
FromJSON DataMember Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser DataMember # parseJSONList :: Value -> Parser [DataMember] # omittedField :: Maybe DataMember # | |
ToJSON DataMember Source # | |
Defined in Ast Methods toJSON :: DataMember -> Value # toEncoding :: DataMember -> Encoding # toJSONList :: [DataMember] -> Value # toEncodingList :: [DataMember] -> Encoding # omitField :: DataMember -> Bool # | |
Generic DataMember Source # | |
Defined in Ast Associated Types type Rep DataMember :: Type -> Type | |
Show DataMember Source # | |
Defined in Ast Methods showsPrec :: Int -> DataMember -> ShowS show :: DataMember -> String showList :: [DataMember] -> ShowS | |
Eq DataMember Source # | |
Defined in Ast | |
Ord DataMember Source # | |
Defined in Ast Methods compare :: DataMember -> DataMember -> Ordering (<) :: DataMember -> DataMember -> Bool (<=) :: DataMember -> DataMember -> Bool (>) :: DataMember -> DataMember -> Bool (>=) :: DataMember -> DataMember -> Bool max :: DataMember -> DataMember -> DataMember min :: DataMember -> DataMember -> DataMember | |
type Rep DataMember Source # | |
Defined in Ast type Rep DataMember = D1 ('MetaData "DataMember" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "DataMember" 'PrefixI 'True) (S1 ('MetaSel ('Just "dataMemberName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MembrName) :*: (S1 ('MetaSel ('Just "dataMemberNominalType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NominalTy) :*: S1 ('MetaSel ('Just "dataMemberInitValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Exp))))) |
data DataMembers Source #
Constructors
DataMembers | |
Fields
|
Instances
FromJSON DataMembers Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser DataMembers # parseJSONList :: Value -> Parser [DataMembers] # omittedField :: Maybe DataMembers # | |
ToJSON DataMembers Source # | |
Defined in Ast Methods toJSON :: DataMembers -> Value # toEncoding :: DataMembers -> Encoding # toJSONList :: [DataMembers] -> Value # toEncodingList :: [DataMembers] -> Encoding # omitField :: DataMembers -> Bool # | |
Generic DataMembers Source # | |
Defined in Ast Associated Types type Rep DataMembers :: Type -> Type | |
Show DataMembers Source # | |
Defined in Ast Methods showsPrec :: Int -> DataMembers -> ShowS show :: DataMembers -> String showList :: [DataMembers] -> ShowS | |
Eq DataMembers Source # | |
Defined in Ast | |
Ord DataMembers Source # | |
Defined in Ast Methods compare :: DataMembers -> DataMembers -> Ordering (<) :: DataMembers -> DataMembers -> Bool (<=) :: DataMembers -> DataMembers -> Bool (>) :: DataMembers -> DataMembers -> Bool (>=) :: DataMembers -> DataMembers -> Bool max :: DataMembers -> DataMembers -> DataMembers min :: DataMembers -> DataMembers -> DataMembers | |
type Rep DataMembers Source # | |
Defined in Ast type Rep DataMembers = D1 ('MetaData "DataMembers" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "DataMembers" 'PrefixI 'True) (S1 ('MetaSel ('Just "actualDataMembers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map MembrName DataMember)))) |
data StmtMethodContent Source #
Constructors
StmtMethodContent | |
Fields |
Instances
FromJSON StmtMethodContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser StmtMethodContent # parseJSONList :: Value -> Parser [StmtMethodContent] # omittedField :: Maybe StmtMethodContent # | |
ToJSON StmtMethodContent Source # | |
Defined in Ast Methods toJSON :: StmtMethodContent -> Value # toEncoding :: StmtMethodContent -> Encoding # toJSONList :: [StmtMethodContent] -> Value # toEncodingList :: [StmtMethodContent] -> Encoding # omitField :: StmtMethodContent -> Bool # | |
Generic StmtMethodContent Source # | |
Defined in Ast Associated Types type Rep StmtMethodContent :: Type -> Type Methods from :: StmtMethodContent -> Rep StmtMethodContent x to :: Rep StmtMethodContent x -> StmtMethodContent | |
Show StmtMethodContent Source # | |
Defined in Ast Methods showsPrec :: Int -> StmtMethodContent -> ShowS show :: StmtMethodContent -> String showList :: [StmtMethodContent] -> ShowS | |
Eq StmtMethodContent Source # | |
Defined in Ast Methods (==) :: StmtMethodContent -> StmtMethodContent -> Bool (/=) :: StmtMethodContent -> StmtMethodContent -> Bool | |
Ord StmtMethodContent Source # | |
Defined in Ast Methods compare :: StmtMethodContent -> StmtMethodContent -> Ordering (<) :: StmtMethodContent -> StmtMethodContent -> Bool (<=) :: StmtMethodContent -> StmtMethodContent -> Bool (>) :: StmtMethodContent -> StmtMethodContent -> Bool (>=) :: StmtMethodContent -> StmtMethodContent -> Bool max :: StmtMethodContent -> StmtMethodContent -> StmtMethodContent min :: StmtMethodContent -> StmtMethodContent -> StmtMethodContent | |
type Rep StmtMethodContent Source # | |
Defined in Ast type Rep StmtMethodContent = D1 ('MetaData "StmtMethodContent" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "StmtMethodContent" 'PrefixI 'True) ((S1 ('MetaSel ('Just "stmtMethodReturnType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NominalTy) :*: (S1 ('MetaSel ('Just "stmtMethodName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MethdName) :*: S1 ('MetaSel ('Just "stmtMethodParams") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Param]))) :*: ((S1 ('MetaSel ('Just "stmtMethodBody") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Stmt]) :*: S1 ('MetaSel ('Just "stmtMethodLocation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Location)) :*: (S1 ('MetaSel ('Just "hostingClassName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ClassName) :*: S1 ('MetaSel ('Just "hostingClassSupers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [SuperName]))))) |
Constructors
Methods | |
Fields |
Instances
FromJSON Methods Source # | |
ToJSON Methods Source # | |
Generic Methods Source # | |
Show Methods Source # | |
Eq Methods Source # | |
Ord Methods Source # | |
type Rep Methods Source # | |
Defined in Ast type Rep Methods = D1 ('MetaData "Methods" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "Methods" 'PrefixI 'True) (S1 ('MetaSel ('Just "actualMethods") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map MethdName StmtMethodContent)))) |
data StmtClassContent Source #
Constructors
StmtClassContent | |
Fields |
Instances
FromJSON StmtClassContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser StmtClassContent # parseJSONList :: Value -> Parser [StmtClassContent] # omittedField :: Maybe StmtClassContent # | |
ToJSON StmtClassContent Source # | |
Defined in Ast Methods toJSON :: StmtClassContent -> Value # toEncoding :: StmtClassContent -> Encoding # toJSONList :: [StmtClassContent] -> Value # toEncodingList :: [StmtClassContent] -> Encoding # omitField :: StmtClassContent -> Bool # | |
Generic StmtClassContent Source # | |
Defined in Ast Associated Types type Rep StmtClassContent :: Type -> Type Methods from :: StmtClassContent -> Rep StmtClassContent x to :: Rep StmtClassContent x -> StmtClassContent | |
Show StmtClassContent Source # | |
Defined in Ast Methods showsPrec :: Int -> StmtClassContent -> ShowS show :: StmtClassContent -> String showList :: [StmtClassContent] -> ShowS | |
Eq StmtClassContent Source # | |
Defined in Ast Methods (==) :: StmtClassContent -> StmtClassContent -> Bool (/=) :: StmtClassContent -> StmtClassContent -> Bool | |
Ord StmtClassContent Source # | |
Defined in Ast Methods compare :: StmtClassContent -> StmtClassContent -> Ordering (<) :: StmtClassContent -> StmtClassContent -> Bool (<=) :: StmtClassContent -> StmtClassContent -> Bool (>) :: StmtClassContent -> StmtClassContent -> Bool (>=) :: StmtClassContent -> StmtClassContent -> Bool max :: StmtClassContent -> StmtClassContent -> StmtClassContent min :: StmtClassContent -> StmtClassContent -> StmtClassContent | |
type Rep StmtClassContent Source # | |
Defined in Ast type Rep StmtClassContent = D1 ('MetaData "StmtClassContent" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "StmtClassContent" 'PrefixI 'True) ((S1 ('MetaSel ('Just "stmtClassName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ClassName) :*: S1 ('MetaSel ('Just "stmtClassSupers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [SuperName])) :*: (S1 ('MetaSel ('Just "stmtClassDataMembers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DataMembers) :*: S1 ('MetaSel ('Just "stmtClassMethods") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Methods)))) |
data StmtFuncContent Source #
Constructors
StmtFuncContent | |
Fields
|
Instances
FromJSON StmtFuncContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser StmtFuncContent # parseJSONList :: Value -> Parser [StmtFuncContent] # omittedField :: Maybe StmtFuncContent # | |
ToJSON StmtFuncContent Source # | |
Defined in Ast Methods toJSON :: StmtFuncContent -> Value # toEncoding :: StmtFuncContent -> Encoding # toJSONList :: [StmtFuncContent] -> Value # toEncodingList :: [StmtFuncContent] -> Encoding # omitField :: StmtFuncContent -> Bool # | |
Generic StmtFuncContent Source # | |
Defined in Ast Associated Types type Rep StmtFuncContent :: Type -> Type Methods from :: StmtFuncContent -> Rep StmtFuncContent x to :: Rep StmtFuncContent x -> StmtFuncContent | |
Show StmtFuncContent Source # | |
Defined in Ast Methods showsPrec :: Int -> StmtFuncContent -> ShowS show :: StmtFuncContent -> String showList :: [StmtFuncContent] -> ShowS | |
Eq StmtFuncContent Source # | |
Defined in Ast Methods (==) :: StmtFuncContent -> StmtFuncContent -> Bool (/=) :: StmtFuncContent -> StmtFuncContent -> Bool | |
Ord StmtFuncContent Source # | |
Defined in Ast Methods compare :: StmtFuncContent -> StmtFuncContent -> Ordering (<) :: StmtFuncContent -> StmtFuncContent -> Bool (<=) :: StmtFuncContent -> StmtFuncContent -> Bool (>) :: StmtFuncContent -> StmtFuncContent -> Bool (>=) :: StmtFuncContent -> StmtFuncContent -> Bool max :: StmtFuncContent -> StmtFuncContent -> StmtFuncContent min :: StmtFuncContent -> StmtFuncContent -> StmtFuncContent | |
type Rep StmtFuncContent Source # | |
Defined in Ast type Rep StmtFuncContent = D1 ('MetaData "StmtFuncContent" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "StmtFuncContent" 'PrefixI 'True) ((S1 ('MetaSel ('Just "stmtFuncReturnType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NominalTy) :*: (S1 ('MetaSel ('Just "stmtFuncName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FuncName) :*: S1 ('MetaSel ('Just "stmtFuncParams") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Param]))) :*: (S1 ('MetaSel ('Just "stmtFuncBody") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Stmt]) :*: (S1 ('MetaSel ('Just "stmtFuncAnnotations") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Exp]) :*: S1 ('MetaSel ('Just "stmtFuncLocation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Location))))) |
data StmtVardecContent Source #
Constructors
StmtVardecContent | |
Fields
|
Instances
FromJSON StmtVardecContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser StmtVardecContent # parseJSONList :: Value -> Parser [StmtVardecContent] # omittedField :: Maybe StmtVardecContent # | |
ToJSON StmtVardecContent Source # | |
Defined in Ast Methods toJSON :: StmtVardecContent -> Value # toEncoding :: StmtVardecContent -> Encoding # toJSONList :: [StmtVardecContent] -> Value # toEncodingList :: [StmtVardecContent] -> Encoding # omitField :: StmtVardecContent -> Bool # | |
Generic StmtVardecContent Source # | |
Defined in Ast Associated Types type Rep StmtVardecContent :: Type -> Type Methods from :: StmtVardecContent -> Rep StmtVardecContent x to :: Rep StmtVardecContent x -> StmtVardecContent | |
Show StmtVardecContent Source # | |
Defined in Ast Methods showsPrec :: Int -> StmtVardecContent -> ShowS show :: StmtVardecContent -> String showList :: [StmtVardecContent] -> ShowS | |
Eq StmtVardecContent Source # | |
Defined in Ast Methods (==) :: StmtVardecContent -> StmtVardecContent -> Bool (/=) :: StmtVardecContent -> StmtVardecContent -> Bool | |
Ord StmtVardecContent Source # | |
Defined in Ast Methods compare :: StmtVardecContent -> StmtVardecContent -> Ordering (<) :: StmtVardecContent -> StmtVardecContent -> Bool (<=) :: StmtVardecContent -> StmtVardecContent -> Bool (>) :: StmtVardecContent -> StmtVardecContent -> Bool (>=) :: StmtVardecContent -> StmtVardecContent -> Bool max :: StmtVardecContent -> StmtVardecContent -> StmtVardecContent min :: StmtVardecContent -> StmtVardecContent -> StmtVardecContent | |
type Rep StmtVardecContent Source # | |
Defined in Ast type Rep StmtVardecContent = D1 ('MetaData "StmtVardecContent" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "StmtVardecContent" 'PrefixI 'True) ((S1 ('MetaSel ('Just "stmtVardecName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 VarName) :*: S1 ('MetaSel ('Just "stmtVardecNominalType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NominalTy)) :*: (S1 ('MetaSel ('Just "stmtVardecInitValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Exp)) :*: S1 ('MetaSel ('Just "stmtVardecLocation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Location)))) |
data ExpIntContent Source #
Constructors
ExpIntContent | |
Fields |
Instances
data ExpStrContent Source #
Constructors
ExpStrContent | |
Fields |
Instances
data ExpBoolContent Source #
Constructors
ExpBoolContent | |
Fields |
Instances
data ExpNullContent Source #
Constructors
ExpNullContent | |
Fields |
Instances
Instances
FromJSON Operator Source # | |
ToJSON Operator Source # | |
Generic Operator Source # | |
Show Operator Source # | |
Eq Operator Source # | |
Ord Operator Source # | |
type Rep Operator Source # | |
Defined in Ast type Rep Operator = D1 ('MetaData "Operator" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) ((C1 ('MetaCons "PLUS" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MINUS" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TIMES" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "DIVIDE" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PERCENT" 'PrefixI 'False) (U1 :: Type -> Type)))) |
data ExpLambdaContent Source #
Constructors
ExpLambdaContent | |
Fields
|
Instances
data ExpBinopContent Source #
Constructors
ExpBinopContent | |
Fields |
Instances
FromJSON ExpBinopContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser ExpBinopContent # parseJSONList :: Value -> Parser [ExpBinopContent] # omittedField :: Maybe ExpBinopContent # | |
ToJSON ExpBinopContent Source # | |
Defined in Ast Methods toJSON :: ExpBinopContent -> Value # toEncoding :: ExpBinopContent -> Encoding # toJSONList :: [ExpBinopContent] -> Value # toEncodingList :: [ExpBinopContent] -> Encoding # omitField :: ExpBinopContent -> Bool # | |
Generic ExpBinopContent Source # | |
Defined in Ast Associated Types type Rep ExpBinopContent :: Type -> Type Methods from :: ExpBinopContent -> Rep ExpBinopContent x to :: Rep ExpBinopContent x -> ExpBinopContent | |
Show ExpBinopContent Source # | |
Defined in Ast Methods showsPrec :: Int -> ExpBinopContent -> ShowS show :: ExpBinopContent -> String showList :: [ExpBinopContent] -> ShowS | |
Eq ExpBinopContent Source # | |
Defined in Ast Methods (==) :: ExpBinopContent -> ExpBinopContent -> Bool (/=) :: ExpBinopContent -> ExpBinopContent -> Bool | |
Ord ExpBinopContent Source # | |
Defined in Ast Methods compare :: ExpBinopContent -> ExpBinopContent -> Ordering (<) :: ExpBinopContent -> ExpBinopContent -> Bool (<=) :: ExpBinopContent -> ExpBinopContent -> Bool (>) :: ExpBinopContent -> ExpBinopContent -> Bool (>=) :: ExpBinopContent -> ExpBinopContent -> Bool max :: ExpBinopContent -> ExpBinopContent -> ExpBinopContent min :: ExpBinopContent -> ExpBinopContent -> ExpBinopContent | |
type Rep ExpBinopContent Source # | |
Defined in Ast type Rep ExpBinopContent = D1 ('MetaData "ExpBinopContent" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "ExpBinopContent" 'PrefixI 'True) ((S1 ('MetaSel ('Just "expBinopLeft") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Exp) :*: S1 ('MetaSel ('Just "expBinopRight") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Exp)) :*: (S1 ('MetaSel ('Just "expBinopOperator") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Operator) :*: S1 ('MetaSel ('Just "expBinopLocation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Location)))) |
data ExpVarContent Source #
Constructors
ExpVarContent | |
Fields
|
Instances
data StmtAssignContent Source #
Constructors
StmtAssignContent | |
Fields
|
Instances
data StmtTryContent Source #
Constructors
StmtTryContent | |
Fields
|
Instances
FromJSON StmtTryContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser StmtTryContent # parseJSONList :: Value -> Parser [StmtTryContent] # omittedField :: Maybe StmtTryContent # | |
ToJSON StmtTryContent Source # | |
Defined in Ast Methods toJSON :: StmtTryContent -> Value # toEncoding :: StmtTryContent -> Encoding # toJSONList :: [StmtTryContent] -> Value # toEncodingList :: [StmtTryContent] -> Encoding # omitField :: StmtTryContent -> Bool # | |
Generic StmtTryContent Source # | |
Defined in Ast Associated Types type Rep StmtTryContent :: Type -> Type | |
Show StmtTryContent Source # | |
Defined in Ast Methods showsPrec :: Int -> StmtTryContent -> ShowS show :: StmtTryContent -> String showList :: [StmtTryContent] -> ShowS | |
Eq StmtTryContent Source # | |
Defined in Ast Methods (==) :: StmtTryContent -> StmtTryContent -> Bool (/=) :: StmtTryContent -> StmtTryContent -> Bool | |
Ord StmtTryContent Source # | |
Defined in Ast Methods compare :: StmtTryContent -> StmtTryContent -> Ordering (<) :: StmtTryContent -> StmtTryContent -> Bool (<=) :: StmtTryContent -> StmtTryContent -> Bool (>) :: StmtTryContent -> StmtTryContent -> Bool (>=) :: StmtTryContent -> StmtTryContent -> Bool max :: StmtTryContent -> StmtTryContent -> StmtTryContent min :: StmtTryContent -> StmtTryContent -> StmtTryContent | |
type Rep StmtTryContent Source # | |
Defined in Ast type Rep StmtTryContent = D1 ('MetaData "StmtTryContent" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "StmtTryContent" 'PrefixI 'True) (S1 ('MetaSel ('Just "stmtTryPart") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Stmt]) :*: (S1 ('MetaSel ('Just "stmtCatchPart") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Stmt]) :*: S1 ('MetaSel ('Just "stmtTryLocation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Location)))) |
data StmtBreakContent Source #
Constructors
StmtBreakContent | |
Fields |
Instances
data StmtBlockContent Source #
Constructors
StmtBlockContent | |
Fields |
Instances
data StmtImportContent Source #
Examples:
- Simple source import
# stmtImportSource is "json" # stmtImportFromSource is Nothing # stmtImportAlias is Nothing import json
- Specifying a specific name from source
# stmtImportSource is "urllib.parse" # stmtImportFromSource is Just "urljoin" # stmtImportAlias is Nothing from urllib.parse import urljoin
- Specifying an alias for a source import
# stmtImportSource is "networkx" # stmtImportFromSource is Nothing # stmtImportAlias is Just "nx" import networkx as nx
Constructors
StmtImportContent | |
Fields
|
Instances
FromJSON StmtImportContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser StmtImportContent # parseJSONList :: Value -> Parser [StmtImportContent] # omittedField :: Maybe StmtImportContent # | |
ToJSON StmtImportContent Source # | |
Defined in Ast Methods toJSON :: StmtImportContent -> Value # toEncoding :: StmtImportContent -> Encoding # toJSONList :: [StmtImportContent] -> Value # toEncodingList :: [StmtImportContent] -> Encoding # omitField :: StmtImportContent -> Bool # | |
Generic StmtImportContent Source # | |
Defined in Ast Associated Types type Rep StmtImportContent :: Type -> Type Methods from :: StmtImportContent -> Rep StmtImportContent x to :: Rep StmtImportContent x -> StmtImportContent | |
Show StmtImportContent Source # | |
Defined in Ast Methods showsPrec :: Int -> StmtImportContent -> ShowS show :: StmtImportContent -> String showList :: [StmtImportContent] -> ShowS | |
Eq StmtImportContent Source # | |
Defined in Ast Methods (==) :: StmtImportContent -> StmtImportContent -> Bool (/=) :: StmtImportContent -> StmtImportContent -> Bool | |
Ord StmtImportContent Source # | |
Defined in Ast Methods compare :: StmtImportContent -> StmtImportContent -> Ordering (<) :: StmtImportContent -> StmtImportContent -> Bool (<=) :: StmtImportContent -> StmtImportContent -> Bool (>) :: StmtImportContent -> StmtImportContent -> Bool (>=) :: StmtImportContent -> StmtImportContent -> Bool max :: StmtImportContent -> StmtImportContent -> StmtImportContent min :: StmtImportContent -> StmtImportContent -> StmtImportContent | |
type Rep StmtImportContent Source # | |
Defined in Ast type Rep StmtImportContent = D1 ('MetaData "StmtImportContent" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "StmtImportContent" 'PrefixI 'True) ((S1 ('MetaSel ('Just "stmtImportSource") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String) :*: S1 ('MetaSel ('Just "stmtImportFromSource") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe String))) :*: (S1 ('MetaSel ('Just "stmtImportAlias") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe String)) :*: S1 ('MetaSel ('Just "stmtImportLocation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Location)))) |
data StmtContinueContent Source #
Constructors
StmtContinueContent | |
Fields |
Instances
data StmtIfContent Source #
Constructors
StmtIfContent | |
Fields
|
Instances
FromJSON StmtIfContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser StmtIfContent # parseJSONList :: Value -> Parser [StmtIfContent] # omittedField :: Maybe StmtIfContent # | |
ToJSON StmtIfContent Source # | |
Defined in Ast Methods toJSON :: StmtIfContent -> Value # toEncoding :: StmtIfContent -> Encoding # toJSONList :: [StmtIfContent] -> Value # toEncodingList :: [StmtIfContent] -> Encoding # omitField :: StmtIfContent -> Bool # | |
Generic StmtIfContent Source # | |
Defined in Ast Associated Types type Rep StmtIfContent :: Type -> Type | |
Show StmtIfContent Source # | |
Defined in Ast Methods showsPrec :: Int -> StmtIfContent -> ShowS show :: StmtIfContent -> String showList :: [StmtIfContent] -> ShowS | |
Eq StmtIfContent Source # | |
Defined in Ast | |
Ord StmtIfContent Source # | |
Defined in Ast Methods compare :: StmtIfContent -> StmtIfContent -> Ordering (<) :: StmtIfContent -> StmtIfContent -> Bool (<=) :: StmtIfContent -> StmtIfContent -> Bool (>) :: StmtIfContent -> StmtIfContent -> Bool (>=) :: StmtIfContent -> StmtIfContent -> Bool max :: StmtIfContent -> StmtIfContent -> StmtIfContent min :: StmtIfContent -> StmtIfContent -> StmtIfContent | |
type Rep StmtIfContent Source # | |
Defined in Ast type Rep StmtIfContent = D1 ('MetaData "StmtIfContent" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "StmtIfContent" 'PrefixI 'True) ((S1 ('MetaSel ('Just "stmtIfCond") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Exp) :*: S1 ('MetaSel ('Just "stmtIfBody") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Stmt])) :*: (S1 ('MetaSel ('Just "stmtElseBody") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Stmt]) :*: S1 ('MetaSel ('Just "stmtIfLocation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Location)))) |
data StmtWhileContent Source #
Constructors
StmtWhileContent | |
Fields
|
Instances
data StmtReturnContent Source #
Constructors
StmtReturnContent | |
Fields
|
Instances
data ExpCallContent Source #
Constructors
ExpCallContent | |
Instances
FromJSON ExpCallContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser ExpCallContent # parseJSONList :: Value -> Parser [ExpCallContent] # omittedField :: Maybe ExpCallContent # | |
ToJSON ExpCallContent Source # | |
Defined in Ast Methods toJSON :: ExpCallContent -> Value # toEncoding :: ExpCallContent -> Encoding # toJSONList :: [ExpCallContent] -> Value # toEncodingList :: [ExpCallContent] -> Encoding # omitField :: ExpCallContent -> Bool # | |
Generic ExpCallContent Source # | |
Defined in Ast Associated Types type Rep ExpCallContent :: Type -> Type | |
Show ExpCallContent Source # | |
Defined in Ast Methods showsPrec :: Int -> ExpCallContent -> ShowS show :: ExpCallContent -> String showList :: [ExpCallContent] -> ShowS | |
Eq ExpCallContent Source # | |
Defined in Ast Methods (==) :: ExpCallContent -> ExpCallContent -> Bool (/=) :: ExpCallContent -> ExpCallContent -> Bool | |
Ord ExpCallContent Source # | |
Defined in Ast Methods compare :: ExpCallContent -> ExpCallContent -> Ordering (<) :: ExpCallContent -> ExpCallContent -> Bool (<=) :: ExpCallContent -> ExpCallContent -> Bool (>) :: ExpCallContent -> ExpCallContent -> Bool (>=) :: ExpCallContent -> ExpCallContent -> Bool max :: ExpCallContent -> ExpCallContent -> ExpCallContent min :: ExpCallContent -> ExpCallContent -> ExpCallContent | |
type Rep ExpCallContent Source # | |
Defined in Ast type Rep ExpCallContent = D1 ('MetaData "ExpCallContent" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "ExpCallContent" 'PrefixI 'True) (S1 ('MetaSel ('Just "callee") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Exp) :*: (S1 ('MetaSel ('Just "args") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Exp]) :*: S1 ('MetaSel ('Just "expCallLocation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Location)))) |
data VarFieldContent Source #
Constructors
VarFieldContent | |
Fields |
Instances
FromJSON VarFieldContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser VarFieldContent # parseJSONList :: Value -> Parser [VarFieldContent] # omittedField :: Maybe VarFieldContent # | |
ToJSON VarFieldContent Source # | |
Defined in Ast Methods toJSON :: VarFieldContent -> Value # toEncoding :: VarFieldContent -> Encoding # toJSONList :: [VarFieldContent] -> Value # toEncodingList :: [VarFieldContent] -> Encoding # omitField :: VarFieldContent -> Bool # | |
Generic VarFieldContent Source # | |
Defined in Ast Associated Types type Rep VarFieldContent :: Type -> Type Methods from :: VarFieldContent -> Rep VarFieldContent x to :: Rep VarFieldContent x -> VarFieldContent | |
Show VarFieldContent Source # | |
Defined in Ast Methods showsPrec :: Int -> VarFieldContent -> ShowS show :: VarFieldContent -> String showList :: [VarFieldContent] -> ShowS | |
Eq VarFieldContent Source # | |
Defined in Ast Methods (==) :: VarFieldContent -> VarFieldContent -> Bool (/=) :: VarFieldContent -> VarFieldContent -> Bool | |
Ord VarFieldContent Source # | |
Defined in Ast Methods compare :: VarFieldContent -> VarFieldContent -> Ordering (<) :: VarFieldContent -> VarFieldContent -> Bool (<=) :: VarFieldContent -> VarFieldContent -> Bool (>) :: VarFieldContent -> VarFieldContent -> Bool (>=) :: VarFieldContent -> VarFieldContent -> Bool max :: VarFieldContent -> VarFieldContent -> VarFieldContent min :: VarFieldContent -> VarFieldContent -> VarFieldContent | |
type Rep VarFieldContent Source # | |
Defined in Ast type Rep VarFieldContent = D1 ('MetaData "VarFieldContent" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "VarFieldContent" 'PrefixI 'True) (S1 ('MetaSel ('Just "varFieldLhs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Exp) :*: (S1 ('MetaSel ('Just "varFieldName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FieldName) :*: S1 ('MetaSel ('Just "varFieldLocation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Location)))) |
data VarSimpleContent Source #
Constructors
VarSimpleContent | |
Instances
data VarSubscriptContent Source #
Constructors
VarSubscriptContent | |
Fields |
Instances
Instances
FromJSON Var Source # | |
ToJSON Var Source # | |
Generic Var Source # | |
Show Var Source # | |
Eq Var Source # | |
Ord Var Source # | |
type Rep Var Source # | |
Defined in Ast type Rep Var = D1 ('MetaData "Var" "Ast" "dhscanner-ast-1.0.8-inplace" 'False) (C1 ('MetaCons "VarSimple" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 VarSimpleContent)) :+: (C1 ('MetaCons "VarField" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 VarFieldContent)) :+: C1 ('MetaCons "VarSubscript" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 VarSubscriptContent)))) |
locationVar :: Var -> Location Source #