-- |

--

-- * The [abstract ayntax tree](https://en.wikipedia.org/wiki/Abstract_syntax_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:

--

--     * first step for /static code analysis/ 

--     * part of the [dhscanner](https://github.com/OrenGitHub/dhscanner) framework for

--       CI\/CD container security checks 🔒 and

--       [PII](https://en.wikipedia.org/wiki/Personal_data) leaks detection 🪪

--

-- * As part of the [dhscanner](https://github.com/OrenGitHub/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](https://docs.python.org/3/library/ast.html), 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](https://haskell-happy.readthedocs.io/en/latest/) +

--       [Alex](https://haskell-alex.readthedocs.io/en/latest/) 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` and `catch` blocks

--

--     * it models both of them as plain sequential code blocks.

--

-- * Every file has exactly one ast ( 'Root' ) that represents it

--

-- * Non Haskell parogrammers note:

--

--     * The ast is /immutable/ ( like everything else in Haskell ... )

--


{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}

module Ast

where

import Data.Aeson
import GHC.Generics
import Data.Map ( Map )

-- project imports

import Location
import qualified Token

-- |

-- * 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.

--

data Root
   = Root
     {
         Root -> FilePath
filename :: FilePath,
         Root -> [Stmt]
stmts :: [ Stmt ]
     }
     deriving ( Int -> Root -> ShowS
[Root] -> ShowS
Root -> FilePath
(Int -> Root -> ShowS)
-> (Root -> FilePath) -> ([Root] -> ShowS) -> Show Root
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Root -> ShowS
showsPrec :: Int -> Root -> ShowS
$cshow :: Root -> FilePath
show :: Root -> FilePath
$cshowList :: [Root] -> ShowS
showList :: [Root] -> ShowS
Show, Root -> Root -> Bool
(Root -> Root -> Bool) -> (Root -> Root -> Bool) -> Eq Root
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Root -> Root -> Bool
== :: Root -> Root -> Bool
$c/= :: Root -> Root -> Bool
/= :: Root -> Root -> Bool
Eq, Eq Root
Eq Root
-> (Root -> Root -> Ordering)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Bool)
-> (Root -> Root -> Root)
-> (Root -> Root -> Root)
-> Ord Root
Root -> Root -> Bool
Root -> Root -> Ordering
Root -> Root -> Root
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
$ccompare :: Root -> Root -> Ordering
compare :: Root -> Root -> Ordering
$c< :: Root -> Root -> Bool
< :: Root -> Root -> Bool
$c<= :: Root -> Root -> Bool
<= :: Root -> Root -> Bool
$c> :: Root -> Root -> Bool
> :: Root -> Root -> Bool
$c>= :: Root -> Root -> Bool
>= :: Root -> Root -> Bool
$cmax :: Root -> Root -> Root
max :: Root -> Root -> Root
$cmin :: Root -> Root -> Root
min :: Root -> Root -> Root
Ord, (forall x. Root -> Rep Root x)
-> (forall x. Rep Root x -> Root) -> Generic Root
forall x. Rep Root x -> Root
forall x. Root -> Rep Root x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Root -> Rep Root x
from :: forall x. Root -> Rep Root x
$cto :: forall x. Rep Root x -> Root
to :: forall x. Rep Root x -> Root
Generic, [Root] -> Value
[Root] -> Encoding
Root -> Bool
Root -> Value
Root -> Encoding
(Root -> Value)
-> (Root -> Encoding)
-> ([Root] -> Value)
-> ([Root] -> Encoding)
-> (Root -> Bool)
-> ToJSON Root
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Root -> Value
toJSON :: Root -> Value
$ctoEncoding :: Root -> Encoding
toEncoding :: Root -> Encoding
$ctoJSONList :: [Root] -> Value
toJSONList :: [Root] -> Value
$ctoEncodingList :: [Root] -> Encoding
toEncodingList :: [Root] -> Encoding
$comitField :: Root -> Bool
omitField :: Root -> Bool
ToJSON, Maybe Root
Value -> Parser [Root]
Value -> Parser Root
(Value -> Parser Root)
-> (Value -> Parser [Root]) -> Maybe Root -> FromJSON Root
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Root
parseJSON :: Value -> Parser Root
$cparseJSONList :: Value -> Parser [Root]
parseJSONList :: Value -> Parser [Root]
$comittedField :: Maybe Root
omittedField :: Maybe Root
FromJSON )

data Exp
   = ExpInt ExpIntContent
   | ExpStr ExpStrContent
   | ExpVar ExpVarContent
   | ExpBool ExpBoolContent
   | ExpCall ExpCallContent
   | ExpBinop ExpBinopContent
   | ExpLambda ExpLambdaContent
   deriving ( Int -> Exp -> ShowS
[Exp] -> ShowS
Exp -> FilePath
(Int -> Exp -> ShowS)
-> (Exp -> FilePath) -> ([Exp] -> ShowS) -> Show Exp
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Exp -> ShowS
showsPrec :: Int -> Exp -> ShowS
$cshow :: Exp -> FilePath
show :: Exp -> FilePath
$cshowList :: [Exp] -> ShowS
showList :: [Exp] -> ShowS
Show, Exp -> Exp -> Bool
(Exp -> Exp -> Bool) -> (Exp -> Exp -> Bool) -> Eq Exp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Exp -> Exp -> Bool
== :: Exp -> Exp -> Bool
$c/= :: Exp -> Exp -> Bool
/= :: Exp -> Exp -> Bool
Eq, Eq Exp
Eq Exp
-> (Exp -> Exp -> Ordering)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Bool)
-> (Exp -> Exp -> Exp)
-> (Exp -> Exp -> Exp)
-> Ord Exp
Exp -> Exp -> Bool
Exp -> Exp -> Ordering
Exp -> Exp -> Exp
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
$ccompare :: Exp -> Exp -> Ordering
compare :: Exp -> Exp -> Ordering
$c< :: Exp -> Exp -> Bool
< :: Exp -> Exp -> Bool
$c<= :: Exp -> Exp -> Bool
<= :: Exp -> Exp -> Bool
$c> :: Exp -> Exp -> Bool
> :: Exp -> Exp -> Bool
$c>= :: Exp -> Exp -> Bool
>= :: Exp -> Exp -> Bool
$cmax :: Exp -> Exp -> Exp
max :: Exp -> Exp -> Exp
$cmin :: Exp -> Exp -> Exp
min :: Exp -> Exp -> Exp
Ord, (forall x. Exp -> Rep Exp x)
-> (forall x. Rep Exp x -> Exp) -> Generic Exp
forall x. Rep Exp x -> Exp
forall x. Exp -> Rep Exp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Exp -> Rep Exp x
from :: forall x. Exp -> Rep Exp x
$cto :: forall x. Rep Exp x -> Exp
to :: forall x. Rep Exp x -> Exp
Generic, [Exp] -> Value
[Exp] -> Encoding
Exp -> Bool
Exp -> Value
Exp -> Encoding
(Exp -> Value)
-> (Exp -> Encoding)
-> ([Exp] -> Value)
-> ([Exp] -> Encoding)
-> (Exp -> Bool)
-> ToJSON Exp
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Exp -> Value
toJSON :: Exp -> Value
$ctoEncoding :: Exp -> Encoding
toEncoding :: Exp -> Encoding
$ctoJSONList :: [Exp] -> Value
toJSONList :: [Exp] -> Value
$ctoEncodingList :: [Exp] -> Encoding
toEncodingList :: [Exp] -> Encoding
$comitField :: Exp -> Bool
omitField :: Exp -> Bool
ToJSON, Maybe Exp
Value -> Parser [Exp]
Value -> Parser Exp
(Value -> Parser Exp)
-> (Value -> Parser [Exp]) -> Maybe Exp -> FromJSON Exp
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Exp
parseJSON :: Value -> Parser Exp
$cparseJSONList :: Value -> Parser [Exp]
parseJSONList :: Value -> Parser [Exp]
$comittedField :: Maybe Exp
omittedField :: Maybe Exp
FromJSON )

data Stmt
   = StmtExp Exp
   | StmtIf StmtIfContent
   | StmtTry StmtTryContent
   | StmtCall ExpCallContent
   | StmtFunc StmtFuncContent
   | StmtDecvar DecVarContent
   | StmtBreak StmtBreakContent
   | StmtClass StmtClassContent
   | StmtWhile StmtWhileContent
   | StmtImport StmtImportContent
   | StmtMethod StmtMethodContent
   | StmtAssign StmtAssignContent
   | StmtReturn StmtReturnContent
   | StmtContinue StmtContinueContent
   deriving ( Int -> Stmt -> ShowS
[Stmt] -> ShowS
Stmt -> FilePath
(Int -> Stmt -> ShowS)
-> (Stmt -> FilePath) -> ([Stmt] -> ShowS) -> Show Stmt
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Stmt -> ShowS
showsPrec :: Int -> Stmt -> ShowS
$cshow :: Stmt -> FilePath
show :: Stmt -> FilePath
$cshowList :: [Stmt] -> ShowS
showList :: [Stmt] -> ShowS
Show, Stmt -> Stmt -> Bool
(Stmt -> Stmt -> Bool) -> (Stmt -> Stmt -> Bool) -> Eq Stmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stmt -> Stmt -> Bool
== :: Stmt -> Stmt -> Bool
$c/= :: Stmt -> Stmt -> Bool
/= :: Stmt -> Stmt -> Bool
Eq, Eq Stmt
Eq Stmt
-> (Stmt -> Stmt -> Ordering)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Stmt)
-> (Stmt -> Stmt -> Stmt)
-> Ord Stmt
Stmt -> Stmt -> Bool
Stmt -> Stmt -> Ordering
Stmt -> Stmt -> Stmt
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
$ccompare :: Stmt -> Stmt -> Ordering
compare :: Stmt -> Stmt -> Ordering
$c< :: Stmt -> Stmt -> Bool
< :: Stmt -> Stmt -> Bool
$c<= :: Stmt -> Stmt -> Bool
<= :: Stmt -> Stmt -> Bool
$c> :: Stmt -> Stmt -> Bool
> :: Stmt -> Stmt -> Bool
$c>= :: Stmt -> Stmt -> Bool
>= :: Stmt -> Stmt -> Bool
$cmax :: Stmt -> Stmt -> Stmt
max :: Stmt -> Stmt -> Stmt
$cmin :: Stmt -> Stmt -> Stmt
min :: Stmt -> Stmt -> Stmt
Ord, (forall x. Stmt -> Rep Stmt x)
-> (forall x. Rep Stmt x -> Stmt) -> Generic Stmt
forall x. Rep Stmt x -> Stmt
forall x. Stmt -> Rep Stmt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Stmt -> Rep Stmt x
from :: forall x. Stmt -> Rep Stmt x
$cto :: forall x. Rep Stmt x -> Stmt
to :: forall x. Rep Stmt x -> Stmt
Generic, [Stmt] -> Value
[Stmt] -> Encoding
Stmt -> Bool
Stmt -> Value
Stmt -> Encoding
(Stmt -> Value)
-> (Stmt -> Encoding)
-> ([Stmt] -> Value)
-> ([Stmt] -> Encoding)
-> (Stmt -> Bool)
-> ToJSON Stmt
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Stmt -> Value
toJSON :: Stmt -> Value
$ctoEncoding :: Stmt -> Encoding
toEncoding :: Stmt -> Encoding
$ctoJSONList :: [Stmt] -> Value
toJSONList :: [Stmt] -> Value
$ctoEncodingList :: [Stmt] -> Encoding
toEncodingList :: [Stmt] -> Encoding
$comitField :: Stmt -> Bool
omitField :: Stmt -> Bool
ToJSON, Maybe Stmt
Value -> Parser [Stmt]
Value -> Parser Stmt
(Value -> Parser Stmt)
-> (Value -> Parser [Stmt]) -> Maybe Stmt -> FromJSON Stmt
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Stmt
parseJSON :: Value -> Parser Stmt
$cparseJSONList :: Value -> Parser [Stmt]
parseJSONList :: Value -> Parser [Stmt]
$comittedField :: Maybe Stmt
omittedField :: Maybe Stmt
FromJSON )

data Param
   = Param
     {
         Param -> ParamName
paramName :: Token.ParamName,
         Param -> NominalTy
paramNominalType :: Token.NominalTy,
         Param -> Word
paramSerialIdx :: Word -- ^ ( /zero/-based )

     }
     deriving ( Int -> Param -> ShowS
[Param] -> ShowS
Param -> FilePath
(Int -> Param -> ShowS)
-> (Param -> FilePath) -> ([Param] -> ShowS) -> Show Param
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Param -> ShowS
showsPrec :: Int -> Param -> ShowS
$cshow :: Param -> FilePath
show :: Param -> FilePath
$cshowList :: [Param] -> ShowS
showList :: [Param] -> ShowS
Show, Param -> Param -> Bool
(Param -> Param -> Bool) -> (Param -> Param -> Bool) -> Eq Param
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Param -> Param -> Bool
== :: Param -> Param -> Bool
$c/= :: Param -> Param -> Bool
/= :: Param -> Param -> Bool
Eq, Eq Param
Eq Param
-> (Param -> Param -> Ordering)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Param)
-> (Param -> Param -> Param)
-> Ord Param
Param -> Param -> Bool
Param -> Param -> Ordering
Param -> Param -> Param
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
$ccompare :: Param -> Param -> Ordering
compare :: Param -> Param -> Ordering
$c< :: Param -> Param -> Bool
< :: Param -> Param -> Bool
$c<= :: Param -> Param -> Bool
<= :: Param -> Param -> Bool
$c> :: Param -> Param -> Bool
> :: Param -> Param -> Bool
$c>= :: Param -> Param -> Bool
>= :: Param -> Param -> Bool
$cmax :: Param -> Param -> Param
max :: Param -> Param -> Param
$cmin :: Param -> Param -> Param
min :: Param -> Param -> Param
Ord, (forall x. Param -> Rep Param x)
-> (forall x. Rep Param x -> Param) -> Generic Param
forall x. Rep Param x -> Param
forall x. Param -> Rep Param x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Param -> Rep Param x
from :: forall x. Param -> Rep Param x
$cto :: forall x. Rep Param x -> Param
to :: forall x. Rep Param x -> Param
Generic, [Param] -> Value
[Param] -> Encoding
Param -> Bool
Param -> Value
Param -> Encoding
(Param -> Value)
-> (Param -> Encoding)
-> ([Param] -> Value)
-> ([Param] -> Encoding)
-> (Param -> Bool)
-> ToJSON Param
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Param -> Value
toJSON :: Param -> Value
$ctoEncoding :: Param -> Encoding
toEncoding :: Param -> Encoding
$ctoJSONList :: [Param] -> Value
toJSONList :: [Param] -> Value
$ctoEncodingList :: [Param] -> Encoding
toEncodingList :: [Param] -> Encoding
$comitField :: Param -> Bool
omitField :: Param -> Bool
ToJSON, Maybe Param
Value -> Parser [Param]
Value -> Parser Param
(Value -> Parser Param)
-> (Value -> Parser [Param]) -> Maybe Param -> FromJSON Param
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Param
parseJSON :: Value -> Parser Param
$cparseJSONList :: Value -> Parser [Param]
parseJSONList :: Value -> Parser [Param]
$comittedField :: Maybe Param
omittedField :: Maybe Param
FromJSON )

data DataMember
   = DataMember
     {
         DataMember -> MembrName
dataMemberName :: Token.MembrName,
         DataMember -> NominalTy
dataMemberNominalType :: Token.NominalTy,
         DataMember -> Maybe Exp
dataMemberInitValue :: Maybe Exp
     }
     deriving ( Int -> DataMember -> ShowS
[DataMember] -> ShowS
DataMember -> FilePath
(Int -> DataMember -> ShowS)
-> (DataMember -> FilePath)
-> ([DataMember] -> ShowS)
-> Show DataMember
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataMember -> ShowS
showsPrec :: Int -> DataMember -> ShowS
$cshow :: DataMember -> FilePath
show :: DataMember -> FilePath
$cshowList :: [DataMember] -> ShowS
showList :: [DataMember] -> ShowS
Show, DataMember -> DataMember -> Bool
(DataMember -> DataMember -> Bool)
-> (DataMember -> DataMember -> Bool) -> Eq DataMember
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataMember -> DataMember -> Bool
== :: DataMember -> DataMember -> Bool
$c/= :: DataMember -> DataMember -> Bool
/= :: DataMember -> DataMember -> Bool
Eq, Eq DataMember
Eq DataMember
-> (DataMember -> DataMember -> Ordering)
-> (DataMember -> DataMember -> Bool)
-> (DataMember -> DataMember -> Bool)
-> (DataMember -> DataMember -> Bool)
-> (DataMember -> DataMember -> Bool)
-> (DataMember -> DataMember -> DataMember)
-> (DataMember -> DataMember -> DataMember)
-> Ord DataMember
DataMember -> DataMember -> Bool
DataMember -> DataMember -> Ordering
DataMember -> DataMember -> DataMember
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
$ccompare :: DataMember -> DataMember -> Ordering
compare :: DataMember -> DataMember -> Ordering
$c< :: DataMember -> DataMember -> Bool
< :: DataMember -> DataMember -> Bool
$c<= :: DataMember -> DataMember -> Bool
<= :: DataMember -> DataMember -> Bool
$c> :: DataMember -> DataMember -> Bool
> :: DataMember -> DataMember -> Bool
$c>= :: DataMember -> DataMember -> Bool
>= :: DataMember -> DataMember -> Bool
$cmax :: DataMember -> DataMember -> DataMember
max :: DataMember -> DataMember -> DataMember
$cmin :: DataMember -> DataMember -> DataMember
min :: DataMember -> DataMember -> DataMember
Ord, (forall x. DataMember -> Rep DataMember x)
-> (forall x. Rep DataMember x -> DataMember) -> Generic DataMember
forall x. Rep DataMember x -> DataMember
forall x. DataMember -> Rep DataMember x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DataMember -> Rep DataMember x
from :: forall x. DataMember -> Rep DataMember x
$cto :: forall x. Rep DataMember x -> DataMember
to :: forall x. Rep DataMember x -> DataMember
Generic, [DataMember] -> Value
[DataMember] -> Encoding
DataMember -> Bool
DataMember -> Value
DataMember -> Encoding
(DataMember -> Value)
-> (DataMember -> Encoding)
-> ([DataMember] -> Value)
-> ([DataMember] -> Encoding)
-> (DataMember -> Bool)
-> ToJSON DataMember
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DataMember -> Value
toJSON :: DataMember -> Value
$ctoEncoding :: DataMember -> Encoding
toEncoding :: DataMember -> Encoding
$ctoJSONList :: [DataMember] -> Value
toJSONList :: [DataMember] -> Value
$ctoEncodingList :: [DataMember] -> Encoding
toEncodingList :: [DataMember] -> Encoding
$comitField :: DataMember -> Bool
omitField :: DataMember -> Bool
ToJSON, Maybe DataMember
Value -> Parser [DataMember]
Value -> Parser DataMember
(Value -> Parser DataMember)
-> (Value -> Parser [DataMember])
-> Maybe DataMember
-> FromJSON DataMember
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DataMember
parseJSON :: Value -> Parser DataMember
$cparseJSONList :: Value -> Parser [DataMember]
parseJSONList :: Value -> Parser [DataMember]
$comittedField :: Maybe DataMember
omittedField :: Maybe DataMember
FromJSON )

data DataMembers
   = DataMembers
     {
         DataMembers -> Map MembrName DataMember
actualDataMembers :: Map Token.MembrName DataMember
     }
     deriving ( Int -> DataMembers -> ShowS
[DataMembers] -> ShowS
DataMembers -> FilePath
(Int -> DataMembers -> ShowS)
-> (DataMembers -> FilePath)
-> ([DataMembers] -> ShowS)
-> Show DataMembers
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataMembers -> ShowS
showsPrec :: Int -> DataMembers -> ShowS
$cshow :: DataMembers -> FilePath
show :: DataMembers -> FilePath
$cshowList :: [DataMembers] -> ShowS
showList :: [DataMembers] -> ShowS
Show, DataMembers -> DataMembers -> Bool
(DataMembers -> DataMembers -> Bool)
-> (DataMembers -> DataMembers -> Bool) -> Eq DataMembers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataMembers -> DataMembers -> Bool
== :: DataMembers -> DataMembers -> Bool
$c/= :: DataMembers -> DataMembers -> Bool
/= :: DataMembers -> DataMembers -> Bool
Eq, Eq DataMembers
Eq DataMembers
-> (DataMembers -> DataMembers -> Ordering)
-> (DataMembers -> DataMembers -> Bool)
-> (DataMembers -> DataMembers -> Bool)
-> (DataMembers -> DataMembers -> Bool)
-> (DataMembers -> DataMembers -> Bool)
-> (DataMembers -> DataMembers -> DataMembers)
-> (DataMembers -> DataMembers -> DataMembers)
-> Ord DataMembers
DataMembers -> DataMembers -> Bool
DataMembers -> DataMembers -> Ordering
DataMembers -> DataMembers -> DataMembers
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
$ccompare :: DataMembers -> DataMembers -> Ordering
compare :: DataMembers -> DataMembers -> Ordering
$c< :: DataMembers -> DataMembers -> Bool
< :: DataMembers -> DataMembers -> Bool
$c<= :: DataMembers -> DataMembers -> Bool
<= :: DataMembers -> DataMembers -> Bool
$c> :: DataMembers -> DataMembers -> Bool
> :: DataMembers -> DataMembers -> Bool
$c>= :: DataMembers -> DataMembers -> Bool
>= :: DataMembers -> DataMembers -> Bool
$cmax :: DataMembers -> DataMembers -> DataMembers
max :: DataMembers -> DataMembers -> DataMembers
$cmin :: DataMembers -> DataMembers -> DataMembers
min :: DataMembers -> DataMembers -> DataMembers
Ord, (forall x. DataMembers -> Rep DataMembers x)
-> (forall x. Rep DataMembers x -> DataMembers)
-> Generic DataMembers
forall x. Rep DataMembers x -> DataMembers
forall x. DataMembers -> Rep DataMembers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DataMembers -> Rep DataMembers x
from :: forall x. DataMembers -> Rep DataMembers x
$cto :: forall x. Rep DataMembers x -> DataMembers
to :: forall x. Rep DataMembers x -> DataMembers
Generic, [DataMembers] -> Value
[DataMembers] -> Encoding
DataMembers -> Bool
DataMembers -> Value
DataMembers -> Encoding
(DataMembers -> Value)
-> (DataMembers -> Encoding)
-> ([DataMembers] -> Value)
-> ([DataMembers] -> Encoding)
-> (DataMembers -> Bool)
-> ToJSON DataMembers
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DataMembers -> Value
toJSON :: DataMembers -> Value
$ctoEncoding :: DataMembers -> Encoding
toEncoding :: DataMembers -> Encoding
$ctoJSONList :: [DataMembers] -> Value
toJSONList :: [DataMembers] -> Value
$ctoEncodingList :: [DataMembers] -> Encoding
toEncodingList :: [DataMembers] -> Encoding
$comitField :: DataMembers -> Bool
omitField :: DataMembers -> Bool
ToJSON, Maybe DataMembers
Value -> Parser [DataMembers]
Value -> Parser DataMembers
(Value -> Parser DataMembers)
-> (Value -> Parser [DataMembers])
-> Maybe DataMembers
-> FromJSON DataMembers
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DataMembers
parseJSON :: Value -> Parser DataMembers
$cparseJSONList :: Value -> Parser [DataMembers]
parseJSONList :: Value -> Parser [DataMembers]
$comittedField :: Maybe DataMembers
omittedField :: Maybe DataMembers
FromJSON )

data StmtMethodContent
   = StmtMethodContent
     {
         StmtMethodContent -> NominalTy
stmtMethodReturnType :: Token.NominalTy,
         StmtMethodContent -> MethdName
stmtMethodName :: Token.MethdName,
         StmtMethodContent -> [Param]
stmtMethodParams :: [ Param ],
         StmtMethodContent -> [Stmt]
stmtMethodBody :: [ Stmt ],
         StmtMethodContent -> Location
stmtMethodLocation :: Location,
         StmtMethodContent -> ClassName
hostingClassName :: Token.ClassName,
         StmtMethodContent -> [SuperName]
hostingClassSupers :: [ Token.SuperName ]
     }
     deriving ( Int -> StmtMethodContent -> ShowS
[StmtMethodContent] -> ShowS
StmtMethodContent -> FilePath
(Int -> StmtMethodContent -> ShowS)
-> (StmtMethodContent -> FilePath)
-> ([StmtMethodContent] -> ShowS)
-> Show StmtMethodContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtMethodContent -> ShowS
showsPrec :: Int -> StmtMethodContent -> ShowS
$cshow :: StmtMethodContent -> FilePath
show :: StmtMethodContent -> FilePath
$cshowList :: [StmtMethodContent] -> ShowS
showList :: [StmtMethodContent] -> ShowS
Show, StmtMethodContent -> StmtMethodContent -> Bool
(StmtMethodContent -> StmtMethodContent -> Bool)
-> (StmtMethodContent -> StmtMethodContent -> Bool)
-> Eq StmtMethodContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtMethodContent -> StmtMethodContent -> Bool
== :: StmtMethodContent -> StmtMethodContent -> Bool
$c/= :: StmtMethodContent -> StmtMethodContent -> Bool
/= :: StmtMethodContent -> StmtMethodContent -> Bool
Eq, Eq StmtMethodContent
Eq StmtMethodContent
-> (StmtMethodContent -> StmtMethodContent -> Ordering)
-> (StmtMethodContent -> StmtMethodContent -> Bool)
-> (StmtMethodContent -> StmtMethodContent -> Bool)
-> (StmtMethodContent -> StmtMethodContent -> Bool)
-> (StmtMethodContent -> StmtMethodContent -> Bool)
-> (StmtMethodContent -> StmtMethodContent -> StmtMethodContent)
-> (StmtMethodContent -> StmtMethodContent -> StmtMethodContent)
-> Ord StmtMethodContent
StmtMethodContent -> StmtMethodContent -> Bool
StmtMethodContent -> StmtMethodContent -> Ordering
StmtMethodContent -> StmtMethodContent -> StmtMethodContent
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
$ccompare :: StmtMethodContent -> StmtMethodContent -> Ordering
compare :: StmtMethodContent -> StmtMethodContent -> Ordering
$c< :: StmtMethodContent -> StmtMethodContent -> Bool
< :: StmtMethodContent -> StmtMethodContent -> Bool
$c<= :: StmtMethodContent -> StmtMethodContent -> Bool
<= :: StmtMethodContent -> StmtMethodContent -> Bool
$c> :: StmtMethodContent -> StmtMethodContent -> Bool
> :: StmtMethodContent -> StmtMethodContent -> Bool
$c>= :: StmtMethodContent -> StmtMethodContent -> Bool
>= :: StmtMethodContent -> StmtMethodContent -> Bool
$cmax :: StmtMethodContent -> StmtMethodContent -> StmtMethodContent
max :: StmtMethodContent -> StmtMethodContent -> StmtMethodContent
$cmin :: StmtMethodContent -> StmtMethodContent -> StmtMethodContent
min :: StmtMethodContent -> StmtMethodContent -> StmtMethodContent
Ord, (forall x. StmtMethodContent -> Rep StmtMethodContent x)
-> (forall x. Rep StmtMethodContent x -> StmtMethodContent)
-> Generic StmtMethodContent
forall x. Rep StmtMethodContent x -> StmtMethodContent
forall x. StmtMethodContent -> Rep StmtMethodContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StmtMethodContent -> Rep StmtMethodContent x
from :: forall x. StmtMethodContent -> Rep StmtMethodContent x
$cto :: forall x. Rep StmtMethodContent x -> StmtMethodContent
to :: forall x. Rep StmtMethodContent x -> StmtMethodContent
Generic, [StmtMethodContent] -> Value
[StmtMethodContent] -> Encoding
StmtMethodContent -> Bool
StmtMethodContent -> Value
StmtMethodContent -> Encoding
(StmtMethodContent -> Value)
-> (StmtMethodContent -> Encoding)
-> ([StmtMethodContent] -> Value)
-> ([StmtMethodContent] -> Encoding)
-> (StmtMethodContent -> Bool)
-> ToJSON StmtMethodContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StmtMethodContent -> Value
toJSON :: StmtMethodContent -> Value
$ctoEncoding :: StmtMethodContent -> Encoding
toEncoding :: StmtMethodContent -> Encoding
$ctoJSONList :: [StmtMethodContent] -> Value
toJSONList :: [StmtMethodContent] -> Value
$ctoEncodingList :: [StmtMethodContent] -> Encoding
toEncodingList :: [StmtMethodContent] -> Encoding
$comitField :: StmtMethodContent -> Bool
omitField :: StmtMethodContent -> Bool
ToJSON, Maybe StmtMethodContent
Value -> Parser [StmtMethodContent]
Value -> Parser StmtMethodContent
(Value -> Parser StmtMethodContent)
-> (Value -> Parser [StmtMethodContent])
-> Maybe StmtMethodContent
-> FromJSON StmtMethodContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StmtMethodContent
parseJSON :: Value -> Parser StmtMethodContent
$cparseJSONList :: Value -> Parser [StmtMethodContent]
parseJSONList :: Value -> Parser [StmtMethodContent]
$comittedField :: Maybe StmtMethodContent
omittedField :: Maybe StmtMethodContent
FromJSON )

data Methods
   = Methods
     {
         Methods -> Map MethdName StmtMethodContent
actualMethods :: Map Token.MethdName StmtMethodContent
     }
     deriving ( Int -> Methods -> ShowS
[Methods] -> ShowS
Methods -> FilePath
(Int -> Methods -> ShowS)
-> (Methods -> FilePath) -> ([Methods] -> ShowS) -> Show Methods
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Methods -> ShowS
showsPrec :: Int -> Methods -> ShowS
$cshow :: Methods -> FilePath
show :: Methods -> FilePath
$cshowList :: [Methods] -> ShowS
showList :: [Methods] -> ShowS
Show, Methods -> Methods -> Bool
(Methods -> Methods -> Bool)
-> (Methods -> Methods -> Bool) -> Eq Methods
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Methods -> Methods -> Bool
== :: Methods -> Methods -> Bool
$c/= :: Methods -> Methods -> Bool
/= :: Methods -> Methods -> Bool
Eq, Eq Methods
Eq Methods
-> (Methods -> Methods -> Ordering)
-> (Methods -> Methods -> Bool)
-> (Methods -> Methods -> Bool)
-> (Methods -> Methods -> Bool)
-> (Methods -> Methods -> Bool)
-> (Methods -> Methods -> Methods)
-> (Methods -> Methods -> Methods)
-> Ord Methods
Methods -> Methods -> Bool
Methods -> Methods -> Ordering
Methods -> Methods -> Methods
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
$ccompare :: Methods -> Methods -> Ordering
compare :: Methods -> Methods -> Ordering
$c< :: Methods -> Methods -> Bool
< :: Methods -> Methods -> Bool
$c<= :: Methods -> Methods -> Bool
<= :: Methods -> Methods -> Bool
$c> :: Methods -> Methods -> Bool
> :: Methods -> Methods -> Bool
$c>= :: Methods -> Methods -> Bool
>= :: Methods -> Methods -> Bool
$cmax :: Methods -> Methods -> Methods
max :: Methods -> Methods -> Methods
$cmin :: Methods -> Methods -> Methods
min :: Methods -> Methods -> Methods
Ord, (forall x. Methods -> Rep Methods x)
-> (forall x. Rep Methods x -> Methods) -> Generic Methods
forall x. Rep Methods x -> Methods
forall x. Methods -> Rep Methods x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Methods -> Rep Methods x
from :: forall x. Methods -> Rep Methods x
$cto :: forall x. Rep Methods x -> Methods
to :: forall x. Rep Methods x -> Methods
Generic, [Methods] -> Value
[Methods] -> Encoding
Methods -> Bool
Methods -> Value
Methods -> Encoding
(Methods -> Value)
-> (Methods -> Encoding)
-> ([Methods] -> Value)
-> ([Methods] -> Encoding)
-> (Methods -> Bool)
-> ToJSON Methods
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Methods -> Value
toJSON :: Methods -> Value
$ctoEncoding :: Methods -> Encoding
toEncoding :: Methods -> Encoding
$ctoJSONList :: [Methods] -> Value
toJSONList :: [Methods] -> Value
$ctoEncodingList :: [Methods] -> Encoding
toEncodingList :: [Methods] -> Encoding
$comitField :: Methods -> Bool
omitField :: Methods -> Bool
ToJSON, Maybe Methods
Value -> Parser [Methods]
Value -> Parser Methods
(Value -> Parser Methods)
-> (Value -> Parser [Methods]) -> Maybe Methods -> FromJSON Methods
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Methods
parseJSON :: Value -> Parser Methods
$cparseJSONList :: Value -> Parser [Methods]
parseJSONList :: Value -> Parser [Methods]
$comittedField :: Maybe Methods
omittedField :: Maybe Methods
FromJSON )

data StmtClassContent
   = StmtClassContent
     {
         StmtClassContent -> ClassName
stmtClassName :: Token.ClassName,
         StmtClassContent -> [SuperName]
stmtClassSupers :: [ Token.SuperName ],
         StmtClassContent -> DataMembers
stmtClassDataMembers :: DataMembers,
         StmtClassContent -> Methods
stmtClassMethods :: Methods
     }
     deriving ( Int -> StmtClassContent -> ShowS
[StmtClassContent] -> ShowS
StmtClassContent -> FilePath
(Int -> StmtClassContent -> ShowS)
-> (StmtClassContent -> FilePath)
-> ([StmtClassContent] -> ShowS)
-> Show StmtClassContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtClassContent -> ShowS
showsPrec :: Int -> StmtClassContent -> ShowS
$cshow :: StmtClassContent -> FilePath
show :: StmtClassContent -> FilePath
$cshowList :: [StmtClassContent] -> ShowS
showList :: [StmtClassContent] -> ShowS
Show, StmtClassContent -> StmtClassContent -> Bool
(StmtClassContent -> StmtClassContent -> Bool)
-> (StmtClassContent -> StmtClassContent -> Bool)
-> Eq StmtClassContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtClassContent -> StmtClassContent -> Bool
== :: StmtClassContent -> StmtClassContent -> Bool
$c/= :: StmtClassContent -> StmtClassContent -> Bool
/= :: StmtClassContent -> StmtClassContent -> Bool
Eq, Eq StmtClassContent
Eq StmtClassContent
-> (StmtClassContent -> StmtClassContent -> Ordering)
-> (StmtClassContent -> StmtClassContent -> Bool)
-> (StmtClassContent -> StmtClassContent -> Bool)
-> (StmtClassContent -> StmtClassContent -> Bool)
-> (StmtClassContent -> StmtClassContent -> Bool)
-> (StmtClassContent -> StmtClassContent -> StmtClassContent)
-> (StmtClassContent -> StmtClassContent -> StmtClassContent)
-> Ord StmtClassContent
StmtClassContent -> StmtClassContent -> Bool
StmtClassContent -> StmtClassContent -> Ordering
StmtClassContent -> StmtClassContent -> StmtClassContent
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
$ccompare :: StmtClassContent -> StmtClassContent -> Ordering
compare :: StmtClassContent -> StmtClassContent -> Ordering
$c< :: StmtClassContent -> StmtClassContent -> Bool
< :: StmtClassContent -> StmtClassContent -> Bool
$c<= :: StmtClassContent -> StmtClassContent -> Bool
<= :: StmtClassContent -> StmtClassContent -> Bool
$c> :: StmtClassContent -> StmtClassContent -> Bool
> :: StmtClassContent -> StmtClassContent -> Bool
$c>= :: StmtClassContent -> StmtClassContent -> Bool
>= :: StmtClassContent -> StmtClassContent -> Bool
$cmax :: StmtClassContent -> StmtClassContent -> StmtClassContent
max :: StmtClassContent -> StmtClassContent -> StmtClassContent
$cmin :: StmtClassContent -> StmtClassContent -> StmtClassContent
min :: StmtClassContent -> StmtClassContent -> StmtClassContent
Ord, (forall x. StmtClassContent -> Rep StmtClassContent x)
-> (forall x. Rep StmtClassContent x -> StmtClassContent)
-> Generic StmtClassContent
forall x. Rep StmtClassContent x -> StmtClassContent
forall x. StmtClassContent -> Rep StmtClassContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StmtClassContent -> Rep StmtClassContent x
from :: forall x. StmtClassContent -> Rep StmtClassContent x
$cto :: forall x. Rep StmtClassContent x -> StmtClassContent
to :: forall x. Rep StmtClassContent x -> StmtClassContent
Generic, [StmtClassContent] -> Value
[StmtClassContent] -> Encoding
StmtClassContent -> Bool
StmtClassContent -> Value
StmtClassContent -> Encoding
(StmtClassContent -> Value)
-> (StmtClassContent -> Encoding)
-> ([StmtClassContent] -> Value)
-> ([StmtClassContent] -> Encoding)
-> (StmtClassContent -> Bool)
-> ToJSON StmtClassContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StmtClassContent -> Value
toJSON :: StmtClassContent -> Value
$ctoEncoding :: StmtClassContent -> Encoding
toEncoding :: StmtClassContent -> Encoding
$ctoJSONList :: [StmtClassContent] -> Value
toJSONList :: [StmtClassContent] -> Value
$ctoEncodingList :: [StmtClassContent] -> Encoding
toEncodingList :: [StmtClassContent] -> Encoding
$comitField :: StmtClassContent -> Bool
omitField :: StmtClassContent -> Bool
ToJSON, Maybe StmtClassContent
Value -> Parser [StmtClassContent]
Value -> Parser StmtClassContent
(Value -> Parser StmtClassContent)
-> (Value -> Parser [StmtClassContent])
-> Maybe StmtClassContent
-> FromJSON StmtClassContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StmtClassContent
parseJSON :: Value -> Parser StmtClassContent
$cparseJSONList :: Value -> Parser [StmtClassContent]
parseJSONList :: Value -> Parser [StmtClassContent]
$comittedField :: Maybe StmtClassContent
omittedField :: Maybe StmtClassContent
FromJSON )

data StmtFuncContent
   = StmtFuncContent
     {
         StmtFuncContent -> NominalTy
stmtFuncReturnType :: Token.NominalTy,
         StmtFuncContent -> FuncName
stmtFuncName :: Token.FuncName,
         StmtFuncContent -> [Param]
stmtFuncParams :: [ Param ],
         StmtFuncContent -> [Stmt]
stmtFuncBody :: [ Stmt ],
         StmtFuncContent -> [Exp]
stmtFuncAnnotations :: [ Exp ],
         StmtFuncContent -> Location
stmtFuncLocation :: Location
     }
     deriving ( Int -> StmtFuncContent -> ShowS
[StmtFuncContent] -> ShowS
StmtFuncContent -> FilePath
(Int -> StmtFuncContent -> ShowS)
-> (StmtFuncContent -> FilePath)
-> ([StmtFuncContent] -> ShowS)
-> Show StmtFuncContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtFuncContent -> ShowS
showsPrec :: Int -> StmtFuncContent -> ShowS
$cshow :: StmtFuncContent -> FilePath
show :: StmtFuncContent -> FilePath
$cshowList :: [StmtFuncContent] -> ShowS
showList :: [StmtFuncContent] -> ShowS
Show, StmtFuncContent -> StmtFuncContent -> Bool
(StmtFuncContent -> StmtFuncContent -> Bool)
-> (StmtFuncContent -> StmtFuncContent -> Bool)
-> Eq StmtFuncContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtFuncContent -> StmtFuncContent -> Bool
== :: StmtFuncContent -> StmtFuncContent -> Bool
$c/= :: StmtFuncContent -> StmtFuncContent -> Bool
/= :: StmtFuncContent -> StmtFuncContent -> Bool
Eq, Eq StmtFuncContent
Eq StmtFuncContent
-> (StmtFuncContent -> StmtFuncContent -> Ordering)
-> (StmtFuncContent -> StmtFuncContent -> Bool)
-> (StmtFuncContent -> StmtFuncContent -> Bool)
-> (StmtFuncContent -> StmtFuncContent -> Bool)
-> (StmtFuncContent -> StmtFuncContent -> Bool)
-> (StmtFuncContent -> StmtFuncContent -> StmtFuncContent)
-> (StmtFuncContent -> StmtFuncContent -> StmtFuncContent)
-> Ord StmtFuncContent
StmtFuncContent -> StmtFuncContent -> Bool
StmtFuncContent -> StmtFuncContent -> Ordering
StmtFuncContent -> StmtFuncContent -> StmtFuncContent
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
$ccompare :: StmtFuncContent -> StmtFuncContent -> Ordering
compare :: StmtFuncContent -> StmtFuncContent -> Ordering
$c< :: StmtFuncContent -> StmtFuncContent -> Bool
< :: StmtFuncContent -> StmtFuncContent -> Bool
$c<= :: StmtFuncContent -> StmtFuncContent -> Bool
<= :: StmtFuncContent -> StmtFuncContent -> Bool
$c> :: StmtFuncContent -> StmtFuncContent -> Bool
> :: StmtFuncContent -> StmtFuncContent -> Bool
$c>= :: StmtFuncContent -> StmtFuncContent -> Bool
>= :: StmtFuncContent -> StmtFuncContent -> Bool
$cmax :: StmtFuncContent -> StmtFuncContent -> StmtFuncContent
max :: StmtFuncContent -> StmtFuncContent -> StmtFuncContent
$cmin :: StmtFuncContent -> StmtFuncContent -> StmtFuncContent
min :: StmtFuncContent -> StmtFuncContent -> StmtFuncContent
Ord, (forall x. StmtFuncContent -> Rep StmtFuncContent x)
-> (forall x. Rep StmtFuncContent x -> StmtFuncContent)
-> Generic StmtFuncContent
forall x. Rep StmtFuncContent x -> StmtFuncContent
forall x. StmtFuncContent -> Rep StmtFuncContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StmtFuncContent -> Rep StmtFuncContent x
from :: forall x. StmtFuncContent -> Rep StmtFuncContent x
$cto :: forall x. Rep StmtFuncContent x -> StmtFuncContent
to :: forall x. Rep StmtFuncContent x -> StmtFuncContent
Generic, [StmtFuncContent] -> Value
[StmtFuncContent] -> Encoding
StmtFuncContent -> Bool
StmtFuncContent -> Value
StmtFuncContent -> Encoding
(StmtFuncContent -> Value)
-> (StmtFuncContent -> Encoding)
-> ([StmtFuncContent] -> Value)
-> ([StmtFuncContent] -> Encoding)
-> (StmtFuncContent -> Bool)
-> ToJSON StmtFuncContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StmtFuncContent -> Value
toJSON :: StmtFuncContent -> Value
$ctoEncoding :: StmtFuncContent -> Encoding
toEncoding :: StmtFuncContent -> Encoding
$ctoJSONList :: [StmtFuncContent] -> Value
toJSONList :: [StmtFuncContent] -> Value
$ctoEncodingList :: [StmtFuncContent] -> Encoding
toEncodingList :: [StmtFuncContent] -> Encoding
$comitField :: StmtFuncContent -> Bool
omitField :: StmtFuncContent -> Bool
ToJSON, Maybe StmtFuncContent
Value -> Parser [StmtFuncContent]
Value -> Parser StmtFuncContent
(Value -> Parser StmtFuncContent)
-> (Value -> Parser [StmtFuncContent])
-> Maybe StmtFuncContent
-> FromJSON StmtFuncContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StmtFuncContent
parseJSON :: Value -> Parser StmtFuncContent
$cparseJSONList :: Value -> Parser [StmtFuncContent]
parseJSONList :: Value -> Parser [StmtFuncContent]
$comittedField :: Maybe StmtFuncContent
omittedField :: Maybe StmtFuncContent
FromJSON )

data DecPackageContent
   = DecPackageContent
     {
         DecPackageContent -> PkgName
decPackageName :: Token.PkgName
     }
     deriving ( Int -> DecPackageContent -> ShowS
[DecPackageContent] -> ShowS
DecPackageContent -> FilePath
(Int -> DecPackageContent -> ShowS)
-> (DecPackageContent -> FilePath)
-> ([DecPackageContent] -> ShowS)
-> Show DecPackageContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecPackageContent -> ShowS
showsPrec :: Int -> DecPackageContent -> ShowS
$cshow :: DecPackageContent -> FilePath
show :: DecPackageContent -> FilePath
$cshowList :: [DecPackageContent] -> ShowS
showList :: [DecPackageContent] -> ShowS
Show, DecPackageContent -> DecPackageContent -> Bool
(DecPackageContent -> DecPackageContent -> Bool)
-> (DecPackageContent -> DecPackageContent -> Bool)
-> Eq DecPackageContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecPackageContent -> DecPackageContent -> Bool
== :: DecPackageContent -> DecPackageContent -> Bool
$c/= :: DecPackageContent -> DecPackageContent -> Bool
/= :: DecPackageContent -> DecPackageContent -> Bool
Eq, Eq DecPackageContent
Eq DecPackageContent
-> (DecPackageContent -> DecPackageContent -> Ordering)
-> (DecPackageContent -> DecPackageContent -> Bool)
-> (DecPackageContent -> DecPackageContent -> Bool)
-> (DecPackageContent -> DecPackageContent -> Bool)
-> (DecPackageContent -> DecPackageContent -> Bool)
-> (DecPackageContent -> DecPackageContent -> DecPackageContent)
-> (DecPackageContent -> DecPackageContent -> DecPackageContent)
-> Ord DecPackageContent
DecPackageContent -> DecPackageContent -> Bool
DecPackageContent -> DecPackageContent -> Ordering
DecPackageContent -> DecPackageContent -> DecPackageContent
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
$ccompare :: DecPackageContent -> DecPackageContent -> Ordering
compare :: DecPackageContent -> DecPackageContent -> Ordering
$c< :: DecPackageContent -> DecPackageContent -> Bool
< :: DecPackageContent -> DecPackageContent -> Bool
$c<= :: DecPackageContent -> DecPackageContent -> Bool
<= :: DecPackageContent -> DecPackageContent -> Bool
$c> :: DecPackageContent -> DecPackageContent -> Bool
> :: DecPackageContent -> DecPackageContent -> Bool
$c>= :: DecPackageContent -> DecPackageContent -> Bool
>= :: DecPackageContent -> DecPackageContent -> Bool
$cmax :: DecPackageContent -> DecPackageContent -> DecPackageContent
max :: DecPackageContent -> DecPackageContent -> DecPackageContent
$cmin :: DecPackageContent -> DecPackageContent -> DecPackageContent
min :: DecPackageContent -> DecPackageContent -> DecPackageContent
Ord, (forall x. DecPackageContent -> Rep DecPackageContent x)
-> (forall x. Rep DecPackageContent x -> DecPackageContent)
-> Generic DecPackageContent
forall x. Rep DecPackageContent x -> DecPackageContent
forall x. DecPackageContent -> Rep DecPackageContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DecPackageContent -> Rep DecPackageContent x
from :: forall x. DecPackageContent -> Rep DecPackageContent x
$cto :: forall x. Rep DecPackageContent x -> DecPackageContent
to :: forall x. Rep DecPackageContent x -> DecPackageContent
Generic, [DecPackageContent] -> Value
[DecPackageContent] -> Encoding
DecPackageContent -> Bool
DecPackageContent -> Value
DecPackageContent -> Encoding
(DecPackageContent -> Value)
-> (DecPackageContent -> Encoding)
-> ([DecPackageContent] -> Value)
-> ([DecPackageContent] -> Encoding)
-> (DecPackageContent -> Bool)
-> ToJSON DecPackageContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DecPackageContent -> Value
toJSON :: DecPackageContent -> Value
$ctoEncoding :: DecPackageContent -> Encoding
toEncoding :: DecPackageContent -> Encoding
$ctoJSONList :: [DecPackageContent] -> Value
toJSONList :: [DecPackageContent] -> Value
$ctoEncodingList :: [DecPackageContent] -> Encoding
toEncodingList :: [DecPackageContent] -> Encoding
$comitField :: DecPackageContent -> Bool
omitField :: DecPackageContent -> Bool
ToJSON, Maybe DecPackageContent
Value -> Parser [DecPackageContent]
Value -> Parser DecPackageContent
(Value -> Parser DecPackageContent)
-> (Value -> Parser [DecPackageContent])
-> Maybe DecPackageContent
-> FromJSON DecPackageContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DecPackageContent
parseJSON :: Value -> Parser DecPackageContent
$cparseJSONList :: Value -> Parser [DecPackageContent]
parseJSONList :: Value -> Parser [DecPackageContent]
$comittedField :: Maybe DecPackageContent
omittedField :: Maybe DecPackageContent
FromJSON )

data DecVarContent
   = DecVarContent
     {
         DecVarContent -> VarName
decVarName :: Token.VarName,
         DecVarContent -> NominalTy
decVarNominalType :: Token.NominalTy,
         DecVarContent -> Maybe Exp
decVarInitValue :: Maybe Exp
     }
     deriving ( Int -> DecVarContent -> ShowS
[DecVarContent] -> ShowS
DecVarContent -> FilePath
(Int -> DecVarContent -> ShowS)
-> (DecVarContent -> FilePath)
-> ([DecVarContent] -> ShowS)
-> Show DecVarContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecVarContent -> ShowS
showsPrec :: Int -> DecVarContent -> ShowS
$cshow :: DecVarContent -> FilePath
show :: DecVarContent -> FilePath
$cshowList :: [DecVarContent] -> ShowS
showList :: [DecVarContent] -> ShowS
Show, DecVarContent -> DecVarContent -> Bool
(DecVarContent -> DecVarContent -> Bool)
-> (DecVarContent -> DecVarContent -> Bool) -> Eq DecVarContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecVarContent -> DecVarContent -> Bool
== :: DecVarContent -> DecVarContent -> Bool
$c/= :: DecVarContent -> DecVarContent -> Bool
/= :: DecVarContent -> DecVarContent -> Bool
Eq, Eq DecVarContent
Eq DecVarContent
-> (DecVarContent -> DecVarContent -> Ordering)
-> (DecVarContent -> DecVarContent -> Bool)
-> (DecVarContent -> DecVarContent -> Bool)
-> (DecVarContent -> DecVarContent -> Bool)
-> (DecVarContent -> DecVarContent -> Bool)
-> (DecVarContent -> DecVarContent -> DecVarContent)
-> (DecVarContent -> DecVarContent -> DecVarContent)
-> Ord DecVarContent
DecVarContent -> DecVarContent -> Bool
DecVarContent -> DecVarContent -> Ordering
DecVarContent -> DecVarContent -> DecVarContent
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
$ccompare :: DecVarContent -> DecVarContent -> Ordering
compare :: DecVarContent -> DecVarContent -> Ordering
$c< :: DecVarContent -> DecVarContent -> Bool
< :: DecVarContent -> DecVarContent -> Bool
$c<= :: DecVarContent -> DecVarContent -> Bool
<= :: DecVarContent -> DecVarContent -> Bool
$c> :: DecVarContent -> DecVarContent -> Bool
> :: DecVarContent -> DecVarContent -> Bool
$c>= :: DecVarContent -> DecVarContent -> Bool
>= :: DecVarContent -> DecVarContent -> Bool
$cmax :: DecVarContent -> DecVarContent -> DecVarContent
max :: DecVarContent -> DecVarContent -> DecVarContent
$cmin :: DecVarContent -> DecVarContent -> DecVarContent
min :: DecVarContent -> DecVarContent -> DecVarContent
Ord, (forall x. DecVarContent -> Rep DecVarContent x)
-> (forall x. Rep DecVarContent x -> DecVarContent)
-> Generic DecVarContent
forall x. Rep DecVarContent x -> DecVarContent
forall x. DecVarContent -> Rep DecVarContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DecVarContent -> Rep DecVarContent x
from :: forall x. DecVarContent -> Rep DecVarContent x
$cto :: forall x. Rep DecVarContent x -> DecVarContent
to :: forall x. Rep DecVarContent x -> DecVarContent
Generic, [DecVarContent] -> Value
[DecVarContent] -> Encoding
DecVarContent -> Bool
DecVarContent -> Value
DecVarContent -> Encoding
(DecVarContent -> Value)
-> (DecVarContent -> Encoding)
-> ([DecVarContent] -> Value)
-> ([DecVarContent] -> Encoding)
-> (DecVarContent -> Bool)
-> ToJSON DecVarContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DecVarContent -> Value
toJSON :: DecVarContent -> Value
$ctoEncoding :: DecVarContent -> Encoding
toEncoding :: DecVarContent -> Encoding
$ctoJSONList :: [DecVarContent] -> Value
toJSONList :: [DecVarContent] -> Value
$ctoEncodingList :: [DecVarContent] -> Encoding
toEncodingList :: [DecVarContent] -> Encoding
$comitField :: DecVarContent -> Bool
omitField :: DecVarContent -> Bool
ToJSON, Maybe DecVarContent
Value -> Parser [DecVarContent]
Value -> Parser DecVarContent
(Value -> Parser DecVarContent)
-> (Value -> Parser [DecVarContent])
-> Maybe DecVarContent
-> FromJSON DecVarContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DecVarContent
parseJSON :: Value -> Parser DecVarContent
$cparseJSONList :: Value -> Parser [DecVarContent]
parseJSONList :: Value -> Parser [DecVarContent]
$comittedField :: Maybe DecVarContent
omittedField :: Maybe DecVarContent
FromJSON )

data ExpIntContent
   = ExpIntContent
     {
         ExpIntContent -> ConstInt
expIntValue :: Token.ConstInt
     }
     deriving ( Int -> ExpIntContent -> ShowS
[ExpIntContent] -> ShowS
ExpIntContent -> FilePath
(Int -> ExpIntContent -> ShowS)
-> (ExpIntContent -> FilePath)
-> ([ExpIntContent] -> ShowS)
-> Show ExpIntContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpIntContent -> ShowS
showsPrec :: Int -> ExpIntContent -> ShowS
$cshow :: ExpIntContent -> FilePath
show :: ExpIntContent -> FilePath
$cshowList :: [ExpIntContent] -> ShowS
showList :: [ExpIntContent] -> ShowS
Show, ExpIntContent -> ExpIntContent -> Bool
(ExpIntContent -> ExpIntContent -> Bool)
-> (ExpIntContent -> ExpIntContent -> Bool) -> Eq ExpIntContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpIntContent -> ExpIntContent -> Bool
== :: ExpIntContent -> ExpIntContent -> Bool
$c/= :: ExpIntContent -> ExpIntContent -> Bool
/= :: ExpIntContent -> ExpIntContent -> Bool
Eq, Eq ExpIntContent
Eq ExpIntContent
-> (ExpIntContent -> ExpIntContent -> Ordering)
-> (ExpIntContent -> ExpIntContent -> Bool)
-> (ExpIntContent -> ExpIntContent -> Bool)
-> (ExpIntContent -> ExpIntContent -> Bool)
-> (ExpIntContent -> ExpIntContent -> Bool)
-> (ExpIntContent -> ExpIntContent -> ExpIntContent)
-> (ExpIntContent -> ExpIntContent -> ExpIntContent)
-> Ord ExpIntContent
ExpIntContent -> ExpIntContent -> Bool
ExpIntContent -> ExpIntContent -> Ordering
ExpIntContent -> ExpIntContent -> ExpIntContent
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
$ccompare :: ExpIntContent -> ExpIntContent -> Ordering
compare :: ExpIntContent -> ExpIntContent -> Ordering
$c< :: ExpIntContent -> ExpIntContent -> Bool
< :: ExpIntContent -> ExpIntContent -> Bool
$c<= :: ExpIntContent -> ExpIntContent -> Bool
<= :: ExpIntContent -> ExpIntContent -> Bool
$c> :: ExpIntContent -> ExpIntContent -> Bool
> :: ExpIntContent -> ExpIntContent -> Bool
$c>= :: ExpIntContent -> ExpIntContent -> Bool
>= :: ExpIntContent -> ExpIntContent -> Bool
$cmax :: ExpIntContent -> ExpIntContent -> ExpIntContent
max :: ExpIntContent -> ExpIntContent -> ExpIntContent
$cmin :: ExpIntContent -> ExpIntContent -> ExpIntContent
min :: ExpIntContent -> ExpIntContent -> ExpIntContent
Ord, (forall x. ExpIntContent -> Rep ExpIntContent x)
-> (forall x. Rep ExpIntContent x -> ExpIntContent)
-> Generic ExpIntContent
forall x. Rep ExpIntContent x -> ExpIntContent
forall x. ExpIntContent -> Rep ExpIntContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExpIntContent -> Rep ExpIntContent x
from :: forall x. ExpIntContent -> Rep ExpIntContent x
$cto :: forall x. Rep ExpIntContent x -> ExpIntContent
to :: forall x. Rep ExpIntContent x -> ExpIntContent
Generic, [ExpIntContent] -> Value
[ExpIntContent] -> Encoding
ExpIntContent -> Bool
ExpIntContent -> Value
ExpIntContent -> Encoding
(ExpIntContent -> Value)
-> (ExpIntContent -> Encoding)
-> ([ExpIntContent] -> Value)
-> ([ExpIntContent] -> Encoding)
-> (ExpIntContent -> Bool)
-> ToJSON ExpIntContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExpIntContent -> Value
toJSON :: ExpIntContent -> Value
$ctoEncoding :: ExpIntContent -> Encoding
toEncoding :: ExpIntContent -> Encoding
$ctoJSONList :: [ExpIntContent] -> Value
toJSONList :: [ExpIntContent] -> Value
$ctoEncodingList :: [ExpIntContent] -> Encoding
toEncodingList :: [ExpIntContent] -> Encoding
$comitField :: ExpIntContent -> Bool
omitField :: ExpIntContent -> Bool
ToJSON, Maybe ExpIntContent
Value -> Parser [ExpIntContent]
Value -> Parser ExpIntContent
(Value -> Parser ExpIntContent)
-> (Value -> Parser [ExpIntContent])
-> Maybe ExpIntContent
-> FromJSON ExpIntContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExpIntContent
parseJSON :: Value -> Parser ExpIntContent
$cparseJSONList :: Value -> Parser [ExpIntContent]
parseJSONList :: Value -> Parser [ExpIntContent]
$comittedField :: Maybe ExpIntContent
omittedField :: Maybe ExpIntContent
FromJSON )

data ExpStrContent
   = ExpStrContent
     {
         ExpStrContent -> ConstStr
expStrValue :: Token.ConstStr
     }
     deriving ( Int -> ExpStrContent -> ShowS
[ExpStrContent] -> ShowS
ExpStrContent -> FilePath
(Int -> ExpStrContent -> ShowS)
-> (ExpStrContent -> FilePath)
-> ([ExpStrContent] -> ShowS)
-> Show ExpStrContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpStrContent -> ShowS
showsPrec :: Int -> ExpStrContent -> ShowS
$cshow :: ExpStrContent -> FilePath
show :: ExpStrContent -> FilePath
$cshowList :: [ExpStrContent] -> ShowS
showList :: [ExpStrContent] -> ShowS
Show, ExpStrContent -> ExpStrContent -> Bool
(ExpStrContent -> ExpStrContent -> Bool)
-> (ExpStrContent -> ExpStrContent -> Bool) -> Eq ExpStrContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpStrContent -> ExpStrContent -> Bool
== :: ExpStrContent -> ExpStrContent -> Bool
$c/= :: ExpStrContent -> ExpStrContent -> Bool
/= :: ExpStrContent -> ExpStrContent -> Bool
Eq, Eq ExpStrContent
Eq ExpStrContent
-> (ExpStrContent -> ExpStrContent -> Ordering)
-> (ExpStrContent -> ExpStrContent -> Bool)
-> (ExpStrContent -> ExpStrContent -> Bool)
-> (ExpStrContent -> ExpStrContent -> Bool)
-> (ExpStrContent -> ExpStrContent -> Bool)
-> (ExpStrContent -> ExpStrContent -> ExpStrContent)
-> (ExpStrContent -> ExpStrContent -> ExpStrContent)
-> Ord ExpStrContent
ExpStrContent -> ExpStrContent -> Bool
ExpStrContent -> ExpStrContent -> Ordering
ExpStrContent -> ExpStrContent -> ExpStrContent
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
$ccompare :: ExpStrContent -> ExpStrContent -> Ordering
compare :: ExpStrContent -> ExpStrContent -> Ordering
$c< :: ExpStrContent -> ExpStrContent -> Bool
< :: ExpStrContent -> ExpStrContent -> Bool
$c<= :: ExpStrContent -> ExpStrContent -> Bool
<= :: ExpStrContent -> ExpStrContent -> Bool
$c> :: ExpStrContent -> ExpStrContent -> Bool
> :: ExpStrContent -> ExpStrContent -> Bool
$c>= :: ExpStrContent -> ExpStrContent -> Bool
>= :: ExpStrContent -> ExpStrContent -> Bool
$cmax :: ExpStrContent -> ExpStrContent -> ExpStrContent
max :: ExpStrContent -> ExpStrContent -> ExpStrContent
$cmin :: ExpStrContent -> ExpStrContent -> ExpStrContent
min :: ExpStrContent -> ExpStrContent -> ExpStrContent
Ord, (forall x. ExpStrContent -> Rep ExpStrContent x)
-> (forall x. Rep ExpStrContent x -> ExpStrContent)
-> Generic ExpStrContent
forall x. Rep ExpStrContent x -> ExpStrContent
forall x. ExpStrContent -> Rep ExpStrContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExpStrContent -> Rep ExpStrContent x
from :: forall x. ExpStrContent -> Rep ExpStrContent x
$cto :: forall x. Rep ExpStrContent x -> ExpStrContent
to :: forall x. Rep ExpStrContent x -> ExpStrContent
Generic, [ExpStrContent] -> Value
[ExpStrContent] -> Encoding
ExpStrContent -> Bool
ExpStrContent -> Value
ExpStrContent -> Encoding
(ExpStrContent -> Value)
-> (ExpStrContent -> Encoding)
-> ([ExpStrContent] -> Value)
-> ([ExpStrContent] -> Encoding)
-> (ExpStrContent -> Bool)
-> ToJSON ExpStrContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExpStrContent -> Value
toJSON :: ExpStrContent -> Value
$ctoEncoding :: ExpStrContent -> Encoding
toEncoding :: ExpStrContent -> Encoding
$ctoJSONList :: [ExpStrContent] -> Value
toJSONList :: [ExpStrContent] -> Value
$ctoEncodingList :: [ExpStrContent] -> Encoding
toEncodingList :: [ExpStrContent] -> Encoding
$comitField :: ExpStrContent -> Bool
omitField :: ExpStrContent -> Bool
ToJSON, Maybe ExpStrContent
Value -> Parser [ExpStrContent]
Value -> Parser ExpStrContent
(Value -> Parser ExpStrContent)
-> (Value -> Parser [ExpStrContent])
-> Maybe ExpStrContent
-> FromJSON ExpStrContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExpStrContent
parseJSON :: Value -> Parser ExpStrContent
$cparseJSONList :: Value -> Parser [ExpStrContent]
parseJSONList :: Value -> Parser [ExpStrContent]
$comittedField :: Maybe ExpStrContent
omittedField :: Maybe ExpStrContent
FromJSON )

data ExpBoolContent
   = ExpBoolContent
     {
         ExpBoolContent -> ConstBool
expBoolValue :: Token.ConstBool
     }
     deriving ( Int -> ExpBoolContent -> ShowS
[ExpBoolContent] -> ShowS
ExpBoolContent -> FilePath
(Int -> ExpBoolContent -> ShowS)
-> (ExpBoolContent -> FilePath)
-> ([ExpBoolContent] -> ShowS)
-> Show ExpBoolContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpBoolContent -> ShowS
showsPrec :: Int -> ExpBoolContent -> ShowS
$cshow :: ExpBoolContent -> FilePath
show :: ExpBoolContent -> FilePath
$cshowList :: [ExpBoolContent] -> ShowS
showList :: [ExpBoolContent] -> ShowS
Show, ExpBoolContent -> ExpBoolContent -> Bool
(ExpBoolContent -> ExpBoolContent -> Bool)
-> (ExpBoolContent -> ExpBoolContent -> Bool) -> Eq ExpBoolContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpBoolContent -> ExpBoolContent -> Bool
== :: ExpBoolContent -> ExpBoolContent -> Bool
$c/= :: ExpBoolContent -> ExpBoolContent -> Bool
/= :: ExpBoolContent -> ExpBoolContent -> Bool
Eq, Eq ExpBoolContent
Eq ExpBoolContent
-> (ExpBoolContent -> ExpBoolContent -> Ordering)
-> (ExpBoolContent -> ExpBoolContent -> Bool)
-> (ExpBoolContent -> ExpBoolContent -> Bool)
-> (ExpBoolContent -> ExpBoolContent -> Bool)
-> (ExpBoolContent -> ExpBoolContent -> Bool)
-> (ExpBoolContent -> ExpBoolContent -> ExpBoolContent)
-> (ExpBoolContent -> ExpBoolContent -> ExpBoolContent)
-> Ord ExpBoolContent
ExpBoolContent -> ExpBoolContent -> Bool
ExpBoolContent -> ExpBoolContent -> Ordering
ExpBoolContent -> ExpBoolContent -> ExpBoolContent
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
$ccompare :: ExpBoolContent -> ExpBoolContent -> Ordering
compare :: ExpBoolContent -> ExpBoolContent -> Ordering
$c< :: ExpBoolContent -> ExpBoolContent -> Bool
< :: ExpBoolContent -> ExpBoolContent -> Bool
$c<= :: ExpBoolContent -> ExpBoolContent -> Bool
<= :: ExpBoolContent -> ExpBoolContent -> Bool
$c> :: ExpBoolContent -> ExpBoolContent -> Bool
> :: ExpBoolContent -> ExpBoolContent -> Bool
$c>= :: ExpBoolContent -> ExpBoolContent -> Bool
>= :: ExpBoolContent -> ExpBoolContent -> Bool
$cmax :: ExpBoolContent -> ExpBoolContent -> ExpBoolContent
max :: ExpBoolContent -> ExpBoolContent -> ExpBoolContent
$cmin :: ExpBoolContent -> ExpBoolContent -> ExpBoolContent
min :: ExpBoolContent -> ExpBoolContent -> ExpBoolContent
Ord, (forall x. ExpBoolContent -> Rep ExpBoolContent x)
-> (forall x. Rep ExpBoolContent x -> ExpBoolContent)
-> Generic ExpBoolContent
forall x. Rep ExpBoolContent x -> ExpBoolContent
forall x. ExpBoolContent -> Rep ExpBoolContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExpBoolContent -> Rep ExpBoolContent x
from :: forall x. ExpBoolContent -> Rep ExpBoolContent x
$cto :: forall x. Rep ExpBoolContent x -> ExpBoolContent
to :: forall x. Rep ExpBoolContent x -> ExpBoolContent
Generic, [ExpBoolContent] -> Value
[ExpBoolContent] -> Encoding
ExpBoolContent -> Bool
ExpBoolContent -> Value
ExpBoolContent -> Encoding
(ExpBoolContent -> Value)
-> (ExpBoolContent -> Encoding)
-> ([ExpBoolContent] -> Value)
-> ([ExpBoolContent] -> Encoding)
-> (ExpBoolContent -> Bool)
-> ToJSON ExpBoolContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExpBoolContent -> Value
toJSON :: ExpBoolContent -> Value
$ctoEncoding :: ExpBoolContent -> Encoding
toEncoding :: ExpBoolContent -> Encoding
$ctoJSONList :: [ExpBoolContent] -> Value
toJSONList :: [ExpBoolContent] -> Value
$ctoEncodingList :: [ExpBoolContent] -> Encoding
toEncodingList :: [ExpBoolContent] -> Encoding
$comitField :: ExpBoolContent -> Bool
omitField :: ExpBoolContent -> Bool
ToJSON, Maybe ExpBoolContent
Value -> Parser [ExpBoolContent]
Value -> Parser ExpBoolContent
(Value -> Parser ExpBoolContent)
-> (Value -> Parser [ExpBoolContent])
-> Maybe ExpBoolContent
-> FromJSON ExpBoolContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExpBoolContent
parseJSON :: Value -> Parser ExpBoolContent
$cparseJSONList :: Value -> Parser [ExpBoolContent]
parseJSONList :: Value -> Parser [ExpBoolContent]
$comittedField :: Maybe ExpBoolContent
omittedField :: Maybe ExpBoolContent
FromJSON )

data Operator
   = PLUS
   | MINUS
   | TIMES
   | DIVIDE
   | PERCENT
   deriving ( Int -> Operator -> ShowS
[Operator] -> ShowS
Operator -> FilePath
(Int -> Operator -> ShowS)
-> (Operator -> FilePath) -> ([Operator] -> ShowS) -> Show Operator
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Operator -> ShowS
showsPrec :: Int -> Operator -> ShowS
$cshow :: Operator -> FilePath
show :: Operator -> FilePath
$cshowList :: [Operator] -> ShowS
showList :: [Operator] -> ShowS
Show, Operator -> Operator -> Bool
(Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool) -> Eq Operator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operator -> Operator -> Bool
== :: Operator -> Operator -> Bool
$c/= :: Operator -> Operator -> Bool
/= :: Operator -> Operator -> Bool
Eq, Eq Operator
Eq Operator
-> (Operator -> Operator -> Ordering)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Operator)
-> (Operator -> Operator -> Operator)
-> Ord Operator
Operator -> Operator -> Bool
Operator -> Operator -> Ordering
Operator -> Operator -> Operator
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
$ccompare :: Operator -> Operator -> Ordering
compare :: Operator -> Operator -> Ordering
$c< :: Operator -> Operator -> Bool
< :: Operator -> Operator -> Bool
$c<= :: Operator -> Operator -> Bool
<= :: Operator -> Operator -> Bool
$c> :: Operator -> Operator -> Bool
> :: Operator -> Operator -> Bool
$c>= :: Operator -> Operator -> Bool
>= :: Operator -> Operator -> Bool
$cmax :: Operator -> Operator -> Operator
max :: Operator -> Operator -> Operator
$cmin :: Operator -> Operator -> Operator
min :: Operator -> Operator -> Operator
Ord, (forall x. Operator -> Rep Operator x)
-> (forall x. Rep Operator x -> Operator) -> Generic Operator
forall x. Rep Operator x -> Operator
forall x. Operator -> Rep Operator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Operator -> Rep Operator x
from :: forall x. Operator -> Rep Operator x
$cto :: forall x. Rep Operator x -> Operator
to :: forall x. Rep Operator x -> Operator
Generic, [Operator] -> Value
[Operator] -> Encoding
Operator -> Bool
Operator -> Value
Operator -> Encoding
(Operator -> Value)
-> (Operator -> Encoding)
-> ([Operator] -> Value)
-> ([Operator] -> Encoding)
-> (Operator -> Bool)
-> ToJSON Operator
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Operator -> Value
toJSON :: Operator -> Value
$ctoEncoding :: Operator -> Encoding
toEncoding :: Operator -> Encoding
$ctoJSONList :: [Operator] -> Value
toJSONList :: [Operator] -> Value
$ctoEncodingList :: [Operator] -> Encoding
toEncodingList :: [Operator] -> Encoding
$comitField :: Operator -> Bool
omitField :: Operator -> Bool
ToJSON, Maybe Operator
Value -> Parser [Operator]
Value -> Parser Operator
(Value -> Parser Operator)
-> (Value -> Parser [Operator])
-> Maybe Operator
-> FromJSON Operator
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Operator
parseJSON :: Value -> Parser Operator
$cparseJSONList :: Value -> Parser [Operator]
parseJSONList :: Value -> Parser [Operator]
$comittedField :: Maybe Operator
omittedField :: Maybe Operator
FromJSON )

