Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Ast
Description
- The abstract ayntax tree (ast) aims to be a data structure able to represent multiple abstract syntax trees from various programming languages.
- Its main purpose is to serve as the first step for static code analysis, as part of the dhscanner framework for CI/CD container security checks.
- As part of that framework, it targets mostly languages used for cloud native applications: Python, Ruby, Php, Javascript, Typescript, Java and Golang.
- Typically, a file is first parsed with the corresponding native parser of the language it's written in (see Python's native parser for example). The native ast is then dumped (as JSON, or plain text) and sent to a Happy + Alex Haskell parser which accommodates the natively parsed content into the 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 and catch blocks, and models both of them as plain sequential code blocks.
- Every file has exactly one ast that represents it.
- Non Haskell parogrammers note: The ast is immutable (like everything else in Haskell ...)
Documentation
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-0.1.0.2-inplace" 'False) (C1 ('MetaCons "Root" 'PrefixI 'True) (S1 ('MetaSel ('Just "filename") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String) :*: (S1 ('MetaSel ('Just "decs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Dec]) :*: S1 ('MetaSel ('Just "stmts") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Stmt])))) |
Constructors
DecVar DecVarContent | |
DecClass DecClassContent | |
DecMethod DecMethodContent |
Instances
FromJSON Dec Source # | |
ToJSON Dec Source # | |
Generic Dec Source # | |
Show Dec Source # | |
Eq Dec Source # | |
Ord Dec Source # | |
type Rep Dec Source # | |
Defined in Ast type Rep Dec = D1 ('MetaData "Dec" "Ast" "dhscanner-ast-0.1.0.2-inplace" 'False) (C1 ('MetaCons "DecVar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DecVarContent)) :+: (C1 ('MetaCons "DecClass" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DecClassContent)) :+: C1 ('MetaCons "DecMethod" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DecMethodContent)))) |
Constructors
ExpInt ExpIntContent | |
ExpStr ExpStrContent | |
ExpVar ExpVarContent | |
ExpBool ExpBoolContent | |
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-0.1.0.2-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 "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-0.1.0.2-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 "StmtCall" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ExpCallContent)) :+: (C1 ('MetaCons "StmtFunc" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtFuncContent)) :+: C1 ('MetaCons "StmtDecvar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DecVarContent))))) :+: ((C1 ('MetaCons "StmtBreak" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtBreakContent)) :+: (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 "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 "StmtContinue" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 StmtContinueContent)))))) |
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-0.1.0.2-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 "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-0.1.0.2-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-0.1.0.2-inplace" 'False) (C1 ('MetaCons "DataMembers" 'PrefixI 'True) (S1 ('MetaSel ('Just "actualDataMembers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map MembrName DataMember)))) |
data DecMethodContent Source #
Constructors
DecMethodContent | |
Fields |
Instances
FromJSON DecMethodContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser DecMethodContent # parseJSONList :: Value -> Parser [DecMethodContent] # omittedField :: Maybe DecMethodContent # | |
ToJSON DecMethodContent Source # | |
Defined in Ast Methods toJSON :: DecMethodContent -> Value # toEncoding :: DecMethodContent -> Encoding # toJSONList :: [DecMethodContent] -> Value # toEncodingList :: [DecMethodContent] -> Encoding # omitField :: DecMethodContent -> Bool # | |
Generic DecMethodContent Source # | |
Defined in Ast Associated Types type Rep DecMethodContent :: Type -> Type Methods from :: DecMethodContent -> Rep DecMethodContent x to :: Rep DecMethodContent x -> DecMethodContent | |
Show DecMethodContent Source # | |
Defined in Ast Methods showsPrec :: Int -> DecMethodContent -> ShowS show :: DecMethodContent -> String showList :: [DecMethodContent] -> ShowS | |
Eq DecMethodContent Source # | |
Defined in Ast Methods (==) :: DecMethodContent -> DecMethodContent -> Bool (/=) :: DecMethodContent -> DecMethodContent -> Bool | |
Ord DecMethodContent Source # | |
Defined in Ast Methods compare :: DecMethodContent -> DecMethodContent -> Ordering (<) :: DecMethodContent -> DecMethodContent -> Bool (<=) :: DecMethodContent -> DecMethodContent -> Bool (>) :: DecMethodContent -> DecMethodContent -> Bool (>=) :: DecMethodContent -> DecMethodContent -> Bool max :: DecMethodContent -> DecMethodContent -> DecMethodContent min :: DecMethodContent -> DecMethodContent -> DecMethodContent | |
type Rep DecMethodContent Source # | |
Defined in Ast type Rep DecMethodContent = D1 ('MetaData "DecMethodContent" "Ast" "dhscanner-ast-0.1.0.2-inplace" 'False) (C1 ('MetaCons "DecMethodContent" 'PrefixI 'True) ((S1 ('MetaSel ('Just "decMethodReturnType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NominalTy) :*: (S1 ('MetaSel ('Just "decMethodName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MethdName) :*: S1 ('MetaSel ('Just "decMethodParams") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Param]))) :*: ((S1 ('MetaSel ('Just "decMethodBody") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Stmt]) :*: S1 ('MetaSel ('Just "decMethodLocation") '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-0.1.0.2-inplace" 'False) (C1 ('MetaCons "Methods" 'PrefixI 'True) (S1 ('MetaSel ('Just "actualMethods") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map MethdName DecMethodContent)))) |
data DecClassContent Source #
Constructors
DecClassContent | |
Fields |
Instances
FromJSON DecClassContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser DecClassContent # parseJSONList :: Value -> Parser [DecClassContent] # omittedField :: Maybe DecClassContent # | |
ToJSON DecClassContent Source # | |
Defined in Ast Methods toJSON :: DecClassContent -> Value # toEncoding :: DecClassContent -> Encoding # toJSONList :: [DecClassContent] -> Value # toEncodingList :: [DecClassContent] -> Encoding # omitField :: DecClassContent -> Bool # | |
Generic DecClassContent Source # | |
Defined in Ast Associated Types type Rep DecClassContent :: Type -> Type Methods from :: DecClassContent -> Rep DecClassContent x to :: Rep DecClassContent x -> DecClassContent | |
Show DecClassContent Source # | |
Defined in Ast Methods showsPrec :: Int -> DecClassContent -> ShowS show :: DecClassContent -> String showList :: [DecClassContent] -> ShowS | |
Eq DecClassContent Source # | |
Defined in Ast Methods (==) :: DecClassContent -> DecClassContent -> Bool (/=) :: DecClassContent -> DecClassContent -> Bool | |
Ord DecClassContent Source # | |
Defined in Ast Methods compare :: DecClassContent -> DecClassContent -> Ordering (<) :: DecClassContent -> DecClassContent -> Bool (<=) :: DecClassContent -> DecClassContent -> Bool (>) :: DecClassContent -> DecClassContent -> Bool (>=) :: DecClassContent -> DecClassContent -> Bool max :: DecClassContent -> DecClassContent -> DecClassContent min :: DecClassContent -> DecClassContent -> DecClassContent | |
type Rep DecClassContent Source # | |
Defined in Ast type Rep DecClassContent = D1 ('MetaData "DecClassContent" "Ast" "dhscanner-ast-0.1.0.2-inplace" 'False) (C1 ('MetaCons "DecClassContent" 'PrefixI 'True) ((S1 ('MetaSel ('Just "decClassName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ClassName) :*: S1 ('MetaSel ('Just "decClassSupers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [SuperName])) :*: (S1 ('MetaSel ('Just "decClassDataMembers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DataMembers) :*: S1 ('MetaSel ('Just "decClassMethods") '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-0.1.0.2-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 DecPackageContent Source #
Constructors
DecPackageContent | |
Fields |
Instances
data DecVarContent Source #
Constructors
DecVarContent | |
Fields
|
Instances
FromJSON DecVarContent Source # | |
Defined in Ast Methods parseJSON :: Value -> Parser DecVarContent # parseJSONList :: Value -> Parser [DecVarContent] # omittedField :: Maybe DecVarContent # | |
ToJSON DecVarContent Source # | |
Defined in Ast Methods toJSON :: DecVarContent -> Value # toEncoding :: DecVarContent -> Encoding # toJSONList :: [DecVarContent] -> Value # toEncodingList :: [DecVarContent] -> Encoding # omitField :: DecVarContent -> Bool # | |
Generic DecVarContent Source # | |
Defined in Ast Associated Types type Rep DecVarContent :: Type -> Type | |
Show DecVarContent Source # | |
Defined in Ast Methods showsPrec :: Int -> DecVarContent -> ShowS show :: DecVarContent -> String showList :: [DecVarContent] -> ShowS | |
Eq DecVarContent Source # | |
Defined in Ast | |
Ord DecVarContent Source # | |
Defined in Ast Methods compare :: DecVarContent -> DecVarContent -> Ordering (<) :: DecVarContent -> DecVarContent -> Bool (<=) :: DecVarContent -> DecVarContent -> Bool (>) :: DecVarContent -> DecVarContent -> Bool (>=) :: DecVarContent -> DecVarContent -> Bool max :: DecVarContent -> DecVarContent -> DecVarContent min :: DecVarContent -> DecVarContent -> DecVarContent | |
type Rep DecVarContent Source # | |
Defined in Ast type Rep DecVarContent = D1 ('MetaData "DecVarContent" "Ast" "dhscanner-ast-0.1.0.2-inplace" 'False) (C1 ('MetaCons "DecVarContent" 'PrefixI 'True) (S1 ('MetaSel ('Just "decVarName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 VarName) :*: (S1 ('MetaSel ('Just "decVarNominalType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NominalTy) :*: S1 ('MetaSel ('Just "decVarInitValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Exp))))) |
data ExpIntContent Source #
Constructors
ExpIntContent | |
Fields |
Instances
data ExpStrContent Source #
Constructors
ExpStrContent | |
Fields |
Instances
data ExpBoolContent Source #
Constructors
ExpBoolContent | |
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-0.1.0.2-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-0.1.0.2-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-0.1.0.2-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 StmtImportContent Source #
Constructors
StmtImportContent | |
Fields
|
Instances
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-0.1.0.2-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-0.1.0.2-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-0.1.0.2-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-0.1.0.2-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 #