{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE StrictData        #-}
module Language.Cimple.AST
    ( AssignOp (..)
    , BinaryOp (..)
    , UnaryOp (..)
    , LiteralType (..)
    , Node (..)
    , Scope (..)
    , CommentStyle (..)
    ) where

import           Data.Aeson   (FromJSON, ToJSON)
import           GHC.Generics (Generic)

data Node attr lexeme
    = Attr attr (Node attr lexeme)
    -- Preprocessor
    | PreprocInclude lexeme
    | PreprocDefine lexeme
    | PreprocDefineConst lexeme (Node attr lexeme)
    | PreprocDefineMacro lexeme [Node attr lexeme] (Node attr lexeme)
    | PreprocIf (Node attr lexeme) [Node attr lexeme] (Node attr lexeme)
    | PreprocIfdef lexeme [Node attr lexeme] (Node attr lexeme)
    | PreprocIfndef lexeme [Node attr lexeme] (Node attr lexeme)
    | PreprocElse [Node attr lexeme]
    | PreprocElif (Node attr lexeme) [Node attr lexeme] (Node attr lexeme)
    | PreprocUndef lexeme
    | PreprocDefined lexeme
    | PreprocScopedDefine (Node attr lexeme) [Node attr lexeme] (Node attr lexeme)
    | MacroBodyStmt [Node attr lexeme]
    | MacroBodyFunCall (Node attr lexeme)
    | MacroParam lexeme
    | StaticAssert (Node attr lexeme) lexeme
    -- Comments
    | LicenseDecl lexeme [Node attr lexeme]
    | CopyrightDecl lexeme (Maybe lexeme) [lexeme]
    | Comment CommentStyle lexeme [Node attr lexeme] lexeme
    | CommentBlock lexeme
    | CommentWord lexeme
    | Commented (Node attr lexeme) (Node attr lexeme)
    -- Namespace-like blocks
    | ExternC [Node attr lexeme]
    | Class Scope lexeme [Node attr lexeme] [Node attr lexeme]
    | Namespace Scope lexeme [Node attr lexeme]
    -- Statements
    | CompoundStmt [Node attr lexeme]
    | Break
    | Goto lexeme
    | Continue
    | Return (Maybe (Node attr lexeme))
    | SwitchStmt (Node attr lexeme) [Node attr lexeme]
    | IfStmt (Node attr lexeme) [Node attr lexeme] (Maybe (Node attr lexeme))
    | ForStmt (Node attr lexeme) (Node attr lexeme) (Node attr lexeme) [Node attr lexeme]
    | WhileStmt (Node attr lexeme) [Node attr lexeme]
    | DoWhileStmt [Node attr lexeme] (Node attr lexeme)
    | Case (Node attr lexeme) (Node attr lexeme)
    | Default (Node attr lexeme)
    | Label lexeme (Node attr lexeme)
    -- Variable declarations
    | VLA (Node attr lexeme) lexeme (Node attr lexeme)
    | VarDecl (Node attr lexeme) (Node attr lexeme)
    | Declarator (Node attr lexeme) (Maybe (Node attr lexeme))
    | DeclSpecVar lexeme
    | DeclSpecArray (Node attr lexeme) (Maybe (Node attr lexeme))
    -- Expressions
    | InitialiserList [Node attr lexeme]
    | UnaryExpr UnaryOp (Node attr lexeme)
    | BinaryExpr (Node attr lexeme) BinaryOp (Node attr lexeme)
    | TernaryExpr (Node attr lexeme) (Node attr lexeme) (Node attr lexeme)
    | AssignExpr (Node attr lexeme) AssignOp (Node attr lexeme)
    | ParenExpr (Node attr lexeme)
    | CastExpr (Node attr lexeme) (Node attr lexeme)
    | CompoundExpr (Node attr lexeme) (Node attr lexeme)
    | SizeofExpr (Node attr lexeme)
    | SizeofType (Node attr lexeme)
    | LiteralExpr LiteralType lexeme
    | VarExpr lexeme
    | MemberAccess (Node attr lexeme) lexeme
    | PointerAccess (Node attr lexeme) lexeme
    | ArrayAccess (Node attr lexeme) (Node attr lexeme)
    | FunctionCall (Node attr lexeme) [Node attr lexeme]
    | CommentExpr (Node attr lexeme) (Node attr lexeme)
    -- Type definitions
    | EnumClass lexeme [Node attr lexeme]
    | EnumConsts (Maybe lexeme) [Node attr lexeme]
    | EnumDecl lexeme [Node attr lexeme] lexeme
    | Enumerator lexeme (Maybe (Node attr lexeme))
    | ClassForward lexeme [Node attr lexeme]
    | Typedef (Node attr lexeme) lexeme
    | TypedefFunction (Node attr lexeme)
    | Struct lexeme [Node attr lexeme]
    | Union lexeme [Node attr lexeme]
    | MemberDecl (Node attr lexeme) (Node attr lexeme) (Maybe lexeme)
    | TyConst (Node attr lexeme)
    | TyPointer (Node attr lexeme)
    | TyStruct lexeme
    | TyFunc lexeme
    | TyStd lexeme
    | TyVar lexeme
    | TyUserDefined lexeme
    -- Functions
    | FunctionDecl Scope (Node attr lexeme) (Maybe (Node attr lexeme))
    | FunctionDefn Scope (Node attr lexeme) [Node attr lexeme]
    | FunctionPrototype (Node attr lexeme) lexeme [Node attr lexeme]
    | FunctionParam (Node attr lexeme) (Node attr lexeme)
    | Event lexeme (Node attr lexeme)
    | EventParams [Node attr lexeme]
    | Property (Node attr lexeme) (Node attr lexeme) [Node attr lexeme]
    | Accessor lexeme [Node attr lexeme] (Maybe (Node attr lexeme))
    | ErrorDecl lexeme [Node attr lexeme]
    | ErrorList [Node attr lexeme]
    | ErrorFor lexeme
    | Ellipsis
    -- Constants
    | ConstDecl (Node attr lexeme) lexeme
    | ConstDefn Scope (Node attr lexeme) lexeme (Node attr lexeme)
    deriving (Int -> Node attr lexeme -> ShowS
[Node attr lexeme] -> ShowS
Node attr lexeme -> String
(Int -> Node attr lexeme -> ShowS)
-> (Node attr lexeme -> String)
-> ([Node attr lexeme] -> ShowS)
-> Show (Node attr lexeme)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall attr lexeme.
(Show attr, Show lexeme) =>
Int -> Node attr lexeme -> ShowS
forall attr lexeme.
(Show attr, Show lexeme) =>
[Node attr lexeme] -> ShowS
forall attr lexeme.
(Show attr, Show lexeme) =>
Node attr lexeme -> String
showList :: [Node attr lexeme] -> ShowS
$cshowList :: forall attr lexeme.
(Show attr, Show lexeme) =>
[Node attr lexeme] -> ShowS
show :: Node attr lexeme -> String
$cshow :: forall attr lexeme.
(Show attr, Show lexeme) =>
Node attr lexeme -> String
showsPrec :: Int -> Node attr lexeme -> ShowS
$cshowsPrec :: forall attr lexeme.
(Show attr, Show lexeme) =>
Int -> Node attr lexeme -> ShowS
Show, Node attr lexeme -> Node attr lexeme -> Bool
(Node attr lexeme -> Node attr lexeme -> Bool)
-> (Node attr lexeme -> Node attr lexeme -> Bool)
-> Eq (Node attr lexeme)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall attr lexeme.
(Eq attr, Eq lexeme) =>
Node attr lexeme -> Node attr lexeme -> Bool
/= :: Node attr lexeme -> Node attr lexeme -> Bool
$c/= :: forall attr lexeme.
(Eq attr, Eq lexeme) =>
Node attr lexeme -> Node attr lexeme -> Bool
== :: Node attr lexeme -> Node attr lexeme -> Bool
$c== :: forall attr lexeme.
(Eq attr, Eq lexeme) =>
Node attr lexeme -> Node attr lexeme -> Bool
Eq, (forall x. Node attr lexeme -> Rep (Node attr lexeme) x)
-> (forall x. Rep (Node attr lexeme) x -> Node attr lexeme)
-> Generic (Node attr lexeme)
forall x. Rep (Node attr lexeme) x -> Node attr lexeme
forall x. Node attr lexeme -> Rep (Node attr lexeme) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall attr lexeme x. Rep (Node attr lexeme) x -> Node attr lexeme
forall attr lexeme x. Node attr lexeme -> Rep (Node attr lexeme) x
$cto :: forall attr lexeme x. Rep (Node attr lexeme) x -> Node attr lexeme
$cfrom :: forall attr lexeme x. Node attr lexeme -> Rep (Node attr lexeme) x
Generic, a -> Node attr b -> Node attr a
(a -> b) -> Node attr a -> Node attr b
(forall a b. (a -> b) -> Node attr a -> Node attr b)
-> (forall a b. a -> Node attr b -> Node attr a)
-> Functor (Node attr)
forall a b. a -> Node attr b -> Node attr a
forall a b. (a -> b) -> Node attr a -> Node attr b
forall attr a b. a -> Node attr b -> Node attr a
forall attr a b. (a -> b) -> Node attr a -> Node attr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Node attr b -> Node attr a
$c<$ :: forall attr a b. a -> Node attr b -> Node attr a
fmap :: (a -> b) -> Node attr a -> Node attr b
$cfmap :: forall attr a b. (a -> b) -> Node attr a -> Node attr b
Functor, Node attr a -> Bool
(a -> m) -> Node attr a -> m
(a -> b -> b) -> b -> Node attr a -> b
(forall m. Monoid m => Node attr m -> m)
-> (forall m a. Monoid m => (a -> m) -> Node attr a -> m)
-> (forall m a. Monoid m => (a -> m) -> Node attr a -> m)
-> (forall a b. (a -> b -> b) -> b -> Node attr a -> b)
-> (forall a b. (a -> b -> b) -> b -> Node attr a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node attr a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node attr a -> b)
-> (forall a. (a -> a -> a) -> Node attr a -> a)
-> (forall a. (a -> a -> a) -> Node attr a -> a)
-> (forall a. Node attr a -> [a])
-> (forall a. Node attr a -> Bool)
-> (forall a. Node attr a -> Int)
-> (forall a. Eq a => a -> Node attr a -> Bool)
-> (forall a. Ord a => Node attr a -> a)
-> (forall a. Ord a => Node attr a -> a)
-> (forall a. Num a => Node attr a -> a)
-> (forall a. Num a => Node attr a -> a)
-> Foldable (Node attr)
forall a. Eq a => a -> Node attr a -> Bool
forall a. Num a => Node attr a -> a
forall a. Ord a => Node attr a -> a
forall m. Monoid m => Node attr m -> m
forall a. Node attr a -> Bool
forall a. Node attr a -> Int
forall a. Node attr a -> [a]
forall a. (a -> a -> a) -> Node attr a -> a
forall attr a. Eq a => a -> Node attr a -> Bool
forall attr a. Num a => Node attr a -> a
forall attr a. Ord a => Node attr a -> a
forall m a. Monoid m => (a -> m) -> Node attr a -> m
forall attr m. Monoid m => Node attr m -> m
forall attr a. Node attr a -> Bool
forall attr a. Node attr a -> Int
forall attr a. Node attr a -> [a]
forall b a. (b -> a -> b) -> b -> Node attr a -> b
forall a b. (a -> b -> b) -> b -> Node attr a -> b
forall attr a. (a -> a -> a) -> Node attr a -> a
forall attr m a. Monoid m => (a -> m) -> Node attr a -> m
forall attr b a. (b -> a -> b) -> b -> Node attr a -> b
forall attr a b. (a -> b -> b) -> b -> Node attr a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Node attr a -> a
$cproduct :: forall attr a. Num a => Node attr a -> a
sum :: Node attr a -> a
$csum :: forall attr a. Num a => Node attr a -> a
minimum :: Node attr a -> a
$cminimum :: forall attr a. Ord a => Node attr a -> a
maximum :: Node attr a -> a
$cmaximum :: forall attr a. Ord a => Node attr a -> a
elem :: a -> Node attr a -> Bool
$celem :: forall attr a. Eq a => a -> Node attr a -> Bool
length :: Node attr a -> Int
$clength :: forall attr a. Node attr a -> Int
null :: Node attr a -> Bool
$cnull :: forall attr a. Node attr a -> Bool
toList :: Node attr a -> [a]
$ctoList :: forall attr a. Node attr a -> [a]
foldl1 :: (a -> a -> a) -> Node attr a -> a
$cfoldl1 :: forall attr a. (a -> a -> a) -> Node attr a -> a
foldr1 :: (a -> a -> a) -> Node attr a -> a
$cfoldr1 :: forall attr a. (a -> a -> a) -> Node attr a -> a
foldl' :: (b -> a -> b) -> b -> Node attr a -> b
$cfoldl' :: forall attr b a. (b -> a -> b) -> b -> Node attr a -> b
foldl :: (b -> a -> b) -> b -> Node attr a -> b
$cfoldl :: forall attr b a. (b -> a -> b) -> b -> Node attr a -> b
foldr' :: (a -> b -> b) -> b -> Node attr a -> b
$cfoldr' :: forall attr a b. (a -> b -> b) -> b -> Node attr a -> b
foldr :: (a -> b -> b) -> b -> Node attr a -> b
$cfoldr :: forall attr a b. (a -> b -> b) -> b -> Node attr a -> b
foldMap' :: (a -> m) -> Node attr a -> m
$cfoldMap' :: forall attr m a. Monoid m => (a -> m) -> Node attr a -> m
foldMap :: (a -> m) -> Node attr a -> m
$cfoldMap :: forall attr m a. Monoid m => (a -> m) -> Node attr a -> m
fold :: Node attr m -> m
$cfold :: forall attr m. Monoid m => Node attr m -> m
Foldable, Functor (Node attr)
Foldable (Node attr)
Functor (Node attr)
-> Foldable (Node attr)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Node attr a -> f (Node attr b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Node attr (f a) -> f (Node attr a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Node attr a -> m (Node attr b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Node attr (m a) -> m (Node attr a))
-> Traversable (Node attr)
(a -> f b) -> Node attr a -> f (Node attr b)
forall attr. Functor (Node attr)
forall attr. Foldable (Node attr)
forall attr (m :: * -> *) a.
Monad m =>
Node attr (m a) -> m (Node attr a)
forall attr (f :: * -> *) a.
Applicative f =>
Node attr (f a) -> f (Node attr a)
forall attr (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node attr a -> m (Node attr b)
forall attr (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node attr a -> f (Node attr b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Node attr (m a) -> m (Node attr a)
forall (f :: * -> *) a.
Applicative f =>
Node attr (f a) -> f (Node attr a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node attr a -> m (Node attr b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node attr a -> f (Node attr b)
sequence :: Node attr (m a) -> m (Node attr a)
$csequence :: forall attr (m :: * -> *) a.
Monad m =>
Node attr (m a) -> m (Node attr a)
mapM :: (a -> m b) -> Node attr a -> m (Node attr b)
$cmapM :: forall attr (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node attr a -> m (Node attr b)
sequenceA :: Node attr (f a) -> f (Node attr a)
$csequenceA :: forall attr (f :: * -> *) a.
Applicative f =>
Node attr (f a) -> f (Node attr a)
traverse :: (a -> f b) -> Node attr a -> f (Node attr b)
$ctraverse :: forall attr (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node attr a -> f (Node attr b)
$cp2Traversable :: forall attr. Foldable (Node attr)
$cp1Traversable :: forall attr. Functor (Node attr)
Traversable)

instance (FromJSON attr, FromJSON lexeme) => FromJSON (Node attr lexeme)
instance (ToJSON attr, ToJSON lexeme) => ToJSON (Node attr lexeme)

data AssignOp
    = AopEq
    | AopMul
    | AopDiv
    | AopPlus
    | AopMinus
    | AopBitAnd
    | AopBitOr
    | AopBitXor
    | AopMod
    | AopLsh
    | AopRsh
    deriving (Int -> AssignOp -> ShowS
[AssignOp] -> ShowS
AssignOp -> String
(Int -> AssignOp -> ShowS)
-> (AssignOp -> String) -> ([AssignOp] -> ShowS) -> Show AssignOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssignOp] -> ShowS
$cshowList :: [AssignOp] -> ShowS
show :: AssignOp -> String
$cshow :: AssignOp -> String
showsPrec :: Int -> AssignOp -> ShowS
$cshowsPrec :: Int -> AssignOp -> ShowS
Show, AssignOp -> AssignOp -> Bool
(AssignOp -> AssignOp -> Bool)
-> (AssignOp -> AssignOp -> Bool) -> Eq AssignOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssignOp -> AssignOp -> Bool
$c/= :: AssignOp -> AssignOp -> Bool
== :: AssignOp -> AssignOp -> Bool
$c== :: AssignOp -> AssignOp -> Bool
Eq, (forall x. AssignOp -> Rep AssignOp x)
-> (forall x. Rep AssignOp x -> AssignOp) -> Generic AssignOp
forall x. Rep AssignOp x -> AssignOp
forall x. AssignOp -> Rep AssignOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssignOp x -> AssignOp
$cfrom :: forall x. AssignOp -> Rep AssignOp x
Generic)

instance FromJSON AssignOp
instance ToJSON AssignOp

data BinaryOp
    = BopNe
    | BopEq
    | BopOr
    | BopBitXor
    | BopBitOr
    | BopAnd
    | BopBitAnd
    | BopDiv
    | BopMul
    | BopMod
    | BopPlus
    | BopMinus
    | BopLt
    | BopLe
    | BopLsh
    | BopGt
    | BopGe
    | BopRsh
    deriving (Int -> BinaryOp -> ShowS
[BinaryOp] -> ShowS
BinaryOp -> String
(Int -> BinaryOp -> ShowS)
-> (BinaryOp -> String) -> ([BinaryOp] -> ShowS) -> Show BinaryOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryOp] -> ShowS
$cshowList :: [BinaryOp] -> ShowS
show :: BinaryOp -> String
$cshow :: BinaryOp -> String
showsPrec :: Int -> BinaryOp -> ShowS
$cshowsPrec :: Int -> BinaryOp -> ShowS
Show, BinaryOp -> BinaryOp -> Bool
(BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> Bool) -> Eq BinaryOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinaryOp -> BinaryOp -> Bool
$c/= :: BinaryOp -> BinaryOp -> Bool
== :: BinaryOp -> BinaryOp -> Bool
$c== :: BinaryOp -> BinaryOp -> Bool
Eq, (forall x. BinaryOp -> Rep BinaryOp x)
-> (forall x. Rep BinaryOp x -> BinaryOp) -> Generic BinaryOp
forall x. Rep BinaryOp x -> BinaryOp
forall x. BinaryOp -> Rep BinaryOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinaryOp x -> BinaryOp
$cfrom :: forall x. BinaryOp -> Rep BinaryOp x
Generic)

instance FromJSON BinaryOp
instance ToJSON BinaryOp

data UnaryOp
    = UopNot
    | UopNeg
    | UopMinus
    | UopAddress
    | UopDeref
    | UopIncr
    | UopDecr
    deriving (Int -> UnaryOp -> ShowS
[UnaryOp] -> ShowS
UnaryOp -> String
(Int -> UnaryOp -> ShowS)
-> (UnaryOp -> String) -> ([UnaryOp] -> ShowS) -> Show UnaryOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnaryOp] -> ShowS
$cshowList :: [UnaryOp] -> ShowS
show :: UnaryOp -> String
$cshow :: UnaryOp -> String
showsPrec :: Int -> UnaryOp -> ShowS
$cshowsPrec :: Int -> UnaryOp -> ShowS
Show, UnaryOp -> UnaryOp -> Bool
(UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool) -> Eq UnaryOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnaryOp -> UnaryOp -> Bool
$c/= :: UnaryOp -> UnaryOp -> Bool
== :: UnaryOp -> UnaryOp -> Bool
$c== :: UnaryOp -> UnaryOp -> Bool
Eq, (forall x. UnaryOp -> Rep UnaryOp x)
-> (forall x. Rep UnaryOp x -> UnaryOp) -> Generic UnaryOp
forall x. Rep UnaryOp x -> UnaryOp
forall x. UnaryOp -> Rep UnaryOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnaryOp x -> UnaryOp
$cfrom :: forall x. UnaryOp -> Rep UnaryOp x
Generic)

instance FromJSON UnaryOp
instance ToJSON UnaryOp

data LiteralType
    = Char
    | Int
    | Bool
    | String
    | ConstId
    deriving (Int -> LiteralType -> ShowS
[LiteralType] -> ShowS
LiteralType -> String
(Int -> LiteralType -> ShowS)
-> (LiteralType -> String)
-> ([LiteralType] -> ShowS)
-> Show LiteralType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiteralType] -> ShowS
$cshowList :: [LiteralType] -> ShowS
show :: LiteralType -> String
$cshow :: LiteralType -> String
showsPrec :: Int -> LiteralType -> ShowS
$cshowsPrec :: Int -> LiteralType -> ShowS
Show, LiteralType -> LiteralType -> Bool
(LiteralType -> LiteralType -> Bool)
-> (LiteralType -> LiteralType -> Bool) -> Eq LiteralType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiteralType -> LiteralType -> Bool
$c/= :: LiteralType -> LiteralType -> Bool
== :: LiteralType -> LiteralType -> Bool
$c== :: LiteralType -> LiteralType -> Bool
Eq, (forall x. LiteralType -> Rep LiteralType x)
-> (forall x. Rep LiteralType x -> LiteralType)
-> Generic LiteralType
forall x. Rep LiteralType x -> LiteralType
forall x. LiteralType -> Rep LiteralType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiteralType x -> LiteralType
$cfrom :: forall x. LiteralType -> Rep LiteralType x
Generic)

instance FromJSON LiteralType
instance ToJSON LiteralType

data Scope
    = Global
    | Static
    deriving (Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show, Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq, (forall x. Scope -> Rep Scope x)
-> (forall x. Rep Scope x -> Scope) -> Generic Scope
forall x. Rep Scope x -> Scope
forall x. Scope -> Rep Scope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scope x -> Scope
$cfrom :: forall x. Scope -> Rep Scope x
Generic)

instance FromJSON Scope
instance ToJSON Scope

data CommentStyle
    = Regular
    | Doxygen
    | Block
    deriving (Int -> CommentStyle -> ShowS
[CommentStyle] -> ShowS
CommentStyle -> String
(Int -> CommentStyle -> ShowS)
-> (CommentStyle -> String)
-> ([CommentStyle] -> ShowS)
-> Show CommentStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentStyle] -> ShowS
$cshowList :: [CommentStyle] -> ShowS
show :: CommentStyle -> String
$cshow :: CommentStyle -> String
showsPrec :: Int -> CommentStyle -> ShowS
$cshowsPrec :: Int -> CommentStyle -> ShowS
Show, CommentStyle -> CommentStyle -> Bool
(CommentStyle -> CommentStyle -> Bool)
-> (CommentStyle -> CommentStyle -> Bool) -> Eq CommentStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentStyle -> CommentStyle -> Bool
$c/= :: CommentStyle -> CommentStyle -> Bool
== :: CommentStyle -> CommentStyle -> Bool
$c== :: CommentStyle -> CommentStyle -> Bool
Eq, (forall x. CommentStyle -> Rep CommentStyle x)
-> (forall x. Rep CommentStyle x -> CommentStyle)
-> Generic CommentStyle
forall x. Rep CommentStyle x -> CommentStyle
forall x. CommentStyle -> Rep CommentStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CommentStyle x -> CommentStyle
$cfrom :: forall x. CommentStyle -> Rep CommentStyle x
Generic)

instance FromJSON CommentStyle
instance ToJSON CommentStyle