data ExpLambdaContent
   = ExpLambdaContent
     {
         ExpLambdaContent -> [Param]
expLambdaParams :: [ Param ],
         ExpLambdaContent -> [Stmt]
expLambdaBody :: [ Stmt ],
         ExpLambdaContent -> Location
expLambdaLocation :: Location
     }
     deriving ( Int -> ExpLambdaContent -> ShowS
[ExpLambdaContent] -> ShowS
ExpLambdaContent -> FilePath
(Int -> ExpLambdaContent -> ShowS)
-> (ExpLambdaContent -> FilePath)
-> ([ExpLambdaContent] -> ShowS)
-> Show ExpLambdaContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpLambdaContent -> ShowS
showsPrec :: Int -> ExpLambdaContent -> ShowS
$cshow :: ExpLambdaContent -> FilePath
show :: ExpLambdaContent -> FilePath
$cshowList :: [ExpLambdaContent] -> ShowS
showList :: [ExpLambdaContent] -> ShowS
Show, ExpLambdaContent -> ExpLambdaContent -> Bool
(ExpLambdaContent -> ExpLambdaContent -> Bool)
-> (ExpLambdaContent -> ExpLambdaContent -> Bool)
-> Eq ExpLambdaContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpLambdaContent -> ExpLambdaContent -> Bool
== :: ExpLambdaContent -> ExpLambdaContent -> Bool
$c/= :: ExpLambdaContent -> ExpLambdaContent -> Bool
/= :: ExpLambdaContent -> ExpLambdaContent -> Bool
Eq, Eq ExpLambdaContent
Eq ExpLambdaContent
-> (ExpLambdaContent -> ExpLambdaContent -> Ordering)
-> (ExpLambdaContent -> ExpLambdaContent -> Bool)
-> (ExpLambdaContent -> ExpLambdaContent -> Bool)
-> (ExpLambdaContent -> ExpLambdaContent -> Bool)
-> (ExpLambdaContent -> ExpLambdaContent -> Bool)
-> (ExpLambdaContent -> ExpLambdaContent -> ExpLambdaContent)
-> (ExpLambdaContent -> ExpLambdaContent -> ExpLambdaContent)
-> Ord ExpLambdaContent
ExpLambdaContent -> ExpLambdaContent -> Bool
ExpLambdaContent -> ExpLambdaContent -> Ordering
ExpLambdaContent -> ExpLambdaContent -> ExpLambdaContent
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
$ccompare :: ExpLambdaContent -> ExpLambdaContent -> Ordering
compare :: ExpLambdaContent -> ExpLambdaContent -> Ordering
$c< :: ExpLambdaContent -> ExpLambdaContent -> Bool
< :: ExpLambdaContent -> ExpLambdaContent -> Bool
$c<= :: ExpLambdaContent -> ExpLambdaContent -> Bool
<= :: ExpLambdaContent -> ExpLambdaContent -> Bool
$c> :: ExpLambdaContent -> ExpLambdaContent -> Bool
> :: ExpLambdaContent -> ExpLambdaContent -> Bool
$c>= :: ExpLambdaContent -> ExpLambdaContent -> Bool
>= :: ExpLambdaContent -> ExpLambdaContent -> Bool
$cmax :: ExpLambdaContent -> ExpLambdaContent -> ExpLambdaContent
max :: ExpLambdaContent -> ExpLambdaContent -> ExpLambdaContent
$cmin :: ExpLambdaContent -> ExpLambdaContent -> ExpLambdaContent
min :: ExpLambdaContent -> ExpLambdaContent -> ExpLambdaContent
Ord, (forall x. ExpLambdaContent -> Rep ExpLambdaContent x)
-> (forall x. Rep ExpLambdaContent x -> ExpLambdaContent)
-> Generic ExpLambdaContent
forall x. Rep ExpLambdaContent x -> ExpLambdaContent
forall x. ExpLambdaContent -> Rep ExpLambdaContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExpLambdaContent -> Rep ExpLambdaContent x
from :: forall x. ExpLambdaContent -> Rep ExpLambdaContent x
$cto :: forall x. Rep ExpLambdaContent x -> ExpLambdaContent
to :: forall x. Rep ExpLambdaContent x -> ExpLambdaContent
Generic, [ExpLambdaContent] -> Value
[ExpLambdaContent] -> Encoding
ExpLambdaContent -> Bool
ExpLambdaContent -> Value
ExpLambdaContent -> Encoding
(ExpLambdaContent -> Value)
-> (ExpLambdaContent -> Encoding)
-> ([ExpLambdaContent] -> Value)
-> ([ExpLambdaContent] -> Encoding)
-> (ExpLambdaContent -> Bool)
-> ToJSON ExpLambdaContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExpLambdaContent -> Value
toJSON :: ExpLambdaContent -> Value
$ctoEncoding :: ExpLambdaContent -> Encoding
toEncoding :: ExpLambdaContent -> Encoding
$ctoJSONList :: [ExpLambdaContent] -> Value
toJSONList :: [ExpLambdaContent] -> Value
$ctoEncodingList :: [ExpLambdaContent] -> Encoding
toEncodingList :: [ExpLambdaContent] -> Encoding
$comitField :: ExpLambdaContent -> Bool
omitField :: ExpLambdaContent -> Bool
ToJSON, Maybe ExpLambdaContent
Value -> Parser [ExpLambdaContent]
Value -> Parser ExpLambdaContent
(Value -> Parser ExpLambdaContent)
-> (Value -> Parser [ExpLambdaContent])
-> Maybe ExpLambdaContent
-> FromJSON ExpLambdaContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExpLambdaContent
parseJSON :: Value -> Parser ExpLambdaContent
$cparseJSONList :: Value -> Parser [ExpLambdaContent]
parseJSONList :: Value -> Parser [ExpLambdaContent]
$comittedField :: Maybe ExpLambdaContent
omittedField :: Maybe ExpLambdaContent
FromJSON )

data ExpBinopContent
   = ExpBinopContent
     {
         ExpBinopContent -> Exp
expBinopLeft :: Exp,
         ExpBinopContent -> Exp
expBinopRight :: Exp,
         ExpBinopContent -> Operator
expBinopOperator :: Operator,
         ExpBinopContent -> Location
expBinopLocation :: Location
     }
     deriving ( Int -> ExpBinopContent -> ShowS
[ExpBinopContent] -> ShowS
ExpBinopContent -> FilePath
(Int -> ExpBinopContent -> ShowS)
-> (ExpBinopContent -> FilePath)
-> ([ExpBinopContent] -> ShowS)
-> Show ExpBinopContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpBinopContent -> ShowS
showsPrec :: Int -> ExpBinopContent -> ShowS
$cshow :: ExpBinopContent -> FilePath
show :: ExpBinopContent -> FilePath
$cshowList :: [ExpBinopContent] -> ShowS
showList :: [ExpBinopContent] -> ShowS
Show, ExpBinopContent -> ExpBinopContent -> Bool
(ExpBinopContent -> ExpBinopContent -> Bool)
-> (ExpBinopContent -> ExpBinopContent -> Bool)
-> Eq ExpBinopContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpBinopContent -> ExpBinopContent -> Bool
== :: ExpBinopContent -> ExpBinopContent -> Bool
$c/= :: ExpBinopContent -> ExpBinopContent -> Bool
/= :: ExpBinopContent -> ExpBinopContent -> Bool
Eq, Eq ExpBinopContent
Eq ExpBinopContent
-> (ExpBinopContent -> ExpBinopContent -> Ordering)
-> (ExpBinopContent -> ExpBinopContent -> Bool)
-> (ExpBinopContent -> ExpBinopContent -> Bool)
-> (ExpBinopContent -> ExpBinopContent -> Bool)
-> (ExpBinopContent -> ExpBinopContent -> Bool)
-> (ExpBinopContent -> ExpBinopContent -> ExpBinopContent)
-> (ExpBinopContent -> ExpBinopContent -> ExpBinopContent)
-> Ord ExpBinopContent
ExpBinopContent -> ExpBinopContent -> Bool
ExpBinopContent -> ExpBinopContent -> Ordering
ExpBinopContent -> ExpBinopContent -> ExpBinopContent
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
$ccompare :: ExpBinopContent -> ExpBinopContent -> Ordering
compare :: ExpBinopContent -> ExpBinopContent -> Ordering
$c< :: ExpBinopContent -> ExpBinopContent -> Bool
< :: ExpBinopContent -> ExpBinopContent -> Bool
$c<= :: ExpBinopContent -> ExpBinopContent -> Bool
<= :: ExpBinopContent -> ExpBinopContent -> Bool
$c> :: ExpBinopContent -> ExpBinopContent -> Bool
> :: ExpBinopContent -> ExpBinopContent -> Bool
$c>= :: ExpBinopContent -> ExpBinopContent -> Bool
>= :: ExpBinopContent -> ExpBinopContent -> Bool
$cmax :: ExpBinopContent -> ExpBinopContent -> ExpBinopContent
max :: ExpBinopContent -> ExpBinopContent -> ExpBinopContent
$cmin :: ExpBinopContent -> ExpBinopContent -> ExpBinopContent
min :: ExpBinopContent -> ExpBinopContent -> ExpBinopContent
Ord, (forall x. ExpBinopContent -> Rep ExpBinopContent x)
-> (forall x. Rep ExpBinopContent x -> ExpBinopContent)
-> Generic ExpBinopContent
forall x. Rep ExpBinopContent x -> ExpBinopContent
forall x. ExpBinopContent -> Rep ExpBinopContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExpBinopContent -> Rep ExpBinopContent x
from :: forall x. ExpBinopContent -> Rep ExpBinopContent x
$cto :: forall x. Rep ExpBinopContent x -> ExpBinopContent
to :: forall x. Rep ExpBinopContent x -> ExpBinopContent
Generic, [ExpBinopContent] -> Value
[ExpBinopContent] -> Encoding
ExpBinopContent -> Bool
ExpBinopContent -> Value
ExpBinopContent -> Encoding
(ExpBinopContent -> Value)
-> (ExpBinopContent -> Encoding)
-> ([ExpBinopContent] -> Value)
-> ([ExpBinopContent] -> Encoding)
-> (ExpBinopContent -> Bool)
-> ToJSON ExpBinopContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExpBinopContent -> Value
toJSON :: ExpBinopContent -> Value
$ctoEncoding :: ExpBinopContent -> Encoding
toEncoding :: ExpBinopContent -> Encoding
$ctoJSONList :: [ExpBinopContent] -> Value
toJSONList :: [ExpBinopContent] -> Value
$ctoEncodingList :: [ExpBinopContent] -> Encoding
toEncodingList :: [ExpBinopContent] -> Encoding
$comitField :: ExpBinopContent -> Bool
omitField :: ExpBinopContent -> Bool
ToJSON, Maybe ExpBinopContent
Value -> Parser [ExpBinopContent]
Value -> Parser ExpBinopContent
(Value -> Parser ExpBinopContent)
-> (Value -> Parser [ExpBinopContent])
-> Maybe ExpBinopContent
-> FromJSON ExpBinopContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExpBinopContent
parseJSON :: Value -> Parser ExpBinopContent
$cparseJSONList :: Value -> Parser [ExpBinopContent]
parseJSONList :: Value -> Parser [ExpBinopContent]
$comittedField :: Maybe ExpBinopContent
omittedField :: Maybe ExpBinopContent
FromJSON )

data ExpVarContent
   = ExpVarContent
     {
         ExpVarContent -> Var
actualExpVar :: Var
     }
     deriving ( Int -> ExpVarContent -> ShowS
[ExpVarContent] -> ShowS
ExpVarContent -> FilePath
(Int -> ExpVarContent -> ShowS)
-> (ExpVarContent -> FilePath)
-> ([ExpVarContent] -> ShowS)
-> Show ExpVarContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpVarContent -> ShowS
showsPrec :: Int -> ExpVarContent -> ShowS
$cshow :: ExpVarContent -> FilePath
show :: ExpVarContent -> FilePath
$cshowList :: [ExpVarContent] -> ShowS
showList :: [ExpVarContent] -> ShowS
Show, ExpVarContent -> ExpVarContent -> Bool
(ExpVarContent -> ExpVarContent -> Bool)
-> (ExpVarContent -> ExpVarContent -> Bool) -> Eq ExpVarContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpVarContent -> ExpVarContent -> Bool
== :: ExpVarContent -> ExpVarContent -> Bool
$c/= :: ExpVarContent -> ExpVarContent -> Bool
/= :: ExpVarContent -> ExpVarContent -> Bool
Eq, Eq ExpVarContent
Eq ExpVarContent
-> (ExpVarContent -> ExpVarContent -> Ordering)
-> (ExpVarContent -> ExpVarContent -> Bool)
-> (ExpVarContent -> ExpVarContent -> Bool)
-> (ExpVarContent -> ExpVarContent -> Bool)
-> (ExpVarContent -> ExpVarContent -> Bool)
-> (ExpVarContent -> ExpVarContent -> ExpVarContent)
-> (ExpVarContent -> ExpVarContent -> ExpVarContent)
-> Ord ExpVarContent
ExpVarContent -> ExpVarContent -> Bool
ExpVarContent -> ExpVarContent -> Ordering
ExpVarContent -> ExpVarContent -> ExpVarContent
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
$ccompare :: ExpVarContent -> ExpVarContent -> Ordering
compare :: ExpVarContent -> ExpVarContent -> Ordering
$c< :: ExpVarContent -> ExpVarContent -> Bool
< :: ExpVarContent -> ExpVarContent -> Bool
$c<= :: ExpVarContent -> ExpVarContent -> Bool
<= :: ExpVarContent -> ExpVarContent -> Bool
$c> :: ExpVarContent -> ExpVarContent -> Bool
> :: ExpVarContent -> ExpVarContent -> Bool
$c>= :: ExpVarContent -> ExpVarContent -> Bool
>= :: ExpVarContent -> ExpVarContent -> Bool
$cmax :: ExpVarContent -> ExpVarContent -> ExpVarContent
max :: ExpVarContent -> ExpVarContent -> ExpVarContent
$cmin :: ExpVarContent -> ExpVarContent -> ExpVarContent
min :: ExpVarContent -> ExpVarContent -> ExpVarContent
Ord, (forall x. ExpVarContent -> Rep ExpVarContent x)
-> (forall x. Rep ExpVarContent x -> ExpVarContent)
-> Generic ExpVarContent
forall x. Rep ExpVarContent x -> ExpVarContent
forall x. ExpVarContent -> Rep ExpVarContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExpVarContent -> Rep ExpVarContent x
from :: forall x. ExpVarContent -> Rep ExpVarContent x
$cto :: forall x. Rep ExpVarContent x -> ExpVarContent
to :: forall x. Rep ExpVarContent x -> ExpVarContent
Generic, [ExpVarContent] -> Value
[ExpVarContent] -> Encoding
ExpVarContent -> Bool
ExpVarContent -> Value
ExpVarContent -> Encoding
(ExpVarContent -> Value)
-> (ExpVarContent -> Encoding)
-> ([ExpVarContent] -> Value)
-> ([ExpVarContent] -> Encoding)
-> (ExpVarContent -> Bool)
-> ToJSON ExpVarContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExpVarContent -> Value
toJSON :: ExpVarContent -> Value
$ctoEncoding :: ExpVarContent -> Encoding
toEncoding :: ExpVarContent -> Encoding
$ctoJSONList :: [ExpVarContent] -> Value
toJSONList :: [ExpVarContent] -> Value
$ctoEncodingList :: [ExpVarContent] -> Encoding
toEncodingList :: [ExpVarContent] -> Encoding
$comitField :: ExpVarContent -> Bool
omitField :: ExpVarContent -> Bool
ToJSON, Maybe ExpVarContent
Value -> Parser [ExpVarContent]
Value -> Parser ExpVarContent
(Value -> Parser ExpVarContent)
-> (Value -> Parser [ExpVarContent])
-> Maybe ExpVarContent
-> FromJSON ExpVarContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExpVarContent
parseJSON :: Value -> Parser ExpVarContent
$cparseJSONList :: Value -> Parser [ExpVarContent]
parseJSONList :: Value -> Parser [ExpVarContent]
$comittedField :: Maybe ExpVarContent
omittedField :: Maybe ExpVarContent
FromJSON )

data StmtAssignContent
   = StmtAssignContent
     {
         StmtAssignContent -> Var
stmtAssignLhs :: Var,
         StmtAssignContent -> Exp
stmtAssignRhs :: Exp
     }
     deriving ( Int -> StmtAssignContent -> ShowS
[StmtAssignContent] -> ShowS
StmtAssignContent -> FilePath
(Int -> StmtAssignContent -> ShowS)
-> (StmtAssignContent -> FilePath)
-> ([StmtAssignContent] -> ShowS)
-> Show StmtAssignContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtAssignContent -> ShowS
showsPrec :: Int -> StmtAssignContent -> ShowS
$cshow :: StmtAssignContent -> FilePath
show :: StmtAssignContent -> FilePath
$cshowList :: [StmtAssignContent] -> ShowS
showList :: [StmtAssignContent] -> ShowS
Show, StmtAssignContent -> StmtAssignContent -> Bool
(StmtAssignContent -> StmtAssignContent -> Bool)
-> (StmtAssignContent -> StmtAssignContent -> Bool)
-> Eq StmtAssignContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtAssignContent -> StmtAssignContent -> Bool
== :: StmtAssignContent -> StmtAssignContent -> Bool
$c/= :: StmtAssignContent -> StmtAssignContent -> Bool
/= :: StmtAssignContent -> StmtAssignContent -> Bool
Eq, Eq StmtAssignContent
Eq StmtAssignContent
-> (StmtAssignContent -> StmtAssignContent -> Ordering)
-> (StmtAssignContent -> StmtAssignContent -> Bool)
-> (StmtAssignContent -> StmtAssignContent -> Bool)
-> (StmtAssignContent -> StmtAssignContent -> Bool)
-> (StmtAssignContent -> StmtAssignContent -> Bool)
-> (StmtAssignContent -> StmtAssignContent -> StmtAssignContent)
-> (StmtAssignContent -> StmtAssignContent -> StmtAssignContent)
-> Ord StmtAssignContent
StmtAssignContent -> StmtAssignContent -> Bool
StmtAssignContent -> StmtAssignContent -> Ordering
StmtAssignContent -> StmtAssignContent -> StmtAssignContent
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
$ccompare :: StmtAssignContent -> StmtAssignContent -> Ordering
compare :: StmtAssignContent -> StmtAssignContent -> Ordering
$c< :: StmtAssignContent -> StmtAssignContent -> Bool
< :: StmtAssignContent -> StmtAssignContent -> Bool
$c<= :: StmtAssignContent -> StmtAssignContent -> Bool
<= :: StmtAssignContent -> StmtAssignContent -> Bool
$c> :: StmtAssignContent -> StmtAssignContent -> Bool
> :: StmtAssignContent -> StmtAssignContent -> Bool
$c>= :: StmtAssignContent -> StmtAssignContent -> Bool
>= :: StmtAssignContent -> StmtAssignContent -> Bool
$cmax :: StmtAssignContent -> StmtAssignContent -> StmtAssignContent
max :: StmtAssignContent -> StmtAssignContent -> StmtAssignContent
$cmin :: StmtAssignContent -> StmtAssignContent -> StmtAssignContent
min :: StmtAssignContent -> StmtAssignContent -> StmtAssignContent
Ord, (forall x. StmtAssignContent -> Rep StmtAssignContent x)
-> (forall x. Rep StmtAssignContent x -> StmtAssignContent)
-> Generic StmtAssignContent
forall x. Rep StmtAssignContent x -> StmtAssignContent
forall x. StmtAssignContent -> Rep StmtAssignContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StmtAssignContent -> Rep StmtAssignContent x
from :: forall x. StmtAssignContent -> Rep StmtAssignContent x
$cto :: forall x. Rep StmtAssignContent x -> StmtAssignContent
to :: forall x. Rep StmtAssignContent x -> StmtAssignContent
Generic, [StmtAssignContent] -> Value
[StmtAssignContent] -> Encoding
StmtAssignContent -> Bool
StmtAssignContent -> Value
StmtAssignContent -> Encoding
(StmtAssignContent -> Value)
-> (StmtAssignContent -> Encoding)
-> ([StmtAssignContent] -> Value)
-> ([StmtAssignContent] -> Encoding)
-> (StmtAssignContent -> Bool)
-> ToJSON StmtAssignContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StmtAssignContent -> Value
toJSON :: StmtAssignContent -> Value
$ctoEncoding :: StmtAssignContent -> Encoding
toEncoding :: StmtAssignContent -> Encoding
$ctoJSONList :: [StmtAssignContent] -> Value
toJSONList :: [StmtAssignContent] -> Value
$ctoEncodingList :: [StmtAssignContent] -> Encoding
toEncodingList :: [StmtAssignContent] -> Encoding
$comitField :: StmtAssignContent -> Bool
omitField :: StmtAssignContent -> Bool
ToJSON, Maybe StmtAssignContent
Value -> Parser [StmtAssignContent]
Value -> Parser StmtAssignContent
(Value -> Parser StmtAssignContent)
-> (Value -> Parser [StmtAssignContent])
-> Maybe StmtAssignContent
-> FromJSON StmtAssignContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StmtAssignContent
parseJSON :: Value -> Parser StmtAssignContent
$cparseJSONList :: Value -> Parser [StmtAssignContent]
parseJSONList :: Value -> Parser [StmtAssignContent]
$comittedField :: Maybe StmtAssignContent
omittedField :: Maybe StmtAssignContent
FromJSON )

data StmtTryContent
   = StmtTryContent
     {
         StmtTryContent -> [Stmt]
stmtTryPart :: [ Stmt ],
         StmtTryContent -> [Stmt]
stmtCatchPart :: [ Stmt ],
         StmtTryContent -> Location
stmtTryLocation :: Location
     }
     deriving ( Int -> StmtTryContent -> ShowS
[StmtTryContent] -> ShowS
StmtTryContent -> FilePath
(Int -> StmtTryContent -> ShowS)
-> (StmtTryContent -> FilePath)
-> ([StmtTryContent] -> ShowS)
-> Show StmtTryContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtTryContent -> ShowS
showsPrec :: Int -> StmtTryContent -> ShowS
$cshow :: StmtTryContent -> FilePath
show :: StmtTryContent -> FilePath
$cshowList :: [StmtTryContent] -> ShowS
showList :: [StmtTryContent] -> ShowS
Show, StmtTryContent -> StmtTryContent -> Bool
(StmtTryContent -> StmtTryContent -> Bool)
-> (StmtTryContent -> StmtTryContent -> Bool) -> Eq StmtTryContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtTryContent -> StmtTryContent -> Bool
== :: StmtTryContent -> StmtTryContent -> Bool
$c/= :: StmtTryContent -> StmtTryContent -> Bool
/= :: StmtTryContent -> StmtTryContent -> Bool
Eq, Eq StmtTryContent
Eq StmtTryContent
-> (StmtTryContent -> StmtTryContent -> Ordering)
-> (StmtTryContent -> StmtTryContent -> Bool)
-> (StmtTryContent -> StmtTryContent -> Bool)
-> (StmtTryContent -> StmtTryContent -> Bool)
-> (StmtTryContent -> StmtTryContent -> Bool)
-> (StmtTryContent -> StmtTryContent -> StmtTryContent)
-> (StmtTryContent -> StmtTryContent -> StmtTryContent)
-> Ord StmtTryContent
StmtTryContent -> StmtTryContent -> Bool
StmtTryContent -> StmtTryContent -> Ordering
StmtTryContent -> StmtTryContent -> StmtTryContent
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
$ccompare :: StmtTryContent -> StmtTryContent -> Ordering
compare :: StmtTryContent -> StmtTryContent -> Ordering
$c< :: StmtTryContent -> StmtTryContent -> Bool
< :: StmtTryContent -> StmtTryContent -> Bool
$c<= :: StmtTryContent -> StmtTryContent -> Bool
<= :: StmtTryContent -> StmtTryContent -> Bool
$c> :: StmtTryContent -> StmtTryContent -> Bool
> :: StmtTryContent -> StmtTryContent -> Bool
$c>= :: StmtTryContent -> StmtTryContent -> Bool
>= :: StmtTryContent -> StmtTryContent -> Bool
$cmax :: StmtTryContent -> StmtTryContent -> StmtTryContent
max :: StmtTryContent -> StmtTryContent -> StmtTryContent
$cmin :: StmtTryContent -> StmtTryContent -> StmtTryContent
min :: StmtTryContent -> StmtTryContent -> StmtTryContent
Ord, (forall x. StmtTryContent -> Rep StmtTryContent x)
-> (forall x. Rep StmtTryContent x -> StmtTryContent)
-> Generic StmtTryContent
forall x. Rep StmtTryContent x -> StmtTryContent
forall x. StmtTryContent -> Rep StmtTryContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StmtTryContent -> Rep StmtTryContent x
from :: forall x. StmtTryContent -> Rep StmtTryContent x
$cto :: forall x. Rep StmtTryContent x -> StmtTryContent
to :: forall x. Rep StmtTryContent x -> StmtTryContent
Generic, [StmtTryContent] -> Value
[StmtTryContent] -> Encoding
StmtTryContent -> Bool
StmtTryContent -> Value
StmtTryContent -> Encoding
(StmtTryContent -> Value)
-> (StmtTryContent -> Encoding)
-> ([StmtTryContent] -> Value)
-> ([StmtTryContent] -> Encoding)
-> (StmtTryContent -> Bool)
-> ToJSON StmtTryContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StmtTryContent -> Value
toJSON :: StmtTryContent -> Value
$ctoEncoding :: StmtTryContent -> Encoding
toEncoding :: StmtTryContent -> Encoding
$ctoJSONList :: [StmtTryContent] -> Value
toJSONList :: [StmtTryContent] -> Value
$ctoEncodingList :: [StmtTryContent] -> Encoding
toEncodingList :: [StmtTryContent] -> Encoding
$comitField :: StmtTryContent -> Bool
omitField :: StmtTryContent -> Bool
ToJSON, Maybe StmtTryContent
Value -> Parser [StmtTryContent]
Value -> Parser StmtTryContent
(Value -> Parser StmtTryContent)
-> (Value -> Parser [StmtTryContent])
-> Maybe StmtTryContent
-> FromJSON StmtTryContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StmtTryContent
parseJSON :: Value -> Parser StmtTryContent
$cparseJSONList :: Value -> Parser [StmtTryContent]
parseJSONList :: Value -> Parser [StmtTryContent]
$comittedField :: Maybe StmtTryContent
omittedField :: Maybe StmtTryContent
FromJSON )

data StmtBreakContent
   = StmtBreakContent
     {
         StmtBreakContent -> Location
stmtBreakLocation :: Location
     }
     deriving ( Int -> StmtBreakContent -> ShowS
[StmtBreakContent] -> ShowS
StmtBreakContent -> FilePath
(Int -> StmtBreakContent -> ShowS)
-> (StmtBreakContent -> FilePath)
-> ([StmtBreakContent] -> ShowS)
-> Show StmtBreakContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtBreakContent -> ShowS
showsPrec :: Int -> StmtBreakContent -> ShowS
$cshow :: StmtBreakContent -> FilePath
show :: StmtBreakContent -> FilePath
$cshowList :: [StmtBreakContent] -> ShowS
showList :: [StmtBreakContent] -> ShowS
Show, StmtBreakContent -> StmtBreakContent -> Bool
(StmtBreakContent -> StmtBreakContent -> Bool)
-> (StmtBreakContent -> StmtBreakContent -> Bool)
-> Eq StmtBreakContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtBreakContent -> StmtBreakContent -> Bool
== :: StmtBreakContent -> StmtBreakContent -> Bool
$c/= :: StmtBreakContent -> StmtBreakContent -> Bool
/= :: StmtBreakContent -> StmtBreakContent -> Bool
Eq, Eq StmtBreakContent
Eq StmtBreakContent
-> (StmtBreakContent -> StmtBreakContent -> Ordering)
-> (StmtBreakContent -> StmtBreakContent -> Bool)
-> (StmtBreakContent -> StmtBreakContent -> Bool)
-> (StmtBreakContent -> StmtBreakContent -> Bool)
-> (StmtBreakContent -> StmtBreakContent -> Bool)
-> (StmtBreakContent -> StmtBreakContent -> StmtBreakContent)
-> (StmtBreakContent -> StmtBreakContent -> StmtBreakContent)
-> Ord StmtBreakContent
StmtBreakContent -> StmtBreakContent -> Bool
StmtBreakContent -> StmtBreakContent -> Ordering
StmtBreakContent -> StmtBreakContent -> StmtBreakContent
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
$ccompare :: StmtBreakContent -> StmtBreakContent -> Ordering
compare :: StmtBreakContent -> StmtBreakContent -> Ordering
$c< :: StmtBreakContent -> StmtBreakContent -> Bool
< :: StmtBreakContent -> StmtBreakContent -> Bool
$c<= :: StmtBreakContent -> StmtBreakContent -> Bool
<= :: StmtBreakContent -> StmtBreakContent -> Bool
$c> :: StmtBreakContent -> StmtBreakContent -> Bool
> :: StmtBreakContent -> StmtBreakContent -> Bool
$c>= :: StmtBreakContent -> StmtBreakContent -> Bool
>= :: StmtBreakContent -> StmtBreakContent -> Bool
$cmax :: StmtBreakContent -> StmtBreakContent -> StmtBreakContent
max :: StmtBreakContent -> StmtBreakContent -> StmtBreakContent
$cmin :: StmtBreakContent -> StmtBreakContent -> StmtBreakContent
min :: StmtBreakContent -> StmtBreakContent -> StmtBreakContent
Ord, (forall x. StmtBreakContent -> Rep StmtBreakContent x)
-> (forall x. Rep StmtBreakContent x -> StmtBreakContent)
-> Generic StmtBreakContent
forall x. Rep StmtBreakContent x -> StmtBreakContent
forall x. StmtBreakContent -> Rep StmtBreakContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StmtBreakContent -> Rep StmtBreakContent x
from :: forall x. StmtBreakContent -> Rep StmtBreakContent x
$cto :: forall x. Rep StmtBreakContent x -> StmtBreakContent
to :: forall x. Rep StmtBreakContent x -> StmtBreakContent
Generic, [StmtBreakContent] -> Value
[StmtBreakContent] -> Encoding
StmtBreakContent -> Bool
StmtBreakContent -> Value
StmtBreakContent -> Encoding
(StmtBreakContent -> Value)
-> (StmtBreakContent -> Encoding)
-> ([StmtBreakContent] -> Value)
-> ([StmtBreakContent] -> Encoding)
-> (StmtBreakContent -> Bool)
-> ToJSON StmtBreakContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StmtBreakContent -> Value
toJSON :: StmtBreakContent -> Value
$ctoEncoding :: StmtBreakContent -> Encoding
toEncoding :: StmtBreakContent -> Encoding
$ctoJSONList :: [StmtBreakContent] -> Value
toJSONList :: [StmtBreakContent] -> Value
$ctoEncodingList :: [StmtBreakContent] -> Encoding
toEncodingList :: [StmtBreakContent] -> Encoding
$comitField :: StmtBreakContent -> Bool
omitField :: StmtBreakContent -> Bool
ToJSON, Maybe StmtBreakContent
Value -> Parser [StmtBreakContent]
Value -> Parser StmtBreakContent
(Value -> Parser StmtBreakContent)
-> (Value -> Parser [StmtBreakContent])
-> Maybe StmtBreakContent
-> FromJSON StmtBreakContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StmtBreakContent
parseJSON :: Value -> Parser StmtBreakContent
$cparseJSONList :: Value -> Parser [StmtBreakContent]
parseJSONList :: Value -> Parser [StmtBreakContent]
$comittedField :: Maybe StmtBreakContent
omittedField :: Maybe StmtBreakContent
FromJSON )

data StmtImportContent
   = StmtImportContent
     {
         StmtImportContent -> FilePath
stmtImportName :: String,
         StmtImportContent -> FilePath
stmtImportAlias :: String,
         StmtImportContent -> Location
stmtImportLocation :: Location
     }
     deriving ( Int -> StmtImportContent -> ShowS
[StmtImportContent] -> ShowS
StmtImportContent -> FilePath
(Int -> StmtImportContent -> ShowS)
-> (StmtImportContent -> FilePath)
-> ([StmtImportContent] -> ShowS)
-> Show StmtImportContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtImportContent -> ShowS
showsPrec :: Int -> StmtImportContent -> ShowS
$cshow :: StmtImportContent -> FilePath
show :: StmtImportContent -> FilePath
$cshowList :: [StmtImportContent] -> ShowS
showList :: [StmtImportContent] -> ShowS
Show, StmtImportContent -> StmtImportContent -> Bool
(StmtImportContent -> StmtImportContent -> Bool)
-> (StmtImportContent -> StmtImportContent -> Bool)
-> Eq StmtImportContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtImportContent -> StmtImportContent -> Bool
== :: StmtImportContent -> StmtImportContent -> Bool
$c/= :: StmtImportContent -> StmtImportContent -> Bool
/= :: StmtImportContent -> StmtImportContent -> Bool
Eq, Eq StmtImportContent
Eq StmtImportContent
-> (StmtImportContent -> StmtImportContent -> Ordering)
-> (StmtImportContent -> StmtImportContent -> Bool)
-> (StmtImportContent -> StmtImportContent -> Bool)
-> (StmtImportContent -> StmtImportContent -> Bool)
-> (StmtImportContent -> StmtImportContent -> Bool)
-> (StmtImportContent -> StmtImportContent -> StmtImportContent)
-> (StmtImportContent -> StmtImportContent -> StmtImportContent)
-> Ord StmtImportContent
StmtImportContent -> StmtImportContent -> Bool
StmtImportContent -> StmtImportContent -> Ordering
StmtImportContent -> StmtImportContent -> StmtImportContent
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
$ccompare :: StmtImportContent -> StmtImportContent -> Ordering
compare :: StmtImportContent -> StmtImportContent -> Ordering
$c< :: StmtImportContent -> StmtImportContent -> Bool
< :: StmtImportContent -> StmtImportContent -> Bool
$c<= :: StmtImportContent -> StmtImportContent -> Bool
<= :: StmtImportContent -> StmtImportContent -> Bool
$c> :: StmtImportContent -> StmtImportContent -> Bool
> :: StmtImportContent -> StmtImportContent -> Bool
$c>= :: StmtImportContent -> StmtImportContent -> Bool
>= :: StmtImportContent -> StmtImportContent -> Bool
$cmax :: StmtImportContent -> StmtImportContent -> StmtImportContent
max :: StmtImportContent -> StmtImportContent -> StmtImportContent
$cmin :: StmtImportContent -> StmtImportContent -> StmtImportContent
min :: StmtImportContent -> StmtImportContent -> StmtImportContent
Ord, (forall x. StmtImportContent -> Rep StmtImportContent x)
-> (forall x. Rep StmtImportContent x -> StmtImportContent)
-> Generic StmtImportContent
forall x. Rep StmtImportContent x -> StmtImportContent
forall x. StmtImportContent -> Rep StmtImportContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StmtImportContent -> Rep StmtImportContent x
from :: forall x. StmtImportContent -> Rep StmtImportContent x
$cto :: forall x. Rep StmtImportContent x -> StmtImportContent
to :: forall x. Rep StmtImportContent x -> StmtImportContent
Generic, [StmtImportContent] -> Value
[StmtImportContent] -> Encoding
StmtImportContent -> Bool
StmtImportContent -> Value
StmtImportContent -> Encoding
(StmtImportContent -> Value)
-> (StmtImportContent -> Encoding)
-> ([StmtImportContent] -> Value)
-> ([StmtImportContent] -> Encoding)
-> (StmtImportContent -> Bool)
-> ToJSON StmtImportContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StmtImportContent -> Value
toJSON :: StmtImportContent -> Value
$ctoEncoding :: StmtImportContent -> Encoding
toEncoding :: StmtImportContent -> Encoding
$ctoJSONList :: [StmtImportContent] -> Value
toJSONList :: [StmtImportContent] -> Value
$ctoEncodingList :: [StmtImportContent] -> Encoding
toEncodingList :: [StmtImportContent] -> Encoding
$comitField :: StmtImportContent -> Bool
omitField :: StmtImportContent -> Bool
ToJSON, Maybe StmtImportContent
Value -> Parser [StmtImportContent]
Value -> Parser StmtImportContent
(Value -> Parser StmtImportContent)
-> (Value -> Parser [StmtImportContent])
-> Maybe StmtImportContent
-> FromJSON StmtImportContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StmtImportContent
parseJSON :: Value -> Parser StmtImportContent
$cparseJSONList :: Value -> Parser [StmtImportContent]
parseJSONList :: Value -> Parser [StmtImportContent]
$comittedField :: Maybe StmtImportContent
omittedField :: Maybe StmtImportContent
FromJSON )

data StmtContinueContent
   = StmtContinueContent
     {
         StmtContinueContent -> Location
stmtContinueLocation :: Location
     }
     deriving ( Int -> StmtContinueContent -> ShowS
[StmtContinueContent] -> ShowS
StmtContinueContent -> FilePath
(Int -> StmtContinueContent -> ShowS)
-> (StmtContinueContent -> FilePath)
-> ([StmtContinueContent] -> ShowS)
-> Show StmtContinueContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtContinueContent -> ShowS
showsPrec :: Int -> StmtContinueContent -> ShowS
$cshow :: StmtContinueContent -> FilePath
show :: StmtContinueContent -> FilePath
$cshowList :: [StmtContinueContent] -> ShowS
showList :: [StmtContinueContent] -> ShowS
Show, StmtContinueContent -> StmtContinueContent -> Bool
(StmtContinueContent -> StmtContinueContent -> Bool)
-> (StmtContinueContent -> StmtContinueContent -> Bool)
-> Eq StmtContinueContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtContinueContent -> StmtContinueContent -> Bool
== :: StmtContinueContent -> StmtContinueContent -> Bool
$c/= :: StmtContinueContent -> StmtContinueContent -> Bool
/= :: StmtContinueContent -> StmtContinueContent -> Bool
Eq, Eq StmtContinueContent
Eq StmtContinueContent
-> (StmtContinueContent -> StmtContinueContent -> Ordering)
-> (StmtContinueContent -> StmtContinueContent -> Bool)
-> (StmtContinueContent -> StmtContinueContent -> Bool)
-> (StmtContinueContent -> StmtContinueContent -> Bool)
-> (StmtContinueContent -> StmtContinueContent -> Bool)
-> (StmtContinueContent
    -> StmtContinueContent -> StmtContinueContent)
-> (StmtContinueContent
    -> StmtContinueContent -> StmtContinueContent)
-> Ord StmtContinueContent
StmtContinueContent -> StmtContinueContent -> Bool
StmtContinueContent -> StmtContinueContent -> Ordering
StmtContinueContent -> StmtContinueContent -> StmtContinueContent
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
$ccompare :: StmtContinueContent -> StmtContinueContent -> Ordering
compare :: StmtContinueContent -> StmtContinueContent -> Ordering
$c< :: StmtContinueContent -> StmtContinueContent -> Bool
< :: StmtContinueContent -> StmtContinueContent -> Bool
$c<= :: StmtContinueContent -> StmtContinueContent -> Bool
<= :: StmtContinueContent -> StmtContinueContent -> Bool
$c> :: StmtContinueContent -> StmtContinueContent -> Bool
> :: StmtContinueContent -> StmtContinueContent -> Bool
$c>= :: StmtContinueContent -> StmtContinueContent -> Bool
>= :: StmtContinueContent -> StmtContinueContent -> Bool
$cmax :: StmtContinueContent -> StmtContinueContent -> StmtContinueContent
max :: StmtContinueContent -> StmtContinueContent -> StmtContinueContent
$cmin :: StmtContinueContent -> StmtContinueContent -> StmtContinueContent
min :: StmtContinueContent -> StmtContinueContent -> StmtContinueContent
Ord, (forall x. StmtContinueContent -> Rep StmtContinueContent x)
-> (forall x. Rep StmtContinueContent x -> StmtContinueContent)
-> Generic StmtContinueContent
forall x. Rep StmtContinueContent x -> StmtContinueContent
forall x. StmtContinueContent -> Rep StmtContinueContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StmtContinueContent -> Rep StmtContinueContent x
from :: forall x. StmtContinueContent -> Rep StmtContinueContent x
$cto :: forall x. Rep StmtContinueContent x -> StmtContinueContent
to :: forall x. Rep StmtContinueContent x -> StmtContinueContent
Generic, [StmtContinueContent] -> Value
[StmtContinueContent] -> Encoding
StmtContinueContent -> Bool
StmtContinueContent -> Value
StmtContinueContent -> Encoding
(StmtContinueContent -> Value)
-> (StmtContinueContent -> Encoding)
-> ([StmtContinueContent] -> Value)
-> ([StmtContinueContent] -> Encoding)
-> (StmtContinueContent -> Bool)
-> ToJSON StmtContinueContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StmtContinueContent -> Value
toJSON :: StmtContinueContent -> Value
$ctoEncoding :: StmtContinueContent -> Encoding
toEncoding :: StmtContinueContent -> Encoding
$ctoJSONList :: [StmtContinueContent] -> Value
toJSONList :: [StmtContinueContent] -> Value
$ctoEncodingList :: [StmtContinueContent] -> Encoding
toEncodingList :: [StmtContinueContent] -> Encoding
$comitField :: StmtContinueContent -> Bool
omitField :: StmtContinueContent -> Bool
ToJSON, Maybe StmtContinueContent
Value -> Parser [StmtContinueContent]
Value -> Parser StmtContinueContent
(Value -> Parser StmtContinueContent)
-> (Value -> Parser [StmtContinueContent])
-> Maybe StmtContinueContent
-> FromJSON StmtContinueContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StmtContinueContent
parseJSON :: Value -> Parser StmtContinueContent
$cparseJSONList :: Value -> Parser [StmtContinueContent]
parseJSONList :: Value -> Parser [StmtContinueContent]
$comittedField :: Maybe StmtContinueContent
omittedField :: Maybe StmtContinueContent
FromJSON )

data StmtIfContent
   = StmtIfContent
     {
         StmtIfContent -> Exp
stmtIfCond :: Exp,
         StmtIfContent -> [Stmt]
stmtIfBody :: [ Stmt ],
         StmtIfContent -> [Stmt]
stmtElseBody :: [ Stmt ],
         StmtIfContent -> Location
stmtIfLocation :: Location
     }
     deriving ( Int -> StmtIfContent -> ShowS
[StmtIfContent] -> ShowS
StmtIfContent -> FilePath
(Int -> StmtIfContent -> ShowS)
-> (StmtIfContent -> FilePath)
-> ([StmtIfContent] -> ShowS)
-> Show StmtIfContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtIfContent -> ShowS
showsPrec :: Int -> StmtIfContent -> ShowS
$cshow :: StmtIfContent -> FilePath
show :: StmtIfContent -> FilePath
$cshowList :: [StmtIfContent] -> ShowS
showList :: [StmtIfContent] -> ShowS
Show, StmtIfContent -> StmtIfContent -> Bool
(StmtIfContent -> StmtIfContent -> Bool)
-> (StmtIfContent -> StmtIfContent -> Bool) -> Eq StmtIfContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtIfContent -> StmtIfContent -> Bool
== :: StmtIfContent -> StmtIfContent -> Bool
$c/= :: StmtIfContent -> StmtIfContent -> Bool
/= :: StmtIfContent -> StmtIfContent -> Bool
Eq, Eq StmtIfContent
Eq StmtIfContent
-> (StmtIfContent -> StmtIfContent -> Ordering)
-> (StmtIfContent -> StmtIfContent -> Bool)
-> (StmtIfContent -> StmtIfContent -> Bool)
-> (StmtIfContent -> StmtIfContent -> Bool)
-> (StmtIfContent -> StmtIfContent -> Bool)
-> (StmtIfContent -> StmtIfContent -> StmtIfContent)
-> (StmtIfContent -> StmtIfContent -> StmtIfContent)
-> Ord StmtIfContent
StmtIfContent -> StmtIfContent -> Bool
StmtIfContent -> StmtIfContent -> Ordering
StmtIfContent -> StmtIfContent -> StmtIfContent
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
$ccompare :: StmtIfContent -> StmtIfContent -> Ordering
compare :: StmtIfContent -> StmtIfContent -> Ordering
$c< :: StmtIfContent -> StmtIfContent -> Bool
< :: StmtIfContent -> StmtIfContent -> Bool
$c<= :: StmtIfContent -> StmtIfContent -> Bool
<= :: StmtIfContent -> StmtIfContent -> Bool
$c> :: StmtIfContent -> StmtIfContent -> Bool
> :: StmtIfContent -> StmtIfContent -> Bool
$c>= :: StmtIfContent -> StmtIfContent -> Bool
>= :: StmtIfContent -> StmtIfContent -> Bool
$cmax :: StmtIfContent -> StmtIfContent -> StmtIfContent
max :: StmtIfContent -> StmtIfContent -> StmtIfContent
$cmin :: StmtIfContent -> StmtIfContent -> StmtIfContent
min :: StmtIfContent -> StmtIfContent -> StmtIfContent
Ord, (forall x. StmtIfContent -> Rep StmtIfContent x)
-> (forall x. Rep StmtIfContent x -> StmtIfContent)
-> Generic StmtIfContent
forall x. Rep StmtIfContent x -> StmtIfContent
forall x. StmtIfContent -> Rep StmtIfContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StmtIfContent -> Rep StmtIfContent x
from :: forall x. StmtIfContent -> Rep StmtIfContent x
$cto :: forall x. Rep StmtIfContent x -> StmtIfContent
to :: forall x. Rep StmtIfContent x -> StmtIfContent
Generic, [StmtIfContent] -> Value
[StmtIfContent] -> Encoding
StmtIfContent -> Bool
StmtIfContent -> Value
StmtIfContent -> Encoding
(StmtIfContent -> Value)
-> (StmtIfContent -> Encoding)
-> ([StmtIfContent] -> Value)
-> ([StmtIfContent] -> Encoding)
-> (StmtIfContent -> Bool)
-> ToJSON StmtIfContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StmtIfContent -> Value
toJSON :: StmtIfContent -> Value
$ctoEncoding :: StmtIfContent -> Encoding
toEncoding :: StmtIfContent -> Encoding
$ctoJSONList :: [StmtIfContent] -> Value
toJSONList :: [StmtIfContent] -> Value
$ctoEncodingList :: [StmtIfContent] -> Encoding
toEncodingList :: [StmtIfContent] -> Encoding
$comitField :: StmtIfContent -> Bool
omitField :: StmtIfContent -> Bool
ToJSON, Maybe StmtIfContent
Value -> Parser [StmtIfContent]
Value -> Parser StmtIfContent
(Value -> Parser StmtIfContent)
-> (Value -> Parser [StmtIfContent])
-> Maybe StmtIfContent
-> FromJSON StmtIfContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StmtIfContent
parseJSON :: Value -> Parser StmtIfContent
$cparseJSONList :: Value -> Parser [StmtIfContent]
parseJSONList :: Value -> Parser [StmtIfContent]
$comittedField :: Maybe StmtIfContent
omittedField :: Maybe StmtIfContent
FromJSON )

data StmtWhileContent
   = StmtWhileContent
     {
         StmtWhileContent -> Exp
stmtWhileCond :: Exp,
         StmtWhileContent -> [Stmt]
stmtWhileBody :: [ Stmt ],
         StmtWhileContent -> Location
stmtWhileLocation :: Location
     }
     deriving ( Int -> StmtWhileContent -> ShowS
[StmtWhileContent] -> ShowS
StmtWhileContent -> FilePath
(Int -> StmtWhileContent -> ShowS)
-> (StmtWhileContent -> FilePath)
-> ([StmtWhileContent] -> ShowS)
-> Show StmtWhileContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtWhileContent -> ShowS
showsPrec :: Int -> StmtWhileContent -> ShowS
$cshow :: StmtWhileContent -> FilePath
show :: StmtWhileContent -> FilePath
$cshowList :: [StmtWhileContent] -> ShowS
showList :: [StmtWhileContent] -> ShowS
Show, StmtWhileContent -> StmtWhileContent -> Bool
(StmtWhileContent -> StmtWhileContent -> Bool)
-> (StmtWhileContent -> StmtWhileContent -> Bool)
-> Eq StmtWhileContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtWhileContent -> StmtWhileContent -> Bool
== :: StmtWhileContent -> StmtWhileContent -> Bool
$c/= :: StmtWhileContent -> StmtWhileContent -> Bool
/= :: StmtWhileContent -> StmtWhileContent -> Bool
Eq, Eq StmtWhileContent
Eq StmtWhileContent
-> (StmtWhileContent -> StmtWhileContent -> Ordering)
-> (StmtWhileContent -> StmtWhileContent -> Bool)
-> (StmtWhileContent -> StmtWhileContent -> Bool)
-> (StmtWhileContent -> StmtWhileContent -> Bool)
-> (StmtWhileContent -> StmtWhileContent -> Bool)
-> (StmtWhileContent -> StmtWhileContent -> StmtWhileContent)
-> (StmtWhileContent -> StmtWhileContent -> StmtWhileContent)
-> Ord StmtWhileContent
StmtWhileContent -> StmtWhileContent -> Bool
StmtWhileContent -> StmtWhileContent -> Ordering
StmtWhileContent -> StmtWhileContent -> StmtWhileContent
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
$ccompare :: StmtWhileContent -> StmtWhileContent -> Ordering
compare :: StmtWhileContent -> StmtWhileContent -> Ordering
$c< :: StmtWhileContent -> StmtWhileContent -> Bool
< :: StmtWhileContent -> StmtWhileContent -> Bool
$c<= :: StmtWhileContent -> StmtWhileContent -> Bool
<= :: StmtWhileContent -> StmtWhileContent -> Bool
$c> :: StmtWhileContent -> StmtWhileContent -> Bool
> :: StmtWhileContent -> StmtWhileContent -> Bool
$c>= :: StmtWhileContent -> StmtWhileContent -> Bool
>= :: StmtWhileContent -> StmtWhileContent -> Bool
$cmax :: StmtWhileContent -> StmtWhileContent -> StmtWhileContent
max :: StmtWhileContent -> StmtWhileContent -> StmtWhileContent
$cmin :: StmtWhileContent -> StmtWhileContent -> StmtWhileContent
min :: StmtWhileContent -> StmtWhileContent -> StmtWhileContent
Ord, (forall x. StmtWhileContent -> Rep StmtWhileContent x)
-> (forall x. Rep StmtWhileContent x -> StmtWhileContent)
-> Generic StmtWhileContent
forall x. Rep StmtWhileContent x -> StmtWhileContent
forall x. StmtWhileContent -> Rep StmtWhileContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StmtWhileContent -> Rep StmtWhileContent x
from :: forall x. StmtWhileContent -> Rep StmtWhileContent x
$cto :: forall x. Rep StmtWhileContent x -> StmtWhileContent
to :: forall x. Rep StmtWhileContent x -> StmtWhileContent
Generic, [StmtWhileContent] -> Value
[StmtWhileContent] -> Encoding
StmtWhileContent -> Bool
StmtWhileContent -> Value
StmtWhileContent -> Encoding
(StmtWhileContent -> Value)
-> (StmtWhileContent -> Encoding)
-> ([StmtWhileContent] -> Value)
-> ([StmtWhileContent] -> Encoding)
-> (StmtWhileContent -> Bool)
-> ToJSON StmtWhileContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StmtWhileContent -> Value
toJSON :: StmtWhileContent -> Value
$ctoEncoding :: StmtWhileContent -> Encoding
toEncoding :: StmtWhileContent -> Encoding
$ctoJSONList :: [StmtWhileContent] -> Value
toJSONList :: [StmtWhileContent] -> Value
$ctoEncodingList :: [StmtWhileContent] -> Encoding
toEncodingList :: [StmtWhileContent] -> Encoding
$comitField :: StmtWhileContent -> Bool
omitField :: StmtWhileContent -> Bool
ToJSON, Maybe StmtWhileContent
Value -> Parser [StmtWhileContent]
Value -> Parser StmtWhileContent
(Value -> Parser StmtWhileContent)
-> (Value -> Parser [StmtWhileContent])
-> Maybe StmtWhileContent
-> FromJSON StmtWhileContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StmtWhileContent
parseJSON :: Value -> Parser StmtWhileContent
$cparseJSONList :: Value -> Parser [StmtWhileContent]
parseJSONList :: Value -> Parser [StmtWhileContent]
$comittedField :: Maybe StmtWhileContent
omittedField :: Maybe StmtWhileContent
FromJSON )

data StmtReturnContent
   = StmtReturnContent
     {
         StmtReturnContent -> Maybe Exp
stmtReturnValue :: Maybe Exp,
         StmtReturnContent -> Location
stmtReturnLocation :: Location
     }
     deriving ( Int -> StmtReturnContent -> ShowS
[StmtReturnContent] -> ShowS
StmtReturnContent -> FilePath
(Int -> StmtReturnContent -> ShowS)
-> (StmtReturnContent -> FilePath)
-> ([StmtReturnContent] -> ShowS)
-> Show StmtReturnContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StmtReturnContent -> ShowS
showsPrec :: Int -> StmtReturnContent -> ShowS
$cshow :: StmtReturnContent -> FilePath
show :: StmtReturnContent -> FilePath
$cshowList :: [StmtReturnContent] -> ShowS
showList :: [StmtReturnContent] -> ShowS
Show, StmtReturnContent -> StmtReturnContent -> Bool
(StmtReturnContent -> StmtReturnContent -> Bool)
-> (StmtReturnContent -> StmtReturnContent -> Bool)
-> Eq StmtReturnContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StmtReturnContent -> StmtReturnContent -> Bool
== :: StmtReturnContent -> StmtReturnContent -> Bool
$c/= :: StmtReturnContent -> StmtReturnContent -> Bool
/= :: StmtReturnContent -> StmtReturnContent -> Bool
Eq, Eq StmtReturnContent
Eq StmtReturnContent
-> (StmtReturnContent -> StmtReturnContent -> Ordering)
-> (StmtReturnContent -> StmtReturnContent -> Bool)
-> (StmtReturnContent -> StmtReturnContent -> Bool)
-> (StmtReturnContent -> StmtReturnContent -> Bool)
-> (StmtReturnContent -> StmtReturnContent -> Bool)
-> (StmtReturnContent -> StmtReturnContent -> StmtReturnContent)
-> (StmtReturnContent -> StmtReturnContent -> StmtReturnContent)
-> Ord StmtReturnContent
StmtReturnContent -> StmtReturnContent -> Bool
StmtReturnContent -> StmtReturnContent -> Ordering
StmtReturnContent -> StmtReturnContent -> StmtReturnContent
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
$ccompare :: StmtReturnContent -> StmtReturnContent -> Ordering
compare :: StmtReturnContent -> StmtReturnContent -> Ordering
$c< :: StmtReturnContent -> StmtReturnContent -> Bool
< :: StmtReturnContent -> StmtReturnContent -> Bool
$c<= :: StmtReturnContent -> StmtReturnContent -> Bool
<= :: StmtReturnContent -> StmtReturnContent -> Bool
$c> :: StmtReturnContent -> StmtReturnContent -> Bool
> :: StmtReturnContent -> StmtReturnContent -> Bool
$c>= :: StmtReturnContent -> StmtReturnContent -> Bool
>= :: StmtReturnContent -> StmtReturnContent -> Bool
$cmax :: StmtReturnContent -> StmtReturnContent -> StmtReturnContent
max :: StmtReturnContent -> StmtReturnContent -> StmtReturnContent
$cmin :: StmtReturnContent -> StmtReturnContent -> StmtReturnContent
min :: StmtReturnContent -> StmtReturnContent -> StmtReturnContent
Ord, (forall x. StmtReturnContent -> Rep StmtReturnContent x)
-> (forall x. Rep StmtReturnContent x -> StmtReturnContent)
-> Generic StmtReturnContent
forall x. Rep StmtReturnContent x -> StmtReturnContent
forall x. StmtReturnContent -> Rep StmtReturnContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StmtReturnContent -> Rep StmtReturnContent x
from :: forall x. StmtReturnContent -> Rep StmtReturnContent x
$cto :: forall x. Rep StmtReturnContent x -> StmtReturnContent
to :: forall x. Rep StmtReturnContent x -> StmtReturnContent
Generic, [StmtReturnContent] -> Value
[StmtReturnContent] -> Encoding
StmtReturnContent -> Bool
StmtReturnContent -> Value
StmtReturnContent -> Encoding
(StmtReturnContent -> Value)
-> (StmtReturnContent -> Encoding)
-> ([StmtReturnContent] -> Value)
-> ([StmtReturnContent] -> Encoding)
-> (StmtReturnContent -> Bool)
-> ToJSON StmtReturnContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StmtReturnContent -> Value
toJSON :: StmtReturnContent -> Value
$ctoEncoding :: StmtReturnContent -> Encoding
toEncoding :: StmtReturnContent -> Encoding
$ctoJSONList :: [StmtReturnContent] -> Value
toJSONList :: [StmtReturnContent] -> Value
$ctoEncodingList :: [StmtReturnContent] -> Encoding
toEncodingList :: [StmtReturnContent] -> Encoding
$comitField :: StmtReturnContent -> Bool
omitField :: StmtReturnContent -> Bool
ToJSON, Maybe StmtReturnContent
Value -> Parser [StmtReturnContent]
Value -> Parser StmtReturnContent
(Value -> Parser StmtReturnContent)
-> (Value -> Parser [StmtReturnContent])
-> Maybe StmtReturnContent
-> FromJSON StmtReturnContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StmtReturnContent
parseJSON :: Value -> Parser StmtReturnContent
$cparseJSONList :: Value -> Parser [StmtReturnContent]
parseJSONList :: Value -> Parser [StmtReturnContent]
$comittedField :: Maybe StmtReturnContent
omittedField :: Maybe StmtReturnContent
FromJSON )

data ExpCallContent
   = ExpCallContent
     {
         ExpCallContent -> Exp
callee :: Exp,
         ExpCallContent -> [Exp]
args :: [ Exp ],
         ExpCallContent -> Location
expCallLocation :: Location
     }
     deriving ( Int -> ExpCallContent -> ShowS
[ExpCallContent] -> ShowS
ExpCallContent -> FilePath
(Int -> ExpCallContent -> ShowS)
-> (ExpCallContent -> FilePath)
-> ([ExpCallContent] -> ShowS)
-> Show ExpCallContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpCallContent -> ShowS
showsPrec :: Int -> ExpCallContent -> ShowS
$cshow :: ExpCallContent -> FilePath
show :: ExpCallContent -> FilePath
$cshowList :: [ExpCallContent] -> ShowS
showList :: [ExpCallContent] -> ShowS
Show, ExpCallContent -> ExpCallContent -> Bool
(ExpCallContent -> ExpCallContent -> Bool)
-> (ExpCallContent -> ExpCallContent -> Bool) -> Eq ExpCallContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpCallContent -> ExpCallContent -> Bool
== :: ExpCallContent -> ExpCallContent -> Bool
$c/= :: ExpCallContent -> ExpCallContent -> Bool
/= :: ExpCallContent -> ExpCallContent -> Bool
Eq, Eq ExpCallContent
Eq ExpCallContent
-> (ExpCallContent -> ExpCallContent -> Ordering)
-> (ExpCallContent -> ExpCallContent -> Bool)
-> (ExpCallContent -> ExpCallContent -> Bool)
-> (ExpCallContent -> ExpCallContent -> Bool)
-> (ExpCallContent -> ExpCallContent -> Bool)
-> (ExpCallContent -> ExpCallContent -> ExpCallContent)
-> (ExpCallContent -> ExpCallContent -> ExpCallContent)
-> Ord ExpCallContent
ExpCallContent -> ExpCallContent -> Bool
ExpCallContent -> ExpCallContent -> Ordering
ExpCallContent -> ExpCallContent -> ExpCallContent
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
$ccompare :: ExpCallContent -> ExpCallContent -> Ordering
compare :: ExpCallContent -> ExpCallContent -> Ordering
$c< :: ExpCallContent -> ExpCallContent -> Bool
< :: ExpCallContent -> ExpCallContent -> Bool
$c<= :: ExpCallContent -> ExpCallContent -> Bool
<= :: ExpCallContent -> ExpCallContent -> Bool
$c> :: ExpCallContent -> ExpCallContent -> Bool
> :: ExpCallContent -> ExpCallContent -> Bool
$c>= :: ExpCallContent -> ExpCallContent -> Bool
>= :: ExpCallContent -> ExpCallContent -> Bool
$cmax :: ExpCallContent -> ExpCallContent -> ExpCallContent
max :: ExpCallContent -> ExpCallContent -> ExpCallContent
$cmin :: ExpCallContent -> ExpCallContent -> ExpCallContent
min :: ExpCallContent -> ExpCallContent -> ExpCallContent
Ord, (forall x. ExpCallContent -> Rep ExpCallContent x)
-> (forall x. Rep ExpCallContent x -> ExpCallContent)
-> Generic ExpCallContent
forall x. Rep ExpCallContent x -> ExpCallContent
forall x. ExpCallContent -> Rep ExpCallContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExpCallContent -> Rep ExpCallContent x
from :: forall x. ExpCallContent -> Rep ExpCallContent x
$cto :: forall x. Rep ExpCallContent x -> ExpCallContent
to :: forall x. Rep ExpCallContent x -> ExpCallContent
Generic, [ExpCallContent] -> Value
[ExpCallContent] -> Encoding
ExpCallContent -> Bool
ExpCallContent -> Value
ExpCallContent -> Encoding
(ExpCallContent -> Value)
-> (ExpCallContent -> Encoding)
-> ([ExpCallContent] -> Value)
-> ([ExpCallContent] -> Encoding)
-> (ExpCallContent -> Bool)
-> ToJSON ExpCallContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExpCallContent -> Value
toJSON :: ExpCallContent -> Value
$ctoEncoding :: ExpCallContent -> Encoding
toEncoding :: ExpCallContent -> Encoding
$ctoJSONList :: [ExpCallContent] -> Value
toJSONList :: [ExpCallContent] -> Value
$ctoEncodingList :: [ExpCallContent] -> Encoding
toEncodingList :: [ExpCallContent] -> Encoding
$comitField :: ExpCallContent -> Bool
omitField :: ExpCallContent -> Bool
ToJSON, Maybe ExpCallContent
Value -> Parser [ExpCallContent]
Value -> Parser ExpCallContent
(Value -> Parser ExpCallContent)
-> (Value -> Parser [ExpCallContent])
-> Maybe ExpCallContent
-> FromJSON ExpCallContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExpCallContent
parseJSON :: Value -> Parser ExpCallContent
$cparseJSONList :: Value -> Parser [ExpCallContent]
parseJSONList :: Value -> Parser [ExpCallContent]
$comittedField :: Maybe ExpCallContent
omittedField :: Maybe ExpCallContent
FromJSON )

data VarFieldContent
   = VarFieldContent
     {
         VarFieldContent -> Exp
varFieldLhs :: Exp,
         VarFieldContent -> FieldName
varFieldName :: Token.FieldName,
         VarFieldContent -> Location
varFieldLocation :: Location
     }
     deriving ( Int -> VarFieldContent -> ShowS
[VarFieldContent] -> ShowS
VarFieldContent -> FilePath
(Int -> VarFieldContent -> ShowS)
-> (VarFieldContent -> FilePath)
-> ([VarFieldContent] -> ShowS)
-> Show VarFieldContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarFieldContent -> ShowS
showsPrec :: Int -> VarFieldContent -> ShowS
$cshow :: VarFieldContent -> FilePath
show :: VarFieldContent -> FilePath
$cshowList :: [VarFieldContent] -> ShowS
showList :: [VarFieldContent] -> ShowS
Show, VarFieldContent -> VarFieldContent -> Bool
(VarFieldContent -> VarFieldContent -> Bool)
-> (VarFieldContent -> VarFieldContent -> Bool)
-> Eq VarFieldContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarFieldContent -> VarFieldContent -> Bool
== :: VarFieldContent -> VarFieldContent -> Bool
$c/= :: VarFieldContent -> VarFieldContent -> Bool
/= :: VarFieldContent -> VarFieldContent -> Bool
Eq, Eq VarFieldContent
Eq VarFieldContent
-> (VarFieldContent -> VarFieldContent -> Ordering)
-> (VarFieldContent -> VarFieldContent -> Bool)
-> (VarFieldContent -> VarFieldContent -> Bool)
-> (VarFieldContent -> VarFieldContent -> Bool)
-> (VarFieldContent -> VarFieldContent -> Bool)
-> (VarFieldContent -> VarFieldContent -> VarFieldContent)
-> (VarFieldContent -> VarFieldContent -> VarFieldContent)
-> Ord VarFieldContent
VarFieldContent -> VarFieldContent -> Bool
VarFieldContent -> VarFieldContent -> Ordering
VarFieldContent -> VarFieldContent -> VarFieldContent
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
$ccompare :: VarFieldContent -> VarFieldContent -> Ordering
compare :: VarFieldContent -> VarFieldContent -> Ordering
$c< :: VarFieldContent -> VarFieldContent -> Bool
< :: VarFieldContent -> VarFieldContent -> Bool
$c<= :: VarFieldContent -> VarFieldContent -> Bool
<= :: VarFieldContent -> VarFieldContent -> Bool
$c> :: VarFieldContent -> VarFieldContent -> Bool
> :: VarFieldContent -> VarFieldContent -> Bool
$c>= :: VarFieldContent -> VarFieldContent -> Bool
>= :: VarFieldContent -> VarFieldContent -> Bool
$cmax :: VarFieldContent -> VarFieldContent -> VarFieldContent
max :: VarFieldContent -> VarFieldContent -> VarFieldContent
$cmin :: VarFieldContent -> VarFieldContent -> VarFieldContent
min :: VarFieldContent -> VarFieldContent -> VarFieldContent
Ord, (forall x. VarFieldContent -> Rep VarFieldContent x)
-> (forall x. Rep VarFieldContent x -> VarFieldContent)
-> Generic VarFieldContent
forall x. Rep VarFieldContent x -> VarFieldContent
forall x. VarFieldContent -> Rep VarFieldContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VarFieldContent -> Rep VarFieldContent x
from :: forall x. VarFieldContent -> Rep VarFieldContent x
$cto :: forall x. Rep VarFieldContent x -> VarFieldContent
to :: forall x. Rep VarFieldContent x -> VarFieldContent
Generic, [VarFieldContent] -> Value
[VarFieldContent] -> Encoding
VarFieldContent -> Bool
VarFieldContent -> Value
VarFieldContent -> Encoding
(VarFieldContent -> Value)
-> (VarFieldContent -> Encoding)
-> ([VarFieldContent] -> Value)
-> ([VarFieldContent] -> Encoding)
-> (VarFieldContent -> Bool)
-> ToJSON VarFieldContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: VarFieldContent -> Value
toJSON :: VarFieldContent -> Value
$ctoEncoding :: VarFieldContent -> Encoding
toEncoding :: VarFieldContent -> Encoding
$ctoJSONList :: [VarFieldContent] -> Value
toJSONList :: [VarFieldContent] -> Value
$ctoEncodingList :: [VarFieldContent] -> Encoding
toEncodingList :: [VarFieldContent] -> Encoding
$comitField :: VarFieldContent -> Bool
omitField :: VarFieldContent -> Bool
ToJSON, Maybe VarFieldContent
Value -> Parser [VarFieldContent]
Value -> Parser VarFieldContent
(Value -> Parser VarFieldContent)
-> (Value -> Parser [VarFieldContent])
-> Maybe VarFieldContent
-> FromJSON VarFieldContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser VarFieldContent
parseJSON :: Value -> Parser VarFieldContent
$cparseJSONList :: Value -> Parser [VarFieldContent]
parseJSONList :: Value -> Parser [VarFieldContent]
$comittedField :: Maybe VarFieldContent
omittedField :: Maybe VarFieldContent
FromJSON )

data VarSimpleContent
   = VarSimpleContent
     {
         VarSimpleContent -> VarName
varName :: Token.VarName
     }
     deriving ( Int -> VarSimpleContent -> ShowS
[VarSimpleContent] -> ShowS
VarSimpleContent -> FilePath
(Int -> VarSimpleContent -> ShowS)
-> (VarSimpleContent -> FilePath)
-> ([VarSimpleContent] -> ShowS)
-> Show VarSimpleContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarSimpleContent -> ShowS
showsPrec :: Int -> VarSimpleContent -> ShowS
$cshow :: VarSimpleContent -> FilePath
show :: VarSimpleContent -> FilePath
$cshowList :: [VarSimpleContent] -> ShowS
showList :: [VarSimpleContent] -> ShowS
Show, VarSimpleContent -> VarSimpleContent -> Bool
(VarSimpleContent -> VarSimpleContent -> Bool)
-> (VarSimpleContent -> VarSimpleContent -> Bool)
-> Eq VarSimpleContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarSimpleContent -> VarSimpleContent -> Bool
== :: VarSimpleContent -> VarSimpleContent -> Bool
$c/= :: VarSimpleContent -> VarSimpleContent -> Bool
/= :: VarSimpleContent -> VarSimpleContent -> Bool
Eq, Eq VarSimpleContent
Eq VarSimpleContent
-> (VarSimpleContent -> VarSimpleContent -> Ordering)
-> (VarSimpleContent -> VarSimpleContent -> Bool)
-> (VarSimpleContent -> VarSimpleContent -> Bool)
-> (VarSimpleContent -> VarSimpleContent -> Bool)
-> (VarSimpleContent -> VarSimpleContent -> Bool)
-> (VarSimpleContent -> VarSimpleContent -> VarSimpleContent)
-> (VarSimpleContent -> VarSimpleContent -> VarSimpleContent)
-> Ord VarSimpleContent
VarSimpleContent -> VarSimpleContent -> Bool
VarSimpleContent -> VarSimpleContent -> Ordering
VarSimpleContent -> VarSimpleContent -> VarSimpleContent
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
$ccompare :: VarSimpleContent -> VarSimpleContent -> Ordering
compare :: VarSimpleContent -> VarSimpleContent -> Ordering
$c< :: VarSimpleContent -> VarSimpleContent -> Bool
< :: VarSimpleContent -> VarSimpleContent -> Bool
$c<= :: VarSimpleContent -> VarSimpleContent -> Bool
<= :: VarSimpleContent -> VarSimpleContent -> Bool
$c> :: VarSimpleContent -> VarSimpleContent -> Bool
> :: VarSimpleContent -> VarSimpleContent -> Bool
$c>= :: VarSimpleContent -> VarSimpleContent -> Bool
>= :: VarSimpleContent -> VarSimpleContent -> Bool
$cmax :: VarSimpleContent -> VarSimpleContent -> VarSimpleContent
max :: VarSimpleContent -> VarSimpleContent -> VarSimpleContent
$cmin :: VarSimpleContent -> VarSimpleContent -> VarSimpleContent
min :: VarSimpleContent -> VarSimpleContent -> VarSimpleContent
Ord, (forall x. VarSimpleContent -> Rep VarSimpleContent x)
-> (forall x. Rep VarSimpleContent x -> VarSimpleContent)
-> Generic VarSimpleContent
forall x. Rep VarSimpleContent x -> VarSimpleContent
forall x. VarSimpleContent -> Rep VarSimpleContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VarSimpleContent -> Rep VarSimpleContent x
from :: forall x. VarSimpleContent -> Rep VarSimpleContent x
$cto :: forall x. Rep VarSimpleContent x -> VarSimpleContent
to :: forall x. Rep VarSimpleContent x -> VarSimpleContent
Generic, [VarSimpleContent] -> Value
[VarSimpleContent] -> Encoding
VarSimpleContent -> Bool
VarSimpleContent -> Value
VarSimpleContent -> Encoding
(VarSimpleContent -> Value)
-> (VarSimpleContent -> Encoding)
-> ([VarSimpleContent] -> Value)
-> ([VarSimpleContent] -> Encoding)
-> (VarSimpleContent -> Bool)
-> ToJSON VarSimpleContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: VarSimpleContent -> Value
toJSON :: VarSimpleContent -> Value
$ctoEncoding :: VarSimpleContent -> Encoding
toEncoding :: VarSimpleContent -> Encoding
$ctoJSONList :: [VarSimpleContent] -> Value
toJSONList :: [VarSimpleContent] -> Value
$ctoEncodingList :: [VarSimpleContent] -> Encoding
toEncodingList :: [VarSimpleContent] -> Encoding
$comitField :: VarSimpleContent -> Bool
omitField :: VarSimpleContent -> Bool
ToJSON, Maybe VarSimpleContent
Value -> Parser [VarSimpleContent]
Value -> Parser VarSimpleContent
(Value -> Parser VarSimpleContent)
-> (Value -> Parser [VarSimpleContent])
-> Maybe VarSimpleContent
-> FromJSON VarSimpleContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser VarSimpleContent
parseJSON :: Value -> Parser VarSimpleContent
$cparseJSONList :: Value -> Parser [VarSimpleContent]
parseJSONList :: Value -> Parser [VarSimpleContent]
$comittedField :: Maybe VarSimpleContent
omittedField :: Maybe VarSimpleContent
FromJSON )

data VarSubscriptContent
   = VarSubscriptContent
     {
         VarSubscriptContent -> Exp
varSubscriptLhs :: Exp,
         VarSubscriptContent -> Exp
varSubscriptIdx :: Exp,
         VarSubscriptContent -> Location
varSubscriptLocation :: Location
     }
     deriving ( Int -> VarSubscriptContent -> ShowS
[VarSubscriptContent] -> ShowS
VarSubscriptContent -> FilePath
(Int -> VarSubscriptContent -> ShowS)
-> (VarSubscriptContent -> FilePath)
-> ([VarSubscriptContent] -> ShowS)
-> Show VarSubscriptContent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarSubscriptContent -> ShowS
showsPrec :: Int -> VarSubscriptContent -> ShowS
$cshow :: VarSubscriptContent -> FilePath
show :: VarSubscriptContent -> FilePath
$cshowList :: [VarSubscriptContent] -> ShowS
showList :: [VarSubscriptContent] -> ShowS
Show, VarSubscriptContent -> VarSubscriptContent -> Bool
(VarSubscriptContent -> VarSubscriptContent -> Bool)
-> (VarSubscriptContent -> VarSubscriptContent -> Bool)
-> Eq VarSubscriptContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarSubscriptContent -> VarSubscriptContent -> Bool
== :: VarSubscriptContent -> VarSubscriptContent -> Bool
$c/= :: VarSubscriptContent -> VarSubscriptContent -> Bool
/= :: VarSubscriptContent -> VarSubscriptContent -> Bool
Eq, Eq VarSubscriptContent
Eq VarSubscriptContent
-> (VarSubscriptContent -> VarSubscriptContent -> Ordering)
-> (VarSubscriptContent -> VarSubscriptContent -> Bool)
-> (VarSubscriptContent -> VarSubscriptContent -> Bool)
-> (VarSubscriptContent -> VarSubscriptContent -> Bool)
-> (VarSubscriptContent -> VarSubscriptContent -> Bool)
-> (VarSubscriptContent
    -> VarSubscriptContent -> VarSubscriptContent)
-> (VarSubscriptContent
    -> VarSubscriptContent -> VarSubscriptContent)
-> Ord VarSubscriptContent
VarSubscriptContent -> VarSubscriptContent -> Bool
VarSubscriptContent -> VarSubscriptContent -> Ordering
VarSubscriptContent -> VarSubscriptContent -> VarSubscriptContent
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
$ccompare :: VarSubscriptContent -> VarSubscriptContent -> Ordering
compare :: VarSubscriptContent -> VarSubscriptContent -> Ordering
$c< :: VarSubscriptContent -> VarSubscriptContent -> Bool
< :: VarSubscriptContent -> VarSubscriptContent -> Bool
$c<= :: VarSubscriptContent -> VarSubscriptContent -> Bool
<= :: VarSubscriptContent -> VarSubscriptContent -> Bool
$c> :: VarSubscriptContent -> VarSubscriptContent -> Bool
> :: VarSubscriptContent -> VarSubscriptContent -> Bool
$c>= :: VarSubscriptContent -> VarSubscriptContent -> Bool
>= :: VarSubscriptContent -> VarSubscriptContent -> Bool
$cmax :: VarSubscriptContent -> VarSubscriptContent -> VarSubscriptContent
max :: VarSubscriptContent -> VarSubscriptContent -> VarSubscriptContent
$cmin :: VarSubscriptContent -> VarSubscriptContent -> VarSubscriptContent
min :: VarSubscriptContent -> VarSubscriptContent -> VarSubscriptContent
Ord, (forall x. VarSubscriptContent -> Rep VarSubscriptContent x)
-> (forall x. Rep VarSubscriptContent x -> VarSubscriptContent)
-> Generic VarSubscriptContent
forall x. Rep VarSubscriptContent x -> VarSubscriptContent
forall x. VarSubscriptContent -> Rep VarSubscriptContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VarSubscriptContent -> Rep VarSubscriptContent x
from :: forall x. VarSubscriptContent -> Rep VarSubscriptContent x
$cto :: forall x. Rep VarSubscriptContent x -> VarSubscriptContent
to :: forall x. Rep VarSubscriptContent x -> VarSubscriptContent
Generic, [VarSubscriptContent] -> Value
[VarSubscriptContent] -> Encoding
VarSubscriptContent -> Bool
VarSubscriptContent -> Value
VarSubscriptContent -> Encoding
(VarSubscriptContent -> Value)
-> (VarSubscriptContent -> Encoding)
-> ([VarSubscriptContent] -> Value)
-> ([VarSubscriptContent] -> Encoding)
-> (VarSubscriptContent -> Bool)
-> ToJSON VarSubscriptContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: VarSubscriptContent -> Value
toJSON :: VarSubscriptContent -> Value
$ctoEncoding :: VarSubscriptContent -> Encoding
toEncoding :: VarSubscriptContent -> Encoding
$ctoJSONList :: [VarSubscriptContent] -> Value
toJSONList :: [VarSubscriptContent] -> Value
$ctoEncodingList :: [VarSubscriptContent] -> Encoding
toEncodingList :: [VarSubscriptContent] -> Encoding
$comitField :: VarSubscriptContent -> Bool
omitField :: VarSubscriptContent -> Bool
ToJSON, Maybe VarSubscriptContent
Value -> Parser [VarSubscriptContent]
Value -> Parser VarSubscriptContent
(Value -> Parser VarSubscriptContent)
-> (Value -> Parser [VarSubscriptContent])
-> Maybe VarSubscriptContent
-> FromJSON VarSubscriptContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser VarSubscriptContent
parseJSON :: Value -> Parser VarSubscriptContent
$cparseJSONList :: Value -> Parser [VarSubscriptContent]
parseJSONList :: Value -> Parser [VarSubscriptContent]
$comittedField :: Maybe VarSubscriptContent
omittedField :: Maybe VarSubscriptContent
FromJSON )

data Var
   = VarSimple VarSimpleContent
   | VarField VarFieldContent
   | VarSubscript VarSubscriptContent
   deriving ( Int -> Var -> ShowS
[Var] -> ShowS
Var -> FilePath
(Int -> Var -> ShowS)
-> (Var -> FilePath) -> ([Var] -> ShowS) -> Show Var
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Var -> ShowS
showsPrec :: Int -> Var -> ShowS
$cshow :: Var -> FilePath
show :: Var -> FilePath
$cshowList :: [Var] -> ShowS
showList :: [Var] -> ShowS
Show, Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
/= :: Var -> Var -> Bool
Eq, Eq Var
Eq Var
-> (Var -> Var -> Ordering)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Var)
-> (Var -> Var -> Var)
-> Ord Var
Var -> Var -> Bool
Var -> Var -> Ordering
Var -> Var -> Var
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
$ccompare :: Var -> Var -> Ordering
compare :: Var -> Var -> Ordering
$c< :: Var -> Var -> Bool
< :: Var -> Var -> Bool
$c<= :: Var -> Var -> Bool
<= :: Var -> Var -> Bool
$c> :: Var -> Var -> Bool
> :: Var -> Var -> Bool
$c>= :: Var -> Var -> Bool
>= :: Var -> Var -> Bool
$cmax :: Var -> Var -> Var
max :: Var -> Var -> Var
$cmin :: Var -> Var -> Var
min :: Var -> Var -> Var
Ord, (forall x. Var -> Rep Var x)
-> (forall x. Rep Var x -> Var) -> Generic Var
forall x. Rep Var x -> Var
forall x. Var -> Rep Var x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Var -> Rep Var x
from :: forall x. Var -> Rep Var x
$cto :: forall x. Rep Var x -> Var
to :: forall x. Rep Var x -> Var
Generic, [Var] -> Value
[Var] -> Encoding
Var -> Bool
Var -> Value
Var -> Encoding
(Var -> Value)
-> (Var -> Encoding)
-> ([Var] -> Value)
-> ([Var] -> Encoding)
-> (Var -> Bool)
-> ToJSON Var
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Var -> Value
toJSON :: Var -> Value
$ctoEncoding :: Var -> Encoding
toEncoding :: Var -> Encoding
$ctoJSONList :: [Var] -> Value
toJSONList :: [Var] -> Value
$ctoEncodingList :: [Var] -> Encoding
toEncodingList :: [Var] -> Encoding
$comitField :: Var -> Bool
omitField :: Var -> Bool
ToJSON, Maybe Var
Value -> Parser [Var]
Value -> Parser Var
(Value -> Parser Var)
-> (Value -> Parser [Var]) -> Maybe Var -> FromJSON Var
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Var
parseJSON :: Value -> Parser Var
$cparseJSONList :: Value -> Parser [Var]
parseJSONList :: Value -> Parser [Var]
$comittedField :: Maybe Var
omittedField :: Maybe Var
FromJSON )

locationVar :: Var -> Location
locationVar :: Var -> Location
locationVar (VarSimple    VarSimpleContent
v) = VarName -> Location
Token.getVarNameLocation (VarSimpleContent -> VarName
varName VarSimpleContent
v)
locationVar (VarField     VarFieldContent
v) = VarFieldContent -> Location
varFieldLocation VarFieldContent
v
locationVar (VarSubscript VarSubscriptContent
v) = VarSubscriptContent -> Location
varSubscriptLocation VarSubscriptContent
